← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to rtl/inc/rtti.inc

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/inc/rtti.inc
1
1
{
2
 
    $Id: rtti.inc,v 1.22 2005/02/14 17:13:26 peter Exp $
3
2
    This file is part of the Free Pascal run time library.
4
3
    Copyright (c) 1999-2000 by Michael Van Canneyt
5
4
    member of the Free Pascal development team
126
125
end;
127
126
 
128
127
 
129
 
 
130
 
Procedure fpc_Initialize (Data,TypeInfo : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias : 'FPC_INITIALIZE'];  {$ifdef hascompilerproc} compilerproc; {$endif}
 
128
Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE'];  compilerproc;
131
129
begin
132
130
  case PByte(TypeInfo)^ of
133
131
    tkAstring,tkWstring,tkInterface,tkDynArray:
137
135
    tkObject,
138
136
    tkRecord:
139
137
      recordrtti(data,typeinfo,@int_initialize);
140
 
{$ifdef HASVARIANT}
141
138
    tkVariant:
142
139
      variant_init(PVarData(Data)^);
143
 
{$endif HASVARIANT}
144
140
  end;
145
141
end;
146
142
 
147
143
 
148
 
Procedure fpc_finalize (Data,TypeInfo: Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias : 'FPC_FINALIZE'];  {$ifdef hascompilerproc} compilerproc; {$endif}
 
144
Procedure fpc_finalize (Data,TypeInfo: Pointer);[Public,Alias : 'FPC_FINALIZE'];  compilerproc;
149
145
begin
150
146
  case PByte(TypeInfo)^ of
151
147
    tkAstring :
153
149
       fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
154
150
        PPointer(Data)^:=nil;
155
151
      end;
156
 
{$ifdef HASWIDESTRING}
157
152
    tkWstring :
158
153
      begin
159
154
        fpc_WideStr_Decr_Ref(PPointer(Data)^);
160
155
        PPointer(Data)^:=nil;
161
156
      end;
162
 
{$endif HASWIDESTRING}
163
157
    tkArray :
164
158
      arrayrtti(data,typeinfo,@int_finalize);
165
159
    tkObject,
166
160
    tkRecord:
167
161
      recordrtti(data,typeinfo,@int_finalize);
168
 
{$ifdef HASINTF}
169
162
    tkInterface:
170
163
      begin
171
164
        Intf_Decr_Ref(PPointer(Data)^);
172
165
        PPointer(Data)^:=nil;
173
166
      end;
174
 
{$endif HASINTF}
175
167
    tkDynArray:
176
168
      fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
177
 
{$ifdef HASVARIANT}
178
169
    tkVariant:
179
170
      variant_clear(PVarData(Data)^);
180
 
{$endif HASVARIANT}
181
171
  end;
182
172
end;
183
173
 
184
174
 
185
 
Procedure fpc_Addref (Data,TypeInfo : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif} [Public,alias : 'FPC_ADDREF'];  {$ifdef hascompilerproc} compilerproc; {$endif}
 
175
Procedure fpc_Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];  compilerproc;
186
176
begin
187
177
  case PByte(TypeInfo)^ of
188
178
    tkAstring :
189
179
      fpc_AnsiStr_Incr_Ref(PPointer(Data)^);
190
 
{$ifdef HASWIDESTRING}
191
180
    tkWstring :
192
181
      fpc_WideStr_Incr_Ref(PPointer(Data)^);
193
 
{$endif HASWIDESTRING}
194
182
    tkArray :
195
183
      arrayrtti(data,typeinfo,@int_addref);
196
184
    tkobject,
198
186
      recordrtti(data,typeinfo,@int_addref);
199
187
    tkDynArray:
200
188
      fpc_dynarray_incr_ref(PPointer(Data)^);
201
 
{$ifdef HASINTF}
202
189
    tkInterface:
203
190
      Intf_Incr_Ref(PPointer(Data)^);
204
 
{$endif HASINTF}
205
 
{$ifdef HASVARIANT}
206
191
    tkVariant:
207
192
      variant_addref(pvardata(Data)^);
208
 
{$endif HASVARIANT}
209
193
  end;
210
194
end;
211
195
 
212
196
 
213
197
{ alias for internal use }
214
198
{ we use another name else the compiler gets puzzled because of the wrong forward def }
215
 
