← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/rtl/inc/rtti.inc

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/rtl/inc/rtti.inc
 
1
{
 
2
    This file is part of the Free Pascal run time library.
 
3
    Copyright (c) 1999-2000 by Michael Van Canneyt
 
4
    member of the Free Pascal development team
 
5
 
 
6
    See the file COPYING.FPC, included in this distribution,
 
7
    for details about the copyright.
 
8
 
 
9
    This program is distributed in the hope that it will be useful,
 
10
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
11
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
12
 
 
13
 **********************************************************************}
 
14
 
 
15
{ Run-Time type information routines }
 
16
 
 
17
{ The RTTI is implemented through a series of constants : }
 
18
 
 
19
Const
 
20
       tkUnknown       = 0;
 
21
       tkInteger       = 1;
 
22
       tkChar          = 2;
 
23
       tkEnumeration   = 3;
 
24
       tkFloat         = 4;
 
25
       tkSet           = 5;
 
26
       tkMethod        = 6;
 
27
       tkSString       = 7;
 
28
       tkString        = tkSString;
 
29
       tkLString       = 8;
 
30
       tkAString       = 9;
 
31
       tkWString       = 10;
 
32
       tkVariant       = 11;
 
33
       tkArray         = 12;
 
34
       tkRecord        = 13;
 
35
       tkInterface     = 14;
 
36
       tkClass         = 15;
 
37
       tkObject        = 16;
 
38
       tkWChar         = 17;
 
39
       tkBool          = 18;
 
40
       tkInt64         = 19;
 
41
       tkQWord         = 20;
 
42
       tkDynArray      = 21;
 
43
 
 
44
 
 
45
type
 
46
  TRTTIProc=procedure(Data,TypeInfo:Pointer);
 
47
 
 
48
{ if you modify this procedure, fpc_copy must be probably modified as well }
 
49
procedure RecordRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc);
 
50
{
 
51
  A record is designed as follows :
 
52
    1    : tkrecord
 
53
    2    : Length of name string (n);
 
54
    3    : name string;
 
55
    3+n  : record size;
 
56
    7+n  : number of elements (N)
 
57
    11+n : N times : Pointer to type info
 
58
                     Offset in record
 
59
}
 
60
var
 
61
  Temp : pbyte;
 
62
  namelen : byte;
 
63
  count,
 
64
  offset,
 
65
  i : longint;
 
66
  info : pointer;
 
67
begin
 
68
  Temp:=PByte(TypeInfo);
 
69
  inc(Temp);
 
70
  { Skip Name }
 
71
  namelen:=Temp^;
 
72
  inc(temp,namelen+1);
 
73
  temp:=aligntoptr(temp);
 
74
  { Skip size }
 
75
  inc(Temp,4);
 
76
  { Element count }
 
77
  Count:=PLongint(Temp)^;
 
78
  inc(Temp,sizeof(Count));
 
79
  { Process elements }
 
80
  for i:=1 to count Do
 
81
    begin
 
82
      Info:=PPointer(Temp)^;
 
83
      inc(Temp,sizeof(Info));
 
84
      Offset:=PLongint(Temp)^;
 
85
      inc(Temp,sizeof(Offset));
 
86
      rttiproc (Data+Offset,Info);
 
87
    end;
 
88
end;
 
89
 
 
90
 
 
91
{ if you modify this procedure, fpc_copy must be probably modified as well }
 
92
procedure ArrayRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc);
 
93
{
 
94
  An array is designed as follows :
 
95
   1    : tkArray;
 
96
   2    : length of name string (n);
 
97
   3    : NAme string
 
98
   3+n  : Element Size
 
99
   7+n  : Number of elements
 
100
   11+n : Pointer to type of elements
 
101
}
 
102
var
 
103
  Temp : pbyte;
 
104
  namelen : byte;
 
105
  count,
 
106
  size,
 
107
  i : SizeInt;
 
108
  info : pointer;
 
109
begin
 
110
  Temp:=PByte(TypeInfo);
 
111
  inc(Temp);
 
112
  { Skip Name }
 
113
  namelen:=Temp^;
 
114
  inc(temp,namelen+1);
 
115
  temp:=aligntoptr(temp);
 
116
  { Element size }
 
117
  size:=PSizeInt(Temp)^;
 
118
  inc(Temp,sizeof(Size));
 
119
  { Element count }
 
120
  Count:=PSizeInt(Temp)^;
 
121
  inc(Temp,sizeof(Count));
 
122
  Info:=PPointer(Temp)^;
 
