source: trunk/Packages/Graphics32/GR32_LowLevel.pas

Last change on this file was 2, checked in by chronos, 6 years ago
File size: 34.4 KB
Line 
1unit GR32_LowLevel;
2
3(* ***** BEGIN LICENSE BLOCK *****
4 * Version: MPL 1.1 or LGPL 2.1 with linking exception
5 *
6 * The contents of this file are subject to the Mozilla Public License Version
7 * 1.1 (the "License"); you may not use this file except in compliance with
8 * the License. You may obtain a copy of the License at
9 * http://www.mozilla.org/MPL/
10 *
11 * Software distributed under the License is distributed on an "AS IS" basis,
12 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13 * for the specific language governing rights and limitations under the
14 * License.
15 *
16 * Alternatively, the contents of this file may be used under the terms of the
17 * Free Pascal modified version of the GNU Lesser General Public License
18 * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
19 * of this license are applicable instead of those above.
20 * Please see the file LICENSE.txt for additional information concerning this
21 * license.
22 *
23 * The Original Code is Graphics32
24 *
25 * The Initial Developer of the Original Code is
26 * Alex A. Denisov
27 *
28 * Portions created by the Initial Developer are Copyright (C) 2000-2009
29 * the Initial Developer. All Rights Reserved.
30 *
31 * Contributor(s):
32 * Michael Hansen <dyster_tid@hotmail.com>
33 * Andre Beckedorf <Andre@metaException.de>
34 * Mattias Andersson <mattias@centaurix.com>
35 *
36 * ***** END LICENSE BLOCK ***** *)
37
38interface
39
40{$I GR32.inc}
41
42{$IFDEF PUREPASCAL}
43 {$DEFINE USENATIVECODE}
44 {$DEFINE USEMOVE}
45{$ENDIF}
46{$IFDEF USEINLINING}
47 {$DEFINE USENATIVECODE}
48{$ENDIF}
49
50uses
51 Graphics, GR32, GR32_Math;
52
53{ Clamp function restricts value to [0..255] range }
54function Clamp(const Value: Integer): Integer; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
55
56{ An analogue of FillChar for 32 bit values }
57var
58 FillLongword: procedure(var X; Count: Cardinal; Value: Longword);
59
60procedure FillWord(var X; Count: Cardinal; Value: Longword);
61
62{ An analogue of Move for 32 bit values }
63{$IFDEF USEMOVE}
64procedure MoveLongword(const Source; var Dest; Count: Integer); {$IFDEF USEINLINING} inline; {$ENDIF}
65{$ELSE}
66procedure MoveLongword(const Source; var Dest; Count: Integer);
67{$ENDIF}
68procedure MoveWord(const Source; var Dest; Count: Integer);
69
70{$IFDEF USESTACKALLOC}
71{ Allocates a 'small' block of memory on the stack }
72function StackAlloc(Size: Integer): Pointer; register;
73
74{ Pops memory allocated by StackAlloc }
75procedure StackFree(P: Pointer); register;
76{$ENDIF}
77
78{ Exchange two 32-bit values }
79procedure Swap(var A, B: Pointer); overload;{$IFDEF USEINLINING} inline; {$ENDIF}
80procedure Swap(var A, B: Integer); overload;{$IFDEF USEINLINING} inline; {$ENDIF}
81procedure Swap(var A, B: TFixed); overload;{$IFDEF USEINLINING} inline; {$ENDIF}
82procedure Swap(var A, B: TColor32); overload;{$IFDEF USEINLINING} inline; {$ENDIF}
83procedure Swap32(var A, B); overload;{$IFDEF USEINLINING} inline; {$ENDIF}
84
85{ Exchange A <-> B only if B < A }
86procedure TestSwap(var A, B: Integer); overload;{$IFDEF USEINLINING} inline; {$ENDIF}
87procedure TestSwap(var A, B: TFixed); overload;{$IFDEF USEINLINING} inline; {$ENDIF}
88
89{ Exchange A <-> B only if B < A then restrict both to [0..Size-1] range }
90{ returns true if resulting range has common points with [0..Size-1] range }
91function TestClip(var A, B: Integer; const Size: Integer): Boolean; overload;
92function TestClip(var A, B: Integer; const Start, Stop: Integer): Boolean; overload;
93
94{ Returns value constrained to [Lo..Hi] range}
95function Constrain(const Value, Lo, Hi: Integer): Integer; {$IFDEF USEINLINING} inline; {$ENDIF} overload;
96function Constrain(const Value, Lo, Hi: Single): Single; {$IFDEF USEINLINING} inline; {$ENDIF} overload;
97
98{ Returns value constrained to [min(Constrain1, Constrain2)..max(Constrain1, Constrain2] range}
99function SwapConstrain(const Value: Integer; Constrain1, Constrain2: Integer): Integer;
100
101{ Returns min./max. value of A, B and C }
102function Min(const A, B, C: Integer): Integer; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
103function Max(const A, B, C: Integer): Integer; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
104
105{ Clamp integer value to [0..Max] range }
106function Clamp(Value, Max: Integer): Integer; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
107{ Same but [Min..Max] range }
108function Clamp(Value, Min, Max: Integer): Integer; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
109
110{ Wrap integer value to [0..Max] range }
111function Wrap(Value, Max: Integer): Integer; overload;
112{ Same but [Min..Max] range }
113function Wrap(Value, Min, Max: Integer): Integer; overload;
114
115{ Wrap single value to [0..Max] range }
116function Wrap(Value, Max: Single): Single; overload; {$IFDEF USEINLINING} inline; {$ENDIF} overload;
117
118{ Fast Wrap alternatives for cases where range + 1 is a power of two }
119function WrapPow2(Value, Max: Integer): Integer; {$IFDEF USEINLINING} inline; {$ENDIF} overload;
120function WrapPow2(Value, Min, Max: Integer): Integer; {$IFDEF USEINLINING} inline; {$ENDIF} overload;
121
122{ Mirror integer value in [0..Max] range }
123function Mirror(Value, Max: Integer): Integer; overload;
124{ Same but [Min..Max] range }
125function Mirror(Value, Min, Max: Integer): Integer; overload;
126
127{ Fast Mirror alternatives for cases where range + 1 is a power of two }
128function MirrorPow2(Value, Max: Integer): Integer; {$IFDEF USEINLINING} inline; {$ENDIF} overload;
129function MirrorPow2(Value, Min, Max: Integer): Integer; {$IFDEF USEINLINING} inline; {$ENDIF} overload;
130
131{ Functions to determine appropiate wrap procs (normal or power of 2 optimized)}
132function GetOptimalWrap(Max: Integer): TWrapProc; {$IFDEF USEINLINING} inline; {$ENDIF} overload;
133function GetOptimalWrap(Min, Max: Integer): TWrapProcEx; {$IFDEF USEINLINING} inline; {$ENDIF} overload;
134function GetOptimalMirror(Max: Integer): TWrapProc; {$IFDEF USEINLINING} inline; {$ENDIF} overload;
135function GetOptimalMirror(Min, Max: Integer): TWrapProcEx; {$IFDEF USEINLINING} inline; {$ENDIF} overload;
136
137{ Functions to retrieve correct WrapProc given WrapMode (and range) }
138function GetWrapProc(WrapMode: TWrapMode): TWrapProc; overload;
139function GetWrapProc(WrapMode: TWrapMode; Max: Integer): TWrapProc; overload;
140function GetWrapProcEx(WrapMode: TWrapMode): TWrapProcEx; overload;
141function GetWrapProcEx(WrapMode: TWrapMode; Min, Max: Integer): TWrapProcEx; overload;
142
143
144const
145 WRAP_PROCS: array[TWrapMode] of TWrapProc = (Clamp, Wrap, Mirror);
146 WRAP_PROCS_EX: array[TWrapMode] of TWrapProcEx = (Clamp, Wrap, Mirror);
147
148{ Fast Value div 255, correct result with Value in [0..66298] range }
149function Div255(Value: Cardinal): Cardinal; {$IFDEF USEINLINING} inline; {$ENDIF}
150
151{ shift right with sign conservation }
152function SAR_3(Value: Integer): Integer;
153function SAR_4(Value: Integer): Integer;
154function SAR_6(Value: Integer): Integer;
155function SAR_8(Value: Integer): Integer;
156function SAR_9(Value: Integer): Integer;
157function SAR_11(Value: Integer): Integer;
158function SAR_12(Value: Integer): Integer;
159function SAR_13(Value: Integer): Integer;
160function SAR_14(Value: Integer): Integer;
161function SAR_15(Value: Integer): Integer;
162function SAR_16(Value: Integer): Integer;
163
164{ ColorSwap exchanges ARGB <-> ABGR and fills A with $FF }
165function ColorSwap(WinColor: TColor): TColor32;
166
167implementation
168
169uses
170{$IFDEF FPC}
171 SysUtils,
172{$ENDIF}
173 GR32_System, GR32_Bindings;
174
175{$R-}{$Q-} // switch off overflow and range checking
176
177function Clamp(const Value: Integer): Integer;
178{$IFDEF USENATIVECODE}
179begin
180 if Value > 255 then
181 Result := 255
182 else
183 if Value < 0 then
184 Result := 0
185 else
186 Result := Value;
187{$ELSE}
188{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
189asm
190{$IFDEF TARGET_x64}
191 // in x64 calling convention parameters are passed in ECX, EDX, R8 & R9
192 MOV EAX,ECX
193{$ENDIF}
194 TEST EAX,$FFFFFF00
195 JNZ @1
196 RET
197@1: JS @2
198 MOV EAX,$FF
199 RET
200@2: XOR EAX,EAX
201{$ENDIF}
202end;
203
204procedure FillLongword_Pas(var X; Count: Cardinal; Value: Longword);
205var
206 I: Integer;
207 P: PIntegerArray;
208begin
209 P := PIntegerArray(@X);
210 for I := Count - 1 downto 0 do
211 P[I] := Integer(Value);
212end;
213
214{$IFNDEF PUREPASCAL}
215procedure FillLongword_ASM(var X; Count: Cardinal; Value: Longword); {$IFDEF FPC} assembler; nostackframe; {$ENDIF}
216asm
217{$IFDEF TARGET_x86}
218 // EAX = X; EDX = Count; ECX = Value
219 PUSH EDI
220
221 MOV EDI,EAX // Point EDI to destination
222 MOV EAX,ECX
223 MOV ECX,EDX
224
225 REP STOSD // Fill count dwords
226@Exit:
227 POP EDI
228{$ENDIF}
229{$IFDEF TARGET_x64}
230 // ECX = X; EDX = Count; R8 = Value
231 PUSH RDI
232
233 MOV RDI,RCX // Point EDI to destination
234 MOV RAX,R8 // copy value from R8 to RAX (EAX)
235 MOV ECX,EDX // copy count to ECX
236 TEST ECX,ECX
237 JS @Exit
238
239 REP STOSD // Fill count dwords
240@Exit:
241 POP RDI
242{$ENDIF}
243end;
244
245procedure FillLongword_MMX(var X; Count: Cardinal; Value: Longword); {$IFDEF FPC} assembler; nostackframe; {$ENDIF}
246asm
247{$IFDEF TARGET_x86}
248 // EAX = X; EDX = Count; ECX = Value
249 TEST EDX, EDX // if Count = 0 then
250 JZ @Exit // Exit
251
252 PUSH EDI
253 MOV EDI, EAX
254 MOV EAX, EDX
255
256 SHR EAX, 1
257 SHL EAX, 1
258 SUB EAX, EDX
259 JE @QLoopIni
260
261 MOV [EDI], ECX
262 ADD EDI, 4
263 DEC EDX
264 JZ @ExitPOP
265 @QLoopIni:
266 MOVD MM1, ECX
267 PUNPCKLDQ MM1, MM1
268 SHR EDX, 1
269 @QLoop:
270 MOVQ [EDI], MM1
271 ADD EDI, 8
272 DEC EDX
273 JNZ @QLoop
274 EMMS
275 @ExitPOP:
276 POP EDI
277 @Exit:
278{$ENDIF}
279{$IFDEF TARGET_x64}
280 // RCX = X; RDX = Count; R8 = Value
281 TEST RDX, RDX // if Count = 0 then
282 JZ @Exit // Exit
283 MOV RAX, RCX // RAX = X
284
285 PUSH RDI // store RDI on stack
286 MOV R9, RDX // R9 = Count
287 MOV RDI, RDX // RDI = Count
288
289 SHR RDI, 1 // RDI = RDI SHR 1
290 SHL RDI, 1 // RDI = RDI SHL 1
291 SUB R9, RDI // check if extra fill is necessary
292 JE @QLoopIni
293
294 MOV [RAX], R8D // eventually perform extra fill
295 ADD RAX, 4 // Inc(X, 4)
296 DEC RDX // Dec(Count)
297 JZ @ExitPOP // if (Count = 0) then Exit
298@QLoopIni:
299 MOVD MM0, R8D // MM0 = R8D
300 PUNPCKLDQ MM0, MM0 // unpack MM0 register
301 SHR RDX, 1 // RDX = RDX div 2
302@QLoop:
303 MOVQ QWORD PTR [RAX], MM0 // perform fill
304 ADD RAX, 8 // Inc(X, 8)
305 DEC RDX // Dec(X);
306 JNZ @QLoop
307 EMMS
308@ExitPOP:
309 POP RDI
310@Exit:
311{$ENDIF}
312end;
313
314procedure FillLongword_SSE2(var X; Count: Integer; Value: Longword); {$IFDEF FPC} assembler; nostackframe; {$ENDIF}
315asm
316{$IFDEF TARGET_x86}
317 // EAX = X; EDX = Count; ECX = Value
318
319 TEST EDX, EDX // if Count = 0 then
320 JZ @Exit // Exit
321
322 PUSH EDI // push EDI on stack
323 MOV EDI, EAX // Point EDI to destination
324
325 CMP EDX, 32
326 JL @SmallLoop
327
328 AND EAX, 3 // get aligned count
329 TEST EAX, EAX // check if X is not dividable by 4
330 JNZ @SmallLoop // otherwise perform slow small loop
331
332 MOV EAX, EDI
333 SHR EAX, 2 // bytes to count
334 AND EAX, 3 // get aligned count
335 ADD EAX,-4
336 NEG EAX // get count to advance
337 JZ @SetupMain
338 SUB EDX, EAX // subtract aligning start from total count
339
340@AligningLoop:
341 MOV [EDI], ECX
342 ADD EDI, 4
343 DEC EAX
344 JNZ @AligningLoop
345
346@SetupMain:
347 MOV EAX, EDX // EAX = remaining count
348 SHR EAX, 2
349 SHL EAX, 2
350 SUB EDX, EAX // EDX = remaining count
351 SHR EAX, 2
352
353 MOVD XMM0, ECX
354 PUNPCKLDQ XMM0, XMM0
355 PUNPCKLDQ XMM0, XMM0
356@SSE2Loop:
357 MOVDQA [EDI], XMM0
358 ADD EDI, 16
359 DEC EAX
360 JNZ @SSE2Loop
361
362@SmallLoop:
363 MOV EAX,ECX
364 MOV ECX,EDX
365
366 REP STOSD // Fill count dwords
367
368@ExitPOP:
369 POP EDI
370
371@Exit:
372{$ENDIF}
373
374{$IFDEF TARGET_x64}
375 // RCX = X; RDX = Count; R8 = Value
376
377 TEST RDX, RDX // if Count = 0 then
378 JZ @Exit // Exit
379
380 MOV R9, RCX // Point R9 to destination
381
382 CMP RDX, 32
383 JL @SmallLoop
384
385 AND RCX, 3 // get aligned count
386 TEST RCX, RCX // check if X is not dividable by 4
387 JNZ @SmallLoop // otherwise perform slow small loop
388
389 MOV RCX, R9
390 SHR RCX, 2 // bytes to count
391 AND RCX, 3 // get aligned count
392 ADD RCX,-4
393 NEG RCX // get count to advance
394 JZ @SetupMain
395 SUB RDX, RCX // subtract aligning start from total count
396
397@AligningLoop:
398 MOV [R9], R8D
399 ADD R9, 4
400 DEC RCX
401 JNZ @AligningLoop
402
403@SetupMain:
404 MOV RCX, RDX // RCX = remaining count
405 SHR RCX, 2
406 SHL RCX, 2
407 SUB RDX, RCX // RDX = remaining count
408 SHR RCX, 2
409
410 MOVD XMM0, R8D
411 PUNPCKLDQ XMM0, XMM0
412 PUNPCKLDQ XMM0, XMM0
413@SSE2Loop:
414 MOVDQA [R9], XMM0
415 ADD R9, 16
416 DEC RCX
417 JNZ @SSE2Loop
418
419 TEST RDX, RDX
420 JZ @Exit
421@SmallLoop:
422 MOV [R9], R8D
423 ADD R9, 4
424 DEC RDX
425 JNZ @SmallLoop
426@Exit:
427{$ENDIF}
428end;
429{$ENDIF}
430
431procedure FillWord(var X; Count: Cardinal; Value: LongWord);
432{$IFDEF USENATIVECODE}
433var
434 I: Integer;
435 P: PWordArray;
436begin
437 P := PWordArray(@X);
438 for I := Count - 1 downto 0 do
439 P[I] := Value;
440{$ELSE}
441{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
442asm
443{$IFDEF TARGET_x86}
444 // EAX = X; EDX = Count; ECX = Value
445 PUSH EDI
446
447 MOV EDI,EAX // Point EDI to destination
448 MOV EAX,ECX
449 MOV ECX,EDX
450 TEST ECX,ECX
451 JZ @exit
452
453 REP STOSW // Fill count words
454@exit:
455 POP EDI
456{$ENDIF}
457
458{$IFDEF TARGET_x64}
459 // ECX = X; EDX = Count; R8D = Value
460 PUSH RDI
461
462 MOV RDI,RCX // Point EDI to destination
463 MOV EAX,R8D
464 MOV ECX,EDX
465 TEST ECX,ECX
466 JZ @exit
467
468 REP STOSW // Fill count words
469@exit:
470 POP RDI
471{$ENDIF}
472{$ENDIF}
473end;
474
475procedure MoveLongword(const Source; var Dest; Count: Integer);
476{$IFDEF USEMOVE}
477begin
478 Move(Source, Dest, Count shl 2);
479{$ELSE}
480{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
481asm
482{$IFDEF TARGET_x86}
483 // EAX = Source; EDX = Dest; ECX = Count
484 PUSH ESI
485 PUSH EDI
486
487 MOV ESI,EAX
488 MOV EDI,EDX
489 CMP EDI,ESI
490 JE @exit
491
492 REP MOVSD
493@exit:
494 POP EDI
495 POP ESI
496{$ENDIF}
497
498{$IFDEF TARGET_x64}
499 // RCX = Source; RDX = Dest; R8 = Count
500 PUSH RSI
501 PUSH RDI
502
503 MOV RSI,RCX
504 MOV RDI,RDX
505 MOV RCX,R8
506 CMP RDI,RSI
507 JE @exit
508
509 REP MOVSD
510@exit:
511 POP RDI
512 POP RSI
513{$ENDIF}
514{$ENDIF}
515end;
516
517procedure MoveWord(const Source; var Dest; Count: Integer);
518{$IFDEF USEMOVE}
519begin
520 Move(Source, Dest, Count shl 1);
521{$ELSE}
522{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
523asm
524{$IFDEF TARGET_x86}
525 // EAX = X; EDX = Count; ECX = Value
526 PUSH ESI
527 PUSH EDI
528
529 MOV ESI,EAX
530 MOV EDI,EDX
531 MOV EAX,ECX
532 CMP EDI,ESI
533 JE @exit
534
535 REP MOVSW
536@exit:
537 POP EDI
538 POP ESI
539{$ENDIF}
540
541{$IFDEF TARGET_x64}
542 // ECX = X; EDX = Count; R8 = Value
543 PUSH RSI
544 PUSH RDI
545
546 MOV RSI,RCX
547 MOV RDI,RDX
548 MOV RAX,R8
549 CMP RDI,RSI
550 JE @exit
551
552 REP MOVSW
553@exit:
554 POP RDI
555 POP RSI
556{$ENDIF}
557{$ENDIF}
558end;
559
560procedure Swap(var A, B: Pointer);
561var
562 T: Pointer;
563begin
564 T := A;
565 A := B;
566 B := T;
567end;
568
569procedure Swap(var A, B: Integer);
570var
571 T: Integer;
572begin
573 T := A;
574 A := B;
575 B := T;
576end;
577
578procedure Swap(var A, B: TFixed);
579var
580 T: TFixed;
581begin
582 T := A;
583 A := B;
584 B := T;
585end;
586
587procedure Swap(var A, B: TColor32);
588var
589 T: TColor32;
590begin
591 T := A;
592 A := B;
593 B := T;
594end;
595
596procedure Swap32(var A, B);
597var
598 T: Integer;
599begin
600 T := Integer(A);
601 Integer(A) := Integer(B);
602 Integer(B) := T;
603end;
604
605procedure TestSwap(var A, B: Integer);
606var
607 T: Integer;
608begin
609 if B < A then
610 begin
611 T := A;
612 A := B;
613 B := T;
614 end;
615end;
616
617procedure TestSwap(var A, B: TFixed);
618var
619 T: TFixed;
620begin
621 if B < A then
622 begin
623 T := A;
624 A := B;
625 B := T;
626 end;
627end;
628
629function TestClip(var A, B: Integer; const Size: Integer): Boolean;
630begin
631 TestSwap(A, B); // now A = min(A,B) and B = max(A, B)
632 if A < 0 then
633 A := 0;
634 if B >= Size then
635 B := Size - 1;
636 Result := B >= A;
637end;
638
639function TestClip(var A, B: Integer; const Start, Stop: Integer): Boolean;
640begin
641 TestSwap(A, B); // now A = min(A,B) and B = max(A, B)
642 if A < Start then
643 A := Start;
644 if B >= Stop then
645 B := Stop - 1;
646 Result := B >= A;
647end;
648
649function Constrain(const Value, Lo, Hi: Integer): Integer;
650{$IFDEF USENATIVECODE}
651begin
652 if Value < Lo then
653 Result := Lo
654 else if Value > Hi then
655 Result := Hi
656 else
657 Result := Value;
658{$ELSE}
659{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
660asm
661{$IFDEF TARGET_x64}
662 MOV EAX,ECX
663 MOV ECX,R8D
664{$ENDIF}
665 CMP EDX,EAX
666 CMOVG EAX,EDX
667 CMP ECX,EAX
668 CMOVL EAX,ECX
669{$ENDIF}
670end;
671
672function Constrain(const Value, Lo, Hi: Single): Single; overload;
673begin
674 if Value < Lo then Result := Lo
675 else if Value > Hi then Result := Hi
676 else Result := Value;
677end;
678
679function SwapConstrain(const Value: Integer; Constrain1, Constrain2: Integer): Integer;
680begin
681 TestSwap(Constrain1, Constrain2);
682 if Value < Constrain1 then Result := Constrain1
683 else if Value > Constrain2 then Result := Constrain2
684 else Result := Value;
685end;
686
687function Max(const A, B, C: Integer): Integer;
688{$IFDEF USENATIVECODE}
689begin
690 if A > B then
691 Result := A
692 else
693 Result := B;
694
695 if C > Result then
696 Result := C;
697{$ELSE}
698{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
699asm
700{$IFDEF TARGET_x64}
701 MOV RAX,RCX
702 MOV RCX,R8
703{$ENDIF}
704 CMP EDX,EAX
705 CMOVG EAX,EDX
706 CMP ECX,EAX
707 CMOVG EAX,ECX
708{$ENDIF}
709end;
710
711function Min(const A, B, C: Integer): Integer;
712{$IFDEF USENATIVECODE}
713begin
714 if A < B then
715 Result := A
716 else
717 Result := B;
718
719 if C < Result then
720 Result := C;
721{$ELSE}
722{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
723asm
724{$IFDEF TARGET_x64}
725 MOV RAX,RCX
726 MOV RCX,R8
727{$ENDIF}
728 CMP EDX,EAX
729 CMOVL EAX,EDX
730 CMP ECX,EAX
731 CMOVL EAX,ECX
732{$ENDIF}
733end;
734
735function Clamp(Value, Max: Integer): Integer;
736{$IFDEF USENATIVECODE}
737begin
738 if Value > Max then
739 Result := Max
740 else if Value < 0 then
741 Result := 0
742 else
743 Result := Value;
744{$ELSE}
745{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
746asm
747{$IFDEF TARGET_x64}
748 MOV EAX,ECX
749 MOV ECX,R8D
750{$ENDIF}
751 CMP EAX,EDX
752 JG @Above
753 TEST EAX,EAX
754 JL @Below
755 RET
756@Above:
757 MOV EAX,EDX
758 RET
759@Below:
760 MOV EAX,0
761 RET
762{$ENDIF}
763end;
764
765function Clamp(Value, Min, Max: Integer): Integer;
766{$IFDEF USENATIVECODE}
767begin
768 if Value > Max then
769 Result := Max
770 else if Value < Min then
771 Result := Min
772 else
773 Result := Value;
774{$ELSE}
775{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
776asm
777{$IFDEF TARGET_x64}
778 MOV EAX,ECX
779 MOV ECX,R8D
780{$ENDIF}
781 CMP EDX,EAX
782 CMOVG EAX,EDX
783 CMP ECX,EAX
784 CMOVL EAX,ECX
785{$ENDIF}
786end;
787
788function Wrap(Value, Max: Integer): Integer;
789{$IFDEF USENATIVECODE}
790begin
791 if Value < 0 then
792 Result := Max + (Value - Max) mod (Max + 1)
793 else
794 Result := Value mod (Max + 1);
795{$ELSE}
796{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
797asm
798{$IFDEF TARGET_x64}
799 MOV EAX,ECX
800 MOV ECX,R8D
801 LEA ECX,[RDX+1]
802{$ELSE}
803 LEA ECX,[EDX+1]
804{$ENDIF}
805 CDQ
806 IDIV ECX
807 MOV EAX,EDX
808 TEST EAX,EAX
809 JNL @Exit
810 ADD EAX,ECX
811@Exit:
812{$ENDIF}
813end;
814
815function Wrap(Value, Min, Max: Integer): Integer;
816begin
817 if Value < Min then
818 Result := Max + (Value - Max) mod (Max - Min + 1)
819 else
820 Result := Min + (Value - Min) mod (Max - Min + 1);
821end;
822
823function Wrap(Value, Max: Single): Single;
824begin
825{$IFDEF USEFLOATMOD}
826 Result := FloatMod(Value, Max);
827{$ELSE}
828 if Max = 0 then
829 begin
830 Result := 0;
831 Exit;
832 end;
833
834 Result := Value;
835 while Result >= Max do Result := Result - Max;
836 while Result < 0 do Result := Result + Max;
837{$ENDIF}
838end;
839
840function DivMod(Dividend, Divisor: Integer; out Remainder: Integer): Integer;
841{$IFDEF USENATIVECODE}
842begin
843 Remainder := Dividend mod Divisor;
844 Result := Dividend div Divisor;
845{$ELSE}
846{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
847asm
848{$IFDEF TARGET_x86}
849 PUSH EBX
850 MOV EBX,EDX
851 CDQ
852 IDIV EBX
853 MOV [ECX],EDX
854 POP EBX
855{$ENDIF}
856{$IFDEF TARGET_x64}
857 PUSH RBX
858 MOV EAX,ECX
859 MOV ECX,R8D
860 MOV EBX,EDX
861 CDQ
862 IDIV EBX
863 MOV [RCX],EDX
864 POP RBX
865{$ENDIF}
866{$ENDIF}
867end;
868
869function Mirror(Value, Max: Integer): Integer;
870{$IFDEF USENATIVECODE}
871var
872 DivResult: Integer;
873begin
874 if Value < 0 then
875 begin
876 DivResult := DivMod(Value - Max, Max + 1, Result);
877 Inc(Result, Max);
878 end
879 else
880 DivResult := DivMod(Value, Max + 1, Result);
881
882 if Odd(DivResult) then
883 Result := Max - Result;
884{$ELSE}
885{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
886asm
887{$IFDEF TARGET_x64}
888 MOV EAX,ECX
889 MOV ECX,R8D
890{$ENDIF}
891 TEST EAX,EAX
892 JNL @@1
893 NEG EAX
894@@1:
895 MOV ECX,EDX
896 CDQ
897 IDIV ECX
898 TEST EAX,1
899 MOV EAX,EDX
900 JZ @Exit
901 NEG EAX
902 ADD EAX,ECX
903@Exit:
904{$ENDIF}
905end;
906
907function Mirror(Value, Min, Max: Integer): Integer;
908var
909 DivResult: Integer;
910begin
911 if Value < Min then
912 begin
913 DivResult := DivMod(Value - Max, Max - Min + 1, Result);
914 Inc(Result, Max);
915 end
916 else
917 begin
918 DivResult := DivMod(Value - Min, Max - Min + 1, Result);
919 Inc(Result, Min);
920 end;
921 if Odd(DivResult) then Result := Max + Min - Result;
922end;
923
924function WrapPow2(Value, Max: Integer): Integer; overload;
925begin
926 Result := Value and Max;
927end;
928
929function WrapPow2(Value, Min, Max: Integer): Integer; overload;
930begin
931 Result := (Value - Min) and (Max - Min) + Min;
932end;
933
934function MirrorPow2(Value, Max: Integer): Integer; overload;
935begin
936 if Value and (Max + 1) = 0 then
937 Result := Value and Max
938 else
939 Result := Max - Value and Max;
940end;
941
942function MirrorPow2(Value, Min, Max: Integer): Integer; overload;
943begin
944 Value := Value - Min;
945 Result := Max - Min;
946
947 if Value and (Result + 1) = 0 then
948 Result := Min + Value and Result
949 else
950 Result := Max - Value and Result;
951end;
952
953function GetOptimalWrap(Max: Integer): TWrapProc; overload;
954begin
955 if (Max >= 0) and IsPowerOf2(Max + 1) then
956 Result := WrapPow2
957 else
958 Result := Wrap;
959end;
960
961function GetOptimalWrap(Min, Max: Integer): TWrapProcEx; overload;
962begin
963 if (Min >= 0) and (Max >= Min) and IsPowerOf2(Max - Min + 1) then
964 Result := WrapPow2
965 else
966 Result := Wrap;
967end;
968
969function GetOptimalMirror(Max: Integer): TWrapProc; overload;
970begin
971 if (Max >= 0) and IsPowerOf2(Max + 1) then
972 Result := MirrorPow2
973 else
974 Result := Mirror;
975end;
976
977function GetOptimalMirror(Min, Max: Integer): TWrapProcEx; overload;
978begin
979 if (Min >= 0) and (Max >= Min) and IsPowerOf2(Max - Min + 1) then
980 Result := MirrorPow2
981 else
982 Result := Mirror;
983end;
984
985function GetWrapProc(WrapMode: TWrapMode): TWrapProc; overload;
986begin
987 case WrapMode of
988 wmRepeat:
989 Result := Wrap;
990 wmMirror:
991 Result := Mirror;
992 else //wmClamp:
993 Result := Clamp;
994 end;
995end;
996
997function GetWrapProc(WrapMode: TWrapMode; Max: Integer): TWrapProc; overload;
998begin
999 case WrapMode of
1000 wmRepeat:
1001 Result := GetOptimalWrap(Max);
1002 wmMirror:
1003 Result := GetOptimalMirror(Max);
1004 else //wmClamp:
1005 Result := Clamp;
1006 end;
1007end;
1008
1009function GetWrapProcEx(WrapMode: TWrapMode): TWrapProcEx; overload;
1010begin
1011 case WrapMode of
1012 wmRepeat:
1013 Result := Wrap;
1014 wmMirror:
1015 Result := Mirror;
1016 else //wmClamp:
1017 Result := Clamp;
1018 end;
1019end;
1020
1021function GetWrapProcEx(WrapMode: TWrapMode; Min, Max: Integer): TWrapProcEx; overload;
1022begin
1023 case WrapMode of
1024 wmRepeat:
1025 Result := GetOptimalWrap(Min, Max);
1026 wmMirror:
1027 Result := GetOptimalMirror(Min, Max);
1028 else //wmClamp:
1029 Result := Clamp;
1030 end;
1031end;
1032
1033function Div255(Value: Cardinal): Cardinal;
1034begin
1035 Result := (Value * $8081) shr 23;
1036end;
1037
1038{ shift right with sign conservation }
1039function SAR_3(Value: Integer): Integer;
1040{$IFDEF PUREPASCAL}
1041begin
1042 Result := Value div 8;
1043{$ELSE}
1044{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
1045asm
1046{$IFDEF TARGET_x64}
1047 MOV EAX,ECX
1048{$ENDIF}
1049 SAR EAX,3
1050{$ENDIF}
1051end;
1052
1053function SAR_4(Value: Integer): Integer;
1054{$IFDEF PUREPASCAL}
1055begin
1056 Result := Value div 16;
1057{$ELSE}
1058{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
1059asm
1060{$IFDEF TARGET_x64}
1061 MOV EAX,ECX
1062{$ENDIF}
1063 SAR EAX,4
1064{$ENDIF}
1065end;
1066
1067function SAR_6(Value: Integer): Integer;
1068{$IFDEF PUREPASCAL}
1069begin
1070 Result := Value div 64;
1071{$ELSE}
1072{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
1073asm
1074{$IFDEF TARGET_x64}
1075 MOV EAX,ECX
1076{$ENDIF}
1077 SAR EAX,6
1078{$ENDIF}
1079end;
1080
1081function SAR_8(Value: Integer): Integer;
1082{$IFDEF PUREPASCAL}
1083begin
1084 Result := Value div 256;
1085{$ELSE}
1086{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
1087asm
1088{$IFDEF TARGET_x64}
1089 MOV EAX,ECX
1090{$ENDIF}
1091 SAR EAX,8
1092{$ENDIF}
1093end;
1094
1095function SAR_9(Value: Integer): Integer;
1096{$IFDEF PUREPASCAL}
1097begin
1098 Result := Value div 512;
1099{$ELSE}
1100{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
1101asm
1102{$IFDEF TARGET_x64}
1103 MOV EAX,ECX
1104{$ENDIF}
1105 SAR EAX,9
1106{$ENDIF}
1107end;
1108
1109function SAR_11(Value: Integer): Integer;
1110{$IFDEF PUREPASCAL}
1111begin
1112 Result := Value div 2048;
1113{$ELSE}
1114{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
1115asm
1116{$IFDEF TARGET_x64}
1117 MOV EAX,ECX
1118{$ENDIF}
1119 SAR EAX,11
1120{$ENDIF}
1121end;
1122
1123function SAR_12(Value: Integer): Integer;
1124{$IFDEF PUREPASCAL}
1125begin
1126 Result := Value div 4096;
1127{$ELSE}
1128{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
1129asm
1130{$IFDEF TARGET_x64}
1131 MOV EAX,ECX
1132{$ENDIF}
1133 SAR EAX,12
1134{$ENDIF}
1135end;
1136
1137function SAR_13(Value: Integer): Integer;
1138{$IFDEF PUREPASCAL}
1139begin
1140 Result := Value div 8192;
1141{$ELSE}
1142{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
1143asm
1144{$IFDEF TARGET_x64}
1145 MOV EAX,ECX
1146{$ENDIF}
1147 SAR EAX,13
1148{$ENDIF}
1149end;
1150
1151function SAR_14(Value: Integer): Integer;
1152{$IFDEF PUREPASCAL}
1153begin
1154 Result := Value div 16384;
1155{$ELSE}
1156{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
1157asm
1158{$IFDEF TARGET_x64}
1159 MOV EAX,ECX
1160{$ENDIF}
1161 SAR EAX,14
1162{$ENDIF}
1163end;
1164
1165function SAR_15(Value: Integer): Integer;
1166{$IFDEF PUREPASCAL}
1167begin
1168 Result := Value div 32768;
1169{$ELSE}
1170{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
1171asm
1172{$IFDEF TARGET_x64}
1173 MOV EAX,ECX
1174{$ENDIF}
1175 SAR EAX,15
1176{$ENDIF}
1177end;
1178
1179function SAR_16(Value: Integer): Integer;
1180{$IFDEF PUREPASCAL}
1181begin
1182 Result := Value div 65536;
1183{$ELSE}
1184{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
1185asm
1186{$IFDEF TARGET_x64}
1187 MOV EAX,ECX
1188{$ENDIF}
1189 SAR EAX,16
1190{$ENDIF}
1191end;
1192
1193{ Colorswap exchanges ARGB <-> ABGR and fill A with $FF }
1194function ColorSwap(WinColor: TColor): TColor32;
1195{$IFDEF USENATIVECODE}
1196var
1197 WCEn: TColor32Entry absolute WinColor;
1198 REn : TColor32Entry absolute Result;
1199begin
1200 Result := WCEn.ARGB;
1201 REn.A := $FF;
1202 REn.R := WCEn.B;
1203 REn.B := WCEn.R;
1204{$ELSE}
1205{$IFDEF FPC} assembler; nostackframe; {$ENDIF}
1206asm
1207// EAX = WinColor
1208// this function swaps R and B bytes in ABGR
1209// and writes $FF into A component
1210{$IFDEF TARGET_x64}
1211 MOV EAX,ECX
1212{$ENDIF}
1213 BSWAP EAX
1214 MOV AL, $FF
1215 ROR EAX,8
1216{$ENDIF}
1217end;
1218
1219{$IFDEF USESTACKALLOC}
1220{$IFDEF PUREPASCAL}
1221function StackAlloc(Size: Integer): Pointer;
1222begin
1223 GetMem(Result, Size);
1224end;
1225
1226procedure StackFree(P: Pointer);
1227begin
1228 FreeMem(P);
1229end;
1230{$ELSE}
1231{ StackAlloc allocates a 'small' block of memory from the stack by
1232 decrementing SP. This provides the allocation speed of a local variable,
1233 but the runtime size flexibility of heap allocated memory.
1234
1235 x64 implementation by Jameel Halabi
1236 }
1237function StackAlloc(Size: Integer): Pointer; register; {$IFDEF FPC} assembler; nostackframe; {$ENDIF}
1238asm
1239{$IFDEF TARGET_x86}
1240 POP ECX // return address
1241 MOV EDX, ESP
1242 ADD EAX, 3
1243 AND EAX, not 3 // round up to keep ESP dword aligned
1244 CMP EAX, 4092
1245 JLE @@2
1246@@1:
1247 SUB ESP, 4092
1248 PUSH EAX // make sure we touch guard page, to grow stack
1249 SUB EAX, 4096
1250 JNS @@1
1251 ADD EAX, 4096
1252@@2:
1253 SUB ESP, EAX
1254 MOV EAX, ESP // function result = low memory address of block
1255 PUSH EDX // save original SP, for cleanup
1256 MOV EDX, ESP
1257 SUB EDX, 4
1258 PUSH EDX // save current SP, for sanity check (sp = [sp])
1259 PUSH ECX // return to caller
1260{$ENDIF}
1261{$IFDEF TARGET_x64}
1262 {$IFNDEF FPC}
1263 .NOFRAME
1264 {$ENDIF}
1265 POP R8 // return address
1266 MOV RDX, RSP // original SP
1267 ADD ECX, 15
1268 AND ECX, NOT 15 // round up to keep SP dqword aligned
1269 CMP ECX, 4088
1270 JLE @@2
1271@@1:
1272 SUB RSP, 4088
1273 PUSH RCX // make sure we touch guard page, to grow stack
1274 SUB ECX, 4096
1275 JNS @@1
1276 ADD ECX, 4096
1277@@2:
1278 SUB RSP, RCX
1279 MOV RAX, RSP // function result = low memory address of block
1280 PUSH RDX // save original SP, for cleanup
1281 MOV RDX, RSP
1282 SUB RDX, 8
1283 PUSH RDX // save current SP, for sanity check (sp = [sp])
1284 PUSH R8 // return to caller
1285{$ENDIF}
1286end;
1287
1288{ StackFree pops the memory allocated by StackAlloc off the stack.
1289- Calling StackFree is optional - SP will be restored when the calling routine
1290 exits, but it's a good idea to free the stack allocated memory ASAP anyway.
1291- StackFree must be called in the same stack context as StackAlloc - not in
1292 a subroutine or finally block.
1293- Multiple StackFree calls must occur in reverse order of their corresponding
1294 StackAlloc calls.
1295- Built-in sanity checks guarantee that an improper call to StackFree will not
1296 corrupt the stack. Worst case is that the stack block is not released until
1297 the calling routine exits. }
1298procedure StackFree(P: Pointer); register; {$IFDEF FPC} assembler; nostackframe; {$ENDIF}
1299asm
1300{$IFDEF TARGET_x86}
1301 POP ECX // return address
1302 MOV EDX, DWORD PTR [ESP]
1303 SUB EAX, 8
1304 CMP EDX, ESP // sanity check #1 (SP = [SP])
1305 JNE @Exit
1306 CMP EDX, EAX // sanity check #2 (P = this stack block)
1307 JNE @Exit
1308 MOV ESP, DWORD PTR [ESP+4] // restore previous SP
1309@Exit:
1310 PUSH ECX // return to caller
1311{$ENDIF}
1312{$IFDEF TARGET_x64}
1313 {$IFNDEF FPC}
1314 .NOFRAME
1315 {$ENDIF}
1316 POP R8 // return address
1317 MOV RDX, QWORD PTR [RSP]
1318 SUB RCX, 16
1319 CMP RDX, RSP // sanity check #1 (SP = [SP])
1320 JNE @Exit
1321 CMP RDX, RCX // sanity check #2 (P = this stack block)
1322 JNE @Exit
1323 MOV RSP, QWORD PTR [RSP + 8] // restore previous SP
1324 @Exit:
1325 PUSH R8 // return to caller
1326{$ENDIF}
1327end;
1328{$ENDIF}
1329{$ENDIF}
1330
1331{CPU target and feature Function templates}
1332
1333const
1334 FID_FILLLONGWORD = 0;
1335
1336{Complete collection of unit templates}
1337
1338var
1339 Registry: TFunctionRegistry;
1340
1341procedure RegisterBindings;
1342begin
1343 Registry := NewRegistry('GR32_LowLevel bindings');
1344 Registry.RegisterBinding(FID_FILLLONGWORD, @@FillLongWord);
1345
1346 Registry.Add(FID_FILLLONGWORD, @FillLongWord_Pas, []);
1347 {$IFNDEF PUREPASCAL}
1348 Registry.Add(FID_FILLLONGWORD, @FillLongWord_ASM, []);
1349 Registry.Add(FID_FILLLONGWORD, @FillLongWord_MMX, [ciMMX]);
1350 Registry.Add(FID_FILLLONGWORD, @FillLongword_SSE2, [ciSSE2]);
1351 {$ENDIF}
1352
1353 Registry.RebindAll;
1354end;
1355
1356initialization
1357 RegisterBindings;
1358
1359end.
Note: See TracBrowser for help on using the repository browser.