← Back to branch summary

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

« back to all changes in this revision

Viewing changes to fpcsrc/rtl/arm/arm.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/arm/arm.inc
 
1
{
 
2
 
 
3
    This file is part of the Free Pascal run time library.
 
4
    Copyright (c) 2003 by the Free Pascal development team.
 
5
 
 
6
    Processor dependent implementation for the system unit for
 
7
    ARM
 
8
 
 
9
    See the file COPYING.FPC, included in this distribution,
 
10
    for details about the copyright.
 
11
 
 
12
    This program is distributed in the hope that it will be useful,
 
13
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
14
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
15
 
 
16
 **********************************************************************}
 
17
 
 
18
{$asmmode gas}
 
19
 
 
20
const
 
21
  cpu_has_edsp : boolean = false;
 
22
  in_edsp_test : boolean = false;
 
23
 
 
24
procedure fpc_cpuinit;
 
25
begin
 
26
{$if not(defined(wince)) and not(defined(gba)) and not(defined(nds)) and not(defined(FPUSOFT)) and not(defined(FPULIBGCC))}
 
27
  { Enable FPU exceptions, but disable INEXACT, UNDERFLOW, DENORMAL }
 
28
  asm
 
29
    rfs r0
 
30
    and r0,r0,#0xffe0ffff
 
31
    orr r0,r0,#0x00070000
 
32
    wfs r0
 
33
  end;
 
34
{$endif}
 
35
end;
 
36
 
 
37
{$ifdef wince}
 
38
function _controlfp(new: DWORD; mask: DWORD): DWORD; cdecl; external 'coredll';
 
39
 
 
40
{$define FPC_SYSTEM_HAS_SYSRESETFPU}
 
41
Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
 
42
begin
 
43
  softfloat_exception_flags:=0;
 
44
  softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
 
45
  { Enable FPU exceptions, but disable INEXACT, UNDERFLOW, DENORMAL }
 
46
  { FPU precision 64 bit, rounding to nearest, affine infinity }
 
47
  _controlfp($000C0003, $030F031F);
 
48
end;
 
49
{$endif wince}
 
50
 
 
51
{****************************************************************************
 
52
                       stack frame related stuff
 
53
****************************************************************************}
 
54
 
 
55
{$IFNDEF INTERNAL_BACKTRACE}
 
56
{$define FPC_SYSTEM_HAS_GET_FRAME}
 
57
function get_frame:pointer;assembler;nostackframe;{$ifdef SYSTEMINLINE}inline;{$endif}
 
58
asm
 
59
  mov    r0,r11
 
60
end ['R0'];
 
61
{$ENDIF not INTERNAL_BACKTRACE}
 
62
 
 
63
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
 
64
function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
 
65
asm
 
66
  movs r0,r0
 
67
  beq .Lg_a_null
 
