← Back to branch summary

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

« back to all changes in this revision

Viewing changes to fpcsrc/rtl/powerpc/powerpc.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/powerpc/powerpc.inc
 
1
{
 
2
 
 
3
    This file is part of the Free Pascal run time library.
 
4
    Copyright (c) 2000-2006 by the Free Pascal development team.
 
5
 
 
6
    Portions Copyright (c) 2000 by Casey Duncan (casey.duncan@state.co.us)
 
7
 
 
8
    Processor dependent implementation for the system unit for
 
9
    PowerPC
 
10
 
 
11
    See the file COPYING.FPC, included in this distribution,
 
12
    for details about the copyright.
 
13
 
 
14
    This program is distributed in the hope that it will be useful,
 
15
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
16
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
17
 
 
18
 **********************************************************************}
 
19
 
 
20
{$IFNDEF LINUX}
 
21
    {$DEFINE USE_DCBZ}
 
22
{$ENDIF LINUX}
 
23
 
 
24
{****************************************************************************
 
25
                           PowerPC specific stuff
 
26
****************************************************************************}
 
27
{
 
28
 
 
29
const
 
30
  ppc_fpu_overflow     = (1 shl (32-3));
 
31
  ppc_fpu_underflow    = (1 shl (32-4));
 
32
  ppc_fpu_divbyzero    = (1 shl (32-5));
 
33
  ppc_fpu_inexact      = (1 shl (32-6));
 
34
  ppc_fpu_invalid_snan = (1 shl (32-7));
 
35
}
 
36
 
 
37
procedure fpc_enable_ppc_fpu_exceptions;
 
38
assembler; nostackframe;
 
39
asm
 
40
  { clear all "exception happened" flags we care about}
 
41
  mtfsfi 0,0
 
42
  mtfsfi 1,0
 
43
  mtfsfi 2,0
 
44
  mtfsfi 3,0
 
45
  mtfsb0 21
 
46
  mtfsb0 22
 
47
  mtfsb0 23
 
48
 
 
49
  { enable invalid operations and division by zero exceptions. }
 
50
  { No overflow/underflow, since those give some spurious      }
 
51
  { exceptions                                                 }
 
52
  mtfsfi 6,9
 
53
end;
 
54
 
 
55
 
 
56
procedure fpc_cpuinit;
 
57
begin
 
58
  fpc_enable_ppc_fpu_exceptions;
 
59
end;
 
60
 
 
61
 
 
62
function fpc_get_ppc_fpscr: cardinal;
 
63
assembler;
 
64
var
 
65
  temp: record a,b:longint; end;
 
66
asm
 
67
  mffs f0
 
68
  stfd f0,temp
 
69
  lwz  r3,temp.b
 
70
  { clear all exception flags }
 
71
{
 
72
  rlwinm r4,r3,0,16,31
 
73
  stw  r4,temp.b
 
74
  lfd  f0,temp
 
75
  a_mtfsf f0
 
76
}
 
77
end;
 
78
 
 
79
{ This function is never called directly, it's a dummy to hold the register save/
 
80
  load subroutines
 
81
}
 
82
{$ifndef MACOS}
 
83
label
 
84
  _restfpr_14_x,
 
85
  _restfpr_15_x,
 
86
  _restfpr_16_x,
 
87
  _restfpr_17_x,
 
88
  _restfpr_18_x,
 
89
  _restfpr_19_x,
 
90
  _restfpr_20_x,
 
91
  _restfpr_21_x,
 
92
  _restfpr_22_x,
 
93
  _restfpr_23_x,
 
94
  _restfpr_24_x,
 
95
  _restfpr_25_x,
 
96
  _restfpr_26_x,
 
97
  _restfpr_27_x,
 
98
  _restfpr_28_x,
 
99
  _restfpr_29_x,
 
100
  _restfpr_30_x,
 
101
  _restfpr_31_x,
 
102
  _restfpr_14_l,
 
103
  _restfpr_15_l,
 
104
  _restfpr_16_l,
 
105
  _restfpr_17_l,
 
106
  _restfpr_18_l,
 
107
  _restfpr_19_l,
 
108
  _restfpr_20_l,
 
109
  _restfpr_21_l,
 
110
  _restfpr_22_l,
 
111
  _restfpr_23_l,
 
112
  _restfpr_24_l,
 
113
  _restfpr_25_l,
 
114
  _restfpr_26_l,
 
115
  _restfpr_27_l,
 
116
  _restfpr_28_l,
 
117
  _restfpr_29_l,
 
118
  _restfpr_30_l,
 
119
  _restfpr_31_l;
 
120
 
 
121
procedure saverestorereg;assembler; nostackframe;
 
122
asm
 
123
{ exit }
 
124
.globl _restfpr_14_x
 
125
_restfpr_14_x:  lfd     f14, -144(r11)
 
126
.globl _restfpr_15_x
 
127
_restfpr_15_x:  lfd     f15, -136(r11)
 
128
.globl _restfpr_16_x
 
129
_restfpr_16_x:  lfd     f16, -128(r11)
 
130
.globl _restfpr_17_x
 
131
_restfpr_17_x:  lfd     f17, -120(r11)
 
132
.globl _restfpr_18_x
 
133
_restfpr_18_x:  lfd     f18, -112(r11)
 
134
.globl _restfpr_19_x
 
135
_restfpr_19_x:  lfd     f19, -104(r11)
 
136
.globl _restfpr_20_x
 
137
_restfpr_20_x:  lfd     f20, -96(r11)
 
138
.globl _restfpr_21_x
 
139
_restfpr_21_x:  lfd     f21, -88(r11)
 
140
.globl _restfpr_22_x
 
141
_restfpr_22_x:  lfd     f22, -80(r11)
 
142
.globl _restfpr_23_x
 
143
_restfpr_23_x:  lfd     f23, -72(r11)
 
144
.globl _restfpr_24_x
 
145
_restfpr_24_x:  lfd     f24, -64(r11)
 
146
.globl _restfpr_25_x
 
147
_restfpr_25_x:  lfd     f25, -56(r11)
 
148
.globl _restfpr_26_x
 
149
_restfpr_26_x:  lfd     f26, -48(r11)
 
150
.globl _restfpr_27_x
 
151
_restfpr_27_x:  lfd     f27, -40(r11)
 
152
.globl _restfpr_28_x
 
153
_restfpr_28_x:  lfd     f28, -32(r11)
 
154
.globl _restfpr_29_x
 
155
_restfpr_29_x:  lfd     f29, -24(r11)
 
156
.globl _restfpr_30_x
 
157
_restfpr_30_x:  lfd     f30, -16(r11)
 
158
.globl _restfpr_31_x
 
159
_restfpr_31_x:  lwz     r0, 4(r11)
 
160
                lfd     f31, -8(r11)
 
161
                mtlr    r0
 
162
                ori     r1, r11, 0
 
163
                blr
 
164
 
 
165
{ exit with restoring lr }
 
166
.globl _restfpr_14_l
 
