← Back to branch summary

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

« back to all changes in this revision

Viewing changes to rtl/inc/dynarr.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/dynarr.inc
1
1
{
2
 
    $Id: dynarr.inc,v 1.38 2005/03/27 14:56:34 jonas Exp $
3
2
    This file is part of the Free Pascal run time library.
4
3
    Copyright (c) 2000 by Florian Klaempfl
5
4
    member of the Free Pascal development team.
21
20
   { to calculate memory requirements       }
22
21
   pdynarray = ^tdynarray;
23
22
   tdynarray = packed record
24
 
      refcount : longint;
 
23
      refcount : ptrint;
25
24
      high : tdynarrayindex;
26
25
   end;
27
26
 
28
 
   pdynarraytypeinfo = ^tdynarraytypeinfo;
29
 
   tdynarraytypeinfo = packed record
30
 
      kind : byte;
31
 
      namelen : byte;
32
 
      { here the chars follow, we've to skip them }
33
 
      elesize : sizeint;
34
 
      eletype : pdynarraytypeinfo;
35
 
   end;
36
27
 
37
 
function aligntoptr(p : pointer) : pointer;
 
28
function aligntoptr(p : pointer) : pointer;inline;
38
29
  begin
39
30
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
40
31
    if (ptrint(p) mod sizeof(ptrint))<>0 then
44
35
  end;
45
36
 
46
37
 
47
 
procedure fpc_dynarray_rangecheck(p : pointer;i : tdynarrayindex);[Public,Alias:'FPC_DYNARRAY_RANGECHECK']; {$ifdef hascompilerproc} compilerproc; {$endif}
 
38
procedure fpc_dynarray_rangecheck(p : pointer;i : tdynarrayindex);[Public,Alias:'FPC_DYNARRAY_RANGECHECK']; compilerproc;
48
39
  begin
49
40
     if not(assigned(p)) or (i<0) or (i>pdynarray(p-sizeof(tdynarray))^.high) then
50
41
       HandleErrorFrame(201,get_frame);
51
42
  end;
52
43
 
53
44
 
54
 
function fpc_dynarray_length(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
 
45
function fpc_dynarray_length(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_LENGTH']; compilerproc;
55
46
  begin
56
47
     if assigned(p) then
57
48
       fpc_dynarray_length:=pdynarray(p-sizeof(tdynarray))^.high+1
60
51
  end;
61
52
 
62
53
 
63
 
function fpc_dynarray_high(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_HIGH']; {$ifdef hascompilerproc} compilerproc; {$endif}
 
54
function fpc_dynarray_high(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_HIGH']; compilerproc;
64
55
  begin
65
56
     if assigned(p) then
66
57
       fpc_dynarray_high:=pdynarray(p-sizeof(tdynarray))^.high
81
72
     { skip kind and name }
82
73
     inc(pointer(ti),ord(pdynarraytypeinfo(ti)^.namelen)+2);
83
74
 
84
 
{$ifdef FPC_ALIGNSRTTI}
85
75
     ti:=aligntoptr(ti);
86
 
{$endif FPC_ALIGNSRTTI}
87
76
 
88
77
     elesize:=psizeint(ti)^;
89
78
     eletype:=pdynarraytypeinfo(pointer(pdynarraytypeinfo(pointer(ti)+sizeof(sizeint)))^);
97
86
  end;
98
87
 
99
88
 
100
 
procedure fpc_dynarray_clear(var p : pointer;ti : pointer); [Public,Alias:'FPC_DYNARRAY_CLEAR']; {$ifdef hascompilerproc} compilerproc; {$endif}
 
89
procedure fpc_dynarray_clear(var p : pointer;ti : pointer); [Public,Alias:'FPC_DYNARRAY_CLEAR']; compilerproc;
101
90
  var
102
91
     realp : pdynarray;
103
92
  begin
109
98
    p:=nil;
110
99
  end;
111
100
 
112
 
{$ifdef hascompilerproc}
113
101
{ alias for internal use }
114
102
Procedure fpc_dynarray_clear (var p : pointer;ti : pointer);[external name 'FPC_DYNARRAY_CLEAR'];
115
 
{$endif hascompilerproc}
116
 
 
117
 
 
118
 
procedure fpc_dynarray_decr_ref(var p : pointer;ti : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias:'FPC_DYNARRAY_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
 
103
 
 
104
 
 
105
procedure fpc_dynarray_decr_ref(var p : pointer;ti : pointer); [Public,Alias:'FPC_DYNARRAY_DECR_REF']; compilerproc;
119
106
  var
120
107
     realp : pdynarray;
121
108
  begin
133
120
     p := nil;
134
121
  end;
135
122
 
136
 
{$ifdef hascompilerproc}
137
123
{ provide local access to dynarr_decr_ref for dynarr_setlength }
138
 
procedure fpc_dynarray_decr_ref(var p : pointer;ti : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif} [external name 'FPC_DYNARRAY_DECR_REF'];
139
 
{$endif}
 
124
procedure fpc_dynarray_decr_ref(var p : pointer;ti : pointer); [external name 'FPC_DYNARRAY_DECR_REF'];
140
125
 
141
 
procedure fpc_dynarray_incr_ref(p : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias:'FPC_DYNARRAY_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
 
126
procedure fpc_dynarray_incr_ref(p : pointer);[Public,Alias:'FPC_DYNARRAY_INCR_REF']; compilerproc;
142
127
  var
143
128
     realp : pdynarray;
144
129
  begin
152
137
     inclocked(realp^.refcount);
153
138
  end;
154
139
 
155
 
{$ifdef hascompilerproc}
156
140
{ provide local access to dynarr_decr_ref for dynarr_setlength }
157
 
procedure fpc_dynarray_incr_ref(p : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[external name 'FPC_DYNARRAY_INCR_REF'];
158
 
{$endif}
 
141
procedure fpc_dynarray_incr_ref(p : pointer); [external name 'FPC_DYNARRAY_INCR_REF'];
 
142
 
159
143
 
160
144
{ provide local access to dynarr_setlength }
161
145
procedure int_dynarray_setlength(var p : pointer;pti : pointer;
162
146
  dimcount : dword;dims : pdynarrayindex);[external name 'FPC_DYNARR_SETLENGTH'];
163
147
 
164
148
procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
165
 
  dimcount : dword;dims : pdynarrayindex);[Public,Alias:'FPC_DYNARR_SETLENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
 
149
  dimcount : dword;dims : pdynarrayindex);[Public,Alias:'FPC_DYNARR_SETLENGTH']; compilerproc;
166
150
 
167
151
  var
168
152
     i : tdynarrayindex;
182
166
     { skip kind and name }
183
167
     inc(pointer(ti),ord(pdynarraytypeinfo(ti)^.namelen)+2);
184
168
 
185
 
{$ifdef FPC_ALIGNSRTTI}
186
169
     ti:=aligntoptr(ti);
187
 
{$endif FPC_ALIGNSRTTI}
188
170
 
189
171
     elesize:=psizeint(ti)^;
190
172
     eletype:=pdynarraytypeinfo(pointer(pdynarraytypeinfo(pointer(ti)+sizeof(sizeint)))^);
297
279
  end;
298
280
 
299
281
 
300
 
{$ifdef HASFUNCTIONCOPYDYNARR}
301
282
{ provide local access to dynarr_copy }
302
283
function int_dynarray_copy(psrc : pointer;ti : pointer;
303
284
    lowidx,count:tdynarrayindex) : pointer;[external name 'FPC_DYNARR_COPY'];
304
285
 
305
286
function fpc_dynarray_copy(psrc : pointer;ti : pointer;
306
 
    lowidx,count:tdynarrayindex) : pointer;[Public,Alias:'FPC_DYNARR_COPY'];{$ifdef hascompilerproc} compilerproc; {$endif}
307
 
{$else HASFUNCTIONCOPYDYNARR}
308
 
procedure int_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer;
309
 
    lowidx,count:tdynarrayindex);[external name 'FPC_DYNARR_COPY'];
310
 
 
311
 
procedure fpc_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer;
312
 
    lowidx,count:tdynarrayindex);[Public,Alias:'FPC_DYNARR_COPY'];{$ifdef hascompilerproc} compilerproc; {$endif}
313
 
{$endif HASFUNCTIONCOPYDYNARR}
 
287
    lowidx,count:tdynarrayindex) : pointer;[Public,Alias:'FPC_DYNARR_COPY'];compilerproc;
314
288
  var
315
289
    realpdest,
316
290
    realpsrc : pdynarray;
319
293
    highidx : tdynarrayindex;
320
294
    elesize : sizeint;
321
295
    eletype : pdynarraytypeinfo;
322
 
{$ifdef HASFUNCTIONCOPYDYNARR}
323
296
    pdest : pointer;
324
 
{$endif HASFUNCTIONCOPYDYNARR}
325
297
  begin
326
298
     highidx:=lowidx+count-1;
327
299
     pdest:=nil;
328
 
{$ifdef HASFUNCTIONCOPYDYNARR}
329
300
     result:=pdest;
330
 
{$endif HASFUNCTIONCOPYDYNARR}
331
301
     if psrc=nil then
332
302
       exit;
333
303
     realpsrc:=pdynarray(psrc-sizeof(tdynarray));
334
304
     { skip kind and name }
335
305
     inc(pointer(ti),ord(pdynarraytypeinfo(ti)^.namelen)+2);
336
306
 
337
 
{$ifdef FPC_ALIGNSRTTI}
338
307
     ti:=aligntoptr(ti);
339
 
{$endif FPC_ALIGNSRTTI}
340
308
 
341
309
     elesize:=psizeint(ti)^;
342
310
     eletype:=pdynarraytypeinfo(pointer(pdynarraytypeinfo(pointer(ti)+sizeof(sizeint)))^);
366
334
     { increment ref. count of members }
367
335
     for i:= 0 to cnt-1 do
368
336
       int_addref(pointer(pdest+elesize*i),eletype);
369
 
{$ifdef HASFUNCTIONCOPYDYNARR}
370
337
     result:=pdest;
371
 
{$endif HASFUNCTIONCOPYDYNARR}
372
 
  end;
373
 
 
374
 
 
375
 
{
376
 
  $Log: dynarr.inc,v $
377
 
  Revision 1.38  2005/03/27 14:56:34  jonas
378
 
    * fixed web bug 3805
379
 
    * extra range check in fpc_dynarray_copy (also error if lowidx >
380
 
      high(source))
381
 
 
382
 
  Revision 1.37  2005/03/05 16:37:28  florian
383
 
    * fixed copy(dyn. array,...);
384
 
 
385
 
  Revision 1.36  2005/02/14 17:13:22  peter
386
 
    * truncate log
387
 
 
388
 
  Revision 1.35  2005/01/24 21:32:48  florian
389
 
    * fixed copy(dyn. array of ansistring)
390
 
 
391
 
}
 
338
  end;
 
339
 
 
340
 
 
341
procedure DynArraySetLength(var a: Pointer; typeInfo: Pointer; dimCnt: SizeInt; lengthVec: PSizeInt);
 
342
  var
 
343
    preallocated : array[0..10] of PSizeInt;
 
344
    i : SizeInt;
 
345
    p : PSizeInt;
 
346
  begin
 
347
    if dimCnt<=length(preallocated) then
 
348
      p:=@preallocated
 
349
    else
 
350
      getmem(p,sizeof(SizeInt)*dimCnt);
 
351
    for i:=0 to dimCnt-1 do
 
352
      p[i]:=lengthVec[dimCnt-1-i];
 
353
    int_dynarray_setlength(a,typeInfo,dimCnt,p);
 
354
    if p<>@preallocated then
 
355
      freemem(p);
 
356
  end;
 
357