procedure fpc_systemDecRef (Data, TypeInfo : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[external name 'FPC_DECREF'];
 
199
procedure fpc_systemDecRef (Data, TypeInfo : Pointer);[external name 'FPC_DECREF'];
216
200
 
217
 
Procedure fpc_DecRef (Data, TypeInfo : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,alias : 'FPC_DECREF'];  {$ifdef hascompilerproc} compilerproc; {$endif}
 
201
Procedure fpc_DecRef (Data, TypeInfo : Pointer);[Public,alias : 'FPC_DECREF'];  compilerproc;
218
202
begin
219
203
  case PByte(TypeInfo)^ of
220
204
    { see AddRef for comment about below construct (JM) }
221
205
    tkAstring:
222
206
      fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
223
 
{$ifdef HASWIDESTRING}
224
207
    tkWstring:
225
208
      fpc_WideStr_Decr_Ref(PPointer(Data)^);
226
 
{$endif HASWIDESTRING}
227
209
    tkArray:
228
210
      arrayrtti(data,typeinfo,@fpc_systemDecRef);
229
211
    tkobject,
231
213
      recordrtti(data,typeinfo,@fpc_systemDecRef);
232
214
    tkDynArray:
233
215
      fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
234
 
{$ifdef HASINTF}
235
216
    tkInterface:
236
217
      Intf_Decr_Ref(PPointer(Data)^);
237
 
{$endif HASINTF}
238
 
{$ifdef HASVARIANT}
239
218
    tkVariant:
240
219
      variant_clear(pvardata(data)^);
241
 
{$endif HASVARIANT}
242
 
  end;
243
 
end;
244
 
 
245
 
 
246
 
procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); [Public,Alias:'FPC_FINALIZEARRAY'];  {$ifdef hascompilerproc} compilerproc; {$endif}
 
220
  end;
 
221
end;
 
222
 
 
223
 
 
224
{
 
225
Procedure fpc_Copy (Src, Dest, TypeInfo : Pointer);[Public,alias : 'FPC_COPY'];  compilerproc;
 
226
var
 
227
  Temp : pbyte;
 
228
  namelen : byte;
 
229
  count,
 
230
  offset,
 
231
  i : longint;
 
232
  info : pointer;
 
233
begin
 
234
  case PByte(TypeInfo)^ of
 
235
    tkAstring:
 
236
      begin
 
237
        fpc_AnsiStr_Incr_Ref(PPointer(Src)^);
 
238
        fpc_AnsiStr_Decr_Ref(PPointer(Dest)^);
 
239
        PPointer(Dest)^:=PPointer(Src)^;
 
240
      end;
 
241
    tkWstring:
 
242
      begin
 
243
        fpc_WideStr_Incr_Ref(PPointer(Src)^);
 
244
        fpc_WideStr_Decr_Ref(PPointer(Dest)^);
 
245
      end;
 
246
    tkArray:
 
247
      begin
 
248
        arrayrtti(data,typeinfo,@fpc_systemDecRef);
 
249
      end;
 
250
    tkobject,
 
251
    tkrecord:
 
252
      begin
 
253
        Temp:=PByte(TypeInfo);
 
254
        inc(Temp);
 
255
        { Skip Name }
 
256
        namelen:=Temp^;
 
257
        inc(temp,namelen+1);
 
258
        temp:=aligntoptr(temp);
 
259
 
 
260
        { copy data }
 
261
        move(src^,dest^,plongint(temp)^);
 
262
 
 
263
        { Skip size }
 
264
        inc(Temp,4);
 
265
        { Element count }
 
266
        Count:=PLongint(Temp)^;
 
267
        inc(Temp,sizeof(Count));
 
268
        { Process elements }
 
269
        for i:=1 to count Do
 
270
          begin
 
271
            Info:=PPointer(Temp)^;
 
272
            inc(Temp,sizeof(Info));
 
273
            Offset:=PLongint(Temp)^;
 
274
            inc(Temp,sizeof(Offset));
 
275
            fpc_Copy(Src+Offset,Src+Offset,Info);
 
276
          end;
 
277
    tkDynArray:
 
278
      begin
 
279
        fpc_dynarray_Incr_Ref(PPointer(Src)^);
 
280
        fpc_dynarray_Decr_Ref(PPointer(Dest)^);
 
281
        PPointer(Dest)^:=PPointer(Src)^;
 
282
      end;
 
283
    tkInterface:
 
284
      begin
 
285
        Intf_Incr_Ref(PPointer(Src)^);
 
286
        Intf_Decr_Ref(PPointer(Dest)^);
 
287
        PPointer(Dest)^:=PPointer(Src)^;
 
288
      end;
 
289
    tkVariant:
 
290
      VarCopyProc(pvardata(dest)^,pvardata(src)^);
 
291
  end;
 
292
end;
 
293
}
 
294
 
 
295
 
 
296
procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); [Public,Alias:'FPC_FINALIZEARRAY'];  compilerproc;
247
297
  var
248
298
     i : longint;
249
299
  begin
251
301
       int_finalize(data+size*i,typeinfo);
252
302
  end;
253
303
 
254
 
{
255
 
  $Log: rtti.inc,v $
256
 
  Revision 1.22  2005/02/14 17:13:26  peter
257
 
    * truncate log
258
 
 
259
 
  Revision 1.21  2005/01/15 18:47:26  florian
260
 
    * several variant init./final. stuff fixed
261
 
 
262
 
  Revision 1.20  2005/01/08 20:43:44  florian
263
 
    + init/cleaning code for variants added
264
 
 
265
 
}