123
  inc(Temp,sizeof(Info));
 
124
  { Process elements }
 
125
  for I:=0 to Count-1 do
 
126
    rttiproc(Data+(I*size),Info);
 
127
end;
 
128
 
 
129
 
 
130
Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE'];  compilerproc;
 
131
begin
 
132
  case PByte(TypeInfo)^ of
 
133
    tkAstring,tkWstring,tkInterface,tkDynArray:
 
134
      PPchar(Data)^:=Nil;
 
135
    tkArray:
 
136
      arrayrtti(data,typeinfo,@int_initialize);
 
137
    tkObject,
 
138
    tkRecord:
 
139
      recordrtti(data,typeinfo,@int_initialize);
 
140
    tkVariant:
 
141
      variant_init(PVarData(Data)^);
 
142
  end;
 
143
end;
 
144
 
 
145
 
 
146
Procedure fpc_finalize (Data,TypeInfo: Pointer);[Public,Alias : 'FPC_FINALIZE'];  compilerproc;
 
147
begin
 
148
  case PByte(TypeInfo)^ of
 
149
    tkAstring :
 
150
      begin
 
151
        fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
 
152
        PPointer(Data)^:=nil;
 
153
      end;
 
154
    tkWstring :
 
155
      begin
 
156
        fpc_WideStr_Decr_Ref(PPointer(Data)^);
 
157
        PPointer(Data)^:=nil;
 
158
      end;
 
159
    tkArray :
 
160
      arrayrtti(data,typeinfo,@int_finalize);
 
161
    tkObject,
 
162
    tkRecord:
 
163
      recordrtti(data,typeinfo,@int_finalize);
 
164
    tkInterface:
 
165
      begin
 
166
        Intf_Decr_Ref(PPointer(Data)^);
 
167
        PPointer(Data)^:=nil;
 
168
      end;
 
169
    tkDynArray:
 
170
      fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
 
171
    tkVariant:
 
172
      variant_clear(PVarData(Data)^);
 
173
  end;
 
174
end;
 
175
 
 
176
 
 
177
Procedure fpc_Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];  compilerproc;
 
178
begin
 
179
  case PByte(TypeInfo)^ of
 
180
    tkAstring :
 
181
      fpc_AnsiStr_Incr_Ref(PPointer(Data)^);
 
182
    tkWstring :
 
183
      fpc_WideStr_Incr_Ref(PPointer(Data)^);
 
184
    tkArray :
 
185
      arrayrtti(data,typeinfo,@int_addref);
 
186
    tkobject,
 
187
    tkrecord :
 
188
      recordrtti(data,typeinfo,@int_addref);
 
189
    tkDynArray:
 
190
      fpc_dynarray_incr_ref(PPointer(Data)^);
 
191
    tkInterface:
 
192
      Intf_Incr_Ref(PPointer(Data)^);
 
193
    tkVariant:
 
194
      variant_addref(pvardata(Data)^);
 
195
  end;
 
196
end;
 
197
 
 
198
 
 
199
{ alias for internal use }
 
200
{ we use another name else the compiler gets puzzled because of the wrong forward def }
 
201
procedure fpc_systemDecRef (Data, TypeInfo : Pointer);[external name 'FPC_DECREF'];
 
202
 
 
203
Procedure fpc_DecRef (Data, TypeInfo : Pointer);[Public,alias : 'FPC_DECREF'];  compilerproc;
 
204
begin
 
205
  case PByte(TypeInfo)^ of
 
206
    { see AddRef for comment about below construct (JM) }
 
207
    tkAstring:
 
208
      fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
 
209
    tkWstring:
 
210
      fpc_WideStr_Decr_Ref(PPointer(Data)^);
 
211
    tkArray:
 
212
      arrayrtti(data,typeinfo,@fpc_systemDecRef);
 
213
    tkobject,
 
214
    tkrecord:
 
215
      recordrtti(data,typeinfo,@fpc_systemDecRef);
 
216
    tkDynArray:
 
217
      fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
 
218
    tkInterface:
 
219
      Intf_Decr_Ref(PPointer(Data)^);
 
220
    tkVariant:
 
221
      variant_clear(pvardata(data)^);
 
222
  end;
 
223
end;
 
224
 
 
225
{ define alias for internal use in the system unit }
 
226
Function fpc_Copy_internal (Src, Dest, TypeInfo : Pointer) : SizeInt;[external name 'FPC_COPY'];
 
227
 
 
228
Function fpc_Copy (Src, Dest, TypeInfo : Pointer) : SizeInt;[Public,alias : 'FPC_COPY']; compilerproc;
 