167
_restfpr_14_l:  lfd     f14, -144(r11)
 
168
.globl _restfpr_15_l
 
169
_restfpr_15_l:  lfd     f15, -136(r11)
 
170
.globl _restfpr_16_l
 
171
_restfpr_16_l:  lfd     f16, -128(r11)
 
172
.globl _restfpr_17_l
 
173
_restfpr_17_l:  lfd     f17, -120(r11)
 
174
.globl _restfpr_18_l
 
175
_restfpr_18_l:  lfd     f18, -112(r11)
 
176
.globl _restfpr_19_l
 
177
_restfpr_19_l:  lfd     f19, -104(r11)
 
178
.globl _restfpr_20_l
 
179
_restfpr_20_l:  lfd     f20, -96(r11)
 
180
.globl _restfpr_21_l
 
181
_restfpr_21_l:  lfd     f21, -88(r11)
 
182
.globl _restfpr_22_l
 
183
_restfpr_22_l:  lfd     f22, -80(r11)
 
184
.globl _restfpr_23_l
 
185
_restfpr_23_l:  lfd     f23, -72(r11)
 
186
.globl _restfpr_24_l
 
187
_restfpr_24_l:  lfd     f24, -64(r11)
 
188
.globl _restfpr_25_l
 
189
_restfpr_25_l:  lfd     f25, -56(r11)
 
190
.globl _restfpr_26_l
 
191
_restfpr_26_l:  lfd     f26, -48(r11)
 
192
.globl _restfpr_27_l
 
193
_restfpr_27_l:  lfd     f27, -40(r11)
 
194
.globl _restfpr_28_l
 
195
_restfpr_28_l:  lfd     f28, -32(r11)
 
196
.globl _restfpr_29_l
 
197
_restfpr_29_l:  lfd     f29, -24(r11)
 
198
.globl _restfpr_30_l
 
199
_restfpr_30_l:  lfd     f30, -16(r11)
 
200
.globl _restfpr_31_l
 
201
_restfpr_31_l:  lwz     r0, 4(r11)
 
202
                lfd     f31, -8(r11)
 
203
                mtlr    r0
 
204
                ori     r1, r11, 0
 
205
                blr
 
206
end;
 
207
{$endif MACOS}
 
208
 
 
209
{****************************************************************************
 
210
                                Move / Fill
 
211
****************************************************************************}
 
212
 
 
213
{$ifndef FPC_SYSTEM_HAS_MOVE}
 
214
{$define FPC_SYSTEM_HAS_MOVE}
 
215
procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler; nostackframe;
 
216
asm
 
217
          {  count <= 0 ?  }
 
218
          cmpwi   cr0,r5,0
 
219
          {  check if we have to do the move backwards because of overlap  }
 
220
          sub     r10,r4,r3
 
221
          {  carry := boolean(dest-source < count) = boolean(overlap) }
 
222
          subc    r10,r10,r5
 
