← Back to branch summary

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

« back to all changes in this revision

Viewing changes to rtl/inc/genset.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:
rtl/inc/genset.inc
1
 
{
2
 
    $Id: genset.inc,v 1.7 2002/09/07 15:07:45 peter Exp $
3
 
    This file is part of the Free Pascal run time library.
4
 
    Copyright (c) 1999-2001 by the Free Pascal development team
5
 
 
6
 
    Include file with set operations called by the compiler
7
 
 
8
 
    See the file COPYING.FPC, included in this distribution,
9
 
    for details about the copyright.
10
 
 
11
 
    This program is distributed in the hope that it will be useful,
12
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
13
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
 
 
15
 
 **********************************************************************}
16
 
 
17
 
{$ifndef FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
18
 
{ Error No pascal version of FPC_SET_LOAD_SMALL}
19
 
 { THIS DEPENDS ON THE ENDIAN OF THE ARCHITECTURE!
20
 
   Not anymore PM}
21
 
 
22
 
function fpc_set_load_small(l: fpc_small_set): fpc_normal_set; [public,alias:'FPC_SET_LOAD_SMALL']; {$ifdef hascompilerproc} compilerproc; {$endif}
23
 
 {
24
 
  load a normal set p from a smallset l
25
 
 }
26
 
 begin
27
 
   fpc_set_load_small[0] := l;
28
 
   FillDWord(fpc_set_load_small[1],7,0);
29
 
 end;
30
 
{$endif FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
31
 
 
32
 
 
33
 
{$ifndef FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
34
 
function fpc_set_create_element(b : byte): fpc_normal_set;[public,alias:'FPC_SET_CREATE_ELEMENT']; {$ifdef hascompilerproc} compilerproc; {$endif}
35
 
 {
36
 
  create a new set in p from an element b
37
 
 }
38
 
 begin
39
 
   FillDWord(fpc_set_create_element,SizeOf(fpc_set_create_element) div 4,0);
40
 
   fpc_set_create_element[b div 32] := 1 shl (b mod 32);
41
 
 end;
42
 
{$endif FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
43
 
 
44
 
{$ifndef FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
45
 
 
46
 
{$ifdef hascompilerproc}
47
 
 function fpc_set_set_byte(const source: fpc_normal_set; b : byte): fpc_normal_set; compilerproc;
48
 
 {
49
 
  add the element b to the set "source"
50
 
 }
51
 
  var
52
 
   c: longint;
53
 
  begin
54
 
    move(source,fpc_set_set_byte,sizeof(source));
55
 
    c := fpc_set_set_byte[b div 32];
56
 
    c := (1 shl (b mod 32)) or c;
57
 
    fpc_set_set_byte[b div 32] := c;
58
 
  end;
59
 
{$else hascompilerproc}
60
 
 procedure do_set_byte(p : pointer;b : byte);[public,alias:'FPC_SET_SET_BYTE'];
61
 
 {
62
 
  add the element b to the set pointed by p
63
 
 }
64
 
  var
65
 
   c: longint;
66
 
  begin
67
 
    c := fpc_normal_set(p^)[b div 32];
68
 
    c := (1 shl (b mod 32)) or c;
69
 
    fpc_normal_set(p^)[b div 32] := c;
70
 
  end;
71
 
{$endif hascompilerproc}
72
 
{$endif FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
73
 
 
74
 
 
75
 
{$ifndef FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
76
 
 
77
 
{$ifdef hascompilerproc}
78
 
function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_set; compilerproc;
79
 
 {
80
 
   suppresses the element b to the set pointed by p
81
 
   used for exclude(set,element)
82
 
 }
83
 
  var
84
 
   c: longint;
85
 
  begin
86
 
    move(source,fpc_set_unset_byte,sizeof(source));
87
 
    c := fpc_set_unset_byte[b div 32];
88
 
    c := c and not (1 shl (b mod 32));
89
 
    fpc_set_unset_byte[b div 32] := c;
90
 
  end;
91
 
{$else hascompilerproc}
92
 
procedure do_unset_byte(p : pointer;b : byte);[public,alias:'FPC_SET_UNSET_BYTE'];
93
 
 {
94
 
   suppresses the element b to the set pointed by p
95
 
   used for exclude(set,element)
96
 
 }
97
 
  var
98
 
   c: longint;
99
 
  begin
100
 
    c := fpc_normal_set(p^)[b div 32];
101
 
    c := c and not (1 shl (b mod 32));
102
 
    fpc_normal_set(p^)[b div 32] := c;
103
 
  end;
104
 
{$endif hascompilerproc}
105
 
{$endif FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
106
 
 
107
 
 
108
 
{$ifndef FPC_SYSTEM_HAS_FPC_SET_SET_RANGE}
109
 
{$ifdef hascompilerproc}
110
 
 function fpc_set_set_range(const orgset: fpc_normal_set; l,h : byte): fpc_normal_set; compilerproc;
111
 
 {
112
 
   adds the range [l..h] to the set orgset
113
 
 }
114
 
  var
115
 
   i: integer;
116
 
   c: longint;
117
 
  begin
118
 
    move(orgset,fpc_set_set_range,sizeof(orgset));
119
 
    for i:=l to h do
120
 
      begin
121
 
        c := fpc_set_set_range[i div 32];
122
 
        c := (1 shl (i mod 32)) or c;
123
 
        fpc_set_set_range[i div 32] := c;
124
 
      end;
125
 
  end;
126
 
{$else hascompilerproc}
127
 
 procedure do_set_range(p : pointer;l,h : byte);[public,alias:'FPC_SET_SET_RANGE'];
128
 
 {
129
 
  bad implementation, but it's very seldom used
130
 
 }
131
 
  var
132
 
   i: integer;
133
 
   c: longint;
134
 
  begin
135
 
    for i:=l to h do
136
 
      begin
137
 
        c := fpc_normal_set(p^)[i div 32];
138
 
        c := (1 shl (i mod 32)) or c;
139
 
        fpc_normal_set(p^)[i div 32] := c;
140
 
      end;
141
 
  end;
142
 
{$endif hascompilerproc}
143
 
{$endif ndef FPC_SYSTEM_HAS_FPC_SET_SET_RANGE}
144
 
 
145
 
 
146
 
{$ifndef FPC_SYSTEM_HAS_FPC_SET_IN_BYTE}
147
 
 
148
 
 function fpc_set_in_byte(const p: fpc_normal_set; b: byte): boolean; [public,alias:'FPC_SET_IN_BYTE']; {$ifdef hascompilerproc} compilerproc; {$else} saveregisters; {$endif}
149
 
 {
150
 
   tests if the element b is in the set p the carryflag is set if it present
151
 
 }
152
 
  begin
153
 
    fpc_set_in_byte := (p[b div 32] and (1 shl (b mod 32))) <> 0;
154
 
  end;
155
 
{$endif}
156
 
 
157
 
 
158
 
{$ifndef FPC_SYSTEM_HAS_FPC_SET_ADD_SETS}
159
 
{$ifdef hascompilerproc}
160
 
 function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_ADD_SETS']; compilerproc;
161
 
 var
162
 
   dest: fpc_normal_set absolute fpc_set_add_sets;
163
 
{$else hascompilerproc}
164
 
 procedure do_add_sets(const set1,set2: fpc_normal_Set; var dest : fpc_normal_set);[public,alias:'FPC_SET_ADD_SETS'];
165
 
{$endif hascompilerproc}
166
 
 {
167
 
   adds set1 and set2 into set dest
168
 
 }
169
 
  var
170
 
    i: integer;
171
 
   begin
172
 
     for i:=0 to 7 do
173
 
       dest[i] := set1[i] or set2[i];
174
 
   end;
175
 
{$endif}
176
 
 
177
 
 
178
 
{$ifndef FPC_SYSTEM_HAS_FPC_SET_MUL_SETS}
179
 
{$ifdef hascompilerproc}
180
 
 function fpc_set_mul_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_MUL_SETS']; compilerproc;
181
 
 var
182
 
   dest: fpc_normal_set absolute fpc_set_mul_sets;
183
 
{$else hascompilerproc}
184
 
 procedure do_mul_sets(const set1,set2: fpc_normal_set; var dest: fpc_normal_set);[public,alias:'FPC_SET_MUL_SETS'];
185
 
{$endif hascompilerproc}
186
 
 {
187
 
   multiplies (takes common elements of) set1 and set2 result put in dest
188
 
 }
189
 
   var
190
 
    i: integer;
191
 
   begin
192
 
     for i:=0 to 7 do
193
 
       dest[i] := set1[i] and set2[i];
194
 
   end;
195
 
{$endif}
196
 
 
197
 
 
198
 
{$ifndef FPC_SYSTEM_HAS_FPC_SET_SUB_SETS}
199
 
{$ifdef hascompilerproc}
200
 
 function fpc_set_sub_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_SUB_SETS']; compilerproc;
201
 
 var
202
 
   dest: fpc_normal_set absolute fpc_set_sub_sets;
203
 
{$else hascompilerproc}
204
 
 procedure do_sub_sets(const set1,set2: fpc_normal_set; var dest: fpc_normal_set);[public,alias:'FPC_SET_SUB_SETS'];
205
 
{$endif hascompilerproc}
206
 
 {
207
 
  computes the diff from set1 to set2 result in dest
208
 
 }
209
 
   var
210
 
    i: integer;
211
 
   begin
212
 
     for i:=0 to 7 do
213
 
       dest[i] := set1[i] and not set2[i];
214
 
   end;
215
 
{$endif}
216
 
 
217
 
 
218
 
{$ifndef FPC_SYSTEM_HAS_FPC_SET_SYMDIF_SETS}
219
 
{$ifdef hascompilerproc}
220
 
 function fpc_set_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_SYMDIF_SETS']; compilerproc;
221
 
 var
222
 
   dest: fpc_normal_set absolute fpc_set_symdif_sets;
223
 
{$else hascompilerproc}
224
 
 procedure do_symdif_sets(const set1,set2: fpc_normal_set; var dest: fpc_normal_set);[public,alias:'FPC_SET_SYMDIF_SETS'];
225
 
{$endif hascompilerproc}
226
 
 {
227
 
   computes the symetric diff from set1 to set2 result in dest
228
 
 }
229
 
   var
230
 
    i: integer;
231
 
   begin
232
 
     for i:=0 to 7 do
233
 
       dest[i] := set1[i] xor set2[i];
234
 
   end;
235
 
{$endif}
236
 
 
237
 
{$ifndef FPC_SYSTEM_HAS_FPC_SET_COMP_SETS}
238
 
 function fpc_set_comp_sets(const set1,set2 : fpc_normal_set):boolean;[public,alias:'FPC_SET_COMP_SETS'];{$ifdef hascompilerproc} compilerproc; {$else} saveregisters; {$endif}
239
 
 {
240
 
  compares set1 and set2 zeroflag is set if they are equal
241
 
 }
242
 
   var
243
 
    i: integer;
244
 
   begin
245
 
     fpc_set_comp_sets:= false;
246
 
     for i:=0 to 7 do
247
 
       if set1[i] <> set2[i] then
248
 
         exit;
249
 
     fpc_set_comp_sets:= true;
250
 
   end;
251
 
{$endif}
252
 
 
253
 
 
254
 
 
255
 
{$ifndef FPC_SYSTEM_HAS_FPC_SET_CONTAINS_SET}
256
 
 function fpc_set_contains_sets(const set1,set2 : fpc_normal_set):boolean;[public,alias:'FPC_SET_CONTAINS_SETS'];{$ifdef hascompilerproc} compilerproc; {$else} saveregisters; {$endif}
257
 
 {
258
 
  on exit, zero flag is set if set1 <= set2 (set2 contains set1)
259
 
 }
260
 
 var
261
 
  i : integer;
262
 
 begin
263
 
   fpc_set_contains_sets:= false;
264
 
   for i:=0 to 7 do
265
 
     if (set1[i] and not set2[i]) <> 0 then
266
 
       exit;
267
 
   fpc_set_contains_sets:= true;
268
 
 end;
269
 
{$endif}
270
 
 
271
 
{
272
 
  $Log: genset.inc,v $
273
 
  Revision 1.7  2002/09/07 15:07:45  peter
274
 
    * old logs removed and tabs fixed
275
 
 
276
 
}
277