68
  ldr r0,[r0,#-4]
 
69
.Lg_a_null:
 
70
end ['R0'];
 
71
 
 
72
 
 
73
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
 
74
function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
 
75
asm
 
76
  movs r0,r0
 
77
  beq .Lgnf_null
 
78
  ldr r0,[r0,#-12]
 
79
.Lgnf_null:
 
80
end ['R0'];
 
81
 
 
82
 
 
83
{$define FPC_SYSTEM_HAS_SPTR}
 
84
Function Sptr : pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
 
85
asm
 
86
  mov    r0,sp
 
87
end ['R0'];
 
88
 
 
89
 
 
90
{$define FPC_SYSTEM_HAS_FILLCHAR}
 
91
Procedure FillChar(var x;count:longint;value:byte);assembler;nostackframe;
 
92
asm
 
93
        // less than 0?
 
94
        cmp r1,#0
 
95
        movlt pc,lr
 
96
        mov     r3,r0
 
97
        cmp     r1,#8           // at least 8 bytes to do?
 
98
        blt     .LFillchar2
 
99
        orr r2,r2,r2,lsl #8
 
100
        orr r2,r2,r2,lsl #16
 
101
.LFillchar0:
 
102
        tst     r3,#3           // aligned yet?
 
103
        strneb r2,[r3],#1
 
104
        subne   r1,r1,#1
 
105
        bne     .LFillchar0
 
106
        mov     ip,r2
 
107
.LFillchar1:
 
108
        cmp     r1,#8           // 8 bytes still to do?
 
109
        blt     .LFillchar2
 
110
        stmia   r3!,{r2,ip}
 
111
        sub     r1,r1,#8
 
112
        cmp     r1,#8           // 8 bytes still to do?
 
113
        blt     .LFillchar2
 
114
        stmia   r3!,{r2,ip}
 
115
        sub     r1,r1,#8
 
116
        cmp     r1,#8           // 8 bytes still to do?
 
117
        blt     .LFillchar2
 
118
        stmia   r3!,{r2,ip}
 
119
        sub     r1,r1,#8
 
120
        cmp     r1,#8           // 8 bytes still to do?
 
121
        stmgeia r3!,{r2,ip}
 
122
        subge   r1,r1,#8
 
123
        bge     .LFillchar1
 
124
.LFillchar2:
 
125
        movs r1,r1              // anything left?
 
126
        moveq pc,lr
 
127
        rsb     r1,r1,#7
 
128
        add     pc,pc,r1,lsl #2
 
129
        mov     r0,r0
 
130
        strb r2,[r3],#1
 
131
        strb r2,[r3],#1
 
132
        strb r2,[r3],#1
 
133
        strb r2,[r3],#1
 
134
        strb r2,[r3],#1
 
135
        strb r2,[r3],#1
 
136
        strb r2,[r3],#1
 
137
        mov pc,lr
 
138
end;
 
139
 
 
140
 
 
141
{$ifndef FPC_SYSTEM_HAS_MOVE}
 
142
{$define FPC_SYSTEM_HAS_MOVE}
 
143
{$define FPC_SYSTEM_FPC_MOVE}
 
144
procedure Move_pld(const source;var dest;count:longint);assembler;nostackframe;
 
145
asm
 
146
  pld [r0]
 
147
  pld [r1]
 
148
  // count <=0 ?
 
149
  cmp r2,#0
 
150
  movle pc,lr
 
151
  // overlap?
 
152
  cmp r1,r0
 
153
  bls .Lnooverlap
 
154
  add r3,r0,r2
 
155
  cmp r3,r1
 
156
  bls .Lnooverlap
 
157
  // overlap, copy backward
 
158
.Loverlapped:
 
159
  subs r2,r2,#1
 
160
  ldrb r3,[r0,r2]
 
161
  strb r3,[r1,r2]
 
162
  bne .Loverlapped
 
163
  mov pc,lr
 
164
.Lnooverlap:
 
165
  // less then 16 bytes to copy?
 
166
  cmp r2,#8
 
167
  // yes, the forget about the whole optimizations
 
168
  // and do a bytewise copy
 
169
  blt .Lbyteloop
 
170
 
 
171
  // both aligned?
 
172
  orr r3,r0,r1
 
173
  tst r3,#3
 
174
 
 
175
  bne .Lbyteloop
 
176
(*
 
177
  // yes, then align
 
178
  // alignment to 4 byte boundries is enough
 
179
  ldrb ip,[r0],#1
 
180
  sub r2,r2,#1
 
181
  stb ip,[r1],#1
 
182
  tst r3,#2
 
183
  bne .Ldifferentaligned
 
184
  ldrh ip,[r0],#2
 
185
  sub r2,r2,#2
 
186
  sth ip,[r1],#2
 
187
 
 
188
.Ldifferentaligned
 
189
  // qword aligned?
 
190
  orrs r3,r0,r1
 
191
  tst r3,#7
 
192
  bne .Ldwordloop
 
193
*)
 
194
  pld [r0,#32]
 
195
  pld [r1,#32]
 
196
.Ldwordloop:
 
197
  sub r2,r2,#4
 
198
  ldr r3,[r0],#4
 
199
  // preload
 
200
  pld [r0,#64]
 
201
  pld [r1,#64]
 
202
  cmp r2,#4
 
203
  str r3,[r1],#4
 
204
  bcs .Ldwordloop
 
205
  cmp r2,#0
 
206
  moveq pc,lr
 
207
.Lbyteloop:
 
208
  subs r2,r2,#1
 
209
  ldrb r3,[r0],#1
 
210
  strb r3,[r1],#1
 
211
  bne .Lbyteloop
 
212
  mov pc,lr
 
213
end;
 
214
 
 
215
procedure Move_blended(const source;var dest;count:longint);assembler;nostackframe;
 
216
asm
 
217
  // count <=0 ?
 
218
  cmp r2,#0
 
219
  movle pc,lr
 
220
  // overlap?
 
221
  cmp r1,r0
 
222
  bls .Lnooverlap
 
223
  add r3,r0,r2
 
224
  cmp r3,r1
 
225
  bls .Lnooverlap
 
226
  // overlap, copy backward
 
227
.Loverlapped:
 
228
  subs r2,r2,#1
 
229
  ldrb r3,[r0,r2]
 
230
  strb r3,[r1,r2]
 
231
  bne .Loverlapped
 
232
  mov pc,lr
 
233
.Lnooverlap:
 
234
  // less then 16 bytes to copy?
 
235
  cmp r2,#8
 
236
  // yes, the forget about the whole optimizations
 
237
  // and do a bytewise copy
 
238
  blt .Lbyteloop
 
239
 
 
240
  // both aligned?
 
241
  orr r3,r0,r1
 
242
  tst r3,#3
 
243
 
 
244
  bne .Lbyteloop
 
245
(*
 
246
  // yes, then align
 
247
  // alignment to 4 byte boundries is enough
 
248
  ldrb ip,[r0],#1
 
249
  sub r2,r2,#1
 
250
  stb ip,[r1],#1
 
251
  tst r3,#2
 
252
  bne .Ldifferentaligned
 
253
  ldrh ip,[r0],#2
 
254
  sub r2,r2,#2
 
255
  sth ip,[r1],#2
 
256
 
 
257
.Ldifferentaligned
 
258
  // qword aligned?
 
259
  orrs r3,r0,r1
 
260
  tst r3,#7
 
261
  bne .Ldwordloop
 
262
*)
 
263
.Ldwordloop:
 
264
  sub r2,r2,#4
 
265
  ldr r3,[r0],#4
 
266
  cmp r2,#4
 
267
  str r3,[r1],#4
 
268
  bcs .Ldwordloop
 
269
  cmp r2,#0
 
270
  moveq pc,lr
 
271
.Lbyteloop:
 
272
  subs r2,r2,#1
 
273
  ldrb r3,[r0],#1
 
274
  strb r3,[r1],#1
 
275
  bne .Lbyteloop
 
276
  mov pc,lr
 
277
end;
 
278
 
 
279
 
 
280
const
 
281
  moveproc : pointer = @move_blended;
 
282
 
 
283
procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler;nostackframe;
 
284
asm
 
285
  ldr ip,.Lmoveproc
 
286
  ldr pc,[ip]
 
287
.Lmoveproc:
 
288
  .long moveproc
 
289
end;
 
290
 
 
291
{$endif FPC_SYSTEM_HAS_MOVE}
 
292
 
 
293
var
 
294
  fpc_system_lock: longint; export name 'fpc_system_lock';
 
295
 
 
296
function InterLockedDecrement (var Target: longint) : longint; assembler; nostackframe;
 
297
asm
 
298
// lock
 
299
  ldr r3, .Lfpc_system_lock
 
300
  mov r1, #1
 
301
.Lloop:
 
302
  swp r2, r1, [r3]
 
303
  cmp r2, #0
 
304
  bne .Lloop
 
305
// do the job
 
306
  ldr r1, [r0]
 
307
  sub r1, r1, #1
 
308
  str r1, [r0]
 
309
  mov r0, r1
 
310
// unlock and return
 
311
  str r2, [r3]
 
312
  mov pc, lr
 
313
 
 
314
.Lfpc_system_lock:
 
315
  .long fpc_system_lock
 
316
end;
 
317
 
 
318
 
 
319
function InterLockedIncrement (var Target: longint) : longint; assembler; nostackframe;
 
320
asm
 
321
// lock
 
322
  ldr r3, .Lfpc_system_lock
 
323
  mov r1, #1
 
324
.Lloop:
 
325
  swp r2, r1, [r3]
 
326
  cmp r2, #0
 
327
  bne .Lloop
 
328
// do the job
 
329
  ldr r1, [r0]
 
330
  add r1, r1, #1
 
331
  str r1, [r0]
 
332
  mov r0, r1
 
333
// unlock and return
 
334
  str r2, [r3]
 
335
  mov pc, lr
 
336
 
 
337
.Lfpc_system_lock:
 
338
  .long fpc_system_lock
 
339
end;
 
340
 
 
341
 
 
342
function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler; nostackframe;
 
343
asm
 
344
  swp r1, r1, [r0]
 
345
  mov r0,r1
 
346
end;
 
347
 
 
348
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler; nostackframe;
 
349
asm
 
350
// lock
 
351
  ldr r3, .Lfpc_system_lock
 
352
  mov r2, #1
 
353
.Lloop:
 
354
  swp r2, r2, [r3]
 
355
  cmp r2, #0
 
356
  bne .Lloop
 
357
// do the job
 
358
  ldr r2, [r0]
 
359
  add r1, r1, r2
 
360
  str r1, [r0]
 
361
  mov r0, r2
 
362
// unlock and return
 
363
  mov r2, #0
 
364
  str r2, [r3]
 
365
  mov pc, lr
 
366
 
 
367
.Lfpc_system_lock:
 
368
  .long fpc_system_lock
 
369
end;
 
370
 
 
371
 
 
372
function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; assembler; nostackframe;
 
373
asm
 
374
// lock
 
375
  ldr r12, .Lfpc_system_lock
 
376
  mov r3, #1
 
377
.Lloop:
 
378
  swp r3, r3, [r12]
 
379
  cmp r3, #0
 
380
  bne .Lloop
 
381
// do the job
 
382
  ldr r3, [r0]
 
383
  cmp r3, r2
 
384
  streq r1, [r0]
 
385
  mov r0, r3
 
386
// unlock and return
 
387
  mov r3, #0
 
388
  str r3, [r12]
 
389
  mov pc, lr
 
390
 
 
391
.Lfpc_system_lock:
 
392
  .long fpc_system_lock
 
393
end;
 
394
 
 
395
{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
 
396
function declocked(var l: longint) : boolean; inline;
 
397
begin
 
398
  Result:=InterLockedDecrement(l) = 0;
 
399
end;
 
400
 
 
401
{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
 
402
procedure inclocked(var l: longint); inline;
 
403
begin
 
404
  InterLockedIncrement(l);
 
405
end;
 
406
 
 
407
procedure fpc_cpucodeinit;
 
408
begin
 
409
  cpu_has_edsp:=true;
 
410
  in_edsp_test:=true;
 
411
  asm
 
412
    pld [r0]
 
413
  end;
 
414
  in_edsp_test:=false;
 
415
{$ifdef FPC_SYSTEM_FPC_MOVE}
 
416
  if cpu_has_edsp then
 
417
    moveproc:=@move_pld
 
418
  else
 
419
    moveproc:=@move_blended;
 
420
{$endif FPC_SYSTEM_FPC_MOVE}
 
421
end;