223
 
 
224
          {  count < 15 ? (to decide whether we will move dwords or bytes  }
 
225
          cmpwi   cr1,r5,15
 
226
 
 
227
          {  if overlap, then r10 := -1 else r10 := 0  }
 
228
          subfe   r10,r10,r10
 
229
 
 
230
          {  count < 63 ? (32 + max. alignment (31) }
 
231
          cmpwi   cr7,r5,63
 
232
 
 
233
          {  if count <= 0, stop  }
 
234
          ble     cr0,.LMoveDone
 
235
 
 
236
          {  load the begin of the source in the data cache }
 
237
          dcbt    0,r3
 
238
          { and the dest as well }
 
239
          dcbtst  0,r4
 
240
 
 
241
          {  if overlap, then r0 := count else r0 := 0  }
 
242
          and     r0,r5,r10
 
243
          {  if overlap, then point source and dest to the end  }
 
244
          add     r3,r3,r0
 
245
          add     r4,r4,r0
 
246
          {  if overlap, then r6 := 0, else r6 := -1  }
 
247
          not     r6,r10
 
248
          {  if overlap, then r10 := -2, else r10 := 0  }
 
249
          slwi    r10,r10,1
 
250
          {  if overlap, then r10 := -1, else r10 := 1  }
 
251
          addi    r10,r10,1
 
252
 
 
253
          {  if count < 15, copy everything byte by byte  }
 
254
          blt     cr1,.LMoveBytes
 
255
 
 
256
          {  if no overlap, then source/dest += -1, otherwise they stay }
 
257
          {  After the next instruction, r3/r4 + r10 = next position to }
 
258
          {  load/store from/to                                         }
 
259
          add     r3,r3,r6
 
260
          add     r4,r4,r6
 
261
 
 
262
          {  otherwise, guarantee 4 byte alignment for dest for starters  }
 
263
.LMove4ByteAlignLoop:
 
264
          lbzux   r0,r3,r10
 
265
          stbux   r0,r4,r10
 
266
          {  is dest now 4 aligned?  }
 
267
          andi.   r0,r4,3
 
268
          subi    r5,r5,1
 
269
          {  while not aligned, continue  }
 
270
          bne     cr0,.LMove4ByteAlignLoop
 
271
 
 
272
{$ifndef ppc603}
 
273
          { check for 32 byte alignment }
 
274
          andi.   r7,r4,31
 
275
{$endif non ppc603}
 
276
          { we are going to copy one byte again (the one at the newly }
 
277
          { aligned address), so increase count byte 1                }
 
278
          addi    r5,r5,1
 
279
          { count div 4 for number of dwords to copy }
 
280
          srwi    r0,r5,2
 
281
          {  if 11 <= count < 63, copy using dwords }
 
282
          blt     cr7,.LMoveDWords
 
283
 
 
284
{$ifndef ppc603}
 
285
          { # of dwords to copy to reach 32 byte alignment (*4) }
 
286
          { (depends on forward/backward copy)                  }
 
287
 
 
288
          { if forward copy, r6 = -1 -> r8 := 32 }
 
289
          { if backward copy, r6 = 0 -> r8 := 0  }
 
290
          rlwinm  r8,r6,0,31-6+1,31-6+1
 
291
          { if forward copy, we have to copy 32 - unaligned count bytes }
 
292
          { if backward copy unaligned count bytes                      }
 
293
          sub     r7,r8,r7
 
294
          { if backward copy, the calculated value is now negate -> }
 
295
          { make it positive again                                 }
 
296
          not     r8, r6
 
297
          add     r7, r7, r8
 
298
          xor     r7, r7, r8
 
299
{$endif not ppc603}
 
300
 
 
301
          { multiply the update count with 4 }
 
302
          slwi    r10,r10,2
 
303
          slwi    r6,r6,2
 
304
          { and adapt the source and dest }
 
305
          add     r3,r3,r6
 
306
          add     r4,r4,r6
 
307
 
 
308
{$ifndef ppc603}
 
309
          beq     cr0,.LMove32BytesAligned
 
310
.L32BytesAlignMoveLoop:
 
311
          {  count >= 39 -> align to 8 byte boundary and then use the FPU  }
 
312
          {  since we're already at 4 byte alignment, use dword store      }
 
313
          subic.  r7,r7,4
 
314
          lwzux   r0,r3,r10
 
315
          subi    r5,r5,4
 
316
          stwux   r0,r4,r10
 
317
          bne     .L32BytesAlignMoveLoop
 
318
 
 
319
.LMove32BytesAligned:
 
320
          { count div 32 ( >= 1, since count was >=63 }
 
321
          srwi    r0,r5,5
 
322
          { remainder }
 
323
          andi.   r5,r5,31
 
324
          { to decide if we will do some dword stores (instead of only }
 
325
          { byte stores) afterwards or not                             }
 
326
{$else not ppc603}
 
327
          srwi    r0,r5,4
 
328
          andi.   r5,r5,15
 
329
{$endif not ppc603}
 
330
          cmpwi   cr1,r5,11
 
331
          mtctr   r0
 
332
 
 
333
          {  r0 := count div 4, will be moved to ctr when copying dwords  }
 
334
          srwi    r0,r5,2
 
335
 
 
336
{$ifndef ppc603}
 
337
          {  adjust the update count: it will now be 8 or -8 depending on overlap  }
 
338
          slwi    r10,r10,1
 
339
 
 
340
          {  adjust source and dest pointers: because of the above loop, dest is now   }
 
341
          {  aligned to 8 bytes. So if we add r6 we will still have an 8 bytes         }
 
342
          { aligned address)                                                           }
 
343
          add     r3,r3,r6
 
344
          add     r4,r4,r6
 
345
 
 
346
          slwi    r6,r6,1
 
347
{$IFDEF USE_DCBZ}
 
348
          { the dcbz offset must give a 32 byte aligned address when added   }
 
349
          { to the current dest address and its address must point to the    }
 
350
          { bytes that will be overwritten in the current iteration. In case }
 
351
          { of a forward loop, the dest address has currently an offset of   }
 
352
          { -8 compared to the bytes that will be overwritten (and r6 = -8). }
 
353
          { In case of a backward of a loop, the dest address currently has  }
 
354
          { an offset of +32 compared to the bytes that will be overwritten  }
 
355
          { (and r6 = 0). So the forward dcbz offset must become +8 and the  }
 
356
          { backward -32 -> (-r6 * 5) - 32 gives the correct offset          }
 
357
          slwi    r7,r6,2
 
358
          add     r7,r7,r6
 
359
          neg     r7,r7
 
360
          subi    r7,r7,32
 
361
{$ENDIF USE_DCBZ}
 
362
.LMove32ByteDcbz:
 
363
          lfdux   f0,r3,r10
 
364
          lfdux   f1,r3,r10
 
365
          lfdux   f2,r3,r10
 
366
          lfdux   f3,r3,r10
 
367
{$IFDEF USE_DCBZ}
 
368
          { must be done only now, in case source and dest are less than }
 
369
          { 32 bytes apart!                                              }
 
370
          dcbz    r4,r7
 
371
{$ENDIF USE_DCBZ}
 
372
          stfdux  f0,r4,r10
 
373
          stfdux  f1,r4,r10
 
374
          stfdux  f2,r4,r10
 
375
          stfdux  f3,r4,r10
 
376
          bdnz    .LMove32ByteDcbz
 
377
.LMove32ByteLoopDone:
 
378
{$else not ppc603}
 
379
.LMove16ByteLoop:
 
380
          lwzux   r11,r3,r10
 
381
          lwzux   r7,r3,r10
 
382
          lwzux   r8,r3,r10
 
383
          lwzux   r9,r3,r10
 
384
          stwux   r11,r4,r10
 
385
          stwux   r7,r4,r10
 
386
          stwux   r8,r4,r10
 
387
          stwux   r9,r4,r10
 
388
          bdnz    .LMove16ByteLoop
 
389
{$endif not ppc603}
 
390
 
 
391
          { cr0*4+eq is true if "count and 31" = 0 }
 
392
          beq     cr0,.LMoveDone
 
393
 
 
394
          {  make r10 again -1 or 1, but first adjust source/dest pointers }
 
395
          sub     r3,r3,r6
 
396
          sub     r4,r4,r6
 
397
{$ifndef ppc603}
 
398
          srawi   r10,r10,3
 
399
          srawi   r6,r6,3
 
400
{$else not ppc603}
 
401
          srawi   r10,r10,2
 
402
          srawi   r6,r6,2
 
403
{$endif not ppc603}
 
404
 
 
405
          { cr1 contains whether count <= 11 }
 
406
          ble     cr1,.LMoveBytes
 
407
 
 
408
.LMoveDWords:
 
409
          mtctr   r0
 
410
          andi.   r5,r5,3
 
411
          {  r10 * 4  }
 
412
          slwi    r10,r10,2
 
413
          slwi    r6,r6,2
 
414
          add     r3,r3,r6
 
415
          add     r4,r4,r6
 
416
 
 
417
.LMoveDWordsLoop:
 
418
          lwzux   r0,r3,r10
 
419
          stwux   r0,r4,r10
 
420
          bdnz    .LMoveDWordsLoop
 
421
 
 
422
          beq     cr0,.LMoveDone
 
423
          {  make r10 again -1 or 1  }
 
424
          sub     r3,r3,r6
 
425
          sub     r4,r4,r6
 
426
          srawi   r10,r10,2
 
427
          srawi   r6,r6,2
 
428
.LMoveBytes:
 
429
          add     r3,r3,r6
 
430
          add     r4,r4,r6
 
431
          mtctr   r5
 
432
.LMoveBytesLoop:
 
433
          lbzux   r0,r3,r10
 
434
          stbux   r0,r4,r10
 
435
          bdnz    .LMoveBytesLoop
 
436
.LMoveDone:
 
437
end;
 
438
{$endif FPC_SYSTEM_HAS_MOVE}
 
439
 
 
440
 
 
441
{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
 
442
{$define FPC_SYSTEM_HAS_FILLCHAR}
 
443
 
 
444
Procedure FillChar(var x;count:longint;value:byte);assembler;
 
445
{ input: x in r3, count in r4, value in r5 }
 
446
 
 
447
{$ifndef FPC_ABI_AIX}
 
448
{ in the AIX ABI, we can use te red zone for temp storage, otherwise we have }
 
449
{ to explicitely allocate room                                               }
 
450
var
 
451
  temp : packed record
 
452
    case byte of
 
453
      0: (l1,l2: longint);
 
454
      1: (d: double);
 
455
    end;
 
456
{$endif FPC_ABI_AIX}
 
457
asm
 
458
        { no bytes? }
 
459
        cmpwi     cr6,r4,0
 
460
        { less than 15 bytes? }
 
461
        cmpwi     cr7,r4,15
 
462
        { less than 64 bytes? }
 
463
        cmpwi     cr1,r4,64
 
464
        { fill r5 with ValueValueValueValue }
 
465
        rlwimi    r5,r5,8,16,23
 
466
        { setup for aligning x to multiple of 4}
 
467
        rlwinm    r10,r3,0,31-2+1,31
 
468
        rlwimi    r5,r5,16,0,15
 
469
        ble       cr6,.LFillCharDone
 
470
        { get the start of the data in the cache (and mark it as "will be }
 
471
        { modified")                                                      }
 
472
        dcbtst    0,r3
 
473
        subfic    r10,r10,4
 
474
        blt       cr7,.LFillCharVerySmall
 
475
        { just store 4 bytes instead of using a loop to align (there are }
 
476
        { plenty of other instructions now to keep the processor busy    }
 
477
        { while it handles the (possibly unaligned) store)               }
 
478
        stw       r5,0(r3)
 
479
        { r3 := align(r3,4) }
 
480
        add       r3,r3,r10
 
481
        { decrease count with number of bytes already stored }
 
482
        sub       r4,r4,r10
 
483
        blt       cr1,.LFillCharSmall
 
484
{$IFDEF USE_DCBZ}
 
485
        { if we have to fill with 0 (which happens a lot), we can simply use }
 
486
        { dcbz for the most part, which is very fast, so make a special case }
 
487
        { for that                                                           }
 
488
        cmplwi    cr1,r5,0
 
489
{$ENDIF}
 
490
        { align to a multiple of 32 (and immediately check whether we aren't }
 
491
        { already 32 byte aligned)                                           }
 
492
        rlwinm.   r10,r3,0,31-5+1,31
 
493
        { setup r3 for using update forms of store instructions }
 
494
        subi      r3,r3,4
 
495
        { get number of bytes to store }
 
496
        subfic    r10,r10,32
 
497
        { if already 32byte aligned, skip align loop }
 
498
        beq       .L32ByteAlignLoopDone
 
499
        { substract from the total count }
 
500
        sub       r4,r4,r10
 
501
.L32ByteAlignLoop:
 
502
        { we were already aligned to 4 byres, so this will count down to }
 
503
        { exactly 0                                                      }
 
504
        subic.    r10,r10,4
 
505
        stwu      r5,4(r3)
 
506
        bne       .L32ByteAlignLoop
 
507
.L32ByteAlignLoopDone:
 
508
        { get the amount of 32 byte blocks }
 
509
        srwi      r10,r4,5
 
510
        { and keep the rest in r4 (recording whether there is any rest) }
 
511
        rlwinm.   r4,r4,0,31-5+1,31
 
512
        { move to ctr }
 
513
        mtctr     r10
 
514
        { check how many rest there is (to decide whether we'll use }
 
515
        { FillCharSmall or FillCharVerySmall)                       }
 
516
        cmplwi    cr7,r4,11
 
517
{$IFDEF USE_DCBZ}
 
518
        { if filling with zero, only use dcbz }
 
519
        bne       cr1, .LFillCharNoZero
 
520
        { make r3 point again to the actual store position }
 
521
        addi      r3,r3,4
 
522
.LFillCharDCBZLoop:
 
523
        dcbz      0,r3
 
524
        addi      r3,r3,32
 
525
        bdnz      .LFillCharDCBZLoop
 
526
        { if there was no rest, we're finished }
 
527
        beq       .LFillCharDone
 
528
        b         .LFillCharVerySmall
 
529
{$ENDIF USE_DCBZ}
 
530
.LFillCharNoZero:
 
531
{$ifdef FPC_ABI_AIX}
 
532
        stw       r5,-4(r1)
 
533
        stw       r5,-8(r1)
 
534
        lfd       f0,-8(r1)
 
535
{$else FPC_ABI_AIX}
 
536
        stw       r5,temp
 
537
        stw       r5,temp+4
 
538
        lfd       f0,temp
 
539
{$endif FPC_ABI_AIX}
 
540
        { make r3 point to address-8, so we're able to use fp double stores }
 
541
        { with update (it's already -4 now)                                 }
 
542
        subi      r3,r3,4
 
543
{$IFDEF USE_DCBZ}
 
544
        { load r10 with 8, so that dcbz uses the correct address }
 
545
        li        r10, 8
 
546
{$ENDIF}
 
547
.LFillChar32ByteLoop:
 
548
{$IFDEF USE_DCBZ}
 
549
        dcbz      r3,r10
 
550
{$ENDIF USE_DCBZ}
 
551
        stfdu     f0,8(r3)
 
552
        stfdu     f0,8(r3)
 
553
        stfdu     f0,8(r3)
 
554
        stfdu     f0,8(r3)
 
555
        bdnz      .LFillChar32ByteLoop
 
556
        { if there was no rest, we're finished }
 
557
        beq       .LFillCharDone
 
558
        { make r3 point again to the actual next byte that must be written }
 
559
        addi      r3,r3,8
 
560
        b         .LFillCharVerySmall
 
561
.LFillCharSmall:
 
562
        { when we arrive here, we're already 4 byte aligned }
 
563
        { get count div 4 to store dwords }
 
564
        srwi      r10,r4,2
 
565
        { get ready for use of update stores }
 
566
        subi      r3,r3,4
 
567
        mtctr     r10
 
568
        rlwinm.   r4,r4,0,31-2+1,31
 
569
.LFillCharSmallLoop:
 
570
        stwu      r5,4(r3)
 
571
        bdnz      .LFillCharSmallLoop
 
572
        { if nothing left, stop }
 
573
        beq       .LFillCharDone
 
574
        { get ready to store bytes }
 
575
        addi      r3,r3,4
 
576
.LFillCharVerySmall:
 
577
        mtctr     r4
 
578
        subi      r3,r3,1
 
579
.LFillCharVerySmallLoop:
 
580
        stbu      r5,1(r3)
 
581
        bdnz      .LFillCharVerySmallLoop
 
582
.LFillCharDone:
 
583
end;
 
584
{$endif FPC_SYSTEM_HAS_FILLCHAR}
 
585
 
 
586
 
 
587
{$ifndef FPC_SYSTEM_HAS_FILLDWORD}
 
588
{$define FPC_SYSTEM_HAS_FILLDWORD}
 
589
procedure filldword(var x;count : longint;value : dword);
 
590
assembler; nostackframe;
 
591
asm
 
592
{       registers:
 
593
        r3              x
 
594
        r4              count
 
595
        r5              value
 
596
}
 
597
                cmpwi   cr0,r4,0
 
598
                mtctr   r4
 
599
                subi    r3,r3,4
 
600
                ble    .LFillDWordEnd    //if count<=0 Then Exit
 
601
.LFillDWordLoop:
 
602
                stwu    r5,4(r3)
 
603
                bdnz    .LFillDWordLoop
 
604
.LFillDWordEnd:
 
605
end;
 
606
{$endif FPC_SYSTEM_HAS_FILLDWORD}
 
607
 
 
608
 
 
609
{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
 
610
{$define FPC_SYSTEM_HAS_INDEXBYTE}
 
611
function IndexByte(const buf;len:longint;b:byte):longint; assembler; nostackframe;
 
612
{ input: r3 = buf, r4 = len, r5 = b                   }
 
613
{ output: r3 = position of b in buf (-1 if not found) }
 
614
asm
 
615
                {  load the begin of the buffer in the data cache }
 
616
                dcbt    0,r3
 
617
                cmplwi  r4,0
 
618
                mtctr   r4
 
619
                subi    r10,r3,1
 
620
                mr      r0,r3
 
621
                { assume not found }
 
622
                li      r3,-1
 
623
                ble     .LIndexByteDone
 
624
.LIndexByteLoop:
 
625
                lbzu    r9,1(r10)
 
626
                cmplw   r9,r5
 
627
                bdnzf   cr0*4+eq,.LIndexByteLoop
 
628
                { r3 still contains -1 here }
 
629
                bne     .LIndexByteDone
 
630
                sub     r3,r10,r0
 
631
.LIndexByteDone:
 
632
end;
 
633
{$endif FPC_SYSTEM_HAS_INDEXBYTE}
 
634
 
 
635
 
 
636
{$ifndef FPC_SYSTEM_HAS_INDEXWORD}
 
637
{$define FPC_SYSTEM_HAS_INDEXWORD}
 
638
function IndexWord(const buf;len:longint;b:word):longint; assembler; nostackframe;
 
639
{ input: r3 = buf, r4 = len, r5 = b                   }
 
640
{ output: r3 = position of b in buf (-1 if not found) }
 
641
asm
 
642
                {  load the begin of the buffer in the data cache }
 
643
                dcbt    0,r3
 
644
                cmplwi  r4,0
 
645
                mtctr   r4
 
646
                subi    r10,r3,2
 
647
                mr      r0,r3
 
648
                { assume not found }
 
649
                li      r3,-1
 
650
                ble     .LIndexWordDone
 
651
.LIndexWordLoop:
 
652
                lhzu    r9,2(r10)
 
653
                cmplw   r9,r5
 
654
                bdnzf   cr0*4+eq,.LIndexWordLoop
 
655
                { r3 still contains -1 here }
 
656
                bne     .LIndexWordDone
 
657
                sub     r3,r10,r0
 
658
                srawi   r3,r3,1
 
659
.LIndexWordDone:
 
660
end;
 
661
{$endif FPC_SYSTEM_HAS_INDEXWORD}
 
662
 
 
663
 
 
664
{$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
 
665
{$define FPC_SYSTEM_HAS_INDEXDWORD}
 
666
function IndexDWord(const buf;len:longint;b:DWord):longint; assembler; nostackframe;
 
667
{ input: r3 = buf, r4 = len, r5 = b                   }
 
668
{ output: r3 = position of b in buf (-1 if not found) }
 
669
asm
 
670
                {  load the begin of the buffer in the data cache }
 
671
                dcbt    0,r3
 
672
                cmplwi  r4,0
 
673
                mtctr   r4
 
674
                subi    r10,r3,4
 
675
                mr      r0,r3
 
676
                { assume not found }
 
677
                li      r3,-1
 
678
                ble     .LIndexDWordDone
 
679
.LIndexDWordLoop:
 
680
                lwzu    r9,4(r10)
 
681
                cmplw   r9,r5
 
682
                bdnzf   cr0*4+eq, .LIndexDWordLoop
 
683
                { r3 still contains -1 here }
 
684
                bne     .LIndexDWordDone
 
685
                sub     r3,r10,r0
 
686
                srawi   r3,r3,2
 
687
.LIndexDWordDone:
 
688
end;
 
689
{$endif FPC_SYSTEM_HAS_INDEXDWORD}
 
690
 
 
691
 
 
692
{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
 
693
{$define FPC_SYSTEM_HAS_COMPAREBYTE}
 
694
function CompareByte(const buf1,buf2;len:longint):longint; assembler; nostackframe;
 
695
{ input: r3 = buf1, r4 = buf2, r5 = len                           }
 
696
{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
 
697
{ note: almost direct copy of strlcomp() from strings.inc         }
 
698
asm
 
699
        {  load the begin of the first buffer in the data cache }
 
700
        dcbt    0,r3
 
701
        { use r0 instead of r3 for buf1 since r3 contains result }
 
702
        cmplwi  r5,0
 
703
        mtctr   r5
 
704
        subi    r11,r3,1
 
705
        subi    r4,r4,1
 
706
        li      r3,0
 
707
        ble     .LCompByteDone
 
708
.LCompByteLoop:
 
709
        { load next chars }
 
710
        lbzu    r9,1(r11)
 
711
        lbzu    r10,1(r4)
 
712
        { calculate difference }
 
713
        sub.    r3,r9,r10
 
714
        { if chars not equal or at the end, we're ready }
 
715
        bdnzt   cr0*4+eq, .LCompByteLoop
 
716
.LCompByteDone:
 
717
end;
 
718
{$endif FPC_SYSTEM_HAS_COMPAREBYTE}
 
719
 
 
720
 
 
721
{$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
 
722
{$define FPC_SYSTEM_HAS_COMPAREWORD}
 
723
function CompareWord(const buf1,buf2;len:longint):longint; assembler; nostackframe;
 
724
{ input: r3 = buf1, r4 = buf2, r5 = len                           }
 
725
{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
 
726
{ note: almost direct copy of strlcomp() from strings.inc         }
 
727
asm
 
728
        {  load the begin of the first buffer in the data cache }
 
729
        dcbt    0,r3
 
730
        { use r0 instead of r3 for buf1 since r3 contains result }
 
731
        cmplwi  r5,0
 
732
        mtctr   r5
 
733
        subi    r11,r3,2
 
734
        subi    r4,r4,2
 
735
        li      r3,0
 
736
        ble     .LCompWordDone
 
737
.LCompWordLoop:
 
738
        { load next chars }
 
739
        lhzu    r9,2(r11)
 
740
        lhzu    r10,2(r4)
 
741
        { calculate difference }
 
742
        sub.    r3,r9,r10
 
743
        { if chars not equal or at the end, we're ready }
 
744
        bdnzt   cr0*4+eq, .LCompWordLoop
 
745
.LCompWordDone:
 
746
end;
 
747
{$endif FPC_SYSTEM_HAS_COMPAREWORD}
 
748
 
 
749
 
 
750
{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
 
751
{$define FPC_SYSTEM_HAS_COMPAREDWORD}
 
752
function CompareDWord(const buf1,buf2;len:longint):longint; assembler; nostackframe;
 
753
{ input: r3 = buf1, r4 = buf2, r5 = len                           }
 
754
{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
 
755
{ note: almost direct copy of strlcomp() from strings.inc         }
 
756
asm
 
757
        {  load the begin of the first buffer in the data cache }
 
758
        dcbt    0,r3
 
759
        { use r0 instead of r3 for buf1 since r3 contains result }
 
760
        cmplwi  r5,0
 
761
        mtctr   r5
 
762
        subi    r11,r3,4
 
763
        subi    r4,r4,4
 
764
        li      r3,0
 
765
        ble     .LCompDWordDone
 
766
.LCompDWordLoop:
 
767
        { load next chars }
 
768
        lwzu    r9,4(r11)
 
769
        lwzu    r10,4(r4)
 
770
        { calculate difference }
 
771
        sub.    r3,r9,r10
 
772
        { if chars not equal or at the end, we're ready }
 
773
        bdnzt   cr0*4+eq, .LCompDWordLoop
 
774
.LCompDWordDone:
 
775
end;
 
776
{$endif FPC_SYSTEM_HAS_COMPAREDWORD}
 
777
 
 
778
 
 
779
{$ifndef FPC_SYSTEM_HAS_INDEXCHAR0}
 
780
{$define FPC_SYSTEM_HAS_INDEXCHAR0}
 
781
function IndexChar0(const buf;len:longint;b:Char):longint; assembler; nostackframe;
 
782
{ input: r3 = buf, r4 = len, r5 = b                         }
 
783
{ output: r3 = position of found position (-1 if not found) }
 
784
asm
 
785
        {  load the begin of the buffer in the data cache }
 
786
        dcbt    0,r3
 
787
        { length = 0? }
 
788
        cmplwi  r4,0
 
789
        mtctr   r4
 
790
        subi    r9,r3,1
 
791
        subi    r0,r3,1
 
792
        { assume not found }
 
793
        li      r3,-1
 
794
        { if yes, do nothing }
 
795
        ble     .LIndexChar0Done
 
796
.LIndexChar0Loop:
 
797
        lbzu    r10,1(r9)
 
798
        cmplwi  cr1,r10,0
 
799
        cmplw   r10,r5
 
800
        beq     cr1,.LIndexChar0Done
 
801
        bdnzf   cr0*4+eq, .LIndexChar0Loop
 
802
        bne     .LIndexChar0Done
 
803
        sub     r3,r9,r0
 
804
.LIndexChar0Done:
 
805
end;
 
806
{$endif FPC_SYSTEM_HAS_INDEXCHAR0}
 
807
 
 
808
 
 
809
{****************************************************************************
 
810
                                 String
 
811
****************************************************************************}
 
812
 
 
813
{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
 
814
{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
 
815
function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
 
816
assembler; nostackframe;
 
817
{ input: r3: pointer to result, r4: len, r5: sstr }
 
818
asm
 
819
        { load length source }
 
820
        lbz     r10,0(r5)
 
821
        {  load the begin of the dest buffer in the data cache }
 
822
        dcbtst  0,r3
 
823
 
 
824
        { put min(length(sstr),len) in r4 }
 
825
        subfc   r7,r10,r4     { r0 := r4 - r10                               }
 
826
        subfe   r4,r4,r4      { if r3 >= r4 then r3' := 0 else r3' := -1     }
 
827
        and     r7,r7,r4      { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
 
828
        add     r4,r10,r7     { if r3 >= r4 then r3' := r10 else r3' := r3   }
 
829
 
 
830
        cmplwi  r4,0
 
831
        { put length in ctr }
 
832
        mtctr   r4
 
833
        stb     r4,0(r3)
 
834
        beq     .LShortStrCopyDone
 
835
.LShortStrCopyLoop:
 
836
        lbzu    r0,1(r5)
 
837
        stbu    r0,1(r3)
 
838
        bdnz    .LShortStrCopyLoop
 
839
.LShortStrCopyDone:
 
840
end;
 
841
 
 
842
 
 
843
procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
 
844
assembler; nostackframe;
 
845
{ input: r3: len, r4: sstr, r5: dstr }
 
846
asm
 
847
        { load length source }
 
848
        lbz     r10,0(r4)
 
849
        {  load the begin of the dest buffer in the data cache }
 
850
        dcbtst  0,r5
 
851
 
 
852
        { put min(length(sstr),len) in r3 }
 
853
        subc    r0,r3,r10    { r0 := r3 - r10                               }
 
854
        subfe   r3,r3,r3     { if r3 >= r4 then r3' := 0 else r3' := -1     }
 
855
        and     r3,r0,r3     { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
 
856
        add     r3,r3,r10    { if r3 >= r4 then r3' := r10 else r3' := r3   }
 
857
 
 
858
        cmplwi  r3,0
 
859
        { put length in ctr }
 
860
        mtctr   r3
 
861
        stb     r3,0(r5)
 
862
        beq     .LShortStrCopyDone2
 
863
.LShortStrCopyLoop2:
 
864
        lbzu    r0,1(r4)
 
865
        stbu    r0,1(r5)
 
866
        bdnz    .LShortStrCopyLoop2
 
867
.LShortStrCopyDone2:
 
868
end;
 
869
{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
 
870
 
 
871
{$ifndef STR_CONCAT_PROCS}
 
872
 
 
873
(*
 
874
{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
 
875
{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
 
876
 
 
877
function fpc_shortstr_concat(const s1, s2: shortstring): shortstring; compilerproc; [public, alias: 'FPC_SHORTSTR_CONCAT'];
 
878
{ expects that (r3) contains a pointer to the result r4 to s1, r5 to s2 }
 
879
assembler;
 
880
asm
 
881
      { load length s1 }
 
882
      lbz     r6, 0(r4)
 
883
      { load length s2 }
 
884
      lbz     r10, 0(r5)
 
885
      { length 0 for s1? }
 
886
      cmplwi  cr7,r6,0
 
887
      { length 255 for s1? }
 
888
      subfic. r7,r6,255
 
889
      { length 0 for s2? }
 
890
      cmplwi  cr1,r10,0
 
891
      { calculate min(length(s2),255-length(s1)) }
 
892
      subc    r8,r7,r10    { r8 := r7 - r10                                }
 
893
      cror    4*6+2,4*1+2,4*7+2
 
894
      subfe   r7,r7,r7     { if r7 >= r10 then r7' := 0 else r7' := -1     }
 
895
      mtctr   r6
 
896
      and     r7,r8,r7     { if r7 >= r10 then r7' := 0 else r7' := r7-r10 }
 
897
      add     r7,r7,r10    { if r7 >= r10 then r7' := r10 else r7' := r7   }
 
898
 
 
899
      mr      r9,r3
 
900
 
 
901
      { calculate length of final string }
 
902
      add     r8,r7,r6
 
903
      stb     r8,0(r3)
 
904
      beq     cr7, .Lcopys1loopDone
 
905
    .Lcopys1loop:
 
906
      lbzu    r0,1(r4)
 
907
      stbu    r0,1(r9)
 
908
      bdnz    .Lcopys1loop
 
909
    .Lcopys1loopDone:
 
910
      mtctr   r7
 
911
      beq     cr6, .LconcatDone
 
912
    .Lcopys2loop:
 
913
      lbzu    r0,1(r5)
 
914
      stbu    r0,1(r9)
 
915
      bdnz    .Lcopys2loop
 
916
end;
 
917
{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
 
918
*)
 
919
 
 
920
{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
 
921
{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
 
922
 
 
923
procedure fpc_shortstr_append_shortstr(var s1: shortstring; const s2: shortstring); compilerproc;
 
924
{ expects that results (r3) contains a pointer to the current string s1, r4 }
 
925
{ high(s1) and (r5) a pointer to the one that has to be concatenated        }
 
926
assembler; nostackframe;
 
927
asm
 
928
      { load length s1 }
 
929
      lbz     r6, 0(r3)
 
930
      { load length s2 }
 
931
      lbz     r10, 0(r5)
 
932
      { length 0? }
 
933
      cmplw   cr1,r6,r4
 
934
      cmplwi  r10,0
 
935
 
 
936
      { calculate min(length(s2),high(result)-length(result)) }
 
937
      sub     r9,r4,r6
 
938
      subc    r8,r9,r10    { r8 := r9 - r10                                }
 
939
      cror    4*7+2,4*0+2,4*1+2
 
940
      subfe   r9,r9,r9     { if r9 >= r10 then r9' := 0 else r9' := -1     }
 
941
      and     r9,r8,r9     { if r9 >= r10 then r9' := 0 else r9' := r9-r10 }
 
942
      add     r9,r9,r10    { if r9 >= r10 then r9' := r10 else r9' := r9   }
 
943
 
 
944
      { calculate new length }
 
945
      add     r10,r6,r9
 
946
      { load value to copy in ctr }
 
947
      mtctr   r9
 
948
      { store new length }
 
949
      stb     r10,0(r3)
 
950
      { go to last current character of result }
 
951
      add     r3,r6,r3
 
952
 
 
953
      { if nothing to do, exit }
 
954
      beq    cr7, .LShortStrAppendDone
 
955
      { and concatenate }
 
956
.LShortStrAppendLoop:
 
957
      lbzu    r10,1(r5)
 
958
      stbu    r10,1(r3)
 
959
      bdnz    .LShortStrAppendLoop
 
960
.LShortStrAppendDone:
 
961
end;
 
962
{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
 
963
 
 
964
{$endif STR_CONCAT_PROCS}
 
965
 
 
966
(*
 
967
{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
 
968
function fpc_shortstr_compare(const dstr,sstr:shortstring): longint; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
 
969
assembler;
 
970
asm
 
971
      { load length sstr }
 
972
      lbz     r9,0(r4)
 
973
      { load length dstr }
 
974
      lbz     r10,0(r3)
 
975
      { save their difference for later and      }
 
976
      { calculate min(length(sstr),length(dstr)) }
 
977
      subfc    r7,r10,r9    { r0 := r9 - r10                               }
 
978
      subfe    r9,r9,r9     { if r9 >= r10 then r9' := 0 else r9' := -1    }
 
979
      and      r7,r7,r9     { if r9 >= r10 then r9' := 0 else r9' := r9-r8 }
 
980
      add      r9,r10,r7    { if r9 >= r10 then r9' := r10 else r9' := r9  }
 
981
 
 
982
      { first compare dwords (length/4) }
 
983
      srwi.   r5,r9,2
 
984
      { keep length mod 4 for the ends }
 
985
      rlwinm  r9,r9,0,30,31
 
986
      { already check whether length mod 4 = 0 }
 
987
      cmplwi  cr1,r9,0
 
988
      { so we can load r3 with 0, in case the strings both have length 0 }
 
989
      mr      r8,r3
 
990
      li      r3, 0
 
991
      { length div 4 in ctr for loop }
 
992
      mtctr   r5
 
993
      { if length < 3, goto byte comparing }
 
994
      beq     LShortStrCompare1
 
995
      { setup for use of update forms of load/store with dwords }
 
996
      subi    r4,r4,3
 
997
      subi    r8,r8,3
 
998
LShortStrCompare4Loop:
 
999
      lwzu    r3,4(r4)
 
1000
      lwzu    r10,4(r8)
 
1001
      sub.    r3,r3,r10
 
1002
      bdnzt   cr0+eq,LShortStrCompare4Loop
 
1003
      { r3 contains result if we stopped because of "ne" flag }
 
1004
      bne     LShortStrCompareDone
 
1005
      { setup for use of update forms of load/store with bytes }
 
1006
      addi    r4,r4,3
 
1007
      addi    r8,r8,3
 
1008
LShortStrCompare1:
 
1009
      { if comparelen mod 4 = 0, skip this and return the difference in }
 
1010
      { lengths                                                         }
 
1011
      beq     cr1,LShortStrCompareLen
 
1012
      mtctr   r9
 
1013
LShortStrCompare1Loop:
 
1014
      lbzu    r3,1(r4)
 
1015
      lbzu    r10,1(r8)
 
1016
      sub.    r3,r3,r10
 
1017
      bdnzt   cr0+eq,LShortStrCompare1Loop
 
1018
      bne     LShortStrCompareDone
 
1019
LShortStrCompareLen:
 
1020
      { also return result in flags, maybe we can use this in the CG }
 
1021
      mr.     r3,r3
 
1022
LShortStrCompareDone:
 
1023
end;
 
1024
*)
 
1025
 
 
1026
 
 
1027
{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
 
1028
{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
 
1029
function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
 
1030
assembler; nostackframe;
 
1031
{$include strpas.inc}
 
1032
{$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
 
1033
 
 
1034
 
 
1035
{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
 
1036
{$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
 
1037
function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc; nostackframe;
 
1038
{$include strlen.inc}
 
1039
{$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
 
1040
 
 
1041
 
 
1042
{$define FPC_SYSTEM_HAS_GET_FRAME}
 
1043
function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
 
1044
asm
 
1045
  { all abi's I know use r1 as stack pointer }
 
1046
  mr r3, r1
 
1047
end;
 
1048
 
 
1049
{NOTE: On MACOS, 68000 code might call powerpc code, through the MixedMode manager,
 
1050
(even in the OS in system 9). The pointer to the switching stack frame is then
 
1051
indicated by the first bit set to 1. This is checked below.}
 
1052
 
 
1053
{Both routines below assumes that framebp is a valid framepointer or nil.}
 
1054
 
 
1055
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
 
1056
function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
 
1057
asm
 
1058
   cmplwi  r3,0
 
1059
   beq     .Lcaller_addr_invalid
 
1060
   lwz r3,0(r3)
 
1061
   cmplwi  r3,0
 
1062
   beq     .Lcaller_addr_invalid
 
1063
{$ifdef MACOS}
 
1064
   rlwinm  r4,r3,0,31,31
 
1065
   cmpwi   r4,0
 
1066
   bne  cr0,.Lcaller_addr_invalid
 
1067
{$endif MACOS}
 
1068
{$ifdef FPC_ABI_AIX}
 
1069
   lwz r3,8(r3)
 
1070
{$else FPC_ABI_AIX}
 
1071
   lwz r3,4(r3)
 
1072
{$endif FPC_ABI_AIX}
 
1073
   blr
 
1074
.Lcaller_addr_invalid:
 
1075
   li r3,0
 
1076
end;
 
1077
 
 
1078
 
 
1079
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
 
1080
function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
 
1081
asm
 
1082
    cmplwi  r3,0
 
1083
    beq     .Lcaller_frame_invalid
 
1084
    lwz  r3,0(r3)
 
1085
{$ifdef MACOS}
 
1086
    rlwinm      r4,r3,0,31,31
 
1087
    cmpwi       r4,0
 
1088
    bne cr0,.Lcaller_frame_invalid
 
1089
{$endif MACOS}
 
1090
    blr
 
1091
.Lcaller_frame_invalid:
 
1092
    li r3,0
 
1093
end;
 
1094
 
 
1095
{$define FPC_SYSTEM_HAS_ABS_LONGINT}
 
1096
function abs(l:longint):longint; assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
 
1097
asm
 
1098
        srawi   r0,r3,31
 
1099
        add     r3,r0,r3
 
1100
        xor     r3,r3,r0
 
1101
end;
 
1102
 
 
1103
 
 
1104
{****************************************************************************
 
1105
                                 Math
 
1106
****************************************************************************}
 
1107
 
 
1108
{$define FPC_SYSTEM_HAS_ODD_LONGINT}
 
1109
function odd(l:longint):boolean;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
 
1110
asm
 
1111
        rlwinm  r3,r3,0,31,31
 
1112
end;
 
1113
 
 
1114
 
 
1115
{$define FPC_SYSTEM_HAS_SQR_LONGINT}
 
1116
function sqr(l:longint):longint;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
 
1117
asm
 
1118
        mullw   r3,r3,r3
 
1119
end;
 
1120
 
 
1121
 
 
1122
{$define FPC_SYSTEM_HAS_SPTR}
 
1123
Function Sptr : Pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
 
1124
asm
 
1125
        mr    r3,r1
 
1126
end;
 
1127
 
 
1128
 
 
1129
{****************************************************************************
 
1130
                                 Str()
 
1131
****************************************************************************}
 
1132
 
 
1133
{ int_str: generic implementation is used for now }
 
1134
 
 
1135
 
 
1136
{****************************************************************************
 
1137
                             Multithreading
 
1138
****************************************************************************}
 
1139
 
 
1140
{ do a thread save inc/dec }
 
1141
 
 
1142
{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
 
1143
function declocked(var l : longint) : boolean;assembler;nostackframe;
 
1144
{ input:  address of l in r3                                      }
 
1145
{ output: boolean indicating whether l is zero after decrementing }
 
1146
asm
 
1147
.LDecLockedLoop:
 
1148
    lwarx   r10,0,r3
 
1149
    subi    r10,r10,1
 
1150
    stwcx.  r10,0,r3
 
1151
    bne-    .LDecLockedLoop
 
1152
    cntlzw  r3,r10
 
1153
    srwi    r3,r3,5
 
1154
end;
 
1155
 
 
1156
{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
 
1157
procedure inclocked(var l : longint);assembler;nostackframe;
 
1158
asm
 
1159
.LIncLockedLoop:
 
1160
    lwarx   r10,0,r3
 
1161
    addi    r10,r10,1
 
1162
    stwcx.  r10,0,r3
 
1163
    bne-    .LIncLockedLoop
 
1164
end;
 
1165
 
 
1166
 
 
1167
function InterLockedDecrement (var Target: longint) : longint; assembler; nostackframe;
 
1168
{ input:  address of target in r3 }
 
1169
{ output: target-1 in r3          }
 
1170
{ side-effect: target := target-1 }
 
1171
asm
 
1172
.LInterLockedDecLoop:
 
1173
        lwarx   r10,0,r3
 
1174
        subi    r10,r10,1
 
1175
        stwcx.  r10,0,r3
 
1176
        bne     .LInterLockedDecLoop
 
1177
        mr      r3,r10
 
1178
end;
 
1179
 
 
1180
 
 
1181
function InterLockedIncrement (var Target: longint) : longint; assembler; nostackframe;
 
1182
{ input:  address of target in r3 }
 
1183
{ output: target+1 in r3          }
 
1184
{ side-effect: target := target+1 }
 
1185
asm
 
1186
.LInterLockedIncLoop:
 
1187
        lwarx   r10,0,r3
 
1188
        addi    r10,r10,1
 
1189
        stwcx.  r10,0,r3
 
1190
        bne     .LInterLockedIncLoop
 
1191
        mr      r3,r10
 
1192
end;
 
1193
 
 
1194
 
 
1195
function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler; nostackframe;
 
1196
{ input:  address of target in r3, source in r4 }
 
1197
{ output: target in r3                          }
 
1198
{ side-effect: target := source                 }
 
1199
asm
 
1200
.LInterLockedXchgLoop:
 
1201
        lwarx   r10,0,r3
 
1202
        stwcx.  r4,0,r3
 
1203
        bne     .LInterLockedXchgLoop
 
1204
        mr      r3,r10
 
1205
end;
 
1206
 
 
1207
 
 
1208
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler; nostackframe;
 
1209
asm
 
1210
.LInterLockedXchgAddLoop:
 
1211
        lwarx   r10,0,r3
 
1212
        add     r10,r10,r4
 
1213
        stwcx.  r10,0,r3
 
1214
        bne     .LInterLockedXchgAddLoop
 
1215
        sub     r3,r10,r4
 
1216
end;
 
1217
 
 
1218
 
 
1219
function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; assembler; nostackframe;
 
1220
{ input:  address of target in r3, newvalue in r4, comparand in r5 }
 
1221
{ output: value stored in target before entry of the function      }
 
1222
{ side-effect: NewValue stored in target if (target = comparand)   }
 
1223
asm
 
1224
.LInterlockedCompareExchangeLoop:
 
1225
  lwarx  r10,0,r3
 
1226
  sub    r9,r10,r5
 
1227
  addic  r9,r9,-1
 
1228
  subfe  r9,r9,r9
 
1229
  and    r8,r4,r9
 
1230
  andc   r7,r5,r9
 
1231
  or     r6,r7,r8
 
1232
  stwcx. r6,0,r3
 
1233
  bne .LInterlockedCompareExchangeLoop
 
1234
  mr     r3, r6
 
1235
end;
 
1236
 
 
1237
{$IFDEF MORPHOS}
 
1238
{ this is only required for MorphOS }
 
1239
{$define FPC_SYSTEM_HAS_SYSRESETFPU}
 
1240
procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
 
1241
  var tmp: array[0..1] of dword;
 
1242
begin
 
1243
  asm
 
1244
     { setting fpu to round to nearest mode }
 
1245
     li r3,0
 
1246
     stw r3,8(r1)
 
1247
     stw r3,12(r1)
 
1248
     lfd f1,8(r1)
 
1249
     mtfsf 7,f1
 
1250
  end;
 
1251
  { powerpc might use softfloat code }
 
1252
  softfloat_exception_flags:=0;
 
1253
  softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
 
1254
end;
 
1255
{$ENDIF}