├── doc ├── Tests.md ├── Generics.md └── Rtti.md ├── objs ├── build_ios32.bat ├── build_ios64.bat ├── build_mac32.bat ├── build_mac64.bat ├── build_win32.bat ├── build_win64.bat ├── build_linux32.bat ├── build_linux64.bat ├── build_android32.bat ├── build_android64.bat ├── sources.txt ├── omf2d.exe ├── coff2omf.exe ├── fixandroid32.exe ├── fixwin32.exe ├── android32 │ ├── tiny.rtti.o │ ├── tiny.invoke.o │ ├── tiny.types.o │ ├── tiny.types.new86.o │ ├── tiny.types.old86.o │ └── tiny.invoke.intrjumps.o ├── android64 │ ├── tiny.rtti.o │ ├── tiny.invoke.o │ ├── tiny.types.o │ ├── tiny.types.new86.o │ ├── tiny.types.old86.o │ └── tiny.invoke.intrjumps.o ├── ios32 │ ├── tiny.invoke.o │ ├── tiny.rtti.o │ ├── tiny.types.o │ ├── tiny.types.new86.o │ ├── tiny.types.old86.o │ └── tiny.invoke.intrjumps.o ├── ios64 │ ├── tiny.invoke.o │ ├── tiny.rtti.o │ ├── tiny.types.o │ ├── tiny.types.new86.o │ ├── tiny.types.old86.o │ └── tiny.invoke.intrjumps.o ├── linux32 │ ├── tiny.invoke.o │ ├── tiny.rtti.o │ ├── tiny.types.o │ ├── tiny.types.new86.o │ ├── tiny.types.old86.o │ └── tiny.invoke.intrjumps.o ├── linux64 │ ├── tiny.rtti.o │ ├── tiny.types.o │ ├── tiny.invoke.o │ ├── tiny.types.new86.o │ ├── tiny.types.old86.o │ └── tiny.invoke.intrjumps.o ├── mac32 │ ├── tiny.invoke.o │ ├── tiny.rtti.o │ ├── tiny.types.o │ ├── tiny.types.new86.o │ ├── tiny.types.old86.o │ └── tiny.invoke.intrjumps.o ├── mac64 │ ├── tiny.invoke.o │ ├── tiny.rtti.o │ ├── tiny.types.o │ ├── tiny.types.new86.o │ ├── tiny.types.old86.o │ └── tiny.invoke.intrjumps.o ├── win32 │ ├── tiny.invoke.o │ ├── tiny.rtti.o │ ├── tiny.types.o │ ├── tiny.types.new86.o │ ├── tiny.types.old86.o │ └── tiny.invoke.intrjumps.o ├── win64 │ ├── tiny.invoke.o │ ├── tiny.rtti.o │ ├── tiny.types.o │ ├── tiny.types.new86.o │ ├── tiny.types.old86.o │ └── tiny.invoke.intrjumps.o ├── build_all.bat ├── fixandroid32.dpr ├── compiler.bat └── fixwin32.dpr ├── data ├── general │ ├── cache │ │ ├── Total.png │ │ ├── FileReading.png │ │ ├── FileWriting.png │ │ └── CachedBufferMemory.png │ └── Move.png ├── Delphi.jpg ├── Benchmarks.xlsx ├── rtti │ ├── Invoke.png │ ├── Total.png │ ├── Values.png │ ├── FlexString.png │ └── VirtualInterface.png ├── text │ ├── Total.png │ ├── FileConversion.png │ ├── StringComparison.png │ ├── StringConversion.png │ └── TypeConversion.png ├── DelphiOriginal.jpg ├── generics │ ├── Sortings.png │ ├── Total.png │ ├── Containers.png │ └── Dictionaries.png └── archives │ └── CachedSerializer.zip ├── demo ├── text │ ├── FileConversion.dpr │ ├── StringComparison.dpr │ ├── StringConversion.dpr │ ├── FileReaders.dpr │ ├── FileWriters.dpr │ └── ToStrings.dpr ├── rtti │ ├── Invoke.dpr │ ├── VirtualInterface.dpr │ ├── frmInvoke.fmx │ ├── frmVirtualInterface.fmx │ ├── frmInvoke.pas │ └── frmVirtualInterface.pas ├── generics │ ├── Sortings.dpr │ ├── Containers.dpr │ ├── Dictionaries.dpr │ ├── uSortings.pas │ └── uDictionaries.pas └── general │ ├── move │ ├── Move.dpr │ ├── frmMove.fmx │ ├── frmMove.pas │ └── Move.lpi │ └── cache │ ├── FileReading.dof │ ├── FileWriting.dof │ ├── FileReading.dpr │ └── FileWriting.dpr ├── thirdparty ├── Cromis │ ├── Cromis.Detours.pas │ └── Cromis.Unicode.pas └── OTL │ ├── OtlOptions.inc │ └── OtlCommon.Utils.pas ├── utilities └── cached_serializer │ ├── examples │ ├── simple2.txt │ ├── null_terminated1.txt │ ├── simple1.txt │ ├── null_terminated2.txt │ ├── utf16code_ignorecase.txt │ ├── simplecode_ignorecase.txt │ ├── html_tags.txt │ └── xml_encodings.txt │ └── CachedSerializer.dpr ├── .gitattributes ├── c ├── rtti │ ├── tiny.invoke.intrjumps.h │ ├── tiny.invoke.intrjumps.c │ └── tiny.rtti.h ├── tiny.header.h ├── tiny.types.old86.c └── tiny.types.new86.c ├── LICENSE ├── .gitignore ├── Tiny.Test.pas ├── Tiny.Marshalling.pas ├── Tiny.Classes.pas ├── codegen ├── rtti │ ├── InvokeTypes.dpr │ └── InterceptJumps.dpr └── uCommon.pas ├── Tiny.Namespace.pas ├── README.md └── TINY.DEFINES.inc /doc/Tests.md: -------------------------------------------------------------------------------- 1 | ### Concept -------------------------------------------------------------------------------- /objs/build_ios32.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | call compiler "ios32" "sources.txt" "..\c\" 3 | pause -------------------------------------------------------------------------------- /objs/build_ios64.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | call compiler "ios64" "sources.txt" "..\c\" 3 | pause -------------------------------------------------------------------------------- /objs/build_mac32.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | call compiler "mac32" "sources.txt" "..\c\" 3 | pause -------------------------------------------------------------------------------- /objs/build_mac64.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | call compiler "mac64" "sources.txt" "..\c\" 3 | pause -------------------------------------------------------------------------------- /objs/build_win32.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | call compiler "win32" "sources.txt" "..\c\" 3 | pause -------------------------------------------------------------------------------- /objs/build_win64.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | call compiler "win64" "sources.txt" "..\c\" 3 | pause -------------------------------------------------------------------------------- /objs/build_linux32.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | call compiler "linux32" "sources.txt" "..\c\" 3 | pause -------------------------------------------------------------------------------- /objs/build_linux64.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | call compiler "linux64" "sources.txt" "..\c\" 3 | pause -------------------------------------------------------------------------------- /objs/build_android32.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | call compiler "android32" "sources.txt" "..\c\" 3 | pause -------------------------------------------------------------------------------- /objs/build_android64.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | call compiler "android64" "sources.txt" "..\c\" 3 | pause -------------------------------------------------------------------------------- /data/general/cache/Total.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/d-mozulyov/Tiny.Library/HEAD/data/general/cache/Total.png -------------------------------------------------------------------------------- /demo/text/FileConversion.dpr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/d-mozulyov/Tiny.Library/HEAD/demo/text/FileConversion.dpr -------------------------------------------------------------------------------- /demo/text/StringComparison.dpr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/d-mozulyov/Tiny.Library/HEAD/demo/text/StringComparison.dpr -------------------------------------------------------------------------------- /demo/text/StringConversion.dpr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/d-mozulyov/Tiny.Library/HEAD/demo/text/StringConversion.dpr -------------------------------------------------------------------------------- /data/general/cache/FileReading.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/d-mozulyov/Tiny.Library/HEAD/data/general/cache/FileReading.png -------------------------------------------------------------------------------- /data/general/cache/FileWriting.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/d-mozulyov/Tiny.Library/HEAD/data/general/cache/FileWriting.png -------------------------------------------------------------------------------- /thirdparty/Cromis/Cromis.Detours.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/d-mozulyov/Tiny.Library/HEAD/thirdparty/Cromis/Cromis.Detours.pas -------------------------------------------------------------------------------- /utilities/cached_serializer/examples/simple2.txt: -------------------------------------------------------------------------------- 1 | -ansi -f"ValueToEnum:tk:TTagKind" 2 | sheet 3 | row 4 | cell 5 | data 6 | value 7 | style -------------------------------------------------------------------------------- /data/general/cache/CachedBufferMemory.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/d-mozulyov/Tiny.Library/HEAD/data/general/cache/CachedBufferMemory.png -------------------------------------------------------------------------------- /utilities/cached_serializer/examples/null_terminated1.txt: -------------------------------------------------------------------------------- 1 | -ansi -f"ValueToID:ID_" -p"S:0" 2 | sheet 3 | row 4 | cell 5 | data 6 | value 7 | style -------------------------------------------------------------------------------- /objs/sources.txt: -------------------------------------------------------------------------------- 1 | tiny.types.c 2 | tiny.types.old86.c 3 | tiny.types.new86.c 4 | rtti/tiny.rtti.c 5 | rtti/tiny.invoke.c 6 | rtti/tiny.invoke.intrjumps.c -------------------------------------------------------------------------------- /data/Delphi.jpg: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:953a2c199a472268093761840c565ceaef5f92f8544f1f01b574bd95aa54aa15 3 | size 104176 4 | -------------------------------------------------------------------------------- /objs/omf2d.exe: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:ca44def33099b51c89a38422c04567ed23e4adf9aea898ba9e955000292a956f 3 | size 39424 4 | -------------------------------------------------------------------------------- /utilities/cached_serializer/examples/simple1.txt: -------------------------------------------------------------------------------- 1 | -ansi -f"ValueToID-AnsiString:ID_" -p"S:Length(S)" 2 | sheet 3 | row 4 | cell 5 | data 6 | value 7 | style -------------------------------------------------------------------------------- /data/Benchmarks.xlsx: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:4865915378ba863bf260dc0f0db6a821fb358a5ccfa76ecbc8f4b2c6471814c9 3 | size 27564 4 | -------------------------------------------------------------------------------- /data/general/Move.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:c0eebab783c9e96ac4639d8895caf03104aad19694d06fefcb456efd148e224d 3 | size 18709 4 | -------------------------------------------------------------------------------- /data/rtti/Invoke.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:0a5c353b914d7e04fcadc9380201a06737c56b180448a80552684b06e2445328 3 | size 6274 4 | -------------------------------------------------------------------------------- /data/rtti/Total.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:3b69abf589f353f7929dcb6cf4af286659b2271a4c33d7e16f8d7d1972a044b5 3 | size 33804 4 | -------------------------------------------------------------------------------- /data/rtti/Values.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:12f9c5faf20d9b1d98db6615f3a59e319e4af33f905bf42470cc2dccee7c489a 3 | size 21094 4 | -------------------------------------------------------------------------------- /data/text/Total.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:691674c00495d77080f3545deb37423ed45933318bb05e47a6505ed7d22af8e6 3 | size 36164 4 | -------------------------------------------------------------------------------- /objs/coff2omf.exe: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:7abb47159fe487bba2d5cea587d2d6ebf2b4413c86f15934d91004d78fbaa3eb 3 | size 60928 4 | -------------------------------------------------------------------------------- /objs/fixandroid32.exe: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:067a43156d93cbd2885edc884246b7556f621e056888505e32442a7d8a41f63e 3 | size 44032 4 | -------------------------------------------------------------------------------- /objs/fixwin32.exe: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:b1fcbdaad9372f2e04a7a5933715b6f2064b96c50ccc27ac6a18c9d777740b78 3 | size 46080 4 | -------------------------------------------------------------------------------- /data/DelphiOriginal.jpg: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:5f272c5b5f8b7a3d4bf4e070dcfa46d5269e5f2b2ea9ea1e7cd9ebf715ac2b5e 3 | size 557038 4 | -------------------------------------------------------------------------------- /data/generics/Sortings.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:039ef2f5f2819359494da9417b30262f7dcfbc3059e99b3772aede1a862496d2 3 | size 16472 4 | -------------------------------------------------------------------------------- /data/generics/Total.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:66bc73665f271e3c3e14539b14a9208c245e7b9b19568ac4c4681c0ef4b8990f 3 | size 18022 4 | -------------------------------------------------------------------------------- /data/rtti/FlexString.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:107b70ffa9a07ba0446160350e7d42ca32b0838c4b5bc6ad8314d3152eebe256 3 | size 8830 4 | -------------------------------------------------------------------------------- /objs/android32/tiny.rtti.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:7d1659e340777882972136286429feb5c882d38d82669454b3a436867c062d38 3 | size 24800 4 | -------------------------------------------------------------------------------- /objs/android64/tiny.rtti.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:b84fb5f2b290ef7f4ba1a213d74bfb05c16e928213ac47714021891593dc3e4e 3 | size 33016 4 | -------------------------------------------------------------------------------- /objs/ios32/tiny.invoke.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:20c89383122597cff783b0dae69f9497468ec9cf420883b52f46e5fd76077d32 3 | size 37336 4 | -------------------------------------------------------------------------------- /objs/ios32/tiny.rtti.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:7372ea4d46caa9b026fc8873df4c42d63eee6ee70ba3936fa6380bef667ef223 3 | size 36696 4 | -------------------------------------------------------------------------------- /objs/ios32/tiny.types.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:10e48f77015f18f4fef39815c273a6e40cf6f314671e2f70b10dceb268616f67 3 | size 23360 4 | -------------------------------------------------------------------------------- /objs/ios64/tiny.invoke.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:8de797501c107a65bbe7ccb20deae2d8a946350e2f58845a385719f66694d192 3 | size 43944 4 | -------------------------------------------------------------------------------- /objs/ios64/tiny.rtti.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:bd27875cf29085e545929686482d1f77b823024a140ae6f2e48cc31533f94722 3 | size 31204 4 | -------------------------------------------------------------------------------- /objs/ios64/tiny.types.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:58ab1bdad9e10bed3436ba845843c49808ce00a4c0c944839185c973806ee79c 3 | size 20612 4 | -------------------------------------------------------------------------------- /objs/linux32/tiny.invoke.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:ba4cdf0881d283a4312faa0c96342d75ce1950c06af3d962a4929f71f2297e88 3 | size 22732 4 | -------------------------------------------------------------------------------- /objs/linux32/tiny.rtti.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:af15c2efd6142ca82f31248bc5f7748571dfa677bd02946d468eee032985702b 3 | size 22860 4 | -------------------------------------------------------------------------------- /objs/linux32/tiny.types.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:e658de381a9e95300f1ccacad509d49c0b3c214f226a249184c899f0daa28974 3 | size 13108 4 | -------------------------------------------------------------------------------- /objs/linux64/tiny.rtti.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:f3c35403a5e4ac7dc97f73d97cb65fade6b241e56ce63a38fe320bb6f1aa0a99 3 | size 36808 4 | -------------------------------------------------------------------------------- /objs/linux64/tiny.types.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:514626613efd31affef544f6a9318f4d58a52d8178911d5bd0656e318f7ffc3d 3 | size 21304 4 | -------------------------------------------------------------------------------- /objs/mac32/tiny.invoke.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:a951785a59a9a88d3d78033ca62505363f1d713e9733982ca5db7fc13ae1db6f 3 | size 23556 4 | -------------------------------------------------------------------------------- /objs/mac32/tiny.rtti.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:7657e5c0407d5795a0e714ed1463cdc30f549f81a7e8039f4e295afeeba6e22f 3 | size 27992 4 | -------------------------------------------------------------------------------- /objs/mac32/tiny.types.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:e58ffd7b4dbfca1155c0c4b31e6e2c24800aa75c4190eba6fc26517acaf80b69 3 | size 17672 4 | -------------------------------------------------------------------------------- /objs/mac64/tiny.invoke.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:85cbb4986782203e26c469c10d929426cefc9e8029f2c4cec7979ee51b35f6c1 3 | size 72012 4 | -------------------------------------------------------------------------------- /objs/mac64/tiny.rtti.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:3800dadd635cb3f07cb9a0c9a84c20aac6a64dd9aaad5f8e3bbb9ad2e2c94d28 3 | size 26792 4 | -------------------------------------------------------------------------------- /objs/mac64/tiny.types.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:e3be0e1e47f71e8817aae79ee86d748136690a5a237a480441798ca3d3c5f525 3 | size 18524 4 | -------------------------------------------------------------------------------- /objs/win32/tiny.invoke.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:3634029c42a3037c1cc3a5cffa0d231300a386dcb406aa9f4fdcad8d123b7856 3 | size 20373 4 | -------------------------------------------------------------------------------- /objs/win32/tiny.rtti.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:62db086f21850a7bd22f44027b8aee4bdb11b519023246005260ce4559764d6b 3 | size 22930 4 | -------------------------------------------------------------------------------- /objs/win32/tiny.types.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:78bb45bc7ca7f2b660087fc1fa55512ceaa3dd5178affebcd76c07dc446fc231 3 | size 12196 4 | -------------------------------------------------------------------------------- /objs/win64/tiny.invoke.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:43d904455d5ef08f281a473d0b3732f1a55d1a7e75d367f7260a89c916da4074 3 | size 42769 4 | -------------------------------------------------------------------------------- /objs/win64/tiny.rtti.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:27c9a1e488ebd38d4a3a3d9a89b7f8a6e12e7493267e53715913f961cf3ca2ea 3 | size 25581 4 | -------------------------------------------------------------------------------- /objs/win64/tiny.types.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:91245a434b8c15b6fedbecc5e6e0fd2fc0939cb583e6b659d7664628b20d87ea 3 | size 18493 4 | -------------------------------------------------------------------------------- /utilities/cached_serializer/examples/null_terminated2.txt: -------------------------------------------------------------------------------- 1 | -utf8 -i -f"ValueToEnum-PUTF8Char:tk:TTagKind" -p"S:4" 2 | sheet 3 | row 4 | cell 5 | data 6 | value 7 | style -------------------------------------------------------------------------------- /data/generics/Containers.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:66bc73665f271e3c3e14539b14a9208c245e7b9b19568ac4c4681c0ef4b8990f 3 | size 18022 4 | -------------------------------------------------------------------------------- /data/generics/Dictionaries.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:095f3b04f8a0e8be741d49a6d2053e8dbf08b5f0f8de57cb18d036c03266e617 3 | size 25394 4 | -------------------------------------------------------------------------------- /data/rtti/VirtualInterface.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:fad8303fd1a5898695ba84946600f4bab15fd67f10590ea5d08fb474b2685925 3 | size 5830 4 | -------------------------------------------------------------------------------- /data/text/FileConversion.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:25b5c52433429489f8bdd5d5bf7d404099218577e1173af57176ca0d0dd5ad1e 3 | size 11912 4 | -------------------------------------------------------------------------------- /data/text/StringComparison.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:bf2ec67897a10d719559e669b901d8d269f2288a23143f547c36293088b572f3 3 | size 20220 4 | -------------------------------------------------------------------------------- /data/text/StringConversion.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:24674531cebf425c5f50bb90581af9c23b14dc0ff10a451e4e93d04d37f84aba 3 | size 16316 4 | -------------------------------------------------------------------------------- /data/text/TypeConversion.png: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:a696070b5a9074d71e1e2f1b6c67441442a45c0789083d0a6cb2e5f97f1285fe 3 | size 18829 4 | -------------------------------------------------------------------------------- /objs/android32/tiny.invoke.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:373305ce6fe066b5deba7a93bde5453803cf2def7dc70c3998aeba9690e04b6c 3 | size 30428 4 | -------------------------------------------------------------------------------- /objs/android32/tiny.types.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:5342c9ba5e2a662600adb79d594e7967894cd627be192e1360be72f6669627fe 3 | size 16876 4 | -------------------------------------------------------------------------------- /objs/android64/tiny.invoke.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:f945afd1cb838aab29ca7bebce541268c91a6f1855c8f175df1a0d2e5789bd95 3 | size 48144 4 | -------------------------------------------------------------------------------- /objs/android64/tiny.types.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:1d611056cab000509728aa327cd884289edecf6d31c9dbceaa7a47ad8a14d230 3 | size 23040 4 | -------------------------------------------------------------------------------- /objs/ios32/tiny.types.new86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:16f2a0c40a38f88b0f1a91442790924015a7f8f02c2f0743c360c494c973772d 3 | size 944 4 | -------------------------------------------------------------------------------- /objs/ios32/tiny.types.old86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:16f2a0c40a38f88b0f1a91442790924015a7f8f02c2f0743c360c494c973772d 3 | size 944 4 | -------------------------------------------------------------------------------- /objs/ios64/tiny.types.new86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:10467d4733ef8f6eac1add81f92b6fe12de642ee8b869e2e5a9b9893b03e8b79 3 | size 1112 4 | -------------------------------------------------------------------------------- /objs/ios64/tiny.types.old86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:10467d4733ef8f6eac1add81f92b6fe12de642ee8b869e2e5a9b9893b03e8b79 3 | size 1112 4 | -------------------------------------------------------------------------------- /objs/linux32/tiny.types.new86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:28647dd705ee996aecb5a879572296edaa7389512dd4451474e4108b2e6e6e48 3 | size 1252 4 | -------------------------------------------------------------------------------- /objs/linux32/tiny.types.old86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:a4b91c9a10cd4d073acc52171ee14d88fc1c2496332a4699800e16f3c80f53a8 3 | size 1252 4 | -------------------------------------------------------------------------------- /objs/linux64/tiny.invoke.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:8d71f83c110c5cc4b3c45a7d77871c861fb5f9f85f7a7783cf06454e5518719e 3 | size 172176 4 | -------------------------------------------------------------------------------- /objs/linux64/tiny.types.new86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:8acfd13abb6aa338321decf4ffcf3ee0639cede80b4afa68d71772a546ed6f65 3 | size 1648 4 | -------------------------------------------------------------------------------- /objs/linux64/tiny.types.old86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:3b97d2d94e03f013ada951c1de68ed91e121d4ab84ee193c94aaf79b24993d40 3 | size 1648 4 | -------------------------------------------------------------------------------- /objs/mac32/tiny.types.new86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:050b27a93b7a431eb82f55da4c80031ece759ac7aef9110a534ddfd6abdb2e9c 3 | size 960 4 | -------------------------------------------------------------------------------- /objs/mac32/tiny.types.old86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:050b27a93b7a431eb82f55da4c80031ece759ac7aef9110a534ddfd6abdb2e9c 3 | size 960 4 | -------------------------------------------------------------------------------- /objs/mac64/tiny.types.new86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:0ca2c1cc677ee46c7dc542fbc79b3e236ab9a26ee310fa4eb6698dd50f26304a 3 | size 1092 4 | -------------------------------------------------------------------------------- /objs/mac64/tiny.types.old86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:0ca2c1cc677ee46c7dc542fbc79b3e236ab9a26ee310fa4eb6698dd50f26304a 3 | size 1092 4 | -------------------------------------------------------------------------------- /objs/win32/tiny.types.new86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:f2d6756099094382db0401ed6c0a59046e74b5da51ca55406b72b23130a75250 3 | size 3124 4 | -------------------------------------------------------------------------------- /objs/win32/tiny.types.old86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:0edacda8b0e9353da0ba96b01ed7b0d7c3bffca73dceca86e9604347c5e4c607 3 | size 2421 4 | -------------------------------------------------------------------------------- /objs/win64/tiny.types.new86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:278277b5272178676d1451eece39c1e77eb5396110f853b1599774aeaf8a307c 3 | size 2165 4 | -------------------------------------------------------------------------------- /objs/win64/tiny.types.old86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:6d5e7311421acd1d69fd895db7fefec5107cdea80eeefc844c1ce6cf0f6dea99 3 | size 2165 4 | -------------------------------------------------------------------------------- /data/archives/CachedSerializer.zip: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:5e04cd0e214c04c7433f29d1878095b253433302a2197fb01da691430b5d70d5 3 | size 154165 4 | -------------------------------------------------------------------------------- /objs/android32/tiny.types.new86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:f25c38346c5b7543c5300fc6d460f3b9d6f2fe4254e20b5a22b8ce1a79754fd4 3 | size 1316 4 | -------------------------------------------------------------------------------- /objs/android32/tiny.types.old86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:46949de82e7123b2b0d9024a4c617744154705a49c48bf27b71a8b3b1e06020d 3 | size 1316 4 | -------------------------------------------------------------------------------- /objs/android64/tiny.types.new86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:0092c89cd3a26f657ecfdd98c82473b1d57c8316d0389f58228b97e32a7d0744 3 | size 1600 4 | -------------------------------------------------------------------------------- /objs/android64/tiny.types.old86.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:b1fbddd9b89b8199d6abf2bebe6b898ad2f06e2dd172e308346f776a7217ce25 3 | size 1600 4 | -------------------------------------------------------------------------------- /objs/ios32/tiny.invoke.intrjumps.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:d7cdea51c1447c58d080a4bfbc339e592f1cb123501af6633711aa1f14ede970 3 | size 115012 4 | -------------------------------------------------------------------------------- /objs/ios64/tiny.invoke.intrjumps.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:81ac5dc3944a18eb55b66b2d3eba1bd8eff4d487e980d63e2b4ce5b1fd876b5c 3 | size 127568 4 | -------------------------------------------------------------------------------- /objs/linux32/tiny.invoke.intrjumps.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:9958bca48719fd8ba58e5028829a54b4e97d26603bd7ada2960048795cc74b2e 3 | size 83460 4 | -------------------------------------------------------------------------------- /objs/mac32/tiny.invoke.intrjumps.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:cf47ae00966169d4029ef5dbebd27998da7399df8f54a69e42c1829e83599a67 3 | size 98636 4 | -------------------------------------------------------------------------------- /objs/mac64/tiny.invoke.intrjumps.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:8026782edc3966e823d052f0fc9f1e9e4d4fdf18effd530c7dace1b60817793a 3 | size 119308 4 | -------------------------------------------------------------------------------- /objs/win32/tiny.invoke.intrjumps.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:b4a1ed335218da8b70d72ab19104eff7e79daea53223edfe0cb2bf0f2dfe591a 3 | size 95238 4 | -------------------------------------------------------------------------------- /objs/win64/tiny.invoke.intrjumps.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:d9b057af14cc1980bfbd7c515ceeb675898140beee92477432b36cdec5c9b62b 3 | size 76217 4 | -------------------------------------------------------------------------------- /objs/android32/tiny.invoke.intrjumps.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:fb1fbeb33f1587fd37217625896f08b16ae6f1de9bfa87dae02aa1dcb73a68da 3 | size 81724 4 | -------------------------------------------------------------------------------- /objs/android64/tiny.invoke.intrjumps.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:02d83abae7c8e62c4c80e8f9354dc962f4c1114659154e1895a604a06395d617 3 | size 110744 4 | -------------------------------------------------------------------------------- /objs/linux64/tiny.invoke.intrjumps.o: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:e894ebdb3670dffb20a310bd366ccd86c22626983be5ca2b4a843cc876cac5e6 3 | size 157928 4 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | data/* filter=lfs diff=lfs merge=lfs -text 2 | data/*/* filter=lfs diff=lfs merge=lfs -text 3 | objs/*.exe filter=lfs diff=lfs merge=lfs -text 4 | objs/*/*.o filter=lfs diff=lfs merge=lfs -text -------------------------------------------------------------------------------- /demo/rtti/Invoke.dpr: -------------------------------------------------------------------------------- 1 | program Invoke; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | frmInvoke in 'frmInvoke.pas' {Form1}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TForm1, Form1); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /demo/rtti/VirtualInterface.dpr: -------------------------------------------------------------------------------- 1 | program VirtualInterface; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | frmVirtualInterface in 'frmVirtualInterface.pas' {Form1}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TForm1, Form1); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /c/rtti/tiny.invoke.intrjumps.h: -------------------------------------------------------------------------------- 1 | 2 | #ifndef tiny_intrjumps_h 3 | #define tiny_intrjumps_h 4 | 5 | #include "../tiny.defines.h" 6 | #include "../tiny.types.h" 7 | #include "tiny.rtti.h" 8 | 9 | /* 10 | Get appropriate interception jump 11 | */ 12 | REGISTER_DECL void* get_intercept_jump(int32_t index, int32_t mode); 13 | 14 | #endif 15 | -------------------------------------------------------------------------------- /demo/rtti/frmInvoke.fmx: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 329 6 | ClientWidth = 640 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | DesignerMasterStyle = 0 11 | object Button1: TButton 12 | Position.X = 224.000000000000000000 13 | Position.Y = 176.000000000000000000 14 | TabOrder = 1 15 | Text = 'Button1' 16 | OnClick = Button1Click 17 | end 18 | end 19 | -------------------------------------------------------------------------------- /demo/rtti/frmVirtualInterface.fmx: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 329 6 | ClientWidth = 640 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | DesignerMasterStyle = 0 11 | object Button1: TButton 12 | Position.X = 224.000000000000000000 13 | Position.Y = 176.000000000000000000 14 | TabOrder = 1 15 | Text = 'Button1' 16 | OnClick = Button1Click 17 | end 18 | end 19 | -------------------------------------------------------------------------------- /demo/generics/Sortings.dpr: -------------------------------------------------------------------------------- 1 | program Sortings; 2 | 3 | {$I TINY.DEFINES.inc} 4 | {$APPTYPE CONSOLE} 5 | 6 | uses 7 | System.SysUtils, 8 | Tiny.Generics in '..\..\Tiny.Generics.pas', 9 | uSortings in 'uSortings.pas'; 10 | 11 | begin 12 | try 13 | Run; 14 | except 15 | on E: Exception do 16 | Writeln(E.ClassName, ': ', E.Message); 17 | end; 18 | 19 | if (ParamStr(1) <> '-nowait') then 20 | begin 21 | Writeln; 22 | Write('Press Enter to quit'); 23 | Readln; 24 | end; 25 | end. 26 | -------------------------------------------------------------------------------- /objs/build_all.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | call compiler "win32" "sources.txt" "..\c\" 3 | call compiler "win64" "sources.txt" "..\c\" 4 | call compiler "mac32" "sources.txt" "..\c\" 5 | call compiler "mac64" "sources.txt" "..\c\" 6 | call compiler "linux32" "sources.txt" "..\c\" 7 | call compiler "linux64" "sources.txt" "..\c\" 8 | call compiler "android32" "sources.txt" "..\c\" 9 | call compiler "android64" "sources.txt" "..\c\" 10 | call compiler "ios32" "sources.txt" "..\c\" 11 | call compiler "ios64" "sources.txt" "..\c\" 12 | pause -------------------------------------------------------------------------------- /demo/generics/Containers.dpr: -------------------------------------------------------------------------------- 1 | program Containers; 2 | 3 | {$I TINY.DEFINES.inc} 4 | {$APPTYPE CONSOLE} 5 | 6 | uses 7 | System.SysUtils, 8 | Tiny.Generics in '..\..\Tiny.Generics.pas', 9 | uContainers in 'uContainers.pas'; 10 | 11 | begin 12 | try 13 | Run; 14 | except 15 | on E: Exception do 16 | Writeln(E.ClassName, ': ', E.Message); 17 | end; 18 | 19 | if (ParamStr(1) <> '-nowait') then 20 | begin 21 | Writeln; 22 | Write('Press Enter to quit'); 23 | Readln; 24 | end; 25 | end. 26 | -------------------------------------------------------------------------------- /demo/generics/Dictionaries.dpr: -------------------------------------------------------------------------------- 1 | program Dictionaries; 2 | 3 | {$I TINY.DEFINES.inc} 4 | {$APPTYPE CONSOLE} 5 | 6 | uses 7 | System.SysUtils, 8 | Tiny.Generics in '..\..\Tiny.Generics.pas', 9 | uDictionaries in 'uDictionaries.pas'; 10 | 11 | begin 12 | try 13 | Run; 14 | except 15 | on E: Exception do 16 | Writeln(E.ClassName, ': ', E.Message); 17 | end; 18 | 19 | if (ParamStr(1) <> '-nowait') then 20 | begin 21 | Writeln; 22 | Write('Press Enter to quit'); 23 | Readln; 24 | end; 25 | end. 26 | -------------------------------------------------------------------------------- /demo/general/move/Move.dpr: -------------------------------------------------------------------------------- 1 | program Move; 2 | 3 | {$I TINY.DEFINES.inc} 4 | {$WARNINGS OFF} 5 | 6 | {$ifdef CPUARM} 7 | uses 8 | System.StartUpCopy, 9 | FMX.Forms, 10 | frmMove {Form1}; 11 | 12 | begin 13 | Application.Initialize; 14 | Application.CreateForm(TForm1, Form1); 15 | Application.Run; 16 | end. 17 | {$else .CONSOLE} 18 | 19 | {$APPTYPE CONSOLE} 20 | uses 21 | uMove; 22 | 23 | procedure Log(const AMessage: string); 24 | begin 25 | Writeln(AMessage); 26 | end; 27 | 28 | begin 29 | uMove.LogProc := Log; 30 | uMove.Run; 31 | 32 | Writeln; 33 | Write('Press Enter to quit'); 34 | Readln; 35 | end. 36 | {$endif} 37 | -------------------------------------------------------------------------------- /utilities/cached_serializer/examples/utf16code_ignorecase.txt: -------------------------------------------------------------------------------- 1 | -utf16 -i -p"Params.Name:Length(Params.Name)" 2 | 3 | -p::case Params.Count of\n 1\: FillSerializeParams(Params.O1 + '.Chars', Params.O1 + '.Length', 0);\n 2\: FillSerializeParams(Params.O1, Params.O2, 0);\n 3\: if (StrToIntDef(Params.O3, -1) >= 0) then\n FillSerializeParams(Params.O1, Params.O2, StrToInt(Params.O3));\nelse\n Exit;\nend; 4 | -i::IgnoreCase \:= True; 5 | -f::UseFuncHeaders \:= True;\ngoto func_params; 6 | -fn::UseFuncHeaders \:= False;\nfunc_params\:\ncase Params.Count of\n 2\: FillFuncParams(Params.O1, Params.O2, '');\n 3\: FillFuncParams(Params.O1, Params.O2, Params.O3);\nelse\n Exit;\nend; 7 | -s::case Params.Count of\n 1\: FileName \:= Params.O1;\n 2\: FileName \:= Params.O1 + Params.O2;\nelse\n Exit;\nend; -------------------------------------------------------------------------------- /doc/Generics.md: -------------------------------------------------------------------------------- 1 | ### Concept 2 | 3 | The _Tiny.Generics.pas_ unit was created in almost full compliance with the standard Delphi generics. The advantageous differences of the unit are performance, compactness and additional features. You may easily replace the standard `Generics.Collections` and` Generics.Defaults` units in your projects with `Tiny.Generics`. 4 | 5 | ### Note 6 | Do not use generics in the \*.dpr-files for XE8 or XE10 Seattle compilers: _QC#103798_. 7 | 8 | ### TRapidDictionary/TRapidObjectDictionary 9 | Rapid "inline" `TDictionary`/`TObjectDictionary` equivalents with default hash codes and comparers 10 | 11 | ### Benchmarks: dictionaries 12 | ![](../data/generics/Dictionaries.png) 13 | 14 | ### Benchmarks: containers 15 | ![](../data/generics/Containers.png) 16 | 17 | ### Benchmarks: sortings 18 | ![](../data/generics/Sortings.png) -------------------------------------------------------------------------------- /demo/general/move/frmMove.fmx: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 480 6 | ClientWidth = 640 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | OnCreate = FormCreate 11 | DesignerMasterStyle = 0 12 | object btnRun: TButton 13 | Position.X = 8.000000000000000000 14 | Position.Y = 216.000000000000000000 15 | TabOrder = 0 16 | Text = 'Run' 17 | OnClick = btnRunClick 18 | end 19 | object memLog: TMemo 20 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 21 | DataDetectorTypes = [] 22 | Align = Top 23 | Size.Width = 640.000000000000000000 24 | Size.Height = 201.000000000000000000 25 | Size.PlatformDefault = False 26 | TabOrder = 1 27 | Viewport.Width = 636.000000000000000000 28 | Viewport.Height = 197.000000000000000000 29 | end 30 | end 31 | -------------------------------------------------------------------------------- /utilities/cached_serializer/examples/simplecode_ignorecase.txt: -------------------------------------------------------------------------------- 1 | -p"A:ALength:2" -i 2 | 3 | -ansi::Enc \:= 0; 4 | -utf8::Enc \:= CODEPAGE_UTF8; 5 | -utf16::Enc \:= CODEPAGE_UTF16; 6 | -utf32::Enc \:= CODEPAGE_UTF32; 7 | -raw::Enc \:= CODEPAGE_RAWDATA; 8 | -874::Enc \:= 874; 9 | -1250::Enc \:= 1250; 10 | -1251::Enc \:= 1251; 11 | -1252::Enc \:= 1252; 12 | -1253::Enc \:= 1253; 13 | -1254::Enc \:= 1254; 14 | -1255::Enc \:= 1255; 15 | -1256::Enc \:= 1256; 16 | -1257::Enc \:= 1257; 17 | -1258::Enc \:= 1258; 18 | -866::Enc \:= 866; 19 | -28592::Enc \:= 28592; 20 | -28593::Enc \:= 28593; 21 | -28594::Enc \:= 28594; 22 | -28595::Enc \:= 28595; 23 | -28596::Enc \:= 28596; 24 | -28597::Enc \:= 28597; 25 | -28598::Enc \:= 28598; 26 | -28600::Enc \:= 28600; 27 | -28603::Enc \:= 28603; 28 | -28604::Enc \:= 28604; 29 | -28605::Enc \:= 28605; 30 | -28606::Enc \:= 28606; 31 | -20866::Enc \:= 20866; 32 | -21866::Enc \:= 21866; 33 | -10000::Enc \:= 10000; 34 | -10007::Enc \:= 10007; 35 | -user::Enc \:= CODEPAGE_USERDEFINED; 36 | -------------------------------------------------------------------------------- /demo/general/move/frmMove.pas: -------------------------------------------------------------------------------- 1 | unit frmMove; 2 | 3 | {$I TINY.DEFINES.inc} 4 | 5 | interface 6 | 7 | uses 8 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 9 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.ScrollBox, 10 | FMX.Memo, FMX.Controls.Presentation, FMX.StdCtrls, uMove; 11 | 12 | type 13 | TForm1 = class(TForm) 14 | btnRun: TButton; 15 | memLog: TMemo; 16 | procedure FormCreate(Sender: TObject); 17 | procedure btnRunClick(Sender: TObject); 18 | private 19 | { Private declarations } 20 | public 21 | { Public declarations } 22 | end; 23 | 24 | var 25 | Form1: TForm1; 26 | 27 | implementation 28 | 29 | {$R *.fmx} 30 | 31 | procedure Log(const AMessage: string); 32 | begin 33 | Form1.memLog.Lines.Add(AMessage) 34 | end; 35 | 36 | procedure TForm1.FormCreate(Sender: TObject); 37 | begin 38 | uMove.LogProc := Log; 39 | end; 40 | 41 | procedure TForm1.btnRunClick(Sender: TObject); 42 | begin 43 | uMove.Run; 44 | end; 45 | 46 | end. 47 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2019 Dmitry Mozulyov 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | 23 | -------------------------------------------------------------------------------- /utilities/cached_serializer/examples/html_tags.txt: -------------------------------------------------------------------------------- 1 | -f"StrToHtmlTag:tag:THtmlTag" -i 2 | 3 | a 4 | abbr 5 | acronym 6 | address 7 | applet 8 | area 9 | article 10 | aside 11 | audio 12 | b 13 | base 14 | basefont 15 | bdo 16 | bgsound 17 | big 18 | blink 19 | blockquote 20 | body 21 | br 22 | button 23 | canvas 24 | caption 25 | center 26 | cite 27 | code 28 | col 29 | colgroup 30 | command 31 | comment 32 | datalist 33 | dd 34 | del 35 | details 36 | dfn 37 | dir 38 | div 39 | dl 40 | dt 41 | em 42 | embed 43 | fieldset 44 | figcaption 45 | figure 46 | font 47 | footer 48 | form 49 | frame 50 | frameset 51 | h1 52 | h2 53 | h3 54 | h4 55 | h5 56 | h6 57 | head 58 | header 59 | hgroup 60 | hr 61 | html 62 | i 63 | iframe 64 | img 65 | input 66 | ins 67 | isindex 68 | kbd 69 | keygen 70 | label 71 | legend 72 | li 73 | link 74 | map 75 | mark 76 | marquee 77 | menu 78 | meta 79 | meter 80 | nav 81 | nobr 82 | noembed 83 | noframes 84 | noscript 85 | object 86 | ol 87 | optgroup 88 | option 89 | output 90 | p 91 | param 92 | plaintext 93 | pre 94 | progress 95 | q 96 | rp 97 | rt 98 | ruby 99 | s 100 | samp 101 | script 102 | section 103 | select 104 | small 105 | source 106 | span 107 | strike 108 | strong 109 | style 110 | sub 111 | summary 112 | sup 113 | table 114 | tbody 115 | td 116 | textarea 117 | tfoot 118 | th 119 | thead 120 | time 121 | title 122 | tr 123 | tt 124 | u 125 | ul 126 | var 127 | video 128 | wbr 129 | xmp -------------------------------------------------------------------------------- /objs/fixandroid32.dpr: -------------------------------------------------------------------------------- 1 | program fixandroid32; 2 | 3 | {$APPTYPE CONSOLE} 4 | {$I ..\TINY.DEFINES.inc} 5 | 6 | uses 7 | SysUtils; 8 | 9 | var 10 | N: Integer; 11 | FileName: string; 12 | Handle: THandle; 13 | Buffer: AnsiString; 14 | BufferSize: Integer; 15 | P: Integer; 16 | S: PAnsiChar; 17 | Value: Byte; 18 | 19 | begin 20 | FileName := ParamStr(1); 21 | if (not FileExists(FileName)) then 22 | begin 23 | Writeln('Object file "', FileName, '" not found'); 24 | Halt(1); 25 | end; 26 | 27 | N := 0; 28 | repeat 29 | Handle := FileOpen(FileName, fmOpenReadWrite); 30 | if (Handle <> THandle(-1)) then 31 | begin 32 | Break; 33 | end; 34 | 35 | Inc(N); 36 | if (N = 10) or (not FileExists(FileName)) then 37 | begin 38 | Writeln('Object file "', FileName, '" not opened'); 39 | Halt(1); 40 | end; 41 | Sleep(100); 42 | until (False); 43 | 44 | try 45 | BufferSize := FileSeek(Handle, -60, 2); 46 | Value := $3C; 47 | FileWrite(Handle, Value, SizeOf(Value)); 48 | 49 | SetLength(Buffer, BufferSize); 50 | FileSeek(Handle, 0, 0); 51 | FileRead(Handle, Pointer(Buffer)^, BufferSize); 52 | P := Pos('clang version ', Buffer); 53 | if (P <> 0) then 54 | begin 55 | UniqueString(Buffer); 56 | S := @Buffer[P + Length('clang version ')]; 57 | while (S^ <> ')') do 58 | Inc(S); 59 | 60 | Inc(S); 61 | PByte(S + 2)^ := $3B; 62 | PByte(S + 13)^ := $31; 63 | PCardinal(S + 57)^ := PCardinal(S + 57 + 2)^; 64 | PWord(S + 57 + 4)^ := $0000; 65 | end; 66 | FileSeek(Handle, 0, 0); 67 | FileWrite(Handle, Pointer(Buffer)^, BufferSize); 68 | finally 69 | FileClose(Handle); 70 | end; 71 | end. 72 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.ocx 46 | 47 | # Delphi autogenerated files (duplicated info) 48 | *.cfg 49 | *.hpp 50 | *Resource.rc 51 | 52 | # Delphi local files (user-specific info) 53 | *.local 54 | *.identcache 55 | *.projdata 56 | *.tvsconfig 57 | *.dsk 58 | 59 | # Delphi history and backups 60 | __history/ 61 | *.~* 62 | 63 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 64 | *.stat 65 | -------------------------------------------------------------------------------- /objs/compiler.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal enabledelayedexpansion 3 | 4 | set platform=%~1 5 | set file=%~2 6 | set sourcefolder=%~3 7 | set targetfolder=%~4 8 | set target=unknown 9 | set flags=-c -O3 -mllvm -align-all-functions=4 -DDELPHI 10 | 11 | if "%platform%"=="win32" ( 12 | set target=i386-windows-gnu -mno-sse 13 | ) else if "%platform%"=="win64" ( 14 | set target=x86_64-windows-gnu -mcx16 15 | ) else if "%platform%"=="linux32" ( 16 | set target=i386-linux-gnu -mno-sse 17 | ) else if "%platform%"=="linux64" ( 18 | set target=x86_64-linux-gnu -mcx16 19 | ) else if "%platform%"=="mac32" ( 20 | set target=i386-darwin-gnu -mno-sse -fomit-frame-pointer 21 | ) else if "%platform%"=="mac64" ( 22 | set target=x86_64-macos-gnu -fomit-frame-pointer 23 | ) else if "%platform%"=="android32" ( 24 | set target=armv7-none-linux-androideabi -mfpu=neon -mfloat-abi=hard -mthumb -fPIC 25 | ) else if "%platform%"=="android64" ( 26 | set target=aarch64-linux-android 27 | ) else if "%platform%"=="ios32" ( 28 | set target=armv7m-none-ios-gnueabi -mfpu=neon -mfloat-abi=hard -mthumb 29 | ) else if "%platform%"=="ios64" ( 30 | set target=arm64-darwin-gnu -fno-stack-protector 31 | ) else ( 32 | echo error: unknown platform "%platform%" 33 | goto :done 34 | ) 35 | 36 | if not exist "%file%" ( 37 | echo error: compiled filed "%file%" not found 38 | goto :done 39 | ) 40 | 41 | echo platform "%platform%": 42 | if not exist "%targetfolder%%platform%\" mkdir %targetfolder%%platform% 43 | 44 | set fileext= 45 | for %%f in ("%file%") do set fileext=%%~xf 46 | if "%fileext%"==".txt" ( 47 | for /F "tokens=*" %%a in (%file%) do call :compile %%a 48 | ) else ( 49 | call :compile %file% 50 | ) 51 | goto :done 52 | 53 | :compile 54 | set filename=%1 55 | set sourcefile=%sourcefolder%%filename:/=\% 56 | set targetfile=%targetfolder%%platform%\%~n1.o 57 | echo %sourcefile% 58 | if not exist "%sourcefile%" ( 59 | echo error: file not found! 60 | goto :eof 61 | ) 62 | 63 | call clang -target %target% %flags% "%sourcefile%" -o"%targetfile%" 64 | if "%platform%"=="win32" ( 65 | fixwin32 %targetfile% 66 | ) 67 | if "%platform%"=="android32" ( 68 | fixandroid32 %targetfile% 69 | ) 70 | 71 | goto :eof 72 | 73 | 74 | :done -------------------------------------------------------------------------------- /Tiny.Test.pas: -------------------------------------------------------------------------------- 1 | unit Tiny.Test; 2 | 3 | {******************************************************************************} 4 | { Copyright (c) Dmitry Mozulyov } 5 | { } 6 | { Permission is hereby granted, free of charge, to any person obtaining a copy } 7 | { of this software and associated documentation files (the "Software"), to deal} 8 | { in the Software without restriction, including without limitation the rights } 9 | { to use, copy, modify, merge, publish, distribute, sublicense, and/or sell } 10 | { copies of the Software, and to permit persons to whom the Software is } 11 | { furnished to do so, subject to the following conditions: } 12 | { } 13 | { The above copyright notice and this permission notice shall be included in } 14 | { all copies or substantial portions of the Software. } 15 | { } 16 | { THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR } 17 | { IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, } 18 | { FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE } 19 | { AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER } 20 | { LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,} 21 | { OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN } 22 | { THE SOFTWARE. } 23 | { } 24 | { email: softforyou@inbox.ru } 25 | { skype: dimandevil } 26 | { repository: https://github.com/d-mozulyov/Tiny.Rtti } 27 | {******************************************************************************} 28 | 29 | {$I TINY.DEFINES.inc} 30 | 31 | interface 32 | uses 33 | Tiny.Rtti; 34 | 35 | implementation 36 | 37 | end. 38 | -------------------------------------------------------------------------------- /Tiny.Marshalling.pas: -------------------------------------------------------------------------------- 1 | unit Tiny.Marshalling; 2 | 3 | {******************************************************************************} 4 | { Copyright (c) Dmitry Mozulyov } 5 | { } 6 | { Permission is hereby granted, free of charge, to any person obtaining a copy } 7 | { of this software and associated documentation files (the "Software"), to deal} 8 | { in the Software without restriction, including without limitation the rights } 9 | { to use, copy, modify, merge, publish, distribute, sublicense, and/or sell } 10 | { copies of the Software, and to permit persons to whom the Software is } 11 | { furnished to do so, subject to the following conditions: } 12 | { } 13 | { The above copyright notice and this permission notice shall be included in } 14 | { all copies or substantial portions of the Software. } 15 | { } 16 | { THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR } 17 | { IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, } 18 | { FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE } 19 | { AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER } 20 | { LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,} 21 | { OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN } 22 | { THE SOFTWARE. } 23 | { } 24 | { email: softforyou@inbox.ru } 25 | { skype: dimandevil } 26 | { repository: https://github.com/d-mozulyov/Tiny.Rtti } 27 | {******************************************************************************} 28 | 29 | {$I TINY.DEFINES.inc} 30 | 31 | interface 32 | uses 33 | Tiny.Rtti; 34 | 35 | implementation 36 | 37 | end. 38 | -------------------------------------------------------------------------------- /Tiny.Classes.pas: -------------------------------------------------------------------------------- 1 | unit Tiny.Classes; 2 | 3 | {******************************************************************************} 4 | { Copyright (c) Dmitry Mozulyov } 5 | { } 6 | { Permission is hereby granted, free of charge, to any person obtaining a copy } 7 | { of this software and associated documentation files (the "Software"), to deal} 8 | { in the Software without restriction, including without limitation the rights } 9 | { to use, copy, modify, merge, publish, distribute, sublicense, and/or sell } 10 | { copies of the Software, and to permit persons to whom the Software is } 11 | { furnished to do so, subject to the following conditions: } 12 | { } 13 | { The above copyright notice and this permission notice shall be included in } 14 | { all copies or substantial portions of the Software. } 15 | { } 16 | { THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR } 17 | { IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, } 18 | { FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE } 19 | { AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER } 20 | { LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,} 21 | { OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN } 22 | { THE SOFTWARE. } 23 | { } 24 | { email: softforyou@inbox.ru } 25 | { skype: dimandevil } 26 | { repository: https://github.com/d-mozulyov/Tiny.Library } 27 | {******************************************************************************} 28 | 29 | {$I TINY.DEFINES.inc} 30 | 31 | interface 32 | uses 33 | Tiny.Types; 34 | 35 | 36 | implementation 37 | 38 | 39 | initialization 40 | 41 | 42 | end. 43 | -------------------------------------------------------------------------------- /demo/general/move/Move.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | <Scaled Value="True"/> 14 | <ResourceType Value="res"/> 15 | <UseXPManifest Value="True"/> 16 | <XPManifest> 17 | <DpiAware Value="True"/> 18 | </XPManifest> 19 | <Icon Value="0"/> 20 | </General> 21 | <BuildModes Count="1"> 22 | <Item1 Name="Default" Default="True"/> 23 | </BuildModes> 24 | <PublishOptions> 25 | <Version Value="2"/> 26 | <UseFileFilters Value="True"/> 27 | </PublishOptions> 28 | <RunParams> 29 | <FormatVersion Value="2"/> 30 | <Modes Count="0"/> 31 | </RunParams> 32 | <RequiredPackages Count="1"> 33 | <Item1> 34 | <PackageName Value="LCL"/> 35 | </Item1> 36 | </RequiredPackages> 37 | <Units Count="1"> 38 | <Unit0> 39 | <Filename Value="Move.dpr"/> 40 | <IsPartOfProject Value="True"/> 41 | </Unit0> 42 | </Units> 43 | </ProjectOptions> 44 | <CompilerOptions> 45 | <Version Value="11"/> 46 | <PathDelim Value="\"/> 47 | <Target> 48 | <Filename Value="Move"/> 49 | </Target> 50 | <SearchPaths> 51 | <IncludeFiles Value="..\..\..;$(ProjOutDir)"/> 52 | <OtherUnitFiles Value="..\..\.."/> 53 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 54 | </SearchPaths> 55 | <CodeGeneration> 56 | <Optimizations> 57 | <OptimizationLevel Value="3"/> 58 | </Optimizations> 59 | </CodeGeneration> 60 | <Linking> 61 | <Options> 62 | <Win32> 63 | <GraphicApplication Value="True"/> 64 | </Win32> 65 | </Options> 66 | </Linking> 67 | </CompilerOptions> 68 | <Debugging> 69 | <Exceptions Count="3"> 70 | <Item1> 71 | <Name Value="EAbort"/> 72 | </Item1> 73 | <Item2> 74 | <Name Value="ECodetoolError"/> 75 | </Item2> 76 | <Item3> 77 | <Name Value="EFOpenError"/> 78 | </Item3> 79 | </Exceptions> 80 | </Debugging> 81 | </CONFIG> 82 | -------------------------------------------------------------------------------- /codegen/rtti/InvokeTypes.dpr: -------------------------------------------------------------------------------- 1 | program InvokeTypes; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | uses 8 | System.SysUtils, 9 | System.Classes, 10 | uCommon; 11 | 12 | var 13 | List: TStringList; 14 | 15 | procedure Add(const S: string); 16 | begin 17 | Writeln(S); 18 | List.Add(S); 19 | end; 20 | 21 | procedure AddFmt(const AFmtStr: string; const AArgs: array of const); 22 | begin 23 | Add(Format(AFmtStr, AArgs)); 24 | end; 25 | 26 | begin 27 | try 28 | List := TStringList.Create; 29 | try 30 | ForEachInvokeDecl( 31 | procedure(const ADecl: TInvokeDecl; const ADeclKind, ADeclName: string) 32 | var 33 | LTypes: TInvokeTypes; 34 | begin 35 | LTypes := [itOutputGeneral, itSingle, itDouble, itFPU, itHFA, itReturnPtr]; 36 | if (ADecl <> idRegister) then 37 | begin 38 | LTypes := LTypes - [itHFA, itReturnPtr]; 39 | end; 40 | 41 | ForEachInvokeType( 42 | procedure(const AType: TInvokeType; const ATypeKind, ATypeName: string) 43 | var 44 | LSignature: TInvokeSignature; 45 | begin 46 | case ADecl of 47 | idRegister: LSignature := isGeneralExtended; 48 | idMicrosoft: LSignature := isMicrosoftGeneralExtended; 49 | else 50 | LSignature := isGeneral; 51 | end; 52 | 53 | ForEachInvokeSignature( 54 | procedure(const ASignatureTitle, ASignature: string; const AGenCount, AExtCount, AArgs: Integer) 55 | begin 56 | AddFmt('typedef %s %s (*func_%s)(%s);', 57 | [ 58 | ADeclName, 59 | ATypeKind, 60 | InvokeFuncName(ADeclKind, ATypeKind, ASignatureTitle), 61 | ASignature 62 | ]); 63 | end, LSignature, (ADecl = idRegister), ADecl in [idCdecl, idStdCall]); 64 | end, LTypes); 65 | end, [idRegister, idMicrosoft, idCdecl, idStdCall], True); 66 | 67 | // safecall 68 | ForEachInvokeSignature( 69 | procedure(const ASignatureTitle, ASignature: string; const AGenCount, AExtCount, AArgs: Integer) 70 | begin 71 | AddFmt('typedef STDCALL gen (*func_safecall_%s)(%s);', 72 | [ 73 | ASignatureTitle, 74 | ASignature 75 | ]); 76 | end, isMicrosoftGeneralExtended, True, False); 77 | 78 | List.SaveToFile('..\..\c\rtti\tiny.invoke.functypes.inc'); 79 | finally 80 | List.Free; 81 | end; 82 | except 83 | on E: Exception do 84 | Writeln(E.ClassName, ': ', E.Message); 85 | end; 86 | 87 | Write('Press Enter to quit'); 88 | Readln; 89 | end. 90 | -------------------------------------------------------------------------------- /thirdparty/Cromis/Cromis.Unicode.pas: -------------------------------------------------------------------------------- 1 | (* 2 | * This software is distributed under BSD license. 3 | * 4 | * Copyright (c) 2008 Iztok Kacin, Cromis (iztok.kacin@gmail.com). 5 | * All rights reserved. 6 | * 7 | * Redistribution and use in source and binary forms, with or without modification, 8 | * are permitted provided that the following conditions are met: 9 | * 10 | * - Redistributions of source code must retain the above copyright notice, this 11 | * list of conditions and the following disclaimer. 12 | * - Redistributions in binary form must reproduce the above copyright notice, this 13 | * list of conditions and the following disclaimer in the documentation and/or 14 | * other materials provided with the distribution. 15 | * - Neither the name of the Iztok Kacin nor the names of its contributors may be 16 | * used to endorse or promote products derived from this software without specific 17 | * prior written permission. 18 | * 19 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 20 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 21 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 22 | * IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, 23 | * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 25 | * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 26 | * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 27 | * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED 28 | * OF THE POSSIBILITY OF SUCH DAMAGE. 29 | *) 30 | unit Cromis.Unicode; 31 | 32 | interface 33 | 34 | uses 35 | SysUtils; 36 | 37 | const 38 | Utf8BOM: array[0..2] of Byte = ($EF, $BB, $BF); 39 | Utf16BEBOM: array[0..1] of Byte = ($FE, $FF); 40 | Utf16LEBOM: array[0..1] of Byte = ($FF, $FE); 41 | Utf32BEBOM: array[0..3] of Byte = ($00, $00, $FE, $FF); 42 | Utf32LEBOM: array[0..3] of Byte = ($FF, $FE, $00, $00); 43 | 44 | type 45 | {$IF Defined(CLR) or Defined(UNICODE)} 46 | uchar = Char; 47 | achar = AnsiChar; 48 | puchar = PChar; 49 | pachar = PAnsiChar; 50 | ustring = string; 51 | astring = AnsiString; 52 | {$ELSE} 53 | uchar = WideChar; 54 | achar = AnsiChar; 55 | puchar = PWideChar; 56 | pachar = PAnsiChar; 57 | ustring = Widestring; 58 | astring = AnsiString; 59 | {$IFEND} 60 | 61 | function CharInSet(const C: Char; const CharSet: TSysCharSet): Boolean; 62 | 63 | implementation 64 | 65 | function CharInSet(const C: Char; const CharSet: TSysCharSet): Boolean; 66 | begin 67 | {$IF Defined(UNICODE)} 68 | Result := SysUtils.CharInSet(C, CharSet); 69 | {$ELSE} 70 | Result := C in CharSet; 71 | {$IFEND} 72 | end; 73 | 74 | end. 75 | -------------------------------------------------------------------------------- /objs/fixwin32.dpr: -------------------------------------------------------------------------------- 1 | program fixwin32; 2 | 3 | {$APPTYPE CONSOLE} 4 | {$I ..\TINY.DEFINES.inc} 5 | 6 | uses 7 | Windows, 8 | SysUtils; 9 | 10 | function GetTempFolder(const APrefix: string): string; 11 | var 12 | LBuffer: array[0..MAX_PATH] of Char; 13 | LTempFolder: string; 14 | LRandSeed: Integer; 15 | begin 16 | FillChar(LBuffer, MAX_PATH, 0); 17 | GetTempPath(High(LBuffer), LBuffer); 18 | LTempFolder := IncludeTrailingPathDelimiter(LBuffer) + APrefix + '_'; 19 | LRandSeed := System.RandSeed; 20 | try 21 | Randomize; 22 | 23 | repeat 24 | Result := LTempFolder + IntToHex(Random(100000000), 8); 25 | until (CreateDir(Result)); 26 | finally 27 | System.RandSeed := LRandSeed; 28 | end; 29 | end; 30 | 31 | procedure ExecuteAndWait(const ACmdLine: string); 32 | var 33 | LStartupInfo: TStartupInfo; 34 | LProcessInformation: TProcessInformation; 35 | begin 36 | FillChar(LStartupInfo, SizeOf(LStartupInfo), 0); 37 | with LStartupInfo do 38 | begin 39 | cb := SizeOf(TStartupInfo); 40 | wShowWindow := SW_HIDE; 41 | end; 42 | 43 | if CreateProcess(nil, PChar(ACmdLine), nil, nil, true, CREATE_NO_WINDOW, 44 | nil, nil, LStartupInfo, LProcessInformation) then 45 | begin 46 | WaitForSingleObject(LProcessInformation.hProcess, INFINITE); 47 | CloseHandle(LProcessInformation.hProcess); 48 | CloseHandle(LProcessInformation.hThread); 49 | end else 50 | begin 51 | RaiseLastOSError; 52 | end; 53 | end; 54 | 55 | var 56 | i: Integer; 57 | FileName: string; 58 | TempFolder: string; 59 | TempFileName: string; 60 | Done: Boolean; 61 | begin 62 | FileName := ParamStr(1); 63 | if (not FileExists(FileName)) then 64 | begin 65 | Writeln('Object file "', FileName, '" not found'); 66 | Halt(1); 67 | end; 68 | 69 | TempFolder := GetTempFolder('fixwin32'); 70 | TempFileName := IncludeTrailingPathDelimiter(TempFolder) + 'temp.o'; 71 | if (not RenameFile(FileName, TempFileName)) then 72 | begin 73 | RemoveDir(TempFolder); 74 | Writeln('Object file "', FileName, '" temporary copying failure'); 75 | Halt(1); 76 | end; 77 | 78 | ExecuteAndWait('coff2omf.exe "' + TempFileName + '"'); 79 | Done := RenameFile(TempFileName, FileName); 80 | begin 81 | i := 0; 82 | repeat 83 | DeleteFile(TempFileName); 84 | if (not FileExists(TempFileName)) or (i >= 50) then 85 | Break; 86 | 87 | Inc(i); 88 | Sleep(100); 89 | until (False); 90 | 91 | i := 0; 92 | repeat 93 | RemoveDir(TempFolder); 94 | if (not DirectoryExists(TempFolder)) or (i >= 50) then 95 | Break; 96 | 97 | Inc(i); 98 | Sleep(100); 99 | until (False); 100 | end; 101 | 102 | if (not Done) then 103 | begin 104 | Writeln('Object file "', FileName, '" temporary restore failure'); 105 | Halt(1); 106 | end; 107 | 108 | ExecuteAndWait('omf2d.exe "' + FileName + '"'); 109 | end. 110 | -------------------------------------------------------------------------------- /c/rtti/tiny.invoke.intrjumps.c: -------------------------------------------------------------------------------- 1 | 2 | #include "../tiny.defines.h" 3 | #include "../tiny.types.h" 4 | #include "tiny.rtti.h" 5 | #include "tiny.invoke.h" 6 | #include "tiny.invoke.intrjumps.h" 7 | 8 | 9 | #if defined (WIN64) 10 | #define intercept_jump_x64_alter 11 | #else 12 | #define intercept_jump_x64_alter \ 13 | ".byte 0xEB, 0x04 \n\t" /* jmp L.start */ \ 14 | ".byte 0x48, 0x8B, 0x47, 0xF8 \n\t" /* mov rax, [rdi - 8] */ 15 | #endif 16 | #if defined (CPUX86) 17 | #define intercept_jump_params \ 18 | [offs_EDX] "n" (sizeof(RttiRegisters) - (offsetof(RttiInvokeDump, registers) + offsetof(RttiRegisters, RegEDX))), 19 | #define intercept_jump_code \ 20 | ".byte 0x89, 0xC8 \n\t" /* mov eax, ecx */ \ 21 | ".byte 0xEB, 0x04 \n\t" /* jmp L.start */ \ 22 | ".byte 0x8B, 0x44, 0x24, 0x04 \n\t" /* mov eax, [esp + 4] */ \ 23 | "mov [esp - %c[offs_EDX]], edx \n\t" \ 24 | "mov edx, [eax - 4] \n\t" \ 25 | "add edx, %c[offset] \n\t" \ 26 | "jmp [edx] \n\t" 27 | #define intercept_jump_offset 8 28 | #elif defined (CPUX64) 29 | #define intercept_jump_params 30 | #define intercept_jump_code \ 31 | ".byte 0x48, 0x8B, 0x41, 0xF8 \n\t" /* mov rax, [rcx - 8] */ \ 32 | intercept_jump_x64_alter \ 33 | "add rax, %c[offset] \n\t" \ 34 | "jmp [rax] \n\t" 35 | 36 | #if defined (WIN64) 37 | #define intercept_jump_offset 0 38 | #else 39 | #define intercept_jump_offset 6 40 | #endif 41 | #elif defined (CPUARM32) 42 | #define intercept_jump_params 43 | #define intercept_jump_code \ 44 | "ldr r12, [r0, #-4] \n\t" \ 45 | "add r12, r12, %[arm32offset_low] \n\t" \ 46 | "add r12, r12, %[arm32offset_high] \n\t" \ 47 | "ldmia r12!, {pc} \n\t" 48 | #define intercept_jump_offset 0 49 | #else // CPUARM64 50 | #define intercept_jump_params 51 | #define intercept_jump_code \ 52 | "ldr x16, [x0, #-8] \n\t" \ 53 | "mov x17, %[offset] \n\t" \ 54 | "add x16, x16, x17 \n\t" \ 55 | "ldr x17, [x16], 8 \n\t" \ 56 | "br x17 \n\t" 57 | #define intercept_jump_offset 0 58 | #endif 59 | 60 | #define intercept_jump(n) NAKED void intercept_jump##n() { \ 61 | __asm__ volatile ( \ 62 | asm_syntax_intel \ 63 | intercept_jump_code \ 64 | : : \ 65 | intercept_jump_params \ 66 | [offset] "n" (n * sizeof(RttiVirtualMethodData)), \ 67 | [arm32offset_low] "n" ((n * sizeof(RttiVirtualMethodData)) & -4096), \ 68 | [arm32offset_high] "n" ((n * sizeof(RttiVirtualMethodData)) & 4095) \ 69 | ); \ 70 | } 71 | 72 | #include "tiny.invoke.intr.jumps.inc" 73 | 74 | /* get appropriate interception jump */ 75 | REGISTER_DECL void* get_intercept_jump(int32_t index, int32_t mode) 76 | { 77 | if (((uint32_t)index) >= (sizeof(INTERCEPT_JUMPS) / sizeof(INTERCEPT_JUMPS[0]))) 78 | return 0; 79 | 80 | uint8_t* ptr = ((uint8_t*)INTERCEPT_JUMPS[index]) + intercept_jump_offset; 81 | 82 | #if defined (CPUX86) 83 | switch (mode) 84 | { 85 | case 1: ptr -= 4; break; 86 | case 2: ptr -= (4 + 4); break; 87 | } 88 | #endif 89 | 90 | #if defined (POSIXINTEL64) 91 | switch (mode) 92 | { 93 | case 1: ptr -= 6; break; 94 | } 95 | #endif 96 | 97 | return ptr; 98 | } 99 | -------------------------------------------------------------------------------- /demo/general/cache/FileReading.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=1 80 | UnsafeCode=1 81 | UnsafeCast=1 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir=bin 94 | UnitOutputDir=dcu 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath=..\..\..\ 98 | Packages=vcl;rtl;dbrtl;adortl;vcldb;vclx;bdertl;vcldbx;ibxpress;dsnap;cds;bdecds;qrpt;teeui;teedb;tee;dss;teeqr;visualclx;visualdbclx;dsnapcrba;dsnapcon;VclSmp;vclshlctrls;vclie;xmlrtl;inet;inetdbbde;inetdbxpress;inetdb;nmfast;webdsnap;websnap;dbexpress;dbxcds;indy;dclOffice2k 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams= 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Version Info] 109 | IncludeVerInfo=0 110 | AutoIncBuild=0 111 | MajorVer=1 112 | MinorVer=0 113 | Release=0 114 | Build=0 115 | Debug=0 116 | PreRelease=0 117 | Special=0 118 | Private=0 119 | DLL=0 120 | Locale=1049 121 | CodePage=1251 122 | [Version Info Keys] 123 | CompanyName= 124 | FileDescription= 125 | FileVersion=1.0.0.0 126 | InternalName= 127 | LegalCopyright= 128 | LegalTrademarks= 129 | OriginalFilename= 130 | ProductName= 131 | ProductVersion=1.0.0.0 132 | Comments= 133 | [HistoryLists\hlUnitAliases] 134 | Count=1 135 | Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 136 | [HistoryLists\hlSearchPath] 137 | Count=3 138 | Item0=..\..\..\ 139 | Item1=..\..\ 140 | Item2=..\ 141 | [HistoryLists\hlUnitOutputDirectory] 142 | Count=1 143 | Item0=dcu 144 | [HistoryLists\hlOutputDirectorry] 145 | Count=1 146 | Item0=bin 147 | -------------------------------------------------------------------------------- /demo/general/cache/FileWriting.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=1 80 | UnsafeCode=1 81 | UnsafeCast=1 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir=bin 94 | UnitOutputDir=dcu 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath=..\..\..\ 98 | Packages=vcl;rtl;dbrtl;adortl;vcldb;vclx;bdertl;vcldbx;ibxpress;dsnap;cds;bdecds;qrpt;teeui;teedb;tee;dss;teeqr;visualclx;visualdbclx;dsnapcrba;dsnapcon;VclSmp;vclshlctrls;vclie;xmlrtl;inet;inetdbbde;inetdbxpress;inetdb;nmfast;webdsnap;websnap;dbexpress;dbxcds;indy;dclOffice2k 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams= 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Version Info] 109 | IncludeVerInfo=0 110 | AutoIncBuild=0 111 | MajorVer=1 112 | MinorVer=0 113 | Release=0 114 | Build=0 115 | Debug=0 116 | PreRelease=0 117 | Special=0 118 | Private=0 119 | DLL=0 120 | Locale=1049 121 | CodePage=1251 122 | [Version Info Keys] 123 | CompanyName= 124 | FileDescription= 125 | FileVersion=1.0.0.0 126 | InternalName= 127 | LegalCopyright= 128 | LegalTrademarks= 129 | OriginalFilename= 130 | ProductName= 131 | ProductVersion=1.0.0.0 132 | Comments= 133 | [HistoryLists\hlUnitAliases] 134 | Count=1 135 | Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 136 | [HistoryLists\hlSearchPath] 137 | Count=3 138 | Item0=..\..\..\ 139 | Item1=..\..\ 140 | Item2=..\ 141 | [HistoryLists\hlUnitOutputDirectory] 142 | Count=1 143 | Item0=dcu 144 | [HistoryLists\hlOutputDirectorry] 145 | Count=1 146 | Item0=bin 147 | -------------------------------------------------------------------------------- /demo/rtti/frmInvoke.pas: -------------------------------------------------------------------------------- 1 | unit frmInvoke; 2 | 3 | {$define RTTION_METHODS} 4 | {$I TINY.DEFINES.inc} 5 | 6 | interface 7 | 8 | uses 9 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 10 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, 11 | FMX.Controls.Presentation, FMX.StdCtrls, System.Diagnostics, 12 | System.Rtti, 13 | Tiny.Types, Tiny.Rtti, Tiny.Invoke; 14 | 15 | type 16 | TForm1 = class(TForm) 17 | Button1: TButton; 18 | procedure Button1Click(Sender: TObject); 19 | private 20 | { Private declarations } 21 | public 22 | procedure SomeMethod(const X, Y, Z: Integer); 23 | end; 24 | 25 | var 26 | Form1: TForm1; 27 | 28 | implementation 29 | 30 | {$R *.fmx} 31 | 32 | procedure TForm1.SomeMethod(const X, Y, Z: Integer); 33 | begin 34 | Tag := X + Y + Z; 35 | end; 36 | 37 | procedure TForm1.Button1Click(Sender: TObject); 38 | const 39 | COUNT = 1000000; 40 | var 41 | i: Integer; 42 | LStopwatch: TStopwatch; 43 | LContext: System.Rtti.TRttiContext; 44 | LMethod: System.Rtti.TRttiMethod; 45 | LMethodEntry: Tiny.Rtti.PVmtMethodExEntry; 46 | LSignature: Tiny.Invoke.TRttiSignature; 47 | LInvokeFunc: Tiny.Invoke.TRttiInvokeFunc; 48 | LDump: Tiny.Invoke.TRttiInvokeDump; 49 | T1, T2, T3, T4: Int64; 50 | begin 51 | // initialization 52 | LContext := System.Rtti.TRttiContext.Create; 53 | LMethod := LContext.GetType(TForm1).GetMethod('SomeMethod'); 54 | LMethodEntry := Tiny.Rtti.PTypeInfo(TypeInfo(TForm1)).TypeData.ClassData.MethodTableEx.Find('SomeMethod'); 55 | LSignature.Init(LMethodEntry^); 56 | LInvokeFunc := LSignature.OptimalInvokeFunc; 57 | 58 | // System.Rtti 59 | LStopwatch := TStopwatch.StartNew; 60 | for i := 1 to COUNT do 61 | begin 62 | LMethod.Invoke(Form1, [1, 2, 3]); 63 | end; 64 | T1 := LStopwatch.ElapsedMilliseconds; 65 | 66 | // Tiny.Rtti(Invoke) values 67 | LStopwatch := TStopwatch.StartNew; 68 | for i := 1 to COUNT do 69 | begin 70 | LSignature.Invoke(LDump, LMethodEntry.CodeAddress, Form1, {TValue}[1, 2, 3], LInvokeFunc); 71 | end; 72 | T2 := LStopwatch.ElapsedMilliseconds; 73 | 74 | // Tiny.Rtti(Invoke) arguments 75 | LStopwatch := TStopwatch.StartNew; 76 | for i := 1 to COUNT do 77 | begin 78 | LSignature.Invoke(LDump, LMethodEntry.CodeAddress, Form1, {array of}[1, 2, 3], nil, LInvokeFunc); 79 | end; 80 | T3 := LStopwatch.ElapsedMilliseconds; 81 | 82 | // Tiny.Rtti(Invoke) direct 83 | LStopwatch := TStopwatch.StartNew; 84 | for i := 1 to COUNT do 85 | begin 86 | PPointer(@LDump.Bytes[LSignature.DumpOptions.ThisOffset])^ := Form1; 87 | PInteger(@LDump.Bytes[LSignature.Arguments[0].Offset])^ := 1; 88 | PInteger(@LDump.Bytes[LSignature.Arguments[1].Offset])^ := 2; 89 | PInteger(@LDump.Bytes[LSignature.Arguments[2].Offset])^ := 3; 90 | LInvokeFunc(@LSignature, LMethodEntry.CodeAddress, @LDump); 91 | end; 92 | T4 := LStopwatch.ElapsedMilliseconds; 93 | 94 | // result 95 | Caption := Format('System.Rtti: %dms, Tiny.Rtti (values): %dms, ' + 96 | 'Tiny.Rtti (args): %dms, Tiny.Rtti (direct): %dms', [T1, T2, T3, T4]); 97 | end; 98 | 99 | 100 | end. 101 | -------------------------------------------------------------------------------- /codegen/rtti/InterceptJumps.dpr: -------------------------------------------------------------------------------- 1 | program InterceptJumps; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | uses 8 | System.SysUtils, 9 | System.Classes, 10 | uCommon; 11 | 12 | const 13 | JUMPS_COUNT = 1024; 14 | COMMA: array[Boolean] of string = ('', ','); 15 | 16 | var 17 | i: Integer; 18 | List: TStringList; 19 | 20 | procedure __AddProc(const S: string); 21 | begin 22 | Writeln(S); 23 | List.Add(S); 24 | end; 25 | 26 | begin 27 | try 28 | List := TStringList.Create; 29 | try 30 | uCommon.AddProc := __AddProc; 31 | 32 | // C-jumps 33 | begin 34 | for i := 0 to JUMPS_COUNT - 1 do 35 | begin 36 | AddFmt('intercept_jump(%d);', [i]); 37 | end; 38 | 39 | Add(''); 40 | 41 | Add('const'); 42 | AddFmt(' void* INTERCEPT_JUMPS[%d] = {', [JUMPS_COUNT]); 43 | for i := 0 to JUMPS_COUNT - 1 do 44 | begin 45 | AddFmt(' &intercept_jump%d%s', [i, COMMA[i <> JUMPS_COUNT - 1]]); 46 | end; 47 | Add(' };'); 48 | end; 49 | List.SaveToFile('..\..\c\rtti\tiny.invoke.intr.jumps.inc'); 50 | 51 | // OldDelphi-jumps 52 | List.Clear; 53 | begin 54 | for i := 0 to JUMPS_COUNT - 1 do 55 | begin 56 | Add(''); 57 | AddFmt('procedure intercept_jump%d;', [i]); 58 | Add('const'); 59 | AddFmt(' ITEM_OFFSET = %d * SizeOf(TRttiVirtualMethodData);', [i]); 60 | Add('asm'); 61 | Add(' DB $89, $C8, $EB, $04, $8B, $44, $24, $04'); 62 | Add(' mov [esp - $18], edx'); 63 | Add(' mov edx, [eax - 4]'); 64 | Add(' add edx, ITEM_OFFSET'); 65 | Add(' jmp [edx]'); 66 | Add('end;'); 67 | end; 68 | 69 | Add(''); 70 | 71 | Add('const'); 72 | AddFmt(' INTERCEPT_JUMPS: array[0..%d] of Pointer = (', [JUMPS_COUNT - 1]); 73 | for i := 0 to JUMPS_COUNT - 1 do 74 | begin 75 | AddFmt(' @intercept_jump%d%s', [i, COMMA[i <> JUMPS_COUNT - 1]]); 76 | end; 77 | Add(' );'); 78 | 79 | Add(''); 80 | 81 | Add('function get_intercept_jump(const AIndex, AMode: Integer): Pointer;'); 82 | Add('var'); 83 | Add(' LPtr: PByte;'); 84 | Add('begin'); 85 | Add(' if (AIndex < Low(INTERCEPT_JUMPS)) or (AIndex > High(INTERCEPT_JUMPS)) then'); 86 | Add(' begin'); 87 | Add(' Result := nil;'); 88 | Add(' Exit;'); 89 | Add(' end;'); 90 | Add(''); 91 | Add(' LPtr := INTERCEPT_JUMPS[AIndex];'); 92 | Add(' Inc(LPtr, 8);'); 93 | Add(''); 94 | Add(' case (AMode) of'); 95 | Add(' 1: Dec(LPtr, 4);'); 96 | Add(' 2: Dec(LPtr, 4 + 4);'); 97 | Add(' end;'); 98 | Add(''); 99 | Add(' Result := LPtr;'); 100 | Add('end;'); 101 | end; 102 | List.SaveToFile('..\..\c\rtti\tiny.invoke.intr.jumps.olddelphi.inc'); 103 | finally 104 | List.Free; 105 | end; 106 | except 107 | on E: Exception do 108 | Writeln(E.ClassName, ': ', E.Message); 109 | end; 110 | 111 | Write('Press Enter to quit'); 112 | Readln; 113 | end. 114 | -------------------------------------------------------------------------------- /demo/rtti/frmVirtualInterface.pas: -------------------------------------------------------------------------------- 1 | unit frmVirtualInterface; 2 | 3 | {$I TINY.DEFINES.inc} 4 | 5 | interface 6 | 7 | uses 8 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 9 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, 10 | FMX.Controls.Presentation, FMX.StdCtrls, System.Diagnostics, 11 | System.Rtti, 12 | Tiny.Types, Tiny.Rtti, Tiny.Invoke; 13 | 14 | type 15 | TForm1 = class(TForm) 16 | Button1: TButton; 17 | procedure Button1Click(Sender: TObject); 18 | private 19 | { Private declarations } 20 | public 21 | { Public declarations } 22 | end; 23 | 24 | var 25 | Form1: TForm1; 26 | 27 | implementation 28 | 29 | {$R *.fmx} 30 | 31 | type 32 | IMyInterface = interface(IInvokable) 33 | ['{89EDBA5C-DFBA-48FA-889C-FC857B0ED609}'] 34 | function Func(const X, Y, Z: Integer): Integer; 35 | end; 36 | 37 | procedure TForm1.Button1Click(Sender: TObject); 38 | const 39 | COUNT = 1000000; 40 | var 41 | i: Integer; 42 | LStopwatch: TStopwatch; 43 | LInterface: IMyInterface; 44 | LValue: Integer; 45 | T1, T2, T3: Int64; 46 | begin 47 | // System.Rtti virtual interface 48 | LInterface := System.Rtti.TVirtualInterface.Create(TypeInfo(IMyInterface), 49 | procedure(Method: System.Rtti.TRttiMethod; 50 | const Args: TArray<System.Rtti.TValue>; out Result: System.Rtti.TValue) 51 | begin 52 | Result := Args[1].AsInteger + Args[2].AsInteger + Args[3].AsInteger; 53 | end) as IMyInterface; 54 | LValue := LInterface.Func(1, 2, 3); 55 | Assert(LValue = (1 + 2 + 3), 'System.Rtti virtual interface'); 56 | LStopwatch := TStopwatch.StartNew; 57 | for i := 1 to COUNT do 58 | begin 59 | LInterface.Func(1, 2, 3); 60 | end; 61 | T1 := LStopwatch.ElapsedMilliseconds; 62 | 63 | // Tiny.Rtti(Invoke) virtual interface 64 | LInterface := Tiny.Invoke.TRttiVirtualInterface.Create(TypeInfo(IMyInterface), 65 | function(const AMethod: Tiny.Invoke.TRttiVirtualMethod; 66 | const AArgs: TArray<Tiny.Rtti.TValue>; const AReturnAddress: Pointer): TValue 67 | begin 68 | Result := AArgs[1].AsInteger + AArgs[2].AsInteger + AArgs[3].AsInteger; 69 | end) as IMyInterface; 70 | LValue := LInterface.Func(1, 2, 3); 71 | Assert(LValue = (1 + 2 + 3), 'Tiny.Rtti(Invoke) virtual interface'); 72 | LStopwatch := TStopwatch.StartNew; 73 | for i := 1 to COUNT do 74 | begin 75 | LInterface.Func(1, 2, 3); 76 | end; 77 | T2 := LStopwatch.ElapsedMilliseconds; 78 | 79 | // Tiny.Rtti(Invoke) direct virtual interface 80 | LInterface := Tiny.Invoke.TRttiVirtualInterface.CreateDirect(TypeInfo(IMyInterface), 81 | procedure(const AMethod: Tiny.Invoke.TRttiVirtualMethod; var ADump: Tiny.Invoke.TRttiInvokeDump) 82 | var 83 | LSignature: Tiny.Invoke.PRttiSignature; 84 | begin 85 | LSignature := AMethod.Signature; 86 | ADump.OutInt32 := PInteger(@ADump.Bytes[LSignature.Arguments[0].Offset])^ + 87 | PInteger(@ADump.Bytes[LSignature.Arguments[1].Offset])^ + 88 | PInteger(@ADump.Bytes[LSignature.Arguments[2].Offset])^; 89 | end) as IMyInterface; 90 | LValue := LInterface.Func(1, 2, 3); 91 | Assert(LValue = (1 + 2 + 3), 'Tiny.Rtti(Invoke) direct virtual interface'); 92 | LStopwatch := TStopwatch.StartNew; 93 | for i := 1 to COUNT do 94 | begin 95 | LInterface.Func(1, 2, 3); 96 | end; 97 | T3 := LStopwatch.ElapsedMilliseconds; 98 | 99 | // result 100 | Caption := Format('System.Rtti: %dms, Tiny.Rtti (values): %dms, Tiny.Rtti (direct): %dms', [T1, T2, T3]); 101 | end; 102 | 103 | end. 104 | -------------------------------------------------------------------------------- /Tiny.Namespace.pas: -------------------------------------------------------------------------------- 1 | unit Tiny.Namespace; 2 | 3 | {******************************************************************************} 4 | { Copyright (c) Dmitry Mozulyov } 5 | { } 6 | { Permission is hereby granted, free of charge, to any person obtaining a copy } 7 | { of this software and associated documentation files (the "Software"), to deal} 8 | { in the Software without restriction, including without limitation the rights } 9 | { to use, copy, modify, merge, publish, distribute, sublicense, and/or sell } 10 | { copies of the Software, and to permit persons to whom the Software is } 11 | { furnished to do so, subject to the following conditions: } 12 | { } 13 | { The above copyright notice and this permission notice shall be included in } 14 | { all copies or substantial portions of the Software. } 15 | { } 16 | { THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR } 17 | { IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, } 18 | { FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE } 19 | { AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER } 20 | { LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,} 21 | { OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN } 22 | { THE SOFTWARE. } 23 | { } 24 | { email: softforyou@inbox.ru } 25 | { skype: dimandevil } 26 | { repository: https://github.com/d-mozulyov/Tiny.Rtti } 27 | {******************************************************************************} 28 | 29 | {$I TINY.DEFINES.inc} 30 | 31 | interface 32 | uses 33 | Tiny.Rtti, Tiny.Invoke, Tiny.Properties, UniConv; 34 | 35 | 36 | type 37 | 38 | { TRttiNamespace object 39 | Universal storage for arbitrary namespace } 40 | 41 | TRttiNamespaceVmt = class(TRttiContextVmt) 42 | 43 | end; 44 | TRttiNamespaceVmtClass = class of TRttiNamespaceVmt; 45 | 46 | PRttiNamespaceVisibility = ^TRttiNamespaceVisibility; 47 | {$A1} 48 | TRttiNamespaceVisibility = object 49 | Fields: TMemberVisibilities; 50 | Properties: TMemberVisibilities; 51 | Methods: TMemberVisibilities; 52 | end; 53 | {$A4} 54 | 55 | PRttiNamespace = ^TRttiNamespace; 56 | {$A1} 57 | TRttiNamespace = object(TRttiContext) 58 | protected 59 | 60 | public 61 | Visibility: TRttiNamespaceVisibility; 62 | 63 | procedure Init(const AVmt: TRttiNamespaceVmtClass = nil; const AThreadSync: Boolean = False); 64 | end; 65 | {$A4} 66 | 67 | 68 | implementation 69 | 70 | 71 | { TRttiNamespace } 72 | 73 | procedure TRttiNamespace.Init(const AVmt: TRttiNamespaceVmtClass; const AThreadSync: Boolean); 74 | const 75 | DEFAULT_VISIBILITY = [mvPublic, mvPublished]; 76 | var 77 | LVmt: TRttiNamespaceVmtClass; 78 | begin 79 | LVmt := AVmt; 80 | if (not Assigned(LVmt)) then 81 | begin 82 | LVmt := TRttiNamespaceVmt; 83 | end; 84 | inherited Init(LVmt, AThreadSync); 85 | 86 | Visibility.Fields := DEFAULT_VISIBILITY; 87 | Visibility.Properties := DEFAULT_VISIBILITY; 88 | Visibility.Methods := DEFAULT_VISIBILITY; 89 | end; 90 | 91 | initialization 92 | {$ifdef UNICODE} 93 | @Tiny.Rtti._utf8_equal_utf8_ignorecase := Pointer(@UniConv.utf8_equal_utf8_ignorecase); 94 | {$endif} 95 | 96 | end. 97 | -------------------------------------------------------------------------------- /utilities/cached_serializer/CachedSerializer.dpr: -------------------------------------------------------------------------------- 1 | program CachedSerializer; 2 | 3 | {$I TINY.DEFINES.inc} 4 | {$WARN SYMBOL_PLATFORM OFF} 5 | {$APPTYPE CONSOLE} 6 | 7 | uses {$ifdef UNITSCOPENAMES}Winapi.Windows{$else}Windows{$endif}, 8 | {$ifdef UNITSCOPENAMES}System.SysUtils{$else}SysUtils{$endif}, 9 | Tiny.Types, 10 | Tiny.Text, 11 | uSerialize in 'uSerialize.pas', 12 | uIdentifiers in 'uIdentifiers.pas'; 13 | 14 | 15 | procedure SetClipboardText(const Text: UnicodeString); 16 | var 17 | Size: NativeUInt; 18 | Handle: HGLOBAL; 19 | Ptr: Pointer; 20 | begin 21 | OpenClipboard(0); 22 | try 23 | Size := (Length(Text) + 1) * SizeOf(WideChar); 24 | Handle := GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE, Size); 25 | try 26 | Win32Check(Handle <> 0); 27 | Ptr := GlobalLock(Handle); 28 | Win32Check(Assigned(Ptr)); 29 | Move(PUnicodeChar(Text)^, Ptr^, Size); 30 | GlobalUnlock(Handle); 31 | SetClipboardData(CF_UNICODETEXT, Handle); 32 | finally 33 | GlobalFree(Handle); 34 | end; 35 | finally 36 | CloseClipboard; 37 | end; 38 | end; 39 | 40 | var 41 | FlagLog, FlagWait, FlagCopy: Boolean; 42 | Index, i: Integer; 43 | OptionsFileName, S: string; 44 | Options: TSerializeOptions; 45 | Serializer: TSerializer; 46 | List: TUnicodeStrings; 47 | Text: UnicodeString; 48 | begin 49 | // check flags: -nolog, -nowait, -nocopy 50 | FlagLog := True; 51 | FlagWait := True; 52 | FlagCopy := True; 53 | Index := 1; 54 | repeat 55 | S := ParamStr(Index); 56 | if (S = '') then Break; 57 | 58 | if (S = '-nolog') then FlagLog := False; 59 | if (S = '-nowait') then FlagWait := False; 60 | if (S = '-nocopy') then FlagCopy := False; 61 | Inc(Index); 62 | until (False); 63 | 64 | // load file 65 | OptionsFileName := ParamStr(1); 66 | try 67 | if (not FileExists(OptionsFileName)) then 68 | begin 69 | Writeln('Identifiers file not found!'); 70 | Writeln('See the detailed description of the utility here:'); 71 | Writeln('https://github.com/d-mozulyov/CachedTexts#cachedserializer'); 72 | end else 73 | begin 74 | Options.Clear; 75 | Options.AddFromFile(OptionsFileName, True); 76 | 77 | // update options 78 | Index := 2; 79 | repeat 80 | S := ParamStr(Index); 81 | if (S = '') then Break; 82 | 83 | if (not Options.ParseOption(S)) then 84 | begin 85 | if (S <> '-nolog') and (S <> '-nowait') and (S <> '-nocopy') then 86 | Writeln('Unknown parameter "', S, '"'); 87 | end; 88 | Inc(Index); 89 | until (False); 90 | 91 | // serialize 92 | Serializer := TSerializer.Create; 93 | try 94 | List := Serializer.Process(Options); 95 | 96 | // display to the console 97 | if (FlagLog) then 98 | for i := 0 to Length(List) - 1 do 99 | begin 100 | if (Text <> '') then Text := Text + #13#10; 101 | Text := Text + List[i]; 102 | 103 | Writeln(List[i]); 104 | end; 105 | 106 | // copy to the clipboard 107 | if (FlagCopy) then 108 | begin 109 | SetClipboardText(Text); 110 | Writeln; 111 | Writeln('The code has been successfully copied to the clipboard'); 112 | end; 113 | finally 114 | Serializer.Free; 115 | end; 116 | end; 117 | except 118 | on EAbort do ; 119 | 120 | on E: Exception do 121 | begin 122 | Writeln(E.ClassName, ':'); 123 | Writeln(E.Message); 124 | end; 125 | end; 126 | 127 | if (FlagWait) then 128 | begin 129 | Writeln; 130 | Write('Press Enter to quit'); 131 | Readln; 132 | end; 133 | end. 134 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ### Concept 2 | 3 | The library is developed by [Zephyr Software](https://www.zephyr-soft.net) company. We specialize in the most complex, ambitious and high-performance projects written in Delphi 7-XE10, FreePascal and C++Builder. [Fill out an application](https://www.zephyr-soft.net/eng) for a **free** 30-minute consultation if you need to support a project or develop a new one! 4 | 5 | The need for a library appeared because we are increasingly working with low-level code, and we need to support different versions of the compiler. We transfer some units from other open repositories, we take some code in closed repositories, we adapt and develop some units. Part of the code is written in C and assembler. Firstly, we want to maintain compatibility with C/C ++ projects. Secondly, these languages allow us to write low-level fast code. The name of the library contains _"Tiny"_ because the principle of low-level programming minimizes the dependencies of standard units, which in turn leads to a small size of the output binary files. 6 | 7 | You may read a more detailed description of the functionality in the sections below: 8 | * [General](#general) 9 | * [Text](#text) 10 | * [Generics](#generics) 11 | * [Rtti](#rtti) 12 | * [Tests](#tests) 13 | * [Services](#services) 14 | * [Delphi](#delphi) 15 | 16 | ### General 17 | 18 | The library has a lot of general purpose code. One of the main units is _Tiny.Types.pas_ - it stores the basic types, synchronization primitives and constants. One of the key features of the unit is to ensure code compatibility for different versions of Delphi and FreePascal. For example, on older versions of Delphi there are no `NativeInt` or `UnicodeString` types, and on NEXTGEN compilers there are no `WideString` or `ShortString` types - in this case they are emulated. On older versions of Delphi and FreePascal, there are no familiar `Atomic-`functions or TypeInfo initialization/copy/finalization functions (`InitializeArray`, `CopyRecord`, etc.) - all of them are also emulated. The `TinyMove` function deserves special attention - its purpose is the same as `System.Move`, but it works faster. 19 | 20 | ![](data/general/Move.png) 21 | 22 | The _Tiny.Cache.Buffers.pas_ unit contains several classes that allow you to process data streams at a high speed due to preliminary buffering of data, read more in the section [CachedBuffers.md](doc/CachedBuffers.md). 23 | 24 | ![](data/general/cache/Total.png) 25 | 26 | ### Text 27 | 28 | Text processing usually is a resource-intensive task. In addition, a text is a simple, flexible and readable data exchange format, therefore it is often used, for example, in network data exchange protocols. The `Tiny.Library` library contains a lot of code that allows you to quickly convert, compare, cache, read or write text data. The main units are _Tiny.Text.pas_ and _Tiny.Cache.Text.pas_. For a more detailed description, see the section [Text.md](doc/Text.md). 29 | 30 | ![](data/text/Total.png) 31 | 32 | ### Generics 33 | 34 | The _Tiny.Generics.pas_ unit was created in almost full compliance with the standard Delphi generics. The advantageous differences of the unit are performance, compactness and additional features. Read more in the section [Generics.md](doc/Generics.md). 35 | 36 | ![](data/generics/Total.png) 37 | 38 | ### Rtti 39 | 40 | One of the most difficult low-level programming tasks that we have encountered is the task of marshalling and executing functions based on _Run Time Type Information_ (RTTI). First, RTTI is very different between the Delphi and FreePascal versions. Secondly, RTTI is not generated in all cases, for example, `Pointer` will not be generated in `{$M+}` interfaces or older versions of Delphi. Thirdly, in FreePascal or older versions of Delphi there is no invocation routine, which is sometimes very necessary. Therefore, the concept of a universal data representation was developed and implemented in units _Tiny.Rtti.pas_, _Tiny.Invoke.pas_, _Tiny.Namespace.pas_, _Tiny.Marshalling.pas_, etc. Read a more detailed description in the section [Rtti.md](doc/Rtti.md). 41 | 42 | ![](data/rtti/Total.png) 43 | 44 | ### Tests 45 | 46 | _ToDo_ 47 | 48 | ### Services 49 | 50 | _ToDo_ 51 | 52 | ### Delphi 53 | 54 | We choose Delphi because in our opinion it is a simple, powerful and high-performance programming language. It allows you to cover almost all programming needs: PC, server, web, mobile, 3D, IoT. We are proud to have known Delphi for over 20 years. Few people know that the language was named after the ancient Greek town. Below are our personal photos from it :blush: 55 | 56 | ![](data/Delphi.jpg) -------------------------------------------------------------------------------- /c/tiny.header.h: -------------------------------------------------------------------------------- 1 | 2 | #ifndef tiny_header_h 3 | #define tiny_header_h 4 | 5 | #include "tiny.defines.h" 6 | #include <stdint.h> 7 | #include <stddef.h> 8 | #include <stdbool.h> 9 | 10 | typedef uint8_t char8_t; 11 | typedef uint16_t char16_t; 12 | typedef uint32_t char32_t; 13 | typedef intptr_t native_int; 14 | typedef uintptr_t native_uint; 15 | typedef int32_t HRESULT; 16 | typedef void* ptr_t; 17 | #if defined (CPUX86) || defined (CPUARM32) || defined (WIN64) 18 | typedef int64_t out_general; 19 | #else 20 | typedef PACKED_STRUCT {native_int low; native_int high;} out_general; 21 | #endif 22 | typedef PACKED_STRUCT 23 | { 24 | #if defined (CPUARM) || defined (POSIX64) 25 | double d0; 26 | double d1; 27 | #if defined (CPUARM) 28 | double d2; 29 | double d3; 30 | #endif 31 | #endif 32 | } 33 | hfa_struct; 34 | typedef uint8_t block16 __attribute__((__vector_size__(16), __aligned__(16))); 35 | typedef uint8_t data16 __attribute__((__vector_size__(16), __aligned__(1))); 36 | typedef uint8_t data8 __attribute__((__vector_size__(8), __aligned__(1))); 37 | /* 38 | #if defined (CPUX86) 39 | #pragma clang attribute push(__attribute__((target("sse2"))), apply_to=function) 40 | ... 41 | #pragma clang attribute pop 42 | #endif 43 | */ 44 | typedef out_general (*GeneralFunc)(); 45 | typedef REGISTER_DECL out_general (*GeneralFunc1)(ptr_t p1); 46 | typedef REGISTER_DECL out_general (*GeneralFunc2)(ptr_t p1, ptr_t p2); 47 | typedef REGISTER_DECL out_general (*GeneralFunc3)(ptr_t p1, ptr_t p2, ptr_t p3); 48 | typedef REGISTER_DECL out_general (*GeneralFunc4)(ptr_t p1, ptr_t p2, ptr_t p3, ptr_t p4); 49 | 50 | 51 | /* 52 | Tagged pointer routine 53 | */ 54 | #pragma pack(push, 1) 55 | typedef struct 56 | { 57 | ptr_t value; 58 | native_int counter; 59 | } 60 | tagged_ptr ALIGNED(sizeof(void*) * 2); 61 | #pragma pack(pop) 62 | typedef tagged_ptr tagged_unaligned_ptr ALIGNED(1); 63 | #if defined (SMALLINT) 64 | typedef int64_t tagged_int ALIGNED(8); 65 | typedef data8 tagged_data ALIGNED(8); 66 | #else 67 | typedef __int128 tagged_int ALIGNED(16); 68 | typedef data16 tagged_data ALIGNED(16); 69 | #endif 70 | FORCEINLINE void tagged_copy(volatile tagged_ptr* target/*aligned*/, volatile tagged_ptr* source/*aligned*/) 71 | { 72 | #if defined (CPUX86) 73 | __asm__ volatile 74 | ( 75 | "fildq %1 \n\t" 76 | "fistpq %0 \n\t" 77 | : "=m"(*target) 78 | : "m" (*source) 79 | : "st", "memory" 80 | ); 81 | #elif defined (CPUX64) 82 | tagged_data temp; 83 | __asm__ volatile 84 | ( 85 | "movaps %2, %0 \n\t" 86 | "movaps %0, %1 \n\t" 87 | : "=&x" (temp), "=m" (*target) 88 | : "m" (*source) 89 | : "memory" 90 | ); 91 | #elif defined (CPUARM32) 92 | tagged_data temp; 93 | __asm__ volatile 94 | ( 95 | "vldr %0, %2 \n\t" 96 | "vstr %0, %1 \n\t" 97 | : "=&w" (temp), "=m" (*target) 98 | : "m" (*source) 99 | : "memory" 100 | ); 101 | #elif defined (CPUARM64) 102 | tagged_data temp; 103 | __asm__ volatile 104 | ( 105 | "ldr %q0, %2 \n\t" 106 | "str %q0, %1 \n\t" 107 | : "=&w" (temp), "=m" (*target) 108 | : "m" (*source) 109 | : "memory" 110 | ); 111 | #endif 112 | } 113 | FORCEINLINE void tagged_read(volatile tagged_unaligned_ptr* target, volatile tagged_ptr* source/*aligned*/) 114 | { 115 | #if defined (CPUX64) 116 | tagged_data temp; 117 | __asm__ volatile 118 | ( 119 | "movaps %2, %0 \n\t" 120 | "movups %0, %1 \n\t" 121 | : "=&x" (temp), "=m" (*target) 122 | : "m" (*source) 123 | : "memory" 124 | ); 125 | #else 126 | tagged_copy(target, source); 127 | #endif 128 | } 129 | FORCEINLINE void tagged_write(volatile tagged_ptr* target/*aligned*/, volatile tagged_unaligned_ptr* source) 130 | { 131 | #if defined (CPUX64) 132 | tagged_data temp; 133 | __asm__ volatile 134 | ( 135 | "movups %2, %0 \n\t" 136 | "movaps %0, %1 \n\t" 137 | : "=&x" (temp), "=m" (*target) 138 | : "m" (*source) 139 | : "memory" 140 | ); 141 | #else 142 | tagged_copy(target, source); 143 | #endif 144 | } 145 | FORCEINLINE tagged_ptr tagged_exchange(tagged_ptr* target/*aligned*/, tagged_unaligned_ptr value) 146 | { 147 | tagged_int ret = atomic_exchange((tagged_int*)target, *((tagged_int*)&value)); 148 | return *((tagged_ptr*)&ret); 149 | } 150 | FORCEINLINE bool tagged_cmp_exchange(tagged_ptr* target/*aligned*/, tagged_unaligned_ptr value, tagged_unaligned_ptr comparand) 151 | { 152 | return atomic_cmp_exchange((tagged_int*)target, *((tagged_int*)&value), *((tagged_int*)&comparand)); 153 | } 154 | 155 | 156 | #endif 157 | -------------------------------------------------------------------------------- /thirdparty/OTL/OtlOptions.inc: -------------------------------------------------------------------------------- 1 | ///<summary>Common compilation settings and conditional defines for the OmniThreadLibrary project.</summary> 2 | ///<author>Primoz Gabrijelcic</author> 3 | ///<license> 4 | ///This software is distributed under the BSD license. 5 | /// 6 | ///Copyright (c) 2019 Primoz Gabrijelcic 7 | ///All rights reserved. 8 | /// 9 | ///Redistribution and use in source and binary forms, with or without modification, 10 | ///are permitted provided that the following conditions are met: 11 | ///- Redistributions of source code must retain the above copyright notice, this 12 | /// list of conditions and the following disclaimer. 13 | ///- Redistributions in binary form must reproduce the above copyright notice, 14 | /// this list of conditions and the following disclaimer in the documentation 15 | /// and/or other materials provided with the distribution. 16 | ///- The name of the Primoz Gabrijelcic may not be used to endorse or promote 17 | /// products derived from this software without specific prior written permission. 18 | /// 19 | ///THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 20 | ///ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 21 | ///WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 22 | ///DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 23 | ///ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 24 | ///(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | ///LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 26 | ///ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 27 | ///(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | ///SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | ///</license> 30 | ///<remarks><para> 31 | /// Author : Primoz Gabrijelcic 32 | /// Creation date : 2010-07-01 33 | /// Last modification : 2019-01-03 34 | /// Version : 1.06 35 | ///</para><para> 36 | /// History: 37 | /// 1.06: 2019-01-03 38 | /// - Introduced OTL_TypeInfoHasTypeData. 39 | /// 1.05: 2018-05-26 40 | /// - Introduced OTL_NameThreadHasStringParameter and OTL_CanInlineOperators. 41 | /// - OTL_StrPasInAnsiStrings moved from XE5 to XE4 section. 42 | /// 1.04: 2012-09-23 43 | /// - Introduced OTL_HasSystemTypes and OTL_LongGetMethodInfo. 44 | /// 1.03: 2011-07-23 45 | /// - Assertions must be always enabled. 46 | /// 1.02: 2010-12-02 47 | /// - Removed OTL_ParallelAggregate. 48 | /// 1.01: 2010-07-25 49 | /// - Introduced OTL_ParallelAggregate. 50 | /// 1.0: 2010-07-01 51 | /// - Released. 52 | ///</para></remarks> 53 | 54 | // See the Configuration block below to configure your build process. 55 | 56 | {$ALIGN 8} 57 | {$BOOLEVAL OFF} 58 | {$EXTENDEDSYNTAX ON} 59 | {$LONGSTRINGS ON} 60 | {$MINENUMSIZE 1} 61 | {$OPENSTRINGS ON} 62 | {$OVERFLOWCHECKS OFF} 63 | {$TYPEDADDRESS OFF} 64 | {$ASSERTIONS ON} 65 | {$TYPEINFO OFF} 66 | 67 | {$IF CompilerVersion >= 26}{$LEGACYIFEND ON}{$IFEND} 68 | 69 | {$IF CompilerVersion < 19} //D2007 70 | {$DEFINE OTL_NeedsWindowsAPIs} 71 | {$IFEND} 72 | 73 | {$IF CompilerVersion >= 20} //D2009 74 | {$DEFINE OTL_Anonymous} 75 | {$DEFINE OTL_Generics} 76 | {$DEFINE OTL_HasInterlockedCompareExchangePointer} 77 | {$DEFINE OTL_NUMASupport} 78 | {$IFEND} 79 | 80 | {$IF CompilerVersion >= 21} //D2010 81 | {$DEFINE OTL_ERTTI} 82 | {$DEFINE OTL_DeprecatedResume} 83 | {$DEFINE OTL_KnowsParamCount} 84 | {$DEFINE OTL_HasTkPointer} 85 | {$DEFINE OTL_HasArrayOfT} 86 | {$DEFINE OTL_HasNameThreadForDebugging} 87 | {$IFEND} 88 | 89 | {$IF CompilerVersion >= 22} //DXE 90 | {$DEFINE OTL_TOmniValueImplicitDateTime} 91 | {$DEFINE OTL_HasThreadID} 92 | {$DEFINE OTL_HasTInterlocked} 93 | {$DEFINE OTL_GoodGenerics} 94 | {$DEFINE OTL_HasTThreadYield} 95 | {$IFEND} 96 | 97 | {$IF CompilerVersion >= 23} //DXE2 98 | {$DEFINE OTL_Supports64Bit} 99 | {$DEFINE OTL_HasSystemTypes} 100 | {$DEFINE OTL_HasCorrectNativeInt} 101 | {$IFEND} 102 | 103 | {$IF CompilerVersion >= 24} //DXE3 104 | {$DEFINE OTL_LongGetMethodInfo} 105 | {$DEFINE OTL_NameThreadHasStringParameter} 106 | {$DEFINE OTL_TypeInfoHasTypeData} 107 | {$IFEND} 108 | 109 | {$IF CompilerVersion >= 25} //DXE4 110 | {$DEFINE OTL_StrPasInAnsiStrings} 111 | {$IFEND} 112 | 113 | {$IF CompilerVersion >= 28} //DX7 114 | {$DEFINE OTL_FixedGenericIncompletelyDefined} 115 | {$IFEND} 116 | 117 | {$IF CompilerVersion >= 29} //DXE8 118 | {$DEFINE OTL_MobileSupport} 119 | {$IFEND} 120 | 121 | {$IF CompilerVersion >= 30} //Seattle 122 | {$DEFINE OTL_CanInlineOperators} 123 | {$IFEND} 124 | 125 | {$IFNDEF MSWINDOWS} 126 | {$IFNDEF OTL_MobileSupport} 127 | {$MESSAGE ERROR 'Only Windows compilation is supported on this Delphi version (at least XE8 is required for non-Windows platforms.'} 128 | {$ENDIF ~OTL_MobileSupport} 129 | {$ENDIF ~MSWINDOWS} 130 | 131 | -------------------------------------------------------------------------------- /thirdparty/OTL/OtlCommon.Utils.pas: -------------------------------------------------------------------------------- 1 | ///<summary>Stuff common to the OmniThreadLibrary project.</summary> 2 | ///<author>Primoz Gabrijelcic</author> 3 | ///<license> 4 | ///This software is distributed under the BSD license. 5 | /// 6 | ///Copyright (c) 2019, Primoz Gabrijelcic 7 | ///All rights reserved. 8 | /// 9 | ///Redistribution and use in source and binary forms, with or without modification, 10 | ///are permitted provided that the following conditions are met: 11 | ///- Redistributions of source code must retain the above copyright notice, this 12 | /// list of conditions and the following disclaimer. 13 | ///- Redistributions in binary form must reproduce the above copyright notice, 14 | /// this list of conditions and the following disclaimer in the documentation 15 | /// and/or other materials provided with the distribution. 16 | ///- The name of the Primoz Gabrijelcic may not be used to endorse or promote 17 | /// products derived from this software without specific prior written permission. 18 | /// 19 | ///THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 20 | ///ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 21 | ///WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 22 | ///DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 23 | ///ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 24 | ///(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | ///LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 26 | ///ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 27 | ///(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | ///SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | ///</license> 30 | ///<remarks><para> 31 | /// Home : http://www.omnithreadlibrary.com 32 | /// Support : https://plus.google.com/communities/112307748950248514961 33 | /// Author : Primoz Gabrijelcic 34 | /// E-Mail : primoz@gabrijelcic.org 35 | /// Blog : http://thedelphigeek.com 36 | /// Contributors : GJ, Lee_Nover, scarre, Sean B. Durkin 37 | /// 38 | /// Creation date : 2011-08-31 39 | /// Last modification : 2018-02-26 40 | /// Version : 1.0b 41 | ///</para><para> 42 | /// History: 43 | /// 1.0b: 2018-02-26 44 | /// - Semantics of OTL_DontSetThreadName was reversed. 45 | /// 1.0a: 2017-11-28 46 | /// - Did not include OtlOptions.inc 47 | /// 1.0: 2011-08-31 48 | /// - [Lee_Nover] SetThreadName implementation moved here. Disabled debug info for 49 | /// the unit. That way, debugger doesn't stop on SetThreadName while 50 | /// single-stepping in another thread. 51 | ///</para></remarks> 52 | 53 | unit OtlCommon.Utils; 54 | 55 | {$I OtlOptions.inc} 56 | {$DEBUGINFO OFF} 57 | 58 | interface 59 | 60 | procedure SetThreadName(const name: string); 61 | 62 | implementation 63 | 64 | {$IFDEF OTL_HasNameThreadForDebugging} 65 | uses 66 | Classes; 67 | {$ELSE ~OTL_HasNameThreadForDebugging} 68 | {$IFDEF MSWINDOWS} 69 | uses 70 | Windows; 71 | {$ENDIF MSWINDOWS} 72 | {$ENDIF ~OTL_HasNameThreadForDebugging} 73 | 74 | threadvar 75 | LastThreadName: string[255]; 76 | 77 | {$IFDEF OTL_DontSetThreadName} 78 | procedure SetThreadName(const name: string); 79 | begin 80 | // do nothing 81 | end; { SetThreadName } 82 | {$ELSE} 83 | 84 | {$IFDEF OTL_HasNameThreadForDebugging} 85 | 86 | procedure SetThreadName(const name: string); 87 | var 88 | ansiName: AnsiString; 89 | begin 90 | ansiName := AnsiString(name); 91 | if ansiName = LastThreadName then 92 | Exit; 93 | 94 | TThread.NameThreadForDebugging({$IFDEF OTL_NameThreadHasStringParameter}name{$ELSE}ansiName{$ENDIF}); 95 | LastThreadName := ansiName; 96 | end; { SetThreadName } 97 | 98 | {$ELSE ~OTL_HasNameThreadForDebugging} 99 | {$IFDEF MSWINDOWS} 100 | {$WARN SYMBOL_PLATFORM OFF} 101 | 102 | procedure SetThreadName(const name: string); 103 | type 104 | TThreadNameInfo = record 105 | FType : LongWord; // must be 0x1000 106 | FName : PAnsiChar;// pointer to name (in user address space) 107 | FThreadID: LongWord; // thread ID (-1 indicates caller thread) 108 | FFlags : LongWord; // reserved for future use, must be zero 109 | end; { TThreadNameInfo } 110 | var 111 | ansiName : AnsiString; 112 | threadNameInfo: TThreadNameInfo; 113 | begin 114 | if DebugHook <> 0 then begin 115 | ansiName := AnsiString(name); 116 | if ansiName = LastThreadName then 117 | Exit; 118 | threadNameInfo.FType := $1000; 119 | threadNameInfo.FName := PAnsiChar(ansiName); 120 | threadNameInfo.FThreadID := $FFFFFFFF; 121 | threadNameInfo.FFlags := 0; 122 | try 123 | RaiseException($406D1388, 0, SizeOf(threadNameInfo) div SizeOf(LongWord), @threadNameInfo); 124 | except {ignore} end; 125 | LastThreadName := ansiName; 126 | end; 127 | end; { SetThreadName } 128 | 129 | {$WARN SYMBOL_PLATFORM ON} 130 | {$ELSE ~MSWINDOWS} 131 | 132 | procedure SetThreadName(const name: string); 133 | begin 134 | end; { SetThreadName } 135 | 136 | {$ENDIF ~MSWINDOWS} 137 | {$ENDIF ~OTL_HasNameThreadForDebugging} 138 | {$ENDIF ~OTL_DontSetThreadName} 139 | 140 | end. 141 | -------------------------------------------------------------------------------- /TINY.DEFINES.inc: -------------------------------------------------------------------------------- 1 | 2 | { RTTI defines } 3 | 4 | {$ifdef RTTION_ALL} 5 | {$define RTTION} 6 | {$define RTTION_FIELDS_ALL} 7 | {$define RTTION_PROPERTIES_ALL} 8 | {$define RTTION_METHODS_ALL} 9 | {$endif} 10 | {$ifdef RTTION_FIELDS_ALL} 11 | {$define RTTION_FIELDS} 12 | {$endif} 13 | {$ifdef RTTION_PROPERTIES_ALL} 14 | {$define RTTION_PROPERTIES} 15 | {$endif} 16 | {$ifdef RTTION_METHODS_ALL} 17 | {$define RTTION_METHODS} 18 | {$endif} 19 | {$ifdef RTTION} 20 | {$define RTTION_INTERFACE} 21 | {$define RTTION_FIELDS} 22 | {$define RTTION_PROPERTIES} 23 | {$define RTTION_METHODS} 24 | {$endif} 25 | 26 | 27 | { Compiler options } 28 | 29 | {$ifdef FPC} 30 | {$MODE DELPHIUNICODE} 31 | {$MODESWITCH CVAR} 32 | {$ASMMODE INTEL} 33 | {$define INLINESUPPORT} 34 | {$define INLINESUPPORTSIMPLE} 35 | {$define OPERATORSUPPORT} 36 | {$define STATICSUPPORT} 37 | {$define SMALLOBJECTSUPPORT} 38 | {$define CLASSCONSTRUCTORSUPPORT} 39 | {$define GENERICSUPPORT} 40 | {$define GENERICSUPPORTSIMPLE} 41 | {$define ANSISTRSUPPORT} 42 | {$define SHORTSTRSUPPORT} 43 | {$define WIDESTRSUPPORT} 44 | {$define INTERNALCODEPAGE} 45 | {$ifdef CPU386} 46 | {$define CPUX86} 47 | {$endif} 48 | {$ifdef CPUX86_64} 49 | {$define CPUX64} 50 | {$endif} 51 | {$if Defined(CPUARM) or Defined(UNIX)} 52 | {$define POSIX} 53 | {$ifend} 54 | {$else} 55 | {$if CompilerVersion >= 24} 56 | {$LEGACYIFEND ON} 57 | {$ifend} 58 | {$if CompilerVersion <= 22} 59 | {$define CPUX86} 60 | {$ifend} 61 | {$if CompilerVersion >= 15} 62 | {$WARN UNSAFE_CODE OFF} 63 | {$WARN UNSAFE_TYPE OFF} 64 | {$WARN UNSAFE_CAST OFF} 65 | {$WARN SYMBOL_DEPRECATED OFF} 66 | {$ifend} 67 | {$if CompilerVersion >= 17} 68 | {$define INLINESUPPORTSIMPLE} 69 | {$ifend} 70 | {$if CompilerVersion >= 18} 71 | {$define OPERATORSUPPORT} 72 | {$ifend} 73 | {$if CompilerVersion >= 18.5} 74 | {$define STATICSUPPORT} 75 | {$ifend} 76 | {$if CompilerVersion >= 20} 77 | {$define INLINESUPPORT} 78 | {$define SMALLOBJECTSUPPORT} 79 | {$define CLASSCONSTRUCTORSUPPORT} 80 | {$define GENERICSUPPORTSIMPLE} 81 | {$define GENERICMETHODSUPPORTSIMPLE} 82 | {$define SYSARRAYSUPPORT} 83 | {$ifend} 84 | {$if CompilerVersion >= 21} 85 | {$WEAKLINKRTTI ON} 86 | {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} 87 | {$define EXTENDEDRTTI} 88 | {$ifend} 89 | {$if CompilerVersion >= 22} 90 | {$define GENERICSUPPORT} 91 | {$define GENERICMETHODSUPPORT} 92 | {$ifend} 93 | {$if CompilerVersion >= 23} 94 | {$define UNITSCOPENAMES} 95 | {$define RETURNADDRESSSUPPORT} 96 | {$define MONITORSUPPORT} 97 | {$ifend} 98 | {$if CompilerVersion >= 31} 99 | {$define VOLATILESUPPORT} 100 | {$ifend} 101 | {$if CompilerVersion >= 34} 102 | {$define MANAGEDRECORDS} 103 | {$ifend} 104 | {$if (not Defined(NEXTGEN)) or (CompilerVersion >= 31)} 105 | {$define ANSISTRSUPPORT} 106 | {$ifend} 107 | {$ifNdef NEXTGEN} 108 | {$define SHORTSTRSUPPORT} 109 | {$endif} 110 | {$if Defined(MSWINDOWS)} 111 | {$define WIDESTRSUPPORT} 112 | {$ifend} 113 | {$if Defined(ANSISTRSUPPORT) and (CompilerVersion >= 20)} 114 | {$define INTERNALCODEPAGE} 115 | {$ifend} 116 | {$if Defined(NEXTGEN)} 117 | {$POINTERMATH ON} 118 | {$ifend} 119 | {$endif} 120 | {$if (not Defined(FPC)) and Defined(IOS) and Defined(CPUARM32) and (CompilerVersion < 28)} 121 | {$define ARM_NO_VFP_USE} 122 | {$ifend} 123 | {$if Defined(MSWINDOWS)} 124 | {$define WIDESTRLENSHIFT} 125 | {$ifend} 126 | {$if Defined(INTERNALCODEPAGE) or not Defined(ANSISTRSUPPORT)} 127 | {$define CODEPAGESUPPORT} 128 | {$ifend} 129 | {$if Defined(CPUX86) or (Defined(CPUX64) and not Defined(MSWINDOWS))} 130 | {$define EXTENDEDSUPPORT} 131 | {$ifend} 132 | {$if (not Defined(FPC)) and Defined(POSIX64)} 133 | {$define HFASUPPORT} 134 | {$ifend} 135 | {$if Defined(FPC) or (CompilerVersion >= 23)} 136 | {$define OBJLINKNAME} 137 | {$ifend} 138 | {$U-}{$V+}{$B-}{$X+}{$T+}{$P+}{$H+}{$J-}{$Z1}{$A4} 139 | {$O+}{$R-}{$I-}{$Q-}{$W-} 140 | {$ifdef CPUX86} 141 | {$if not Defined(NEXTGEN)} 142 | {$define CPUX86ASM} 143 | {$define CPUINTELASM} 144 | {$ifend} 145 | {$define CPUINTEL} 146 | {$endif} 147 | {$ifdef CPUX64} 148 | {$if (not Defined(POSIX)) or Defined(FPC)} 149 | {$define CPUX64ASM} 150 | {$define CPUINTELASM} 151 | {$ifend} 152 | {$define CPUINTEL} 153 | {$endif} 154 | {$if Defined(CPUINTEL) and Defined(POSIX)} 155 | {$ifdef CPUX86} 156 | {$define POSIXINTEL32} 157 | {$else} 158 | {$define POSIXINTEL64} 159 | {$endif} 160 | {$ifend} 161 | {$if Defined(CPUX64) or Defined(CPUARM64)} 162 | {$define LARGEINT} 163 | {$else} 164 | {$define SMALLINT} 165 | {$ifend} 166 | {$ifdef KOL_MCK} 167 | {$define KOL} 168 | {$endif} 169 | 170 | 171 | { RTTI including } 172 | 173 | {$ifdef RTTION_INTERFACE} 174 | {$M+} 175 | {$endif} 176 | {$ifdef EXTENDEDRTTI} 177 | {$ifdef RTTION_FIELDS} 178 | {$ifdef RTTION_FIELDS_ALL} 179 | {$RTTI EXPLICIT FIELDS([vcPrivate, vcProtected, vcPublic, vcPublished])} 180 | {$else} 181 | {$RTTI EXPLICIT FIELDS([vcPublic, vcPublished])} 182 | {$endif} 183 | {$endif} 184 | {$ifdef RTTION_PROPERTIES} 185 | {$ifdef RTTION_PROPERTIES_ALL} 186 | {$RTTI EXPLICIT PROPERTIES([vcPrivate, vcProtected, vcPublic, vcPublished])} 187 | {$else} 188 | {$RTTI EXPLICIT PROPERTIES([vcPublic, vcPublished])} 189 | {$endif} 190 | {$endif} 191 | {$ifdef RTTION_METHODS} 192 | {$ifdef RTTION_METHODS_ALL} 193 | {$RTTI EXPLICIT METHODS([vcPrivate, vcProtected, vcPublic, vcPublished])} 194 | {$else} 195 | {$RTTI EXPLICIT METHODS([vcPublic, vcPublished])} 196 | {$endif} 197 | {$endif} 198 | {$endif} 199 | -------------------------------------------------------------------------------- /demo/text/FileReaders.dpr: -------------------------------------------------------------------------------- 1 | program FileReaders; 2 | 3 | {$I TINY.DEFINES.inc} 4 | {$APPTYPE CONSOLE} 5 | 6 | uses {$ifdef UNITSCOPENAMES} 7 | Winapi.Windows, System.SysUtils, System.Classes, 8 | {$else} 9 | Windows, SysUtils, Classes, 10 | {$endif} 11 | Tiny.Types, Tiny.Text, Tiny.Cache.Text; 12 | 13 | 14 | // test file information 15 | const 16 | STRINGS_COUNT = 1000; 17 | ITERATIONS_COUNT = 22000; 18 | CORRECT_LINES_COUNT = ITERATIONS_COUNT * STRINGS_COUNT; 19 | CORRECT_FILE_NAME = 'Correct.txt'; 20 | 21 | procedure GenerateTestFile; 22 | var 23 | Iteration, i: Integer; 24 | T: TextFile; 25 | Buffer: array[Word] of Byte; 26 | begin 27 | AssignFile(T, CORRECT_FILE_NAME); 28 | ReWrite(T); 29 | SetTextBuf(T, Buffer); 30 | try 31 | // UTF-8 BOM 32 | Write(T, AnsiString(#$EF#$BB#$BF)); 33 | 34 | // text 35 | SetTextCodePage(T, CODEPAGE_UTF8); 36 | for Iteration := 1 to ITERATIONS_COUNT do 37 | for i := 1 to STRINGS_COUNT do 38 | Writeln(T, i); 39 | finally 40 | CloseFile(T); 41 | end; 42 | end; 43 | 44 | 45 | type 46 | TReaderMethod = function(const FileName: string): Integer; 47 | 48 | 49 | function StringListReader(const FileName: string): Integer; 50 | var 51 | List: TStringList; 52 | begin 53 | List := TStringList.Create; 54 | try 55 | List.LoadFromFile(FileName); 56 | Result := List.Count; 57 | finally 58 | List.Free; 59 | end; 60 | end; 61 | 62 | function TextFileReader(const FileName: string): Integer; 63 | var 64 | T: TextFile; 65 | S: string; 66 | begin 67 | Result := 0; 68 | 69 | AssignFile(T, FileName); 70 | Reset(T); 71 | SetTextCodePage(T, CODEPAGE_UTF8); 72 | try 73 | while (not EOF(T)) do 74 | begin 75 | Readln(T, S); 76 | Inc(Result); 77 | end; 78 | finally 79 | CloseFile(T); 80 | end; 81 | end; 82 | 83 | function BufferedTextFileReader(const FileName: string): Integer; 84 | var 85 | T: TextFile; 86 | S: string; 87 | Buffer: array[Word] of Byte; 88 | begin 89 | Result := 0; 90 | 91 | AssignFile(T, FileName); 92 | Reset(T); 93 | SetTextBuf(T, Buffer); 94 | SetTextCodePage(T, CODEPAGE_UTF8); 95 | try 96 | while (not EOF(T)) do 97 | begin 98 | Readln(T, S); 99 | Inc(Result); 100 | end; 101 | finally 102 | CloseFile(T); 103 | end; 104 | end; 105 | 106 | function CachedANSIReader(const FileName: string): Integer; 107 | var 108 | T: TByteTextReader; 109 | S: ByteString; 110 | begin 111 | Result := 0; 112 | 113 | T := TByteTextReader.CreateFromFile(0, FileName); 114 | try 115 | while (T.Readln(S)) do 116 | begin 117 | Inc(Result); 118 | end; 119 | finally 120 | T.Free 121 | end; 122 | end; 123 | 124 | function CachedUTF8Reader(const FileName: string): Integer; 125 | var 126 | T: TByteTextReader; 127 | S: ByteString; 128 | begin 129 | Result := 0; 130 | 131 | T := TByteTextReader.CreateFromFile(CODEPAGE_UTF8, FileName); 132 | try 133 | while (T.Readln(S)) do 134 | begin 135 | Inc(Result); 136 | end; 137 | finally 138 | T.Free 139 | end; 140 | end; 141 | 142 | function CachedUTF16Reader(const FileName: string): Integer; 143 | var 144 | T: TUTF16TextReader; 145 | S: UTF16String; 146 | begin 147 | Result := 0; 148 | 149 | T := TUTF16TextReader.CreateFromFile(FileName); 150 | try 151 | while (T.Readln(S)) do 152 | begin 153 | Inc(Result); 154 | end; 155 | finally 156 | T.Free 157 | end; 158 | end; 159 | 160 | function CachedUTF32Reader(const FileName: string): Integer; 161 | var 162 | T: TUTF32TextReader; 163 | S: UTF32String; 164 | begin 165 | Result := 0; 166 | 167 | T := TUTF32TextReader.CreateFromFile(FileName); 168 | try 169 | while (T.Readln(S)) do 170 | begin 171 | Inc(Result); 172 | end; 173 | finally 174 | T.Free 175 | end; 176 | end; 177 | 178 | 179 | var 180 | ReaderMethodNumber: Cardinal = 0; 181 | 182 | procedure RunReaderMethod(const Description: string; const ReaderMethod: TReaderMethod); 183 | var 184 | Time: Cardinal; 185 | LinesCount: Integer; 186 | begin 187 | // reset filesystem cache to have same test conditions 188 | // (thanks for Sapersky) 189 | FileClose(CreateFile(PChar(CORRECT_FILE_NAME), GENERIC_READ, FILE_SHARE_READ, nil ,OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, 0)); 190 | 191 | Inc(ReaderMethodNumber); 192 | Write(ReaderMethodNumber, ') ', Description, '...'); 193 | Time := GetTickCount; 194 | LinesCount := ReaderMethod(CORRECT_FILE_NAME); 195 | Time := GetTickCount - Time; 196 | 197 | Write(' ', Time, 'ms'); 198 | if (LinesCount <> CORRECT_LINES_COUNT) then Write(' FAILURE LINES COUNT = ', LinesCount); 199 | Writeln; 200 | end; 201 | 202 | 203 | begin 204 | try 205 | // benchmark text 206 | Writeln('The benchmark shows how to use TCachedTextReader-classes to carry out'); 207 | Writeln('the reading of text files lines by analogy with standard solutions.'); 208 | if (not FileExists(CORRECT_FILE_NAME)) then 209 | begin 210 | Write('Correct file generating... '); 211 | GenerateTestFile; 212 | Writeln('done.'); 213 | end; 214 | 215 | // run readers, measure time, compare lines count 216 | Writeln; 217 | RunReaderMethod('TStringList <-- UTF8', StringListReader); 218 | RunReaderMethod('TextFile <-- UTF8', TextFileReader); 219 | RunReaderMethod('TextFile + Buffer <-- UTF8', BufferedTextFileReader); 220 | RunReaderMethod('CachedByteReader ANSI <-- UTF8', CachedANSIReader); 221 | RunReaderMethod('CachedByteReader UTF8 <-- UTF8', CachedUTF8Reader); 222 | RunReaderMethod('CachedUTF16Reader <-- UTF8', CachedUTF16Reader); 223 | RunReaderMethod('CachedUTF32Reader <-- UTF8', CachedUTF32Reader); 224 | 225 | except 226 | on E: Exception do 227 | Writeln(E.ClassName, ': ', E.Message); 228 | end; 229 | 230 | if (ParamStr(1) <> '-nowait') then 231 | begin 232 | Writeln; 233 | Write('Press Enter to quit'); 234 | Readln; 235 | end; 236 | end. 237 | -------------------------------------------------------------------------------- /demo/generics/uSortings.pas: -------------------------------------------------------------------------------- 1 | unit uSortings; 2 | 3 | {$I TINY.DEFINES.inc} 4 | 5 | interface 6 | uses 7 | Winapi.Windows, System.SysUtils, Generics.Defaults, Generics.Collections, 8 | Tiny.Types, Tiny.Generics; 9 | 10 | const 11 | ITEMS_COUNT = 1000000; 12 | 13 | type 14 | TProc = procedure of object; 15 | 16 | {$M+} 17 | TTest<T> = class 18 | public type 19 | TItems = array[0..ITEMS_COUNT - 1] of T; 20 | TRandomFunc = reference to function: T; 21 | public 22 | Items: TItems; 23 | SourceItems: TItems; 24 | Comparison: Generics.Defaults.TComparison<T>; 25 | 26 | constructor Create(const RandomFunc: TRandomFunc; const AComparison: Generics.Defaults.TComparison<T>); 27 | destructor Destroy; override; 28 | procedure Run(const SystemTest, TinyTest: TProc; const IterationsCount: Integer; 29 | const MakeCopy: Boolean = True); 30 | 31 | procedure RunEach; 32 | published 33 | procedure SystemSortComparison; 34 | procedure TinySortComparison; 35 | procedure SystemSort; 36 | procedure TinySort; 37 | procedure SystemSearchComparison; 38 | procedure TinySearchComparison; 39 | procedure SystemSearch; 40 | procedure TinySearch; 41 | end; 42 | {$M-} 43 | 44 | 45 | procedure Run; 46 | 47 | implementation 48 | 49 | 50 | procedure Run; 51 | begin 52 | with TTest<string>.Create( 53 | function: string 54 | var 55 | Len, i: Integer; 56 | begin 57 | Len := 5 + Random(8); 58 | SetLength(Result, Len); 59 | 60 | for i := 1 to Len do 61 | Result[i] := Char(Ord('A') + Random(Ord('Z') - Ord('A') + 1)); 62 | end, 63 | function(const Left, Right: string): Integer 64 | begin 65 | Result := CompareStr(Left, Right); 66 | end) do 67 | try 68 | RunEach; 69 | finally 70 | Free; 71 | end; 72 | 73 | with TTest<Single>.Create( 74 | function: Single 75 | begin 76 | Result := Random * ITEMS_COUNT; 77 | end, 78 | function(const Left, Right: Single): Integer 79 | begin 80 | Result := Shortint(Byte(Left >= Right) - Byte(Left <= Right)); 81 | end) do 82 | try 83 | RunEach; 84 | finally 85 | Free; 86 | end; 87 | 88 | with TTest<Integer>.Create( 89 | function: Integer 90 | begin 91 | Result := Random(ITEMS_COUNT); 92 | end, 93 | function(const Left, Right: Integer): Integer 94 | begin 95 | Result := Shortint(Byte(Left >= Right) - Byte(Left <= Right)); 96 | end) do 97 | try 98 | RunEach; 99 | finally 100 | Free; 101 | end; 102 | end; 103 | 104 | 105 | { TTest<T> } 106 | 107 | constructor TTest<T>.Create(const RandomFunc: TRandomFunc; const AComparison: Generics.Defaults.TComparison<T>); 108 | var 109 | i: Integer; 110 | begin 111 | Comparison := AComparison; 112 | 113 | for i := Low(TItems) to High(TItems) do 114 | SourceItems[i] := RandomFunc; 115 | end; 116 | 117 | destructor TTest<T>.Destroy; 118 | begin 119 | FillChar(Items, SizeOf(Items), #0); 120 | inherited; 121 | end; 122 | 123 | procedure TTest<T>.Run(const SystemTest, TinyTest: TProc; const IterationsCount: Integer; 124 | const MakeCopy: Boolean); 125 | var 126 | i: Integer; 127 | N: Boolean; 128 | Proc: TProc; 129 | TotalTime, Time: Cardinal; 130 | begin 131 | for N := Low(Boolean) to High(Boolean) do 132 | begin 133 | Proc := SystemTest; 134 | if (N = True) then Proc := TinyTest; 135 | Write(Self.MethodName(TMethod(Proc).Code), '... '); 136 | 137 | TotalTime := 0; 138 | for i := 1 to IterationsCount do 139 | begin 140 | if (MakeCopy) then 141 | begin 142 | Move(SourceItems, Items, SizeOf(TItems)); 143 | end; 144 | 145 | Time := GetTickCount; 146 | Proc; 147 | Time := GetTickCount - Time; 148 | 149 | Inc(TotalTime, Time); 150 | end; 151 | 152 | Writeln(TotalTime, 'ms'); 153 | end; 154 | end; 155 | 156 | procedure TTest<T>.SystemSortComparison; 157 | begin 158 | Generics.Collections.TArray.Sort<T>(Items, 159 | Generics.Defaults.TComparer<T>.Construct(Comparison) 160 | ); 161 | end; 162 | 163 | procedure TTest<T>.TinySortComparison; 164 | begin 165 | Tiny.Generics.TArray.Sort<T>(Items, 166 | Tiny.Generics.TComparer<T>.Construct(Tiny.Generics.TComparison<T>(Comparison)) 167 | ); 168 | end; 169 | 170 | procedure TTest<T>.SystemSort; 171 | begin 172 | Generics.Collections.TArray.Sort<T>(Items); 173 | end; 174 | 175 | procedure TTest<T>.TinySort; 176 | begin 177 | Tiny.Generics.TArray.Sort<T>(Items); 178 | end; 179 | 180 | procedure TTest<T>.SystemSearchComparison; 181 | var 182 | i: NativeInt; 183 | Index: Integer; 184 | Found: Boolean; 185 | begin 186 | for i := Low(Items) to High(Items) do 187 | begin 188 | Found := Generics.Collections.TArray.BinarySearch<T>(Items, Items[i], 189 | Index, Generics.Defaults.TComparer<T>.Construct(Comparison) 190 | ); 191 | 192 | if (not Found) then 193 | raise Exception.Create(''); 194 | end; 195 | end; 196 | 197 | procedure TTest<T>.TinySearchComparison; 198 | var 199 | i: NativeInt; 200 | Index: Integer; 201 | Found: Boolean; 202 | begin 203 | for i := Low(Items) to High(Items) do 204 | begin 205 | Found := Tiny.Generics.TArray.BinarySearch<T>(Items, Items[i], 206 | Index, Tiny.Generics.TComparer<T>.Construct(Tiny.Generics.TComparison<T>(Comparison)) 207 | ); 208 | 209 | if (not Found) then 210 | raise Exception.Create(''); 211 | end; 212 | end; 213 | 214 | procedure TTest<T>.SystemSearch; 215 | var 216 | i: NativeInt; 217 | Index: Integer; 218 | Found: Boolean; 219 | begin 220 | for i := Low(Items) to High(Items) do 221 | begin 222 | Found := Generics.Collections.TArray.BinarySearch<T>(Items, Items[i], Index); 223 | 224 | if (not Found) then 225 | raise Exception.Create(''); 226 | end; 227 | end; 228 | 229 | 230 | procedure TTest<T>.TinySearch; 231 | var 232 | i: NativeInt; 233 | Index: Integer; 234 | Found: Boolean; 235 | begin 236 | for i := Low(Items) to High(Items) do 237 | begin 238 | Found := Tiny.Generics.TArray.BinarySearch<T>(Items, Items[i], Index); 239 | 240 | if (not Found) then 241 | raise Exception.Create(''); 242 | end; 243 | end; 244 | 245 | procedure TTest<T>.RunEach; 246 | begin 247 | Writeln; 248 | Writeln(PShortString(NativeUInt(TypeInfo(T)) + 1)^); 249 | 250 | Run(SystemSortComparison, TinySortComparison, 5); 251 | Run(SystemSort, TinySort, 5); 252 | Run(SystemSearchComparison, TinySearchComparison, 5, False); 253 | Run(SystemSearch, TinySearch, 5, False); 254 | end; 255 | 256 | end. 257 | -------------------------------------------------------------------------------- /utilities/cached_serializer/examples/xml_encodings.txt: -------------------------------------------------------------------------------- 1 | -utf8 -p"Str" -i 2 | 3 | unicode-1-1-utf-8:utf-8: CP \:= CODEPAGE_UTF8; 4 | utf-8:utf-8 5 | utf8:utf-8 6 | 7 | 866:ibm866: CP \:= 866; 8 | cp866:ibm866 9 | csibm866:ibm866 10 | ibm866:ibm866 11 | 12 | csisolatin2:iso-8859-2: CP \:= 28592; 13 | iso-8859-2:iso-8859-2 14 | iso-ir-101:iso-8859-2 15 | iso8859-2:iso-8859-2 16 | iso88592:iso-8859-2 17 | iso_8859-2:iso-8859-2 18 | iso_8859-2\:1987:iso-8859-2 19 | l2:iso-8859-2 20 | latin2:iso-8859-2 21 | 22 | csisolatin3:iso-8859-3: CP \:= 28593; 23 | iso-8859-3:iso-8859-3 24 | iso-ir-109:iso-8859-3 25 | iso8859-3:iso-8859-3 26 | iso88593:iso-8859-3 27 | iso_8859-3:iso-8859-3 28 | iso_8859-3\:1988:iso-8859-3 29 | l3:iso-8859-3 30 | latin3:iso-8859-3 31 | 32 | csisolatin4:iso-8859-4: CP \:= 28594; 33 | iso-8859-4:iso-8859-4 34 | iso-ir-110:iso-8859-4 35 | iso8859-4:iso-8859-4 36 | iso88594:iso-8859-4 37 | iso_8859-4:iso-8859-4 38 | iso_8859-4\:1988:iso-8859-4 39 | l4:iso-8859-4 40 | latin4:iso-8859-4 41 | 42 | csisolatincyrillic:iso-8859-5: CP \:= 28595; 43 | cyrillic:iso-8859-5 44 | iso-8859-5:iso-8859-5 45 | iso-ir-144:iso-8859-5 46 | iso8859-5:iso-8859-5 47 | iso88595:iso-8859-5 48 | iso_8859-5:iso-8859-5 49 | iso_8859-5\:1988:iso-8859-5 50 | 51 | arabic:iso-8859-6: CP \:= 28596; 52 | asmo-708:iso-8859-6 53 | csiso88596e:iso-8859-6 54 | csiso88596i:iso-8859-6 55 | csisolatinarabic:iso-8859-6 56 | ecma-114:iso-8859-6 57 | iso-8859-6:iso-8859-6 58 | iso-8859-6-e:iso-8859-6 59 | iso-8859-6-i:iso-8859-6 60 | iso-ir-127:iso-8859-6 61 | iso8859-6:iso-8859-6 62 | iso88596:iso-8859-6 63 | iso_8859-6:iso-8859-6 64 | iso_8859-6\:1987:iso-8859-6 65 | 66 | csisolatingreek:iso-8859-7: CP \:= 28597; 67 | ecma-118:iso-8859-7 68 | elot_928:iso-8859-7 69 | greek:iso-8859-7 70 | greek8:iso-8859-7 71 | iso-8859-7:iso-8859-7 72 | iso-ir-126:iso-8859-7 73 | iso8859-7:iso-8859-7 74 | iso88597:iso-8859-7 75 | iso_8859-7:iso-8859-7 76 | iso_8859-7\:1987:iso-8859-7 77 | sun_eu_greek:iso-8859-7 78 | 79 | csiso88598e:iso-8859-8: CP \:= 28598; 80 | csisolatinhebrew:iso-8859-8 81 | hebrew:iso-8859-8 82 | iso-8859-8:iso-8859-8 83 | iso-8859-8-e:iso-8859-8 84 | iso-ir-138:iso-8859-8 85 | iso8859-8:iso-8859-8 86 | iso88598:iso-8859-8 87 | iso_8859-8:iso-8859-8 88 | iso_8859-8\:1988:iso-8859-8 89 | visual:iso-8859-8 90 | 91 | csiso88598i:iso-8859-8-i: CP \:= 28598; 92 | iso-8859-8-i:iso-8859-8-i 93 | logical:iso-8859-8-i 94 | 95 | csisolatin6:iso-8859-10: CP \:= 28600; 96 | iso-8859-10:iso-8859-10 97 | iso-ir-157:iso-8859-10 98 | iso8859-10:iso-8859-10 99 | iso885910:iso-8859-10 100 | l6:iso-8859-10 101 | latin6:iso-8859-10 102 | 103 | iso-8859-13:iso-8859-13: CP \:= 28603; 104 | iso8859-13:iso-8859-13 105 | iso885913:iso-8859-13 106 | 107 | iso-8859-14:iso-8859-14: CP \:= 28604; 108 | iso8859-14:iso-8859-14 109 | iso885914:iso-8859-14 110 | 111 | csisolatin9:iso-8859-15: CP \:= 28605; 112 | iso-8859-15:iso-8859-15 113 | iso8859-15:iso-8859-15 114 | iso885915:iso-8859-15 115 | iso_8859-15:iso-8859-15 116 | l9:iso-8859-15 117 | 118 | iso-8859-16:iso-8859-16: CP \:= 28606; 119 | 120 | cskoi8r:koi8-r: CP \:= 20866; 121 | koi:koi8-r 122 | koi8:koi8-r 123 | koi8-r:koi8-r 124 | koi8_r:koi8-r 125 | 126 | koi8-u:koi8-u: CP \:= 21866; 127 | 128 | csmacintosh:macintosh: CP \:= 10000; 129 | mac:macintosh 130 | macintosh:macintosh 131 | x-mac-roman:macintosh 132 | 133 | dos-874:windows-874: CP \:= 874; 134 | iso-8859-11:windows-874 135 | iso8859-11:windows-874 136 | iso885911:windows-874 137 | tis-620:windows-874 138 | windows-874:windows-874 139 | 140 | cp1250:windows-1250: CP \:= 1250; 141 | windows-1250:windows-1250 142 | x-cp1250:windows-1250 143 | 144 | cp1251:windows-1251: CP \:= 1251; 145 | windows-1251:windows-1251 146 | x-cp1251:windows-1251 147 | 148 | ansi_x3.4-1968:windows-1252: CP \:= 1252; 149 | ascii:windows-1252 150 | cp1252:windows-1252 151 | cp819:windows-1252 152 | csisolatin1:windows-1252 153 | ibm819:windows-1252 154 | iso-8859-1:windows-1252 155 | iso-ir-100:windows-1252 156 | iso8859-1:windows-1252 157 | iso88591:windows-1252 158 | iso_8859-1:windows-1252 159 | iso_8859-1\:1987:windows-1252 160 | l1:windows-1252 161 | latin1:windows-1252 162 | us-ascii:windows-1252 163 | windows-1252:windows-1252 164 | x-cp1252:windows-1252 165 | 166 | cp1253:windows-1253: CP \:= 1253; 167 | windows-1253:windows-1253 168 | x-cp1253:windows-1253 169 | 170 | cp1254:windows-1254: CP \:= 1254; 171 | csisolatin5:windows-1254 172 | iso-8859-9:windows-1254 173 | iso-ir-148:windows-1254 174 | iso8859-9:windows-1254 175 | iso88599:windows-1254 176 | iso_8859-9:windows-1254 177 | iso_8859-9\:1989:windows-1254 178 | l5:windows-1254 179 | latin5:windows-1254 180 | windows-1254:windows-1254 181 | x-cp1254:windows-1254 182 | 183 | cp1255:windows-1255: CP \:= 1255; 184 | windows-1255:windows-1255 185 | x-cp1255:windows-1255 186 | 187 | cp1256:windows-1256: CP \:= 1256; 188 | windows-1256:windows-1256 189 | x-cp1256:windows-1256 190 | 191 | cp1257:windows-1257: CP \:= 1257; 192 | windows-1257:windows-1257 193 | x-cp1257:windows-1257 194 | 195 | cp1258:windows-1258: CP \:= 1258; 196 | windows-1258:windows-1258 197 | x-cp1258:windows-1258 198 | 199 | x-mac-cyrillic:x-mac-cyrillic: CP \:= 10007; 200 | x-mac-ukrainian:x-mac-cyrillic 201 | 202 | chinese:gb18030: CP \:= 54936; 203 | csgb2312:gb18030 204 | csiso58gb231280:gb18030 205 | gb18030:gb18030 206 | gb2312:gb18030 207 | gb_2312:gb18030 208 | gb_2312-80:gb18030 209 | gbk:gb18030 210 | iso-ir-58:gb18030 211 | x-gbk:gb18030 212 | 213 | hz-gb-2312:hz-gb-2312: CP \:= 52936; 214 | 215 | big5:big5: CP \:= 950; 216 | big5-hkscs:big5 217 | cn-big5:big5 218 | csbig5:big5 219 | x-x-big5:big5 220 | 221 | cseucpkdfmtjapanese:euc-jp: CP \:= 20932; 222 | euc-jp:euc-jp 223 | x-euc-jp:euc-jp 224 | 225 | csiso2022jp:iso-2022-jp: CP \:= 50221; 226 | iso-2022-jp:iso-2022-jp 227 | 228 | csshiftjis:shift_jis: CP \:= 932; 229 | ms_kanji:shift_jis 230 | shift-jis:shift_jis 231 | shift_jis:shift_jis 232 | sjis:shift_jis 233 | windows-31j:shift_jis 234 | x-sjis:shift_jis 235 | 236 | cseuckr:euc-kr: CP \:= 51949; 237 | csksc56011987:euc-kr 238 | euc-kr:euc-kr 239 | iso-ir-149:euc-kr 240 | korean:euc-kr 241 | ks_c_5601-1987:euc-kr 242 | ks_c_5601-1989:euc-kr 243 | ksc5601:euc-kr 244 | ksc_5601:euc-kr 245 | windows-949:euc-kr 246 | 247 | csiso2022kr:replacement: CP \:= 949; 248 | iso-2022-cn:replacement 249 | iso-2022-cn-ext:replacement 250 | iso-2022-kr:replacement 251 | 252 | utf-16be:utf-16be: CP \:= CODEPAGE_UTF16BE; 253 | 254 | utf-16:utf-16le: CP \:= CODEPAGE_UTF16; 255 | utf-16le:utf-16le 256 | 257 | x-user-defined:x-user-defined: CP \:= CODEPAGE_USERDEFINED; 258 | -------------------------------------------------------------------------------- /demo/text/FileWriters.dpr: -------------------------------------------------------------------------------- 1 | program FileWriters; 2 | 3 | {$I TINY.DEFINES.inc} 4 | {$APPTYPE CONSOLE} 5 | 6 | uses {$ifdef UNITSCOPENAMES} 7 | Winapi.Windows, System.SysUtils, System.Classes, 8 | {$else} 9 | Windows, SysUtils, Classes, 10 | {$endif} 11 | Tiny.Types, Tiny.Text, Tiny.Cache.Text; 12 | 13 | 14 | // test file information 15 | const 16 | STRINGS_COUNT = 1000; 17 | ITERATIONS_COUNT = 22000; 18 | CORRECT_LINES_COUNT = ITERATIONS_COUNT * STRINGS_COUNT; 19 | CORRECT_FILE_NAME = 'Correct.txt'; 20 | OUTPUT_FILE_NAME = 'Output.txt'; 21 | 22 | procedure CompareOutputAndCorrectFiles; 23 | var 24 | F1, F2: TFileStream; 25 | Size: Int64; 26 | Count: Integer; 27 | Same: Boolean; 28 | Buffer1, Buffer2: array[1..64*1024] of Byte; 29 | begin 30 | 31 | if (not FileExists(CORRECT_FILE_NAME)) then 32 | begin 33 | Writeln('"', CORRECT_FILE_NAME, '" not found'); 34 | Abort; 35 | end; 36 | if (not FileExists(OUTPUT_FILE_NAME)) then 37 | begin 38 | Writeln('"', OUTPUT_FILE_NAME, '" not found'); 39 | Abort; 40 | end; 41 | 42 | F1 := TFileStream.Create(CORRECT_FILE_NAME, fmOpenRead or fmShareDenyWrite); 43 | try 44 | Size := F1.Size; 45 | F2 := TFileStream.Create(OUTPUT_FILE_NAME, fmOpenRead or fmShareDenyWrite); 46 | try 47 | if (Size <> F2.Size) then 48 | begin 49 | Writeln('FAILURE SIZE: ', Size, ' and ', F2.Size); 50 | Abort; 51 | end; 52 | 53 | Same := True; 54 | while (Size <> 0) do 55 | begin 56 | Count := SizeOf(Buffer1); 57 | if (Count > Size) then Count := Size; 58 | 59 | F1.ReadBuffer(Buffer1, Count); 60 | F2.ReadBuffer(Buffer2, Count); 61 | if (not CompareMem(@Buffer1, @Buffer2, Count)) then 62 | begin 63 | Same := False; 64 | Break; 65 | end; 66 | 67 | Size := Size - Count; 68 | end; 69 | 70 | if (not Same) then 71 | begin 72 | Writeln('FAILURE'); 73 | Abort; 74 | end else 75 | begin 76 | Writeln('done.'); 77 | end; 78 | finally 79 | F2.Free 80 | end; 81 | finally 82 | F1.Free; 83 | end; 84 | end; 85 | 86 | 87 | type 88 | TWriterMethod = procedure(const FileName: string); 89 | 90 | procedure StringListWriter(const FileName: string); 91 | var 92 | Iteration, i: Integer; 93 | List: TStringList; 94 | begin 95 | List := TStringList.Create; 96 | try 97 | for Iteration := 1 to ITERATIONS_COUNT do 98 | for i := 1 to STRINGS_COUNT do 99 | List.Add(IntToStr(i)); 100 | 101 | List.SaveToFile(FileName, TEncoding.UTF8); 102 | finally 103 | List.Free; 104 | end; 105 | end; 106 | 107 | procedure TextFileWriter(const FileName: string); 108 | var 109 | Iteration, i: Integer; 110 | T: TextFile; 111 | begin 112 | AssignFile(T, FileName); 113 | ReWrite(T); 114 | try 115 | // UTF-8 BOM 116 | Write(T, AnsiString(#$EF#$BB#$BF)); 117 | 118 | // text 119 | SetTextCodePage(T, CODEPAGE_UTF8); 120 | for Iteration := 1 to ITERATIONS_COUNT do 121 | for i := 1 to STRINGS_COUNT do 122 | Writeln(T, i); 123 | finally 124 | CloseFile(T); 125 | end; 126 | end; 127 | 128 | procedure BufferedTextFileWriter(const FileName: string); 129 | var 130 | Iteration, i: Integer; 131 | T: TextFile; 132 | Buffer: array[Word] of Byte; 133 | begin 134 | AssignFile(T, FileName); 135 | ReWrite(T); 136 | SetTextBuf(T, Buffer); 137 | try 138 | // UTF-8 BOM 139 | Write(T, AnsiString(#$EF#$BB#$BF)); 140 | 141 | // text 142 | SetTextCodePage(T, CODEPAGE_UTF8); 143 | for Iteration := 1 to ITERATIONS_COUNT do 144 | for i := 1 to STRINGS_COUNT do 145 | Writeln(T, i); 146 | finally 147 | CloseFile(T); 148 | end; 149 | end; 150 | 151 | procedure CachedTextWriterAppend(const Text: TCachedTextWriter); 152 | var 153 | Iteration, i: Integer; 154 | begin 155 | for Iteration := 1 to ITERATIONS_COUNT do 156 | for i := 1 to STRINGS_COUNT do 157 | begin 158 | Text.WriteInteger(i); 159 | Text.WriteCRLF; 160 | end; 161 | end; 162 | 163 | procedure CachedANSIWriter(const FileName: string); 164 | var 165 | Text: TByteTextWriter; 166 | begin 167 | Text := TByteTextWriter.CreateFromFile(0, FileName, bomUTF8); 168 | try 169 | CachedTextWriterAppend(Text); 170 | finally 171 | Text.Free; 172 | end; 173 | end; 174 | 175 | procedure CachedUTF8Writer(const FileName: string); 176 | var 177 | Text: TByteTextWriter; 178 | begin 179 | Text := TByteTextWriter.CreateFromFile(CODEPAGE_UTF8, FileName, bomUTF8); 180 | try 181 | CachedTextWriterAppend(Text); 182 | finally 183 | Text.Free; 184 | end; 185 | end; 186 | 187 | procedure CachedUTF16Writer(const FileName: string); 188 | var 189 | Text: TUTF16TextWriter; 190 | begin 191 | Text := TUTF16TextWriter.CreateFromFile(FileName, bomUTF8); 192 | try 193 | CachedTextWriterAppend(Text); 194 | finally 195 | Text.Free; 196 | end; 197 | end; 198 | 199 | procedure CachedUTF32Writer(const FileName: string); 200 | var 201 | Text: TUTF32TextWriter; 202 | begin 203 | Text := TUTF32TextWriter.CreateFromFile(FileName, bomUTF8); 204 | try 205 | CachedTextWriterAppend(Text); 206 | finally 207 | Text.Free; 208 | end; 209 | end; 210 | 211 | 212 | var 213 | WriterMethodNumber: Cardinal = 0; 214 | 215 | procedure RunWriterMethod(const Description: string; const WriterMethod: TWriterMethod); 216 | var 217 | Time: Cardinal; 218 | begin 219 | Inc(WriterMethodNumber); 220 | Write(WriterMethodNumber, ') ', Description, '...'); 221 | 222 | Time := GetTickCount; 223 | WriterMethod(OUTPUT_FILE_NAME); 224 | Time := GetTickCount - Time; 225 | Write(' ', Time, 'ms '); 226 | 227 | CompareOutputAndCorrectFiles; 228 | end; 229 | 230 | 231 | begin 232 | try 233 | // benchmark text 234 | Writeln('The benchmark shows how to use TCachedTextWriter-classes to carry out'); 235 | Writeln('the text data writing by analogy with standard solutions.'); 236 | if (not FileExists(CORRECT_FILE_NAME)) then 237 | begin 238 | Write('Correct file generating... '); 239 | BufferedTextFileWriter(CORRECT_FILE_NAME); 240 | Writeln('done.'); 241 | end; 242 | 243 | // run writers, measure time, compare with correct file 244 | Writeln; 245 | RunWriterMethod('TStringList --> UTF8', StringListWriter); 246 | RunWriterMethod('TextFile --> UTF8', TextFileWriter); 247 | RunWriterMethod('TextFile + Buffer --> UTF8', BufferedTextFileWriter); 248 | RunWriterMethod('CachedByteWriter ANSI --> UTF8', CachedANSIWriter); 249 | RunWriterMethod('CachedByteWriter UTF8 --> UTF8', CachedUTF8Writer); 250 | RunWriterMethod('CachedUTF16Writer --> UTF8', CachedUTF16Writer); 251 | RunWriterMethod('CachedUTF32Writer --> UTF8', CachedUTF32Writer); 252 | 253 | except 254 | on EAbort do ; 255 | 256 | on E: Exception do 257 | Writeln(E.ClassName, ': ', E.Message); 258 | end; 259 | 260 | if (ParamStr(1) <> '-nowait') then 261 | begin 262 | Writeln; 263 | Write('Press Enter to quit'); 264 | Readln; 265 | end; 266 | end. 267 | -------------------------------------------------------------------------------- /demo/generics/uDictionaries.pas: -------------------------------------------------------------------------------- 1 | unit uDictionaries; 2 | 3 | {$I TINY.DEFINES.inc} 4 | 5 | interface 6 | uses 7 | Winapi.Windows, System.SysUtils, Generics.Defaults, Generics.Collections, 8 | Tiny.Types, Tiny.Generics; 9 | 10 | const 11 | ITEMS_COUNT = 1024 * (1024 div 4 * 3); 12 | ITERATIONS_COUNT = 10; 13 | MODES: array[0..2] of string = ('Add', 'Add+Capacity', 'Items'); 14 | CAPACITIES: array[0..2] of Integer = (0, ITEMS_COUNT, ITEMS_COUNT); 15 | 16 | type 17 | TRunner<T> = class 18 | public type 19 | TItems = array[0..ITEMS_COUNT - 1] of T; 20 | TRandomFunc = reference to function: T; 21 | 22 | TTest = class 23 | constructor Create(const Items: TItems; const Capacity: Integer); virtual; abstract; 24 | function ExecuteItems(const Items: TItems): Integer; virtual; abstract; 25 | end; 26 | TTestClass = class of TTest; 27 | public 28 | Items: TItems; 29 | constructor Create(const RandomFunc: TRandomFunc); 30 | 31 | procedure Run(const TestClass: TTestClass); 32 | procedure RunEach; 33 | public type 34 | SystemSystem = class(TTest) 35 | Dictionary: Generics.Collections.TDictionary<T,Integer>; 36 | 37 | constructor Create(const Items: TItems; const Capacity: Integer); override; 38 | destructor Destroy; override; 39 | function ExecuteItems(const Items: TItems): Integer; override; 40 | end; 41 | 42 | SystemTiny = class(SystemSystem) 43 | constructor Create(const Items: TItems; const Capacity: Integer); override; 44 | end; 45 | 46 | TinyTiny = class(TTest) 47 | Dictionary: Tiny.Generics.TDictionary<T,Integer>; 48 | 49 | constructor Create(const Items: TItems; const Capacity: Integer); override; 50 | destructor Destroy; override; 51 | function ExecuteItems(const Items: TItems): Integer; override; 52 | end; 53 | 54 | RapidDictionary = class(TTest) 55 | Dictionary: TRapidDictionary<T,Integer>; 56 | 57 | constructor Create(const Items: TItems; const Capacity: Integer); override; 58 | destructor Destroy; override; 59 | function ExecuteItems(const Items: TItems): Integer; override; 60 | end; 61 | end; 62 | 63 | 64 | procedure Run; 65 | 66 | implementation 67 | 68 | 69 | procedure Run; 70 | begin 71 | with TRunner<string>.Create( 72 | function: string 73 | var 74 | Len, i: Integer; 75 | begin 76 | Len := 5 + Random(8); 77 | SetLength(Result, Len); 78 | 79 | for i := 1 to Len do 80 | Result[i] := Char(Ord('A') + Random(Ord('Z') - Ord('A') + 1)); 81 | end) do 82 | try 83 | RunEach; 84 | finally 85 | Free; 86 | end; 87 | 88 | with TRunner<Single>.Create( 89 | function: Single 90 | begin 91 | Result := Random * ITEMS_COUNT; 92 | end) do 93 | try 94 | RunEach; 95 | finally 96 | Free; 97 | end; 98 | 99 | with TRunner<Integer>.Create( 100 | function: Integer 101 | begin 102 | Result := Random(ITEMS_COUNT); 103 | end) do 104 | try 105 | RunEach; 106 | finally 107 | Free; 108 | end; 109 | end; 110 | 111 | 112 | { TRunner<T>.SystemSystem } 113 | 114 | constructor TRunner<T>.SystemSystem.Create(const Items: TItems; const Capacity: Integer); 115 | var 116 | i: Integer; 117 | begin 118 | Dictionary := Generics.Collections.TDictionary<T,Integer>.Create(Capacity); 119 | for i := Low(TItems) to High(TItems) do 120 | Dictionary.AddOrSetValue(Items[i], i); 121 | end; 122 | 123 | destructor TRunner<T>.SystemSystem.Destroy; 124 | begin 125 | Dictionary.Free; 126 | inherited; 127 | end; 128 | 129 | function TRunner<T>.SystemSystem.ExecuteItems(const Items: TItems): Integer; 130 | var 131 | i: Integer; 132 | begin 133 | for i := Low(TItems) to High(TItems) do 134 | Result := Dictionary.Items[Items[i]]; 135 | end; 136 | 137 | { TRunner<T>.SystemTiny } 138 | 139 | constructor TRunner<T>.SystemTiny.Create(const Items: TItems; const Capacity: Integer); 140 | var 141 | i: Integer; 142 | Comparer: Generics.Defaults.IEqualityComparer<T>; 143 | begin 144 | IInterface(Comparer) := Tiny.Generics.TEqualityComparer<T>.Default; 145 | Dictionary := Generics.Collections.TDictionary<T,Integer>.Create(Capacity, Comparer); 146 | 147 | for i := Low(TItems) to High(TItems) do 148 | Dictionary.AddOrSetValue(Items[i], i); 149 | end; 150 | 151 | { TRunner<T>.TinyTiny } 152 | 153 | constructor TRunner<T>.TinyTiny.Create(const Items: TItems; const Capacity: Integer); 154 | var 155 | i: Integer; 156 | begin 157 | Dictionary := Tiny.Generics.TDictionary<T,Integer>.Create(Capacity); 158 | for i := Low(TItems) to High(TItems) do 159 | Dictionary.AddOrSetValue(Items[i], i); 160 | end; 161 | 162 | destructor TRunner<T>.TinyTiny.Destroy; 163 | begin 164 | Dictionary.Free; 165 | inherited; 166 | end; 167 | 168 | function TRunner<T>.TinyTiny.ExecuteItems(const Items: TItems): Integer; 169 | var 170 | i: Integer; 171 | begin 172 | for i := Low(TItems) to High(TItems) do 173 | Result := Dictionary.Items[Items[i]]; 174 | end; 175 | 176 | { TRunner<T>.RapidDictionary } 177 | 178 | constructor TRunner<T>.RapidDictionary.Create(const Items: TItems; const Capacity: Integer); 179 | var 180 | i: Integer; 181 | begin 182 | Dictionary := TRapidDictionary<T,Integer>.Create(Capacity); 183 | for i := Low(TItems) to High(TItems) do 184 | Dictionary.AddOrSetValue(Items[i], i); 185 | end; 186 | 187 | destructor TRunner<T>.RapidDictionary.Destroy; 188 | begin 189 | Dictionary.Free; 190 | inherited; 191 | end; 192 | 193 | function TRunner<T>.RapidDictionary.ExecuteItems(const Items: TItems): Integer; 194 | var 195 | i: Integer; 196 | begin 197 | for i := Low(TItems) to High(TItems) do 198 | Result := Dictionary.Items[Items[i]]; 199 | end; 200 | 201 | 202 | { TRunner<T> } 203 | 204 | constructor TRunner<T>.Create(const RandomFunc: TRandomFunc); 205 | var 206 | i: Integer; 207 | begin 208 | for i := Low(TItems) to High(TItems) do 209 | Items[i] := RandomFunc; 210 | end; 211 | 212 | procedure TRunner<T>.Run(const TestClass: TTestClass); 213 | var 214 | i: Integer; 215 | Mode: Integer; 216 | S: string; 217 | Instance: TTest; 218 | TotalTime, Time: Cardinal; 219 | begin 220 | for Mode := Low(MODES) to High(MODES) do 221 | begin 222 | S := MODES[Mode]; 223 | Write(TestClass.ClassName, ' ', S, '... '); 224 | 225 | if (Mode <> 2) then 226 | begin 227 | TotalTime := 0; 228 | for i := 1 to ITERATIONS_COUNT do 229 | begin 230 | Time := GetTickCount; 231 | Instance := TestClass.Create(Items, CAPACITIES[Mode]); 232 | Time := GetTickCount - Time; 233 | Inc(TotalTime, Time); 234 | 235 | Instance.Free; 236 | end; 237 | end else 238 | // Mode = 2 239 | begin 240 | Instance := TestClass.Create(Items, CAPACITIES[Mode]); 241 | 242 | TotalTime := GetTickCount; 243 | for i := 1 to ITERATIONS_COUNT do 244 | begin 245 | Instance.ExecuteItems(Items); 246 | end; 247 | TotalTime := GetTickCount - TotalTime; 248 | 249 | Instance.Free; 250 | end; 251 | 252 | Writeln(TotalTime, 'ms'); 253 | end; 254 | end; 255 | 256 | procedure TRunner<T>.RunEach; 257 | begin 258 | Writeln; 259 | Writeln(PShortString(NativeUInt(TypeInfo(T)) + 1)^); 260 | 261 | Run(SystemSystem); 262 | Run(SystemTiny); 263 | Run(TinyTiny); 264 | Run(RapidDictionary); 265 | end; 266 | 267 | end. 268 | -------------------------------------------------------------------------------- /c/tiny.types.old86.c: -------------------------------------------------------------------------------- 1 | #include "tiny.types.h" 2 | 3 | #if defined (CPUX86) && defined (MSWINDOWS) 4 | 5 | 6 | REGISTER_DECL void AStrClear(void* value) /*AStrClear_old*/ 7 | { 8 | RtlStrRec* rec = *((ptr_t*)value); 9 | if (rec) 10 | { 11 | *((ptr_t*)value) = 0; 12 | rtl_string_release(rec, RETURN_ADDRESS, ); 13 | } 14 | } 15 | 16 | REGISTER_DECL void* AStrInit(void* value, char8_t* chars, uint32_t length, uint16_t codepage) /*AStrInit_old*/ 17 | { 18 | RtlStrRec* rec = *((ptr_t*)value); 19 | 20 | if (rec) 21 | { 22 | if (length) 23 | { 24 | if ((rec - 1)->length == length) 25 | { 26 | if ((void*)rec != chars && chars) goto copy; 27 | return rec; 28 | } 29 | if ((rec - 1)->refcount == 1 && rtl_rec_hintrealloc((rec - 1)->length, sizeof(*chars), length)) 30 | { 31 | rtl_rec_realloc(rec, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 32 | goto markup; 33 | } 34 | else 35 | { 36 | *((ptr_t*)value) = 0; 37 | rtl_string_release(rec, RETURN_ADDRESS, 0); 38 | goto allocate; 39 | } 40 | } 41 | else 42 | { 43 | *((ptr_t*)value) = 0; 44 | rtl_string_release(rec, RETURN_ADDRESS, 0); 45 | } 46 | } 47 | else 48 | if (length) 49 | { 50 | allocate: 51 | rtl_rec_alloc(rec, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 52 | markup: 53 | rtl_lstr_markup(rec, length, codepage); 54 | copy: 55 | *((ptr_t*)value) = rec; 56 | if (chars) rtl_memcopy(rec, chars, length * sizeof(*chars)); 57 | return rec; 58 | } 59 | 60 | return 0; 61 | } 62 | 63 | REGISTER_DECL void* AStrReserve(void* value, uint32_t length) /*AStrReserve_old*/ 64 | { 65 | RtlStrRec* rec = *((ptr_t*)value); 66 | char8_t* chars/*none*/; 67 | 68 | if (rec) 69 | { 70 | if (length) 71 | { 72 | if ((rec - 1)->refcount == 1) 73 | { 74 | if ((rec - 1)->length >= length) return rec; 75 | if (rtl_rec_hintrealloc((rec - 1)->length, sizeof(*chars), length)) 76 | { 77 | rtl_rec_realloc(rec, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 78 | goto markup; 79 | } 80 | } 81 | 82 | *((ptr_t*)value) = 0; 83 | rtl_string_release(rec, RETURN_ADDRESS, 0); 84 | goto allocate; 85 | } 86 | else 87 | { 88 | *((ptr_t*)value) = 0; 89 | rtl_string_release(rec, RETURN_ADDRESS, 0); 90 | } 91 | } 92 | else 93 | if (length) 94 | { 95 | allocate: 96 | rtl_rec_alloc(rec, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 97 | markup: 98 | rtl_lstr_markup(rec, length, DefaultCP); 99 | *((ptr_t*)value) = rec; 100 | return rec; 101 | } 102 | 103 | return 0; 104 | } 105 | 106 | REGISTER_DECL void* AStrSetLength(void* value, uint32_t length, uint16_t codepage) /*AStrSetLength_old*/ 107 | { 108 | RtlStrRec* source = *((ptr_t*)value); 109 | RtlStrRec* target; 110 | char8_t* chars/*none*/; 111 | 112 | if (source) 113 | { 114 | if (length) 115 | { 116 | if ((source - 1)->refcount != 1 || (source - 1)->length != length) goto allocate; 117 | return source; 118 | } 119 | else 120 | { 121 | *((ptr_t*)value) = 0; 122 | rtl_string_release(source, RETURN_ADDRESS, 0); 123 | } 124 | } 125 | else 126 | if (length) 127 | { 128 | allocate: 129 | rtl_rec_alloc(target, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 130 | rtl_lstr_markup(target, length, codepage); 131 | *((ptr_t*)value) = target; 132 | if (source) 133 | { 134 | if (length > (source - 1)->length) length = (source - 1)->length; 135 | rtl_memcopy(target, source, length * sizeof(*chars)); 136 | rtl_string_release(source, RETURN_ADDRESS, 0); 137 | } 138 | 139 | return target; 140 | } 141 | 142 | return 0; 143 | } 144 | 145 | REGISTER_DECL void UStrClear(void* value) /*WStrClear*/ 146 | { 147 | RtlWideStrRec* rec = *((ptr_t*)value); 148 | if (rec) 149 | { 150 | *((ptr_t*)value) = 0; 151 | MMSysStrFree(rec); 152 | } 153 | } 154 | 155 | REGISTER_DECL void* UStrInit(void* value, char16_t* chars, uint32_t length) /*WStrInit*/ 156 | { 157 | RtlWideStrRec* rec = *((ptr_t*)value); 158 | 159 | if (rec) 160 | { 161 | if (length) 162 | { 163 | if ((rec - 1)->size == length * sizeof(char16_t)) 164 | { 165 | if (chars && (void*)rec != chars) rtl_memcopy(rec, chars, length * sizeof(*chars)); 166 | return rec; 167 | } 168 | else 169 | { 170 | if (MMSysStrRealloc(value, chars, length)) return *((ptr_t*)value); 171 | TinyErrorOutOfMemory(RETURN_ADDRESS); 172 | } 173 | } 174 | else 175 | { 176 | *((ptr_t*)value) = 0; 177 | MMSysStrFree(rec); 178 | } 179 | } 180 | else 181 | if (length) 182 | { 183 | ptr_t s = MMSysStrAlloc(chars, length); 184 | if (s) 185 | { 186 | *((ptr_t*)value) = s; 187 | return s; 188 | } 189 | else 190 | { 191 | TinyErrorOutOfMemory(RETURN_ADDRESS); 192 | } 193 | } 194 | 195 | return 0; 196 | } 197 | 198 | REGISTER_DECL void* UStrReserve(void* value, uint32_t length) /*WStrReserve*/ 199 | { 200 | if (!length) return 0; 201 | RtlWideStrRec* rec = *((ptr_t*)value); 202 | 203 | if (rec) 204 | { 205 | if ((rec - 1)->size >= length * sizeof(char16_t)) return rec; 206 | if (MMSysStrRealloc(value, 0, length)) return *((ptr_t*)value); 207 | TinyErrorOutOfMemory(RETURN_ADDRESS); 208 | } 209 | else 210 | { 211 | ptr_t s = MMSysStrAlloc(0, length); 212 | if (s) 213 | { 214 | *((ptr_t*)value) = s; 215 | return s; 216 | } 217 | else 218 | { 219 | TinyErrorOutOfMemory(RETURN_ADDRESS); 220 | } 221 | } 222 | 223 | return 0; 224 | } 225 | 226 | REGISTER_DECL void* UStrSetLength(void* value, uint32_t length) /*WStrSetLength*/ 227 | { 228 | RtlWideStrRec* rec = *((ptr_t*)value); 229 | 230 | if (rec) 231 | { 232 | if (length) 233 | { 234 | if ((rec - 1)->size == length * sizeof(char16_t)) return rec; 235 | if (!MMSysStrRealloc(value, (void*)rec, length)) return *((ptr_t*)value); 236 | TinyErrorOutOfMemory(RETURN_ADDRESS); 237 | } 238 | else 239 | { 240 | *((ptr_t*)value) = 0; 241 | MMSysStrFree(rec); 242 | } 243 | } 244 | else 245 | if (length) 246 | { 247 | ptr_t s = MMSysStrAlloc(0, length); 248 | if (s) 249 | { 250 | *((ptr_t*)value) = s; 251 | } 252 | else 253 | { 254 | TinyErrorOutOfMemory(RETURN_ADDRESS); 255 | } 256 | } 257 | 258 | return 0; 259 | } 260 | 261 | #endif 262 | -------------------------------------------------------------------------------- /demo/text/ToStrings.dpr: -------------------------------------------------------------------------------- 1 | program ToStrings; 2 | 3 | {$I TINY.DEFINES.inc} 4 | {$APPTYPE CONSOLE} 5 | 6 | uses {$ifdef UNITSCOPENAMES} 7 | Winapi.Windows, System.SysUtils, 8 | {$else} 9 | Windows, SysUtils, 10 | {$endif} 11 | Tiny.Types, Tiny.Text, Tiny.Cache.Text; 12 | 13 | 14 | type 15 | TSysUtilsProc = procedure(var S: string); 16 | TStringBufferProc = procedure(var S: TStringBuffer); 17 | 18 | const 19 | CONST_BOOLEAN: Boolean = True; 20 | CONST_INTEGER: Integer = 123456; 21 | CONST_INT64: Int64 = 9876543210; 22 | CONST_HEX: Integer = $abcdef; 23 | CONST_HEX64: Int64 = $012345abcdef; 24 | CONST_FLOAT: Extended = 768.645; 25 | CONST_DATE: TDateTime = 42094{2015-03-31}; 26 | CONST_TIME: TDateTime = 0.524259259259259{12:34:56}; 27 | CONST_DATETIME: TDateTime = 42094.524259259259259; 28 | 29 | ITERATIONS_COUNT = 10 * 1000000; 30 | 31 | 32 | procedure SysUtilsBoolean(var S: string); 33 | var 34 | i: Integer; 35 | begin 36 | for i := 1 to ITERATIONS_COUNT do 37 | begin 38 | S := ''; 39 | S := BoolToStr(CONST_BOOLEAN, True); 40 | end; 41 | end; 42 | 43 | procedure StringBufferBoolean(var S: TStringBuffer); 44 | var 45 | i: Integer; 46 | begin 47 | for i := 1 to ITERATIONS_COUNT do 48 | begin 49 | S.Length := 0; 50 | S.AppendBoolean(CONST_BOOLEAN); 51 | end; 52 | end; 53 | 54 | procedure SysUtilsInteger(var S: string); 55 | var 56 | i: Integer; 57 | begin 58 | for i := 1 to ITERATIONS_COUNT do 59 | begin 60 | S := ''; 61 | S := IntToStr(CONST_INTEGER); 62 | end; 63 | end; 64 | 65 | procedure StringBufferInteger(var S: TStringBuffer); 66 | var 67 | i: Integer; 68 | begin 69 | for i := 1 to ITERATIONS_COUNT do 70 | begin 71 | S.Length := 0; 72 | S.AppendInteger(CONST_INTEGER); 73 | end; 74 | end; 75 | 76 | procedure SysUtilsInt64(var S: string); 77 | var 78 | i: Integer; 79 | begin 80 | for i := 1 to ITERATIONS_COUNT do 81 | begin 82 | S := ''; 83 | S := IntToStr(CONST_INT64); 84 | end; 85 | end; 86 | 87 | procedure StringBufferInt64(var S: TStringBuffer); 88 | var 89 | i: Integer; 90 | begin 91 | for i := 1 to ITERATIONS_COUNT do 92 | begin 93 | S.Length := 0; 94 | S.AppendInt64(CONST_INT64); 95 | end; 96 | end; 97 | 98 | procedure SysUtilsHex(var S: string); 99 | var 100 | i: Integer; 101 | begin 102 | for i := 1 to ITERATIONS_COUNT do 103 | begin 104 | S := ''; 105 | S := IntToHex(CONST_HEX, 0); 106 | end; 107 | end; 108 | 109 | procedure StringBufferHex(var S: TStringBuffer); 110 | var 111 | i: Integer; 112 | begin 113 | for i := 1 to ITERATIONS_COUNT do 114 | begin 115 | S.Length := 0; 116 | S.AppendHex(CONST_HEX); 117 | end; 118 | end; 119 | 120 | procedure SysUtilsHex64(var S: string); 121 | var 122 | i: Integer; 123 | begin 124 | for i := 1 to ITERATIONS_COUNT do 125 | begin 126 | S := ''; 127 | S := IntToHex(CONST_HEX64, 0); 128 | end; 129 | end; 130 | 131 | procedure StringBufferHex64(var S: TStringBuffer); 132 | var 133 | i: Integer; 134 | begin 135 | for i := 1 to ITERATIONS_COUNT do 136 | begin 137 | S.Length := 0; 138 | S.AppendHex64(CONST_HEX64); 139 | end; 140 | end; 141 | 142 | procedure SysUtilsFloat(var S: string); 143 | var 144 | i: Integer; 145 | begin 146 | for i := 1 to ITERATIONS_COUNT do 147 | begin 148 | S := ''; 149 | S := FloatToStr(CONST_FLOAT); 150 | end; 151 | end; 152 | 153 | procedure StringBufferFloat(var S: TStringBuffer); 154 | var 155 | i: Integer; 156 | begin 157 | for i := 1 to ITERATIONS_COUNT do 158 | begin 159 | S.Length := 0; 160 | S.AppendFloat(CONST_FLOAT); 161 | end; 162 | end; 163 | 164 | procedure SysUtilsDate(var S: string); 165 | var 166 | i: Integer; 167 | begin 168 | for i := 1 to ITERATIONS_COUNT do 169 | begin 170 | S := ''; 171 | S := DateToStr(CONST_DATE); 172 | end; 173 | end; 174 | 175 | procedure StringBufferDate(var S: TStringBuffer); 176 | var 177 | i: Integer; 178 | begin 179 | for i := 1 to ITERATIONS_COUNT do 180 | begin 181 | S.Length := 0; 182 | S.AppendDate(CONST_DATE); 183 | end; 184 | end; 185 | 186 | procedure SysUtilsTime(var S: string); 187 | var 188 | i: Integer; 189 | begin 190 | for i := 1 to ITERATIONS_COUNT do 191 | begin 192 | S := ''; 193 | S := TimeToStr(CONST_TIME); 194 | end; 195 | end; 196 | 197 | procedure StringBufferTime(var S: TStringBuffer); 198 | var 199 | i: Integer; 200 | begin 201 | for i := 1 to ITERATIONS_COUNT do 202 | begin 203 | S.Length := 0; 204 | S.AppendTime(CONST_TIME); 205 | end; 206 | end; 207 | 208 | procedure SysUtilsDateTime(var S: string); 209 | var 210 | i: Integer; 211 | begin 212 | for i := 1 to ITERATIONS_COUNT do 213 | begin 214 | S := ''; 215 | S := DateTimeToStr(CONST_DATETIME); 216 | end; 217 | end; 218 | 219 | procedure StringBufferDateTime(var S: TStringBuffer); 220 | var 221 | i: Integer; 222 | begin 223 | for i := 1 to ITERATIONS_COUNT do 224 | begin 225 | S.Length := 0; 226 | S.AppendDateTime(CONST_DATETIME); 227 | end; 228 | end; 229 | 230 | 231 | procedure RunTest(const Description: string; const SysUtilsProc: TSysUtilsProc; 232 | const StringBufferProc: TStringBufferProc); 233 | const 234 | STRINGTYPES: array[1..3] of string = ('ByteString', 'UTF16String', 'UTF32String'); 235 | var 236 | i: Integer; 237 | Time: Cardinal; 238 | Str: string; 239 | Temp: TStringBuffer; 240 | begin 241 | Writeln(Description, '...'); 242 | 243 | Write('SysUtils', ': '); 244 | Time := GetTickCount; 245 | SysUtilsProc(Str); 246 | Time := GetTickCount - Time; 247 | Write(Time:5, 'ms; '); 248 | 249 | for i := 1 to 3 do 250 | begin 251 | case i of 252 | 1: Temp.InitByteString(CODEPAGE_UTF8); 253 | 2: Temp.InitUTF16String; 254 | 3: Temp.InitUTF32String; 255 | end; 256 | 257 | Write(STRINGTYPES[i], ': '); 258 | Time := GetTickCount; 259 | StringBufferProc(Temp); 260 | Time := GetTickCount - Time; 261 | Write(Time:3, 'ms; '); 262 | end; 263 | 264 | Writeln; 265 | end; 266 | 267 | begin 268 | try 269 | Writeln('The benchmark shows how to convert Booleans, Ordinals, Floats and DateTimes'); 270 | Writeln('to strings (TStringBuffer) by analogy with SysUtils-functions.'); 271 | 272 | // initialize the same (default) format settings 273 | FormatSettings.ThousandSeparator := #32; 274 | FormatSettings.DecimalSeparator := '.'; 275 | FormatSettings.DateSeparator := '-'; 276 | FormatSettings.TimeSeparator := ':'; 277 | FormatSettings.ShortDateFormat := 'yyyy-mm-dd'; 278 | FormatSettings.LongTimeFormat := 'hh:mm:ss'; 279 | 280 | // run conversion tests 281 | Writeln; 282 | RunTest('BooleanToStr', SysUtilsBoolean, StringBufferBoolean); 283 | RunTest('IntegerToStr', SysUtilsInteger, StringBufferInteger); 284 | RunTest('Int64ToStr', SysUtilsInt64, StringBufferInt64); 285 | RunTest('HexToStr', SysUtilsHex, StringBufferHex); 286 | RunTest('Hex64ToStr', SysUtilsHex64, StringBufferHex64); 287 | RunTest('FloatToStr', SysUtilsFloat, StringBufferFloat); 288 | RunTest('DateToStr', SysUtilsDate, StringBufferDate); 289 | RunTest('TimeToStr', SysUtilsTime, StringBufferTime); 290 | RunTest('DateTimeToStr', SysUtilsDateTime, StringBufferDateTime); 291 | 292 | except 293 | on EAbort do ; 294 | 295 | on E: Exception do 296 | Writeln(E.ClassName, ': ', E.Message); 297 | end; 298 | 299 | if (ParamStr(1) <> '-nowait') then 300 | begin 301 | Writeln; 302 | Write('Press Enter to quit'); 303 | Readln; 304 | end; 305 | end. 306 | -------------------------------------------------------------------------------- /c/rtti/tiny.rtti.h: -------------------------------------------------------------------------------- 1 | 2 | #ifndef tiny_rtti_h 3 | #define tiny_rtti_h 4 | 5 | #include "../tiny.defines.h" 6 | #include "../tiny.types.h" 7 | 8 | 9 | /* 10 | RttiTypeRules struct 11 | General set of rules for interacting with a type 12 | */ 13 | typedef PACKED_STRUCT 14 | { 15 | uint32_t size; 16 | uint8_t stack_size; 17 | uint8_t return_mode; // "Return" field 18 | uint8_t flags; 19 | uint8_t init_func; 20 | uint8_t final_func; 21 | uint8_t weak_final_func; 22 | uint8_t copy_func; 23 | uint8_t weak_copy_func; 24 | } 25 | RttiTypeRules; 26 | 27 | 28 | /* 29 | RttiTypeData struct 30 | Basic structure for storing additional type information 31 | */ 32 | #define rtti_type_data_fields \ 33 | union \ 34 | { \ 35 | uint32_t marker; \ 36 | PACKED_STRUCT {uint8_t marker_bytes[3]; uint8_t base_type;}; \ 37 | }; \ 38 | void* context; \ 39 | ShortString* name; 40 | typedef PACKED_STRUCT 41 | { 42 | rtti_type_data_fields; 43 | } 44 | RttiTypeData; 45 | 46 | 47 | /* 48 | RttiMetaType struct 49 | Universal structure that describes meta types - types whose rules of behavior are determined by content 50 | */ 51 | #define RTTI_TYPEDATA_MASK 0x00ffffff 52 | #define RTTI_TYPEDATA_MARKER ('R' + ('M' << 8) + ('T' << 16)) 53 | typedef REGISTER_DECL void (*RttiMetaTypeFunc)(/*RttiMetaType*/void* meta_type, void* value); 54 | typedef REGISTER_DECL void (*RttiMetaTypeCopyFunc)(/*RttiMetaType*/void* meta_type, void* target, void* source); 55 | typedef PACKED_STRUCT /*: RttiTypeData*/ 56 | { 57 | rtti_type_data_fields; 58 | RttiTypeRules rules; 59 | RttiMetaTypeFunc init_func; 60 | RttiMetaTypeFunc final_func; 61 | RttiMetaTypeFunc weak_final_func; 62 | RttiMetaTypeCopyFunc copy_func; 63 | RttiMetaTypeCopyFunc weak_copy_func; 64 | } 65 | RttiMetaType; 66 | 67 | 68 | /* 69 | RttiExType struct 70 | Universal structure describing any type, including pointer depth and additional information 71 | */ 72 | #define rtti_extype_fields \ 73 | union \ 74 | { \ 75 | PACKED_STRUCT \ 76 | { \ 77 | uint8_t base_type; \ 78 | uint8_t pointer_depth; \ 79 | union \ 80 | { \ 81 | uint16_t id; \ 82 | uint16_t code_page; \ 83 | PACKED_STRUCT {uint8_t max_length; uint16_t flags;}; \ 84 | uint16_t ex_flags; \ 85 | }; \ 86 | }; \ 87 | PACKED_STRUCT \ 88 | { \ 89 | uint32_t options; \ 90 | union \ 91 | { \ 92 | void* custom_data; \ 93 | RttiTypeData* type_data; \ 94 | RttiMetaType* meta_type; \ 95 | }; \ 96 | }; \ 97 | }; 98 | typedef PACKED_STRUCT 99 | { 100 | rtti_extype_fields; 101 | } 102 | RttiExType; 103 | 104 | 105 | /* 106 | RttiValue (TValue) struct 107 | Any type value container (lightweight Variant) 108 | */ 109 | typedef PACKED_STRUCT 110 | { 111 | RttiExType extype; 112 | ptr_t managed_data; 113 | uint8_t buffer[16]; 114 | } 115 | RttiValue; 116 | 117 | 118 | /* 119 | RttiArgument struct 120 | Signature argument description 121 | */ 122 | typedef PACKED_STRUCT 123 | { 124 | rtti_extype_fields; 125 | ShortString* name; 126 | int32_t offset; 127 | uint8_t qualifier; 128 | uint8_t getter_func; 129 | uint8_t setter_func; 130 | int8_t high_offset; 131 | } 132 | RttiArgument; 133 | 134 | 135 | /* 136 | Initializing, finalizing and copying routine 137 | */ 138 | typedef REGISTER_DECL void (*RttiTypeFunc)(RttiExType* type, void* value); 139 | typedef REGISTER_DECL void (*RttiCopyFunc)(RttiExType* type, void* target, void* source); 140 | 141 | 142 | /* 143 | RttiOptions struct 144 | Library initialization options 145 | */ 146 | uint8_t RTTI_TYPE_GROUPS[256]; 147 | RttiTypeRules* RTTI_TYPE_RULES[256]; 148 | RttiTypeFunc RTTI_INIT_FUNCS[256]; 149 | RttiTypeFunc RTTI_FINAL_FUNCS[256]; 150 | RttiCopyFunc RTTI_COPY_FUNCS[256]; 151 | #define RTTI_INITNONE_FUNC 0 152 | #define RTTI_INITPOINTER_FUNC 1 153 | #define RTTI_INITPOINTERPAIR_FUNC 2 154 | #define RTTI_INITMETATYPE_FUNC 3 155 | #define RTTI_INITVALUE_FUNC 4 156 | #define RTTI_INITBYTES_LOWFUNC 5 157 | #define RTTI_INITBYTES_MAXCOUNT 32 158 | #define RTTI_INITBYTES_HIGHFUNC RTTI_INITBYTES_LOWFUNC + RTTI_INITBYTES_MAXCOUNT 159 | #define RTTI_INITRTL_LOWFUNC 38 160 | #define RTTI_INITFULLSTATICARRAY_FUNC RTTI_INITRTL_LOWFUNC + 0 161 | #define RTTI_INITFULLSTRUCTURE_FUNC RTTI_INITRTL_LOWFUNC + 1 162 | #define RTTI_FINALNONE_FUNC 0 163 | #define RTTI_FINALMETATYPE_FUNC 1 164 | #define RTTI_FINALWEAKMETATYPE_FUNC 2 165 | #define RTTI_FINALINTERFACE_FUNC 3 166 | #define RTTI_FINALVALUE_FUNC 4 167 | #define RTTI_FINALRTL_LOWFUNC 5 168 | #define RTTI_FINALSTRING_FUNC RTTI_FINALRTL_LOWFUNC + 0 169 | #define RTTI_FINALWIDESTRING_FUNC RTTI_FINALRTL_LOWFUNC + 1 170 | #define RTTI_FINALWEAKINTERFACE_FUNC RTTI_FINALRTL_LOWFUNC + 2 171 | #define RTTI_FINALREFOBJECT_FUNC RTTI_FINALRTL_LOWFUNC + 3 172 | #define RTTI_FINALWEAKREFOBJECT_FUNC RTTI_FINALRTL_LOWFUNC + 4 173 | #define RTTI_FINALVARIANT_FUNC RTTI_FINALRTL_LOWFUNC + 5 174 | #define RTTI_FINALWEAKMETHOD_FUNC RTTI_FINALRTL_LOWFUNC + 6 175 | #define RTTI_FINALDYNARRAY_FUNC RTTI_FINALRTL_LOWFUNC + 7 176 | #define RTTI_FINALFULLDYNARRAY_FUNC RTTI_FINALRTL_LOWFUNC + 8 177 | #define RTTI_FINALFULLSTATICARRAY_FUNC RTTI_FINALRTL_LOWFUNC + 9 178 | #define RTTI_FINALFULLSTRUCTURE_FUNC RTTI_FINALRTL_LOWFUNC + 10 179 | #define RTTI_COPYREFERENCE_FUNC 0 180 | #define RTTI_COPYNATIVE_FUNC 1 181 | #define RTTI_COPYALTERNATIVE_FUNC 2 182 | #define RTTI_COPYMETATYPE_FUNC 3 183 | #define RTTI_COPYWEAKMETATYPE_FUNC 4 184 | #define RTTI_COPYMETATYPEBYTES_FUNC 5 185 | #define RTTI_COPYINTERFACE_FUNC 6 186 | #define RTTI_COPYVALUE_FUNC 7 187 | #if defined (SMALLINT) 188 | #define RTTI_COPYBYTES_CARDINAL RTTI_COPYNATIVE_FUNC 189 | #define RTTI_COPYBYTES_INT64 RTTI_COPYNATIVE_FUNC + 1 190 | #else 191 | #define RTTI_COPYBYTES_CARDINAL RTTI_COPYNATIVE_FUNC + 1 192 | #define RTTI_COPYBYTES_INT64 RTTI_COPYNATIVE_FUNC 193 | #endif 194 | #define RTTI_COPYBYTES_LOWFUNC 8 195 | #define RTTI_COPYBYTES_MAXCOUNT 64 196 | #define RTTI_COPYBYTES_HIGHFUNC RTTI_COPYBYTES_LOWFUNC + RTTI_COPYBYTES_MAXCOUNT 197 | #define RTTI_COPYHFAREAD_LOWFUNC 73 198 | #define RTTI_COPYHFAWRITE_LOWFUNC 76 199 | #define RTTI_COPYSHORTSTRING_FUNC 79 200 | #define RTTI_COPYRTL_LOWFUNC 80 201 | #define RTTI_COPYSTRING_FUNC RTTI_COPYRTL_LOWFUNC + 0 202 | #define RTTI_COPYWIDESTRING_FUNC RTTI_COPYRTL_LOWFUNC + 1 203 | #define RTTI_COPYWEAKINTERFACE_FUNC RTTI_COPYRTL_LOWFUNC + 2 204 | #define RTTI_COPYREFOBJECT_FUNC RTTI_COPYRTL_LOWFUNC + 3 205 | #define RTTI_COPYWEAKREFOBJECT_FUNC RTTI_COPYRTL_LOWFUNC + 4 206 | #define RTTI_COPYVARIANT_FUNC RTTI_COPYRTL_LOWFUNC + 5 207 | #define RTTI_COPYWEAKMETHOD_FUNC RTTI_COPYRTL_LOWFUNC + 6 208 | #define RTTI_COPYDYNARRAY_FUNC RTTI_COPYRTL_LOWFUNC + 7 209 | #define RTTI_COPYFULLDYNARRAY_FUNC RTTI_COPYRTL_LOWFUNC + 8 210 | #define RTTI_COPYSTATICARRAY_FUNC RTTI_COPYRTL_LOWFUNC + 9 211 | #define RTTI_COPYFULLSTATICARRAY_FUNC RTTI_COPYRTL_LOWFUNC + 10 212 | #define RTTI_COPYSTRUCTURE_FUNC RTTI_COPYRTL_LOWFUNC + 11 213 | #define RTTI_COPYFULLSTRUCTURE_FUNC RTTI_COPYRTL_LOWFUNC + 12 214 | #define RTTI_COPYVAROPENSTRINGWRITE_FUNC RTTI_COPYRTL_LOWFUNC + 13 215 | #define RTTI_COPYARGARRAYREAD_FUNC RTTI_COPYRTL_LOWFUNC + 14 216 | #define RTTI_COPYARGARRAYWRITE_FUNC RTTI_COPYRTL_LOWFUNC + 15 217 | REGISTER_DECL RttiTypeRules* (*RttiCalculatedRules)(RttiExType* type, RttiTypeRules* buffer); 218 | 219 | 220 | /* 221 | Initialization 222 | */ 223 | void init_library(); 224 | 225 | #endif 226 | -------------------------------------------------------------------------------- /c/tiny.types.new86.c: -------------------------------------------------------------------------------- 1 | #include "tiny.types.h" 2 | 3 | #if defined (CPUX86) && defined (MSWINDOWS) 4 | 5 | REGISTER_DECL void AStrClear(void* value) /*AStrClear_new*/ 6 | { 7 | RtlStrRec_new* rec = *((ptr_t*)value); 8 | if (rec) 9 | { 10 | *((ptr_t*)value) = 0; 11 | rtl_string_release_new(rec, RETURN_ADDRESS, ); 12 | } 13 | } 14 | 15 | REGISTER_DECL void* AStrInit(void* value, char8_t* chars, uint32_t length, uint16_t codepage) /*AStrInit_new*/ 16 | { 17 | RtlStrRec_new* rec = *((ptr_t*)value); 18 | 19 | if (rec) 20 | { 21 | if (length) 22 | { 23 | if ((rec - 1)->length == length) 24 | { 25 | if ((void*)rec != chars && chars) goto copy; 26 | return rec; 27 | } 28 | if ((rec - 1)->refcount == 1 && rtl_rec_hintrealloc((rec - 1)->length, sizeof(*chars), length)) 29 | { 30 | rtl_rec_realloc_new(rec, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 31 | goto markup; 32 | } 33 | else 34 | { 35 | *((ptr_t*)value) = 0; 36 | rtl_string_release_new(rec, RETURN_ADDRESS, 0); 37 | goto allocate; 38 | } 39 | } 40 | else 41 | { 42 | *((ptr_t*)value) = 0; 43 | rtl_string_release_new(rec, RETURN_ADDRESS, 0); 44 | } 45 | } 46 | else 47 | if (length) 48 | { 49 | allocate: 50 | rtl_rec_alloc_new(rec, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 51 | markup: 52 | rtl_lstr_markup_new(rec, length, codepage); 53 | copy: 54 | *((ptr_t*)value) = rec; 55 | if (chars) rtl_memcopy(rec, chars, length * sizeof(*chars)); 56 | return rec; 57 | } 58 | 59 | return 0; 60 | } 61 | 62 | REGISTER_DECL void* AStrReserve(void* value, uint32_t length) /*AStrReserve_new*/ 63 | { 64 | RtlStrRec_new* rec = *((ptr_t*)value); 65 | char8_t* chars/*none*/; 66 | 67 | if (rec) 68 | { 69 | if (length) 70 | { 71 | if ((rec - 1)->refcount == 1) 72 | { 73 | if ((rec - 1)->length >= length) return rec; 74 | if (rtl_rec_hintrealloc((rec - 1)->length, sizeof(*chars), length)) 75 | { 76 | rtl_rec_realloc_new(rec, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 77 | goto markup; 78 | } 79 | } 80 | 81 | *((ptr_t*)value) = 0; 82 | rtl_string_release_new(rec, RETURN_ADDRESS, 0); 83 | goto allocate; 84 | } 85 | else 86 | { 87 | *((ptr_t*)value) = 0; 88 | rtl_string_release_new(rec, RETURN_ADDRESS, 0); 89 | } 90 | } 91 | else 92 | if (length) 93 | { 94 | allocate: 95 | rtl_rec_alloc_new(rec, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 96 | markup: 97 | rtl_lstr_markup_new(rec, length, DefaultCP); 98 | *((ptr_t*)value) = rec; 99 | return rec; 100 | } 101 | 102 | return 0; 103 | } 104 | 105 | REGISTER_DECL void* AStrSetLength(void* value, uint32_t length, uint16_t codepage) /*AStrSetLength_new*/ 106 | { 107 | RtlStrRec_new* source = *((ptr_t*)value); 108 | RtlStrRec_new* target; 109 | char8_t* chars/*none*/; 110 | 111 | if (source) 112 | { 113 | if (length) 114 | { 115 | if ((source - 1)->refcount != 1 || (source - 1)->length != length) goto allocate; 116 | (source - 1)->cpelemsize = ((uint32_t)codepage) + 0x10000; 117 | return source; 118 | } 119 | else 120 | { 121 | *((ptr_t*)value) = 0; 122 | rtl_string_release_new(source, RETURN_ADDRESS, 0); 123 | } 124 | } 125 | else 126 | if (length) 127 | { 128 | allocate: 129 | rtl_rec_alloc_new(target, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 130 | rtl_lstr_markup_new(target, length, codepage); 131 | *((ptr_t*)value) = target; 132 | if (source) 133 | { 134 | if (length > (source - 1)->length) length = (source - 1)->length; 135 | rtl_memcopy(target, source, length * sizeof(*chars)); 136 | rtl_string_release_new(source, RETURN_ADDRESS, 0); 137 | } 138 | 139 | return target; 140 | } 141 | 142 | return 0; 143 | } 144 | 145 | REGISTER_DECL void UStrClear(void* value) /*UStrClear_new*/ 146 | { 147 | RtlStrRec_new* rec = *((ptr_t*)value); 148 | if (rec) 149 | { 150 | *((ptr_t*)value) = 0; 151 | rtl_string_release_new(rec, RETURN_ADDRESS, ); 152 | } 153 | } 154 | 155 | REGISTER_DECL void* UStrInit(void* value, char8_t* chars, uint32_t length, uint16_t codepage) /*UStrInit_new*/ 156 | { 157 | RtlStrRec_new* rec = *((ptr_t*)value); 158 | 159 | if (rec) 160 | { 161 | if (length) 162 | { 163 | if ((rec - 1)->length == length) 164 | { 165 | if ((void*)rec != chars && chars) goto copy; 166 | return rec; 167 | } 168 | if ((rec - 1)->refcount == 1 && rtl_rec_hintrealloc((rec - 1)->length, sizeof(*chars), length)) 169 | { 170 | rtl_rec_realloc_new(rec, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 171 | goto markup; 172 | } 173 | else 174 | { 175 | *((ptr_t*)value) = 0; 176 | rtl_string_release_new(rec, RETURN_ADDRESS, 0); 177 | goto allocate; 178 | } 179 | } 180 | else 181 | { 182 | *((ptr_t*)value) = 0; 183 | rtl_string_release_new(rec, RETURN_ADDRESS, 0); 184 | } 185 | } 186 | else 187 | if (length) 188 | { 189 | allocate: 190 | rtl_rec_alloc_new(rec, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 191 | markup: 192 | rtl_ustr_markup_new(rec, length); 193 | copy: 194 | *((ptr_t*)value) = rec; 195 | if (chars) rtl_memcopy(rec, chars, length * sizeof(*chars)); 196 | return rec; 197 | } 198 | 199 | return 0; 200 | } 201 | 202 | REGISTER_DECL void* UStrReserve(void* value, uint32_t length, uint16_t codepage) /*UStrReserve_new*/ 203 | { 204 | RtlStrRec_new* rec = *((ptr_t*)value); 205 | char16_t* chars/*none*/; 206 | 207 | if (rec) 208 | { 209 | if (length) 210 | { 211 | if ((rec - 1)->refcount == 1) 212 | { 213 | if ((rec - 1)->length >= length) return rec; 214 | if (rtl_rec_hintrealloc((rec - 1)->length, sizeof(*chars), length)) 215 | { 216 | rtl_rec_realloc_new(rec, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 217 | goto markup; 218 | } 219 | } 220 | 221 | *((ptr_t*)value) = 0; 222 | rtl_string_release_new(rec, RETURN_ADDRESS, 0); 223 | goto allocate; 224 | } 225 | else 226 | { 227 | *((ptr_t*)value) = 0; 228 | rtl_string_release_new(rec, RETURN_ADDRESS, 0); 229 | } 230 | } 231 | else 232 | if (length) 233 | { 234 | allocate: 235 | rtl_rec_alloc_new(rec, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 236 | markup: 237 | rtl_ustr_markup_new(rec, length); 238 | *((ptr_t*)value) = rec; 239 | return rec; 240 | } 241 | 242 | return 0; 243 | } 244 | 245 | REGISTER_DECL void* UStrSetLength(void* value, uint32_t length) /*UStrSetLength_new*/ 246 | { 247 | RtlStrRec_new* source = *((ptr_t*)value); 248 | RtlStrRec_new* target; 249 | char16_t* chars/*none*/; 250 | 251 | if (source) 252 | { 253 | if (length) 254 | { 255 | if ((source - 1)->refcount != 1 || (source - 1)->length != length) goto allocate; 256 | (source - 1)->cpelemsize = USTR_CPELEMSIZE; 257 | return source; 258 | } 259 | else 260 | { 261 | *((ptr_t*)value) = 0; 262 | rtl_string_release_new(source, RETURN_ADDRESS, 0); 263 | } 264 | } 265 | else 266 | if (length) 267 | { 268 | allocate: 269 | rtl_rec_alloc_new(target, (length + 1) * sizeof(*chars), RETURN_ADDRESS, 0); 270 | rtl_ustr_markup_new(target, length); 271 | *((ptr_t*)value) = target; 272 | if (source) 273 | { 274 | if (length > (source - 1)->length) length = (source - 1)->length; 275 | rtl_memcopy(target, source, length * sizeof(*chars)); 276 | rtl_string_release_new(source, RETURN_ADDRESS, 0); 277 | } 278 | 279 | return target; 280 | } 281 | 282 | return 0; 283 | } 284 | 285 | #endif 286 | -------------------------------------------------------------------------------- /demo/general/cache/FileReading.dpr: -------------------------------------------------------------------------------- 1 | program FileReading; 2 | 3 | {$I TINY.DEFINES.inc} 4 | {$APPTYPE CONSOLE} 5 | 6 | uses {$ifdef UNITSCOPENAMES} 7 | Winapi.Windows, System.SysUtils, System.Classes, 8 | {$else} 9 | Windows, SysUtils, Classes, 10 | {$endif} 11 | Tiny.Types, Tiny.Cache.Buffers; 12 | 13 | 14 | // test file information 15 | const 16 | CORRECT_FILE_NAME = 'Correct.txt'; 17 | CORRECT_SUM = Int64($2904E86C0); 18 | 19 | procedure GenerateTestFile; 20 | const 21 | STRINGS_COUNT = 1000; 22 | ITERATIONS_COUNT = 22000; 23 | var 24 | Iteration, i: Integer; 25 | T: TextFile; 26 | Buffer: array[Word] of Byte; 27 | begin 28 | AssignFile(T, CORRECT_FILE_NAME); 29 | ReWrite(T); 30 | SetTextBuf(T, Buffer); 31 | try 32 | for Iteration := 1 to ITERATIONS_COUNT do 33 | for i := 1 to STRINGS_COUNT do 34 | Writeln(T, i); 35 | 36 | finally 37 | CloseFile(T); 38 | end; 39 | end; 40 | 41 | // copied from System.ValLong and corrected to ShortString with DefValue 0 42 | function ShortStrToInt(const S: ShortString): Integer; 43 | var 44 | I, Len: Integer; 45 | Negative, Hex: Boolean; 46 | begin 47 | Result := 0; 48 | Negative := False; 49 | Hex := False; 50 | I := 1; 51 | Len := Length(S); 52 | 53 | while (I <= Len) and (S[I] = ' ') do Inc(I); 54 | if (I > Len) then Exit; 55 | 56 | case S[I] of 57 | '$', 58 | 'x', 59 | 'X': begin 60 | Hex := True; 61 | Inc(I); 62 | end; 63 | '0': begin 64 | Hex := (Len > I) and (S[I+1] in ['x', 'X']); 65 | if Hex then Inc(I,2); 66 | end; 67 | '-': begin 68 | Negative := True; 69 | Inc(I); 70 | end; 71 | '+': Inc(I); 72 | end; 73 | if Hex then 74 | while I <= Len do 75 | begin 76 | if Result > (High(Result) div 16) then 77 | begin 78 | Result := 0; 79 | Exit; 80 | end; 81 | case s[I] of 82 | '0'..'9': Result := Result * 16 + Ord(S[I]) - Ord('0'); 83 | 'a'..'f': Result := Result * 16 + Ord(S[I]) - Ord('a') + 10; 84 | 'A'..'F': Result := Result * 16 + Ord(S[I]) - Ord('A') + 10; 85 | else 86 | Result := 0; 87 | Exit; 88 | end; 89 | end 90 | else 91 | while (I <= Len) do 92 | begin 93 | if Result > (High(Result) div 10) then 94 | begin 95 | Result := 0; 96 | Exit; 97 | end; 98 | Result := Result * 10 + Ord(S[I]) - Ord('0'); 99 | Inc(I); 100 | end; 101 | if Negative then 102 | Result := -Result; 103 | end; 104 | 105 | const 106 | PARSE_MARKER_CRLF = #13; 107 | PARSE_MARKER_DIGIT = '1'; 108 | 109 | (* 110 | Many of the parsing algorithms use the <Pointer, Size> variables. 111 | However, lots of tests show that it is more effective to use <Pointer, Overflow> 112 | + some character markers in Additional memory on which the parser will 113 | definitely stop. The productivity benefits are made due to fact that there is 114 | no need to analyze the Size at every character reading time. Moreover with a 115 | shortage of CPU registers, Overflow variables store on stack and the 116 | comparison takes only 2 CPU cycles instead of 2 + 6 cycles at comparison and 117 | modification of Size. 118 | 119 | Sometimes it is useful to modify a "reading" memory. For example, with XML parsing 120 | it is possible to replace the &...; entities with the real characters. 121 | Knowing the storage features of System types it is possible for example 122 | to emulate UnicodeString or dynamic array instances. In this function we emulate 123 | ShortString by store length byte on Previous memory. 124 | 125 | The function parses and sums up the numbers stopping on markers at the end. 126 | It returns the pointer to the last non-parsed data at the end of the buffer. 127 | *) 128 | function AddParsedTextNumbers(var Sum: Int64; Current: PAnsiChar; Overflow: PAnsiChar): PAnsiChar; 129 | var 130 | S: PAnsiChar; 131 | Len: NativeUInt; 132 | begin 133 | repeat 134 | // left trim 135 | while (Current^ <= ' ') do Inc(Current); 136 | if (Current >= Overflow{overflow marker found}) then 137 | begin 138 | Current := Overflow; 139 | Break; 140 | end; 141 | 142 | // find first non-numeric character or marker 143 | S := Current + 1; 144 | while (S^ > ' ') do Inc(S); 145 | if (S >= Overflow{overflow marker found}) then Break; 146 | 147 | // length 148 | Len := NativeUInt(S) - NativeUInt(Current); 149 | 150 | // WRITE length to previous memory and use char buffer as ShortString pointer 151 | // ShortString = [Len: Byte] array(Len) of AnsiChar 152 | Dec(Current); 153 | Byte(Current^) := Len; 154 | Sum := Sum + ShortStrToInt(PShortString(Current)^); 155 | 156 | // next current character 157 | Current := S + 1; 158 | until (False); 159 | 160 | // return current usually numeric string pointer 161 | Result := Current; 162 | end; 163 | 164 | 165 | type 166 | TParsingMethod = function(const FileName: string): Int64; 167 | 168 | // standard way to load file and 169 | // process every TStringList item 170 | function StringListParsing(const FileName: string): Int64; 171 | var 172 | i: Integer; 173 | List: TStringList; 174 | begin 175 | Result := 0; 176 | List := TStringList.Create; 177 | try 178 | List.LoadFromFile(FileName); 179 | 180 | for i := 0 to List.Count - 1 do 181 | Result := Result + StrToInt(List[i]); 182 | finally 183 | List.Free; 184 | end; 185 | end; 186 | 187 | // fast parsing method 188 | // but it need too much memory (same as file size) 189 | function AllocatedMemoryParsing(const FileName: string): Int64; 190 | var 191 | Memory: Pointer; 192 | F: TFileStream; 193 | Size: Integer; 194 | Current, Overflow: PAnsiChar; 195 | begin 196 | Memory := nil; 197 | try 198 | // read entire file to allocated memory buffer 199 | F := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone); 200 | try 201 | Size := F.Size; 202 | GetMem(Memory, 1{previous} + Size + 3{markers}); 203 | 204 | Current := PAnsiChar(Memory) + 1; 205 | F.Read(Current^, Size); 206 | finally 207 | F.Free; 208 | end; 209 | 210 | // overflow 211 | Overflow := Current + Size; 212 | 213 | // mark CRLF to parse last number correctly 214 | Overflow^ := #13; 215 | Inc(Overflow); 216 | 217 | // advanced markers 218 | Overflow[0] := PARSE_MARKER_CRLF; 219 | Overflow[1] := PARSE_MARKER_DIGIT; 220 | 221 | // parse numbers 222 | Result := 0; 223 | AddParsedTextNumbers(Result, Current, Overflow); 224 | finally 225 | if (Memory <> nil) then FreeMem(Memory); 226 | end; 227 | end; 228 | 229 | // optimal way to sequential file parsing 230 | // flush and parse memory buffer by TCachedReader interface 231 | function CachedReaderParsing(const FileName: string): Int64; 232 | var 233 | Reader: TCachedReader; 234 | Current, Overflow: PAnsiChar; 235 | begin 236 | Result := 0; 237 | 238 | Reader := TCachedFileReader.Create(FileName); 239 | try 240 | while (not Reader.EOF) do 241 | begin 242 | Current := PAnsiChar(Reader.Current); 243 | Overflow := PAnsiChar(Reader.Overflow); 244 | 245 | // mark CRLF to parse last number correctly 246 | if (Reader.Finishing) then 247 | begin 248 | Overflow^ := #13; 249 | Inc(Overflow); 250 | end; 251 | 252 | // markers 253 | Overflow[0] := PARSE_MARKER_CRLF; 254 | Overflow[1] := PARSE_MARKER_DIGIT; 255 | 256 | // parse reader memory, flush reader (or EOF in Finishing case) 257 | Reader.Current := PByte(AddParsedTextNumbers(Result, Current, Overflow)); 258 | if (Reader.Finishing) then Reader.Current := Reader.Overflow; 259 | Reader.Flush; 260 | end; 261 | finally 262 | Reader.Free; 263 | end; 264 | end; 265 | 266 | // run parser and measure the time 267 | var 268 | ParsingMethodNumber: Cardinal = 0; 269 | 270 | procedure RunParsingMethod(const Description: string; const ParsingMethod: TParsingMethod); 271 | var 272 | Time: Cardinal; 273 | Sum: Int64; 274 | begin 275 | // reset filesystem cache to have same test conditions 276 | // (thanks for Sapersky) 277 | FileClose(CreateFile(PChar(CORRECT_FILE_NAME), GENERIC_READ, FILE_SHARE_READ, nil ,OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, 0)); 278 | 279 | Inc(ParsingMethodNumber); 280 | Write(ParsingMethodNumber, ') ', Description, '...'); 281 | Time := GetTickCount; 282 | Sum := ParsingMethod(CORRECT_FILE_NAME); 283 | Time := GetTickCount - Time; 284 | 285 | Write(' ', Time, 'ms'); 286 | if (Sum <> CORRECT_SUM) then Write(' FAILURE Sum = 0x%s', IntToHex(Sum, 0)); 287 | Writeln; 288 | end; 289 | 290 | 291 | begin 292 | try 293 | // benchmark text 294 | Writeln('The benchmark helps to compare the time of binary/text files parsing methods'); 295 | Writeln('Testing file is "Correct.txt" (about 100Mb)'); 296 | Writeln('Total sum of numbers must be equal 0x', IntToHex(CORRECT_SUM, 0)); 297 | if (not FileExists(CORRECT_FILE_NAME)) then 298 | begin 299 | Write('Correct file generating... '); 300 | GenerateTestFile; 301 | Writeln('done.'); 302 | end; 303 | 304 | // run parsers, measure time, compare summary value 305 | Writeln; 306 | Writeln('Let''s test parsing methods (it may take a few minutes):'); 307 | RunParsingMethod('Allocated 100Mb memory', AllocatedMemoryParsing); 308 | RunParsingMethod('CachedReader', CachedReaderParsing); 309 | RunParsingMethod('StringList', StringListParsing); 310 | except 311 | on E: Exception do 312 | Writeln(E.ClassName, ': ', E.Message); 313 | end; 314 | 315 | if (ParamStr(1) <> '-nowait') then 316 | begin 317 | Writeln; 318 | Write('Press Enter to quit'); 319 | Readln; 320 | end; 321 | end. 322 | -------------------------------------------------------------------------------- /doc/Rtti.md: -------------------------------------------------------------------------------- 1 | ### Concept 2 | 3 | The basis of the RTTI units we laid the following conceptual features: 4 | * Standard types, including FreePascal, old and new versions of Delphi, convenient functions for managing them. 5 | * Universal data representation, regardless of programming language and compiler version. 6 | * Convert standard RTTI to universal data representation. 7 | * Minimizing dependencies on heavy units like Classes, Variants, Generics, etc. 8 | * Cross-platform functions invoke, including FreePascal and old versions of Delphi, creation of function and interface interpreters. 9 | * Marshalling (serialization and deserialization of data) through different formatters: JSON, XML, [FlexBin](FlexBin.md) and others. 10 | * Easy to use unit testing library that does not access the memory manager. 11 | 12 | The following sections deserve special attention: 13 | * [Compatibility](#compatibility) 14 | * [Universal data representation](#universal-data-representation) 15 | * [Context](#context) 16 | * [TValue benchmark](#tvalue-benchmark) 17 | * [Invoke benchmark](#invoke-benchmark) 18 | * [Virtual interface benchmark](#virtual-interface-benchmark) 19 | 20 | ### Compatibility 21 | 22 | The library is created with the prospect of using in different programming languages, but primarily for Delphi, FreePascal and C++Builder. The main unit is _Tiny.Rtti.pas_, it contains the main types and functions of the library. One of the key ideas of the unit is to ensure code compatibility on different versions of Delphi or FreePascal, therefore, RTTI types are TTypeInfo, TTypeData, etc. reduced to a single naming and interface. Another feature of the library is that the internal types and functions match the units of _System.TypInfo.pas_ and _System.Rtti.pas_ as closely as possible. For example, there are the usual `GetTypeData`, `GetEnumName`, `IsManaged` and `HasWeakRef` functions, there is a [TValue](#tvalue-benchmark) type, including for old Delphi and FreePascal. 23 | 24 | ### Universal data representation 25 | 26 | Despite the fact that a significant part of the library works with RTTI, its essence boils down to the universal representation of data: types and information about them. To store the base type, the `TRttiType` enumeration is used. To classify the types, the `TRttiTypeGroup` enumeration is used. There is a standard set of types and groups, but you may always extend this set with the `RttiTypeIncrease` and `RttiTypeIncreaseGroup` functions. For a detailed description of the type, the `TRttiExType` structure is used - it stores the base type, pointer depth, options and additional meta information. 27 | 28 | ### Context 29 | 30 | Typically, context is used to convert TypeInfo into the [universal data representation](#universal-data-representation). You may use the `DefaultContext` variable for these purposes. The context functionality can be expanded, for example, to store information about classes, interfaces, properties and methods. For storing and caching a namespace, there is a type `TRttiNamespace` (_Tiny.Namespace.pas_). 31 | 32 | On older versions of Delphi, RTTI is not generated for some types, for example, `PAnsiChar`. Therefore, the library supports the concept of PTypeInfo equivalents that will be correctly converted by the context. Use dummy constants (`TYPEINFO_PANSICHAR`, `TYPEINFO_UINT64`, etc.) or the `DummyTypeInfo` function for such cases. 33 | 34 | ### TValue benchmark 35 | 36 | `TValue` is a lightweight analogue of the Variant type. This type supports almost all types available in Tiny.Rtti, an exception is made only by all pointer types, they are all cast to `Pointer`. The functional largely repeats the System.Rtti implementation, the difference is only in increasing the number of `As`-properties and reducing the functions of the casts. In addition, much attention was paid to optimizations, you may see this on the benchmark below. Type `TValue` and the benchmark were created with the participation of [Alexander Zhirov](mailto:suprito2012@gmail.com). 37 | 38 | ![](../data/rtti/Values.png) 39 | 40 | ### Invoke benchmark 41 | 42 | In some cases, for example, when binding code with scripts, or when performing automatic tests, there is a need to invoke your native functions. In older versions of Delphi, this functionality was not available, but in newer versions, the call occurs with low performance. The _Tiny.Invoke.pas_ unit allows you to invoke functions at 3 levels of abstraction ([values](#tvalue-benchmark), arguments, direct), the benchmark below shows how to do this and measures performance. 43 | 44 | `TRttiSignature` structure stores service information about the function signature: calling convention, argument description, register and stack information. The `TRttiInvokeDump` structure is used to store arguments in memory. 45 | 46 | ![](../data/rtti/Invoke.png) 47 | ```pascal 48 | procedure TForm1.SomeMethod(const X, Y, Z: Integer); 49 | begin 50 | Tag := X + Y + Z; 51 | end; 52 | 53 | procedure TForm1.Button1Click(Sender: TObject); 54 | const 55 | COUNT = 1000000; 56 | var 57 | i: Integer; 58 | LStopwatch: TStopwatch; 59 | LContext: System.Rtti.TRttiContext; 60 | LMethod: System.Rtti.TRttiMethod; 61 | LMethodEntry: Tiny.Rtti.PVmtMethodExEntry; 62 | LSignature: Tiny.Invoke.TRttiSignature; 63 | LInvokeFunc: Tiny.Invoke.TRttiInvokeFunc; 64 | LDump: Tiny.Invoke.TRttiInvokeDump; 65 | T1, T2, T3, T4: Int64; 66 | begin 67 | // initialization 68 | LContext := System.Rtti.TRttiContext.Create; 69 | LMethod := LContext.GetType(TForm1).GetMethod('SomeMethod'); 70 | LMethodEntry := Tiny.Rtti.PTypeInfo(TypeInfo(TForm1)).TypeData.ClassData.MethodTableEx.Find('SomeMethod'); 71 | LSignature.Init(LMethodEntry^); 72 | LInvokeFunc := LSignature.OptimalInvokeFunc; 73 | 74 | // System.Rtti 75 | LStopwatch := TStopwatch.StartNew; 76 | for i := 1 to COUNT do 77 | begin 78 | LMethod.Invoke(Form1, [1, 2, 3]); 79 | end; 80 | T1 := LStopwatch.ElapsedMilliseconds; 81 | 82 | // Tiny.Rtti(Invoke) values 83 | LStopwatch := TStopwatch.StartNew; 84 | for i := 1 to COUNT do 85 | begin 86 | LSignature.Invoke(LDump, LMethodEntry.CodeAddress, Form1, {TValue}[1, 2, 3], LInvokeFunc); 87 | end; 88 | T2 := LStopwatch.ElapsedMilliseconds; 89 | 90 | // Tiny.Rtti(Invoke) arguments 91 | LStopwatch := TStopwatch.StartNew; 92 | for i := 1 to COUNT do 93 | begin 94 | LSignature.Invoke(LDump, LMethodEntry.CodeAddress, Form1, {array of}[1, 2, 3], nil, LInvokeFunc); 95 | end; 96 | T3 := LStopwatch.ElapsedMilliseconds; 97 | 98 | // Tiny.Rtti(Invoke) direct 99 | LStopwatch := TStopwatch.StartNew; 100 | for i := 1 to COUNT do 101 | begin 102 | PPointer(@LDump.Bytes[LSignature.DumpOptions.ThisOffset])^ := Form1; 103 | PInteger(@LDump.Bytes[LSignature.Arguments[0].Offset])^ := 1; 104 | PInteger(@LDump.Bytes[LSignature.Arguments[1].Offset])^ := 2; 105 | PInteger(@LDump.Bytes[LSignature.Arguments[2].Offset])^ := 3; 106 | LInvokeFunc(@LSignature, LMethodEntry.CodeAddress, @LDump); 107 | end; 108 | T4 := LStopwatch.ElapsedMilliseconds; 109 | 110 | // result 111 | Caption := Format('System.Rtti: %dms, Tiny.Rtti (values): %dms, ' + 112 | 'Tiny.Rtti (args): %dms, Tiny.Rtti (direct): %dms', [T1, T2, T3, T4]); 113 | end; 114 | ``` 115 | ### Virtual interface benchmark 116 | 117 | Virtual interfaces can be used, for example, for high-level marshalling, when a native function call leads to the conversion of the arguments into binary form and sending them to server. The idea of a virtual interface is that you intercept the methods you call and process the arguments as you like. The _Tiny.Invoke.pas_ unit allows you to intercept interface methods at 2 levels of abstraction: [values](#tvalue-benchmark) and direct. At the direct level, the structures `TRttiSignature` and `TRttiInvokeDump`, which are described [above](#invoke-benchmark), are important. 118 | 119 | Unlike the implementation of _System.Rtti.pas_, the library allows you to redefine the method context (**not** [TRttiContext](#context)) and the callback for each method. The benchmark below demonstrates the functionality of a virtual interface and compares performance. 120 | 121 | ![](../data/rtti/VirtualInterface.png) 122 | ```pascal 123 | type 124 | IMyInterface = interface(IInvokable) 125 | ['{89EDBA5C-DFBA-48FA-889C-FC857B0ED609}'] 126 | function Func(const X, Y, Z: Integer): Integer; 127 | end; 128 | 129 | procedure TForm1.Button1Click(Sender: TObject); 130 | const 131 | COUNT = 1000000; 132 | var 133 | i: Integer; 134 | LStopwatch: TStopwatch; 135 | LInterface: IMyInterface; 136 | LValue: Integer; 137 | T1, T2, T3: Int64; 138 | begin 139 | // System.Rtti virtual interface 140 | LInterface := System.Rtti.TVirtualInterface.Create(TypeInfo(IMyInterface), 141 | procedure(Method: System.Rtti.TRttiMethod; 142 | const Args: TArray<System.Rtti.TValue>; out Result: System.Rtti.TValue) 143 | begin 144 | Result := Args[1].AsInteger + Args[2].AsInteger + Args[3].AsInteger; 145 | end) as IMyInterface; 146 | LValue := LInterface.Func(1, 2, 3); 147 | Assert(LValue = (1 + 2 + 3), 'System.Rtti virtual interface'); 148 | LStopwatch := TStopwatch.StartNew; 149 | for i := 1 to COUNT do 150 | begin 151 | LInterface.Func(1, 2, 3); 152 | end; 153 | T1 := LStopwatch.ElapsedMilliseconds; 154 | 155 | // Tiny.Rtti(Invoke) virtual interface 156 | LInterface := Tiny.Invoke.TRttiVirtualInterface.Create(TypeInfo(IMyInterface), 157 | function(const AMethod: Tiny.Invoke.TRttiVirtualMethod; 158 | const AArgs: TArray<Tiny.Rtti.TValue>; const AReturnAddress: Pointer): TValue 159 | begin 160 | Result := AArgs[1].AsInteger + AArgs[2].AsInteger + AArgs[3].AsInteger; 161 | end) as IMyInterface; 162 | LValue := LInterface.Func(1, 2, 3); 163 | Assert(LValue = (1 + 2 + 3), 'Tiny.Rtti(Invoke) virtual interface'); 164 | LStopwatch := TStopwatch.StartNew; 165 | for i := 1 to COUNT do 166 | begin 167 | LInterface.Func(1, 2, 3); 168 | end; 169 | T2 := LStopwatch.ElapsedMilliseconds; 170 | 171 | // Tiny.Rtti(Invoke) direct virtual interface 172 | LInterface := Tiny.Invoke.TRttiVirtualInterface.CreateDirect(TypeInfo(IMyInterface), 173 | procedure(const AMethod: Tiny.Invoke.TRttiVirtualMethod; var ADump: Tiny.Invoke.TRttiInvokeDump) 174 | var 175 | LSignature: Tiny.Invoke.PRttiSignature; 176 | begin 177 | LSignature := AMethod.Signature; 178 | ADump.OutInt32 := PInteger(@ADump.Bytes[LSignature.Arguments[0].Offset])^ + 179 | PInteger(@ADump.Bytes[LSignature.Arguments[1].Offset])^ + 180 | PInteger(@ADump.Bytes[LSignature.Arguments[2].Offset])^; 181 | end) as IMyInterface; 182 | LValue := LInterface.Func(1, 2, 3); 183 | Assert(LValue = (1 + 2 + 3), 'Tiny.Rtti(Invoke) direct virtual interface'); 184 | LStopwatch := TStopwatch.StartNew; 185 | for i := 1 to COUNT do 186 | begin 187 | LInterface.Func(1, 2, 3); 188 | end; 189 | T3 := LStopwatch.ElapsedMilliseconds; 190 | 191 | // result 192 | Caption := Format('System.Rtti: %dms, Tiny.Rtti (values): %dms, Tiny.Rtti (direct): %dms', [T1, T2, T3]); 193 | end; 194 | ``` -------------------------------------------------------------------------------- /demo/general/cache/FileWriting.dpr: -------------------------------------------------------------------------------- 1 | program FileWriting; 2 | 3 | {$I TINY.DEFINES.inc} 4 | {$APPTYPE CONSOLE} 5 | 6 | uses {$ifdef UNITSCOPENAMES} 7 | Winapi.Windows, System.SysUtils, System.Classes, 8 | {$else} 9 | Windows, SysUtils, Classes, 10 | {$endif} 11 | Tiny.Types, Tiny.Cache.Buffers; 12 | 13 | 14 | // test string array 15 | var 16 | TEST_STRINGS: array[1..1000] of record 17 | Value: AnsiString; 18 | Length: Integer; 19 | end; 20 | 21 | procedure GenerateTestStrings; 22 | var 23 | i: Integer; 24 | begin 25 | for i := Low(TEST_STRINGS) to High(TEST_STRINGS) do 26 | begin 27 | TEST_STRINGS[i].Value := AnsiString(IntToStr(i)); 28 | TEST_STRINGS[i].Length := Length(TEST_STRINGS[i].Value); 29 | end; 30 | end; 31 | 32 | // file names and comparison 33 | const 34 | CORRECT_FILE_NAME = 'Correct.txt'; 35 | OUTPUT_FILE_NAME = 'Output.txt'; 36 | 37 | procedure CompareOutputAndCorrectFiles; 38 | var 39 | F1, F2: TFileStream; 40 | Size: Int64; 41 | Count: Integer; 42 | Same: Boolean; 43 | Buffer1, Buffer2: array[1..64*1024] of Byte; 44 | begin 45 | 46 | if (not FileExists(CORRECT_FILE_NAME)) then 47 | begin 48 | Writeln('"', CORRECT_FILE_NAME, '" not found'); 49 | Abort; 50 | end; 51 | if (not FileExists(OUTPUT_FILE_NAME)) then 52 | begin 53 | Writeln('"', OUTPUT_FILE_NAME, '" not found'); 54 | Abort; 55 | end; 56 | 57 | F1 := TFileStream.Create(CORRECT_FILE_NAME, fmOpenRead or fmShareDenyWrite); 58 | try 59 | Size := F1.Size; 60 | F2 := TFileStream.Create(OUTPUT_FILE_NAME, fmOpenRead or fmShareDenyWrite); 61 | try 62 | if (Size <> F2.Size) then 63 | begin 64 | Writeln('FAILURE SIZE: ', Size, ' and ', F2.Size); 65 | Abort; 66 | end; 67 | 68 | Same := True; 69 | while (Size <> 0) do 70 | begin 71 | Count := SizeOf(Buffer1); 72 | if (Count > Size) then Count := Size; 73 | 74 | F1.ReadBuffer(Buffer1, Count); 75 | F2.ReadBuffer(Buffer2, Count); 76 | if (not CompareMem(@Buffer1, @Buffer2, Count)) then 77 | begin 78 | Same := False; 79 | Break; 80 | end; 81 | 82 | Size := Size - Count; 83 | end; 84 | 85 | if (not Same) then 86 | begin 87 | Writeln('FAILURE'); 88 | Abort; 89 | end else 90 | begin 91 | Writeln('done.'); 92 | end; 93 | finally 94 | F2.Free 95 | end; 96 | finally 97 | F1.Free; 98 | end; 99 | end; 100 | 101 | (* 102 | There is a several common binary/text files generation methods: 103 | - TStream.Write 104 | - TStringList save to File/Stream 105 | - File/TextFile Writeln 106 | 107 | You can significantly increase the perfornace with CachedBuffer classes: 108 | - TCachedWriter (TCachedFileWriter) 109 | - TCachedStreamWriter (TCachedWriter) + TFileStream 110 | - TCachedBufferStream (TStream) + TCachedFileWriter 111 | *) 112 | 113 | const 114 | CRLF_VALUE = 13 or (10 shl 8); 115 | CRLF: Word = CRLF_VALUE; 116 | ITERATIONS_COUNT = 22000; 117 | 118 | // standard way to write data to Stream 119 | procedure AppendToStream(const Stream: TStream); 120 | var 121 | Iteration, i: Integer; 122 | begin 123 | for Iteration := 1 to ITERATIONS_COUNT do 124 | for i := Low(TEST_STRINGS) to High(TEST_STRINGS) do 125 | with TEST_STRINGS[i] do 126 | begin 127 | Stream.Write(Pointer(Value)^, Length); 128 | Stream.Write(CRLF, SizeOf(CRLF)); 129 | end; 130 | end; 131 | 132 | // high level way to write data to CachedWriter 133 | procedure AppendToCachedWriterHighLevel(const Writer: TCachedWriter); 134 | var 135 | Iteration, i: Integer; 136 | begin 137 | for Iteration := 1 to ITERATIONS_COUNT do 138 | for i := Low(TEST_STRINGS) to High(TEST_STRINGS) do 139 | with TEST_STRINGS[i] do 140 | begin 141 | Writer.Write(Pointer(Value)^, Length); 142 | Writer.Write(CRLF, SizeOf(CRLF)); 143 | end; 144 | end; 145 | 146 | // difficult but the fastest way to write data with TCachedWriter 147 | // you should use Current, Margin and Flush directly. [optional additional memory] 148 | procedure AppendToCachedWriterDirectly(const Writer: TCachedWriter); 149 | var 150 | Iteration, i, Length: Integer; 151 | Current: PByte; 152 | begin 153 | // store current cached pointer to fast register variable 154 | Current := Writer.Current; 155 | 156 | for Iteration := 1 to ITERATIONS_COUNT do 157 | for i := Low(TEST_STRINGS) to High(TEST_STRINGS) do 158 | begin 159 | // write string data 160 | Length := TEST_STRINGS[i].Length; 161 | if (Length <= SizeOf(Int64)) then 162 | begin 163 | // use cached memory directly 164 | if (Length <= SizeOf(Integer)) then PInteger(Current)^ := PInteger(TEST_STRINGS[i].Value)^ 165 | else PInt64(Current)^ := PInt64(TEST_STRINGS[i].Value)^; 166 | 167 | Inc(Current, Length); 168 | end else 169 | begin 170 | // you can use Overflow/Margin and Flush directly 171 | // or call smart high level Write method 172 | // but do not forget to retrieve Current value every high level (e.g. Flush) time 173 | Writer.Current := Current; 174 | Writer.Write(Pointer(TEST_STRINGS[i].Value)^, Length); 175 | Current := Writer.Current; 176 | end; 177 | 178 | // CRLF_VALUE constant is better then CRLF "variable" 179 | PWord(Current)^ := CRLF_VALUE; 180 | Inc(Current, SizeOf(Word)); 181 | if (NativeUInt(Current) >= NativeUInt(Writer.Overflow)) then 182 | begin 183 | Writer.Current := Current; 184 | Writer.Flush; 185 | Current := Writer.Current; 186 | end; 187 | end; 188 | 189 | // retrieve current cached pointer 190 | Writer.Current := Current; 191 | end; 192 | 193 | // standard way to write data to File/TextFile 194 | procedure AppendToTextFile(const T: TextFile); 195 | var 196 | Iteration, i: Integer; 197 | begin 198 | for Iteration := 1 to ITERATIONS_COUNT do 199 | for i := Low(TEST_STRINGS) to High(TEST_STRINGS) do 200 | Writeln(T, TEST_STRINGS[i].Value); 201 | end; 202 | 203 | // standard way to append strings to TStringList 204 | procedure AppendToStringList(const List: TStringList); 205 | var 206 | Iteration, i: Integer; 207 | begin 208 | for Iteration := 1 to ITERATIONS_COUNT do 209 | for i := Low(TEST_STRINGS) to High(TEST_STRINGS) do 210 | List.Add(string(TEST_STRINGS[i].Value)); 211 | end; 212 | 213 | (* 214 | So let's try to use some common methods, CachedWriter 215 | and combine some of them 216 | *) 217 | 218 | type 219 | TGeneratingMethod = procedure(const FileName: string); 220 | 221 | // standard TStringList + SaveToFile (slow) 222 | procedure StringListGenerating(const FileName: string); 223 | var 224 | List: TStringList; 225 | begin 226 | List := TStringList.Create; 227 | try 228 | AppendToStringList(List); 229 | List.SaveToFile(FileName); 230 | finally 231 | List.Free; 232 | end; 233 | end; 234 | 235 | // standard sequential TFileStream writing (slow) 236 | procedure FileStreamGenerating(const FileName: string); 237 | var 238 | F: TFileStream; 239 | begin 240 | F := TFileStream.Create(FileName, fmCreate); 241 | try 242 | AppendToStream(F); 243 | finally 244 | F.Free; 245 | end; 246 | end; 247 | 248 | // standard sequential TMemoryStream writing + SaveToFile (slow) 249 | procedure MemoryStreamGenerating(const FileName: string); 250 | var 251 | M: TMemoryStream; 252 | begin 253 | M := TMemoryStream.Create; 254 | try 255 | AppendToStream(M); 256 | M.SaveToFile(FileName); 257 | finally 258 | M.Free; 259 | end; 260 | end; 261 | 262 | // standard TextFile writing 263 | procedure TextFileGenerating(const FileName: string); 264 | var 265 | T: TextFile; 266 | begin 267 | AssignFile(T, FileName); 268 | ReWrite(T); 269 | try 270 | AppendToTextFile(T); 271 | finally 272 | CloseFile(T); 273 | end; 274 | end; 275 | 276 | // standard TextFile + 64kb buffer writing (fast) 277 | procedure BufferedTextFileGenerating(const FileName: string); 278 | var 279 | T: TextFile; 280 | Buffer: array[Word] of Byte; 281 | begin 282 | AssignFile(T, FileName); 283 | ReWrite(T); 284 | SetTextBuf(T, Buffer); 285 | try 286 | AppendToTextFile(T); 287 | finally 288 | CloseFile(T); 289 | end; 290 | end; 291 | 292 | // high level TCachedFileWriter writing (very fast) 293 | procedure CachedFileWriterGenerating(const FileName: string); 294 | var 295 | Writer: TCachedFileWriter; 296 | begin 297 | Writer := TCachedFileWriter.Create(FileName); 298 | try 299 | AppendToCachedWriterHighLevel(Writer); 300 | finally 301 | Writer.Free; 302 | end; 303 | end; 304 | 305 | // low level directly TCachedFileWriter writing (extremely fast) 306 | procedure CachedFileWriterDirectlyGenerating(const FileName: string); 307 | var 308 | Writer: TCachedFileWriter; 309 | begin 310 | Writer := TCachedFileWriter.Create(FileName); 311 | try 312 | AppendToCachedWriterDirectly(Writer); 313 | finally 314 | Writer.Free; 315 | end; 316 | end; 317 | 318 | // generate output file and measure the time 319 | var 320 | GeneratingMethodNumber: Cardinal = 0; 321 | 322 | procedure RunGeneratingMethod(const Description: string; const GeneratingMethod: TGeneratingMethod); 323 | var 324 | Time: Cardinal; 325 | begin 326 | Inc(GeneratingMethodNumber); 327 | Write(GeneratingMethodNumber, ') ', Description, '...'); 328 | 329 | Time := GetTickCount; 330 | GeneratingMethod(OUTPUT_FILE_NAME); 331 | Time := GetTickCount - Time; 332 | Write(' ', Time, 'ms '); 333 | 334 | CompareOutputAndCorrectFiles; 335 | end; 336 | 337 | 338 | begin 339 | try 340 | // benchmark text 341 | Writeln('The benchmark helps to compare the time of binary/text files generating methods'); 342 | Writeln('Output file must be equal to "Correct.txt" (about 100Mb)'); 343 | GenerateTestStrings; 344 | if (not FileExists(CORRECT_FILE_NAME)) then 345 | begin 346 | Write('Correct file generating... '); 347 | BufferedTextFileGenerating(CORRECT_FILE_NAME); 348 | Writeln('done.'); 349 | end; 350 | 351 | // run writers, measure time, compare with correct file 352 | Writeln; 353 | Writeln('Let''s test generating methods (it may take up to ten minutes):'); 354 | RunGeneratingMethod('StringList + SaveToFile', StringListGenerating); 355 | RunGeneratingMethod('FileStream', FileStreamGenerating); 356 | RunGeneratingMethod('MemoryStream + SaveToFile', MemoryStreamGenerating); 357 | RunGeneratingMethod('TextFile', TextFileGenerating); 358 | RunGeneratingMethod('TextFile + Buffer', BufferedTextFileGenerating); 359 | RunGeneratingMethod('CachedFileWriter', CachedFileWriterGenerating); 360 | RunGeneratingMethod('CachedFileWriter directly', CachedFileWriterDirectlyGenerating); 361 | except 362 | on EAbort do ; 363 | 364 | on E: Exception do 365 | Writeln(E.ClassName, ': ', E.Message); 366 | end; 367 | 368 | if (ParamStr(1) <> '-nowait') then 369 | begin 370 | Writeln; 371 | Write('Press Enter to quit'); 372 | Readln; 373 | end; 374 | end. 375 | -------------------------------------------------------------------------------- /codegen/uCommon.pas: -------------------------------------------------------------------------------- 1 | unit uCommon; 2 | 3 | interface 4 | uses System.SysUtils; 5 | 6 | type 7 | TAddProc = reference to procedure(const AText: string); 8 | 9 | TInvokePlatform = (ipX86, ipWin64, ipX64, ipARM32, ipARM64); 10 | PInvokePlatform = ^TInvokePlatform; 11 | TInvokePlatforms = set of TInvokePlatform; 12 | PInvokePlatforms = ^TInvokePlatforms; 13 | 14 | TInvokeDecl = (idRegister, idMicrosoft, idCdecl, idStdCall, idSafeCall); 15 | PInvokeDecl = ^TInvokeDecl; 16 | TInvokeDecls = set of TInvokeDecl; 17 | PInvokeDecls = ^TInvokeDecls; 18 | 19 | TInvokeType = (itNone, itGeneral, itOutputGeneral, 20 | itSingle, itDouble, itFPU, itFPUInt64, itHFA, itReturnPtr); 21 | PInvokeType = ^TInvokeType; 22 | TInvokeTypes = set of TInvokeType; 23 | PInvokeTypes = ^TInvokeTypes; 24 | 25 | TInvokeSignature = (isGeneral, isExtended, isGeneralExtended, isMicrosoftGeneralExtended); 26 | PInvokeSignature = ^TInvokeSignature; 27 | TInvokeSignatures = set of TInvokeSignature; 28 | PInvokeSignatures = ^TInvokeSignatures; 29 | 30 | 31 | const 32 | ALL_INVOKE_PLATFORMS = [Low(TInvokePlatform)..High(TInvokePlatform)]; 33 | ALL_INVOKE_DECLS = [Low(TInvokeDecl)..High(TInvokeDecl)]; 34 | ALL_INVOKE_TYPES = [Low(TInvokeType)..High(TInvokeType)]; 35 | ALL_INVOKE_SIGNATURES = [Low(TInvokeSignature)..High(TInvokeSignature)]; 36 | 37 | INVOKE_PLATFORM_NAMES: array[TInvokePlatform] of string = ( 38 | 'CPUX86', 'WIN64', 'POSIXCPUX64', 'CPUARM32', 'CPUARM64'); 39 | 40 | INVOKE_DECL_KINDS: array[TInvokeDecl] of string = ( 41 | 'register', 'msabi', 'cdecl', 'stdcall', 'safecall'); 42 | INVOKE_DECL_NAMES: array[TInvokeDecl] of string = ( 43 | 'REGISTER_DECL', 'MS_DECL', 'CDECL', 'STDCALL', 'SAFECALL'); 44 | 45 | INVOKE_TYPE_KINDS: array[TInvokeType] of string = ( 46 | 'none', 'gen', 'outgen', 'float', 'ext', 'fpu', 'fpuint64', 'hfa', 'retptr'); 47 | INVOKE_TYPE_NAMES: array[TInvokeType] of string = ( 48 | '', 'g', '', '', 'e', '', '', '', 'r'); 49 | 50 | 51 | type 52 | TInvokePlatformProc = reference to procedure(const APlatform: TInvokePlatform; const APlatformName: string); 53 | TInvokeDeclProc = reference to procedure(const ADecl: TInvokeDecl; const ADeclKind, ADeclName: string); 54 | TInvokeTypeProc = reference to procedure(const AType: TInvokeType; const ATypeKind, ATypeName: string); 55 | TInvokeSignatureProc = reference to procedure(const ASignatureTitle, ASignature: string; 56 | const AGenCount, AExtCount, AArgs: Integer); 57 | 58 | 59 | var 60 | AddProc: TAddProc; 61 | 62 | procedure Add(const AText: string); 63 | procedure AddFmt(const AFmtStr: string; const AArgs: array of const); 64 | 65 | function InvokeFuncName(const ADeclKind, ATypeKind, ASignatureTitle: string): string; 66 | 67 | procedure ForEachInvokePlatform(const AProc: TInvokePlatformProc; 68 | const APlatforms: TInvokePlatforms = ALL_INVOKE_PLATFORMS); 69 | 70 | procedure ForEachInvokeDecl(const AProc: TInvokeDeclProc; 71 | const ADecls: TInvokeDecls = ALL_INVOKE_DECLS; const ARegDecls: Boolean = False); 72 | 73 | procedure ForEachInvokeType(const AProc: TInvokeTypeProc ; 74 | const ATypes: TInvokeTypes = ALL_INVOKE_TYPES); 75 | 76 | procedure ForEachInvokeSignature(const AProc: TInvokeSignatureProc; 77 | const ASignature: TInvokeSignature; const AEmpty: Boolean = False; 78 | const ARegDeclsArgs: Boolean = False); 79 | 80 | 81 | procedure AddDefinePlatforms(const APlatforms: TInvokePlatforms; const ASpaces: Cardinal = 4); 82 | procedure AddEndifPlatforms(const APlatforms: TInvokePlatforms; const ASpaces: Cardinal = 4); 83 | 84 | implementation 85 | 86 | procedure Add(const AText: string); 87 | begin 88 | if (Assigned(AddProc)) then 89 | begin 90 | AddProc(AText); 91 | end; 92 | end; 93 | 94 | procedure AddFmt(const AFmtStr: string; const AArgs: array of const); 95 | begin 96 | Add(Format(AFmtStr, AArgs)); 97 | end; 98 | 99 | function InvokeFuncName(const ADeclKind, ATypeKind, ASignatureTitle: string): string; 100 | begin 101 | if (ADeclKind = 'safecall') then 102 | begin 103 | Result := Format('%s_%s', [ADeclKind, ASignatureTitle]) 104 | end else 105 | begin 106 | Result := Format('%s_%s_%s', [ADeclKind, ATypeKind, ASignatureTitle]) 107 | end; 108 | end; 109 | 110 | procedure ForEachInvokePlatform(const AProc: TInvokePlatformProc; 111 | const APlatforms: TInvokePlatforms); 112 | var 113 | LPlatform: TInvokePlatform; 114 | begin 115 | for LPlatform in APlatforms do 116 | begin 117 | AProc(LPlatform, INVOKE_PLATFORM_NAMES[LPlatform]); 118 | end; 119 | end; 120 | 121 | procedure ForEachInvokeDecl(const AProc: TInvokeDeclProc; 122 | const ADecls: TInvokeDecls; const ARegDecls: Boolean); 123 | var 124 | LDecl: TInvokeDecl; 125 | LPrefix: string; 126 | begin 127 | for LDecl in ADecls do 128 | begin 129 | LPrefix := ''; 130 | if (LDecl in [idCdecl, idStdCall]) and (ARegDecls) then 131 | begin 132 | LPrefix := 'REG_'; 133 | end; 134 | 135 | AProc(LDecl, INVOKE_DECL_KINDS[LDecl], LPrefix + INVOKE_DECL_NAMES[LDecl]); 136 | end; 137 | end; 138 | 139 | procedure ForEachInvokeType(const AProc: TInvokeTypeProc; 140 | const ATypes: TInvokeTypes); 141 | var 142 | LType: TInvokeType; 143 | begin 144 | for LType in ATypes do 145 | begin 146 | AProc(LType, INVOKE_TYPE_KINDS[LType], INVOKE_TYPE_NAMES[LType]); 147 | end; 148 | end; 149 | 150 | procedure ForEachInvokeSignature(const AProc: TInvokeSignatureProc; 151 | const ASignature: TInvokeSignature; const AEmpty, ARegDeclsArgs: Boolean); 152 | const 153 | TYPES: array[0..2] of TInvokeType = (itNone, itGeneral, itDouble); 154 | var 155 | i: Integer; 156 | LDone: Boolean; 157 | a0, a1, a2, a3: Byte; 158 | t0, t1, t2, t3: TInvokeType; 159 | a: array[0..3] of Byte; 160 | LGenCount, LExtCount: Integer; 161 | LFormat: string; 162 | LSignatureTitle: string; 163 | LSignature: string; 164 | begin 165 | for a0 := 0 to 2 do 166 | for a1 := 0 to 2 do 167 | for a2 := 0 to 2 do 168 | for a3 := 0 to 2 do 169 | begin 170 | if (a0 = 0) then 171 | begin 172 | if (a1 <> 0) or (a2 <> 0) or (a3 <> 0) then Continue; 173 | if (not AEmpty) then Continue; 174 | LFormat := ''; 175 | end else 176 | if (a1 = 0) then 177 | begin 178 | if (a2 <> 0) or (a3 <> 0) then Continue; 179 | LFormat := '%s a0'; 180 | end else 181 | if (a2 = 0) then 182 | begin 183 | if (a3 <> 0) then Continue; 184 | LFormat := '%s a0, %s a1'; 185 | end else 186 | if (a3 = 0) then 187 | begin 188 | LFormat := '%s a0, %s a1, %s a2'; 189 | end else 190 | begin 191 | LFormat := '%s a0, %s a1, %s a2, %s a3'; 192 | end; 193 | LGenCount := Ord(a0 = 1) + Ord(a1 = 1) + Ord(a2 = 1) + Ord(a3 = 1); 194 | LExtCount := Ord(a0 = 2) + Ord(a1 = 2) + Ord(a2 = 2) + Ord(a3 = 2); 195 | 196 | if (ASignature = isGeneral) then 197 | begin 198 | if (LExtCount <> 0) then 199 | Continue; 200 | end else 201 | if (ASignature = isExtended) then 202 | begin 203 | if (LGenCount <> 0) then 204 | Continue; 205 | end; 206 | if (ASignature = isGeneralExtended) then 207 | begin 208 | LDone := True; 209 | a[0] := a0; 210 | a[1] := a1; 211 | a[2] := a2; 212 | a[3] := a3; 213 | 214 | for i := 0 to LGenCount - 1 do 215 | begin 216 | if (a[i] <> 1) then 217 | begin 218 | LDone := False; 219 | Break; 220 | end; 221 | end; 222 | 223 | if (not LDone) then 224 | Continue; 225 | end; 226 | 227 | t0 := TYPES[a0]; 228 | t1 := TYPES[a1]; 229 | t2 := TYPES[a2]; 230 | t3 := TYPES[a3]; 231 | LSignatureTitle := INVOKE_TYPE_NAMES[t0] + INVOKE_TYPE_NAMES[t1] + INVOKE_TYPE_NAMES[t2] + INVOKE_TYPE_NAMES[t3]; 232 | LSignature := Format(LFormat, [ 233 | INVOKE_TYPE_KINDS[t0], INVOKE_TYPE_KINDS[t1], INVOKE_TYPE_KINDS[t2], INVOKE_TYPE_KINDS[t3] 234 | ]); 235 | 236 | if (ARegDeclsArgs) then 237 | begin 238 | if (LSignature = '') then 239 | begin 240 | LSignature := 'gen eax, gen edx, gen ecx'; 241 | end else 242 | begin 243 | LSignature := 'gen eax, gen edx, gen ecx, ' + LSignature; 244 | end; 245 | end; 246 | 247 | AProc(LSignatureTitle, LSignature, LGenCount, LExtCount, 248 | Integer(a0) + (Integer(a1) shl 2) + (Integer(a2) shl 4) + (Integer(a3) shl 6)); 249 | end; 250 | end; 251 | 252 | procedure AddDefinePlatforms(const APlatforms: TInvokePlatforms; const ASpaces: Cardinal); 253 | const 254 | DEFINE_NAMES: array[TInvokePlatform] of string = ( 255 | 'CPUX86', 'WIN64', 'POSIXINTEL64', 'CPUARM32', 'CPUARM64'); 256 | label 257 | done; 258 | var 259 | S: string; 260 | LPlatforms: TInvokePlatforms; 261 | LPlatform: TInvokePlatform; 262 | LDefines: TArray<string>; 263 | LBuffer: string; 264 | begin 265 | if (APlatforms = []) or (APlatforms = ALL_INVOKE_PLATFORMS) then 266 | Exit; 267 | 268 | LPlatforms := APlatforms; 269 | if (LPlatforms = [ipX64, ipARM32, ipARM64]) then 270 | begin 271 | LBuffer := '#if defined (' + DEFINE_NAMES[ipX64] + ') || defined (CPUARM)'; 272 | goto done; 273 | end; 274 | 275 | for LPlatform := Low(TInvokePlatform) to High(TInvokePlatform) do 276 | begin 277 | if (LPlatforms = ALL_INVOKE_PLATFORMS - [LPlatform]) then 278 | begin 279 | LBuffer := '#if !defined (' + DEFINE_NAMES[LPlatform] + ')'; 280 | goto done; 281 | end; 282 | end; 283 | 284 | if (LPlatforms * [ipWin64, ipX64] = [ipWin64, ipX64]) then 285 | begin 286 | if (ipARM64 in LPlatforms) then 287 | begin 288 | LPlatforms := LPlatforms - [ipWin64, ipX64, ipARM64]; 289 | LDefines := LDefines + ['LARGEINT']; 290 | end else 291 | begin 292 | LPlatforms := LPlatforms - [ipWin64, ipX64]; 293 | LDefines := LDefines + ['CPUX64']; 294 | end; 295 | end; 296 | if (LPlatforms * [ipX86, ipARM32] = [ipX86, ipARM32]) then 297 | begin 298 | LPlatforms := LPlatforms - [ipX86, ipARM32]; 299 | LDefines := LDefines + ['SMALLINT']; 300 | end; 301 | if (LPlatforms * [ipX64, ipARM64] = [ipX64, ipARM64]) then 302 | begin 303 | LPlatforms := LPlatforms - [ipX64, ipARM64]; 304 | LDefines := LDefines + ['POSIX64']; 305 | end; 306 | if (LPlatforms * [ipARM32, ipARM64] = [ipARM32, ipARM64]) then 307 | begin 308 | LPlatforms := LPlatforms - [ipARM32, ipARM64]; 309 | LDefines := LDefines + ['CPUARM']; 310 | end; 311 | 312 | for LPlatform in LPlatforms do 313 | begin 314 | LDefines := LDefines + [DEFINE_NAMES[LPlatform]]; 315 | end; 316 | 317 | LBuffer := '#if'; 318 | for S in LDefines do 319 | begin 320 | if (Length(LBuffer) > 3) then LBuffer := LBuffer + ' ||'; 321 | LBuffer := LBuffer + ' defined (' + S + ')'; 322 | end; 323 | 324 | done: 325 | Add(string.Create(' ', ASpaces) + LBuffer); 326 | end; 327 | 328 | procedure AddEndifPlatforms(const APlatforms: TInvokePlatforms; const ASpaces: Cardinal); 329 | begin 330 | if (APlatforms = []) or (APlatforms = ALL_INVOKE_PLATFORMS) then 331 | Exit; 332 | 333 | Add(string.Create(' ', ASpaces) + '#endif');; 334 | end; 335 | 336 | end. 337 | --------------------------------------------------------------------------------