229
var
 
230
  Temp : pbyte;
 
231
  namelen : byte;
 
232
  copiedsize,
 
233
  expectedoffset,
 
234
  count,
 
235
  offset,
 
236
  size,
 
237
  i : SizeInt;
 
238
  info : pointer;
 
239
begin
 
240
  result:=sizeof(pointer);
 
241
  case PByte(TypeInfo)^ of
 
242
    tkAstring:
 
243
      begin
 
244
        fpc_AnsiStr_Incr_Ref(PPointer(Src)^);
 
245
        fpc_AnsiStr_Decr_Ref(PPointer(Dest)^);
 
246
        PPointer(Dest)^:=PPointer(Src)^;
 
247
      end;
 
248
    tkWstring:
 
249
      fpc_WideStr_Assign(PPointer(Dest)^,PPointer(Src)^);
 
250
    tkArray:
 
251
      begin
 
252
        Temp:=PByte(TypeInfo);
 
253
        inc(Temp);
 
254
        { Skip Name }
 
255
        namelen:=Temp^;
 
256
        inc(temp,namelen+1);
 
257
        temp:=aligntoptr(temp);
 
258
 
 
259
        { Element size }
 
260
        size:=PSizeInt(Temp)^;
 
261
        inc(Temp,sizeof(Size));
 
262
 
 
263
        { Element count }
 
264
        Count:=PSizeInt(Temp)^;
 
265
        inc(Temp,sizeof(Count));
 
266
        Info:=PPointer(Temp)^;
 
267
        inc(Temp,sizeof(Info));
 
268
        { Process elements }
 
269
        for I:=0 to Count-1 do
 
270
          fpc_Copy_internal(Src+(I*size),Dest+(I*size),Info);
 
271
        Result:=size*count;
 
272
      end;
 
273
    tkobject,
 
274
    tkrecord:
 
275
      begin
 
276
        Temp:=PByte(TypeInfo);
 
277
        inc(Temp);
 
278
        { Skip Name }
 
279
        namelen:=Temp^;
 
280
        inc(temp,namelen+1);
 
281
        temp:=aligntoptr(temp);
 
282
 
 
283
        Result:=plongint(temp)^;
 
284
 
 
285
        { Skip size }
 
286
        inc(Temp,4);
 
287
 
 
288
        { Element count }
 
289
        Count:=PLongint(Temp)^;
 
290
        inc(Temp,sizeof(longint));
 
291
        expectedoffset:=0;
 
292
        { Process elements with rtti }
 
293
        for i:=1 to count Do
 
294
          begin
 
295
            Info:=PPointer(Temp)^;
 
296
            inc(Temp,sizeof(Info));
 
297
            Offset:=PLongint(Temp)^;
 
298
            if Offset>expectedoffset then
 
299
              move((Src+expectedoffset)^,(Dest+expectedoffset)^,Offset-expectedoffset);
 
300
            inc(Temp,sizeof(longint));
 
301
            copiedsize:=fpc_Copy_internal(Src+Offset,Dest+Offset,Info);
 
302
            expectedoffset:=Offset+copiedsize;
 
303
          end;
 
304
        { elements remaining? }
 
305
        if result>expectedoffset then
 
306
          move((Src+expectedoffset)^,(Dest+expectedoffset)^,Result-expectedoffset);
 
307
      end;
 
308
    tkDynArray:
 
309
      begin
 
310
        fpc_dynarray_Incr_Ref(PPointer(Src)^);
 
311
        fpc_dynarray_Decr_Ref(PPointer(Dest)^,typeinfo);
 
312
        PPointer(Dest)^:=PPointer(Src)^;
 
313
      end;
 
314
    tkInterface:
 
315
      begin
 
316
        Intf_Incr_Ref(PPointer(Src)^);
 
317
        Intf_Decr_Ref(PPointer(Dest)^);
 
318
        PPointer(Dest)^:=PPointer(Src)^;
 
319
      end;
 
320
    tkVariant:
 
321
      begin
 
322
        VarCopyProc(pvardata(dest)^,pvardata(src)^);
 
323
        result:=sizeof(tvardata);
 
324
      end;
 
325
  end;
 
326
end;
 
327
 
 
328
 
 
329
procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); [Public,Alias:'FPC_FINALIZEARRAY'];  compilerproc;
 
330
  var
 
331
     i : longint;
 
332
  begin
 
333
     for i:=0 to count-1 do
 
334
       int_finalize(data+size*i,typeinfo);
 
335
  end;
 
336