rtti.inc 4.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2011 by Jonas Maebe
  4. member of the Free Pascal development team
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. procedure fpc_initialize_array_jstring_intern(arr: TJObjectArray; normalarrdim: longint); external name 'fpc_initialize_array_unicodestring';
  12. procedure fpc_initialize_array_unicodestring(arr: TJObjectArray; normalarrdim: longint);compilerproc;
  13. var
  14. i: longint;
  15. begin
  16. if normalarrdim > 0 then
  17. begin
  18. for i:=low(arr) to high(arr) do
  19. fpc_initialize_array_jstring_intern(TJObjectArray(arr[i]),normalarrdim-1);
  20. end
  21. else
  22. begin
  23. for i:=low(arr) to high(arr) do
  24. unicodestring(arr[i]):='';
  25. end;
  26. end;
  27. procedure fpc_initialize_array_ansistring_intern(arr: TJObjectArray; normalarrdim: longint); external name 'fpc_initialize_array_ansistring';
  28. procedure fpc_initialize_array_ansistring(arr: TJObjectArray; normalarrdim: longint);compilerproc;
  29. var
  30. i: longint;
  31. begin
  32. if normalarrdim > 0 then
  33. begin
  34. for i:=low(arr) to high(arr) do
  35. fpc_initialize_array_ansistring_intern(TJObjectArray(arr[i]),normalarrdim-1);
  36. end
  37. else
  38. begin
  39. for i:=low(arr) to high(arr) do
  40. ansistring(arr[i]):='';
  41. end;
  42. end;
  43. procedure fpc_initialize_array_dynarr_intern(arr: TJObjectArray; normalarrdim: longint); external name 'fpc_initialize_array_dynarr';
  44. procedure fpc_initialize_array_dynarr(arr: TJObjectArray; normalarrdim: longint);compilerproc;
  45. var
  46. i: longint;
  47. begin
  48. if normalarrdim > 0 then
  49. begin
  50. for i:=low(arr) to high(arr) do
  51. fpc_initialize_array_dynarr_intern(TJObjectArray(arr[i]),normalarrdim-1);
  52. end
  53. else
  54. begin
  55. for i:=low(arr) to high(arr) do
  56. arr[i]:=nil;
  57. end;
  58. end;
  59. procedure fpc_initialize_array_record_intern(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseRecordType); external name 'fpc_initialize_array_record';
  60. procedure fpc_initialize_array_record(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseRecordType);compilerproc;
  61. var
  62. i: longint;
  63. begin
  64. if normalarrdim > 0 then
  65. begin
  66. for i:=low(arr) to high(arr) do
  67. fpc_initialize_array_record_intern(TJObjectArray(arr[i]),normalarrdim-1,inst);
  68. end
  69. else
  70. begin
  71. for i:=low(arr) to high(arr) do
  72. arr[i]:=inst.clone;
  73. end;
  74. end;
  75. { exactly the same as fpc_initialize_array_record, but can't use generic
  76. routine because of Java clonable design :( (except by rtti/invoke, but that's
  77. not particularly fast either) }
  78. procedure fpc_initialize_array_bitset_intern(arr: TJObjectArray; normalarrdim: longint; inst: FpcBitSet); external name 'fpc_initialize_array_bitset';
  79. procedure fpc_initialize_array_bitset(arr: TJObjectArray; normalarrdim: longint; inst: FpcBitSet);compilerproc;
  80. var
  81. i: longint;
  82. begin
  83. if normalarrdim > 0 then
  84. begin
  85. for i:=low(arr) to high(arr) do
  86. fpc_initialize_array_bitset_intern(TJObjectArray(arr[i]),normalarrdim-1,inst);
  87. end
  88. else
  89. begin
  90. for i:=low(arr) to high(arr) do
  91. arr[i]:=inst.clone;
  92. end;
  93. end;
  94. { idem }
  95. procedure fpc_initialize_array_enumset_intern(arr: TJObjectArray; normalarrdim: longint; inst: JUEnumSet); external name 'fpc_initialize_array_enumset';
  96. procedure fpc_initialize_array_enumset(arr: TJObjectArray; normalarrdim: longint; inst: JUEnumSet);compilerproc;
  97. var
  98. i: longint;
  99. begin
  100. if normalarrdim > 0 then
  101. begin
  102. for i:=low(arr) to high(arr) do
  103. fpc_initialize_array_enumset_intern(TJObjectArray(arr[i]),normalarrdim-1,inst);
  104. end
  105. else
  106. begin
  107. for i:=low(arr) to high(arr) do
  108. arr[i]:=inst.clone;
  109. end;
  110. end;
  111. procedure fpc_initialize_array_shortstring_intern(arr: TJObjectArray; normalarrdim: longint; maxlen: byte); external name 'fpc_initialize_array_shortstring';
  112. procedure fpc_initialize_array_shortstring(arr: TJObjectArray; normalarrdim: longint; maxlen: byte);compilerproc;
  113. var
  114. i: longint;
  115. begin
  116. if normalarrdim > 0 then
  117. begin
  118. for i:=low(arr) to high(arr) do
  119. fpc_initialize_array_shortstring_intern(TJObjectArray(arr[i]),normalarrdim-1,maxlen);
  120. end
  121. else
  122. begin
  123. for i:=low(arr) to high(arr) do
  124. arr[i]:=ShortstringClass.CreateEmpty(maxlen);
  125. end;
  126. end;