mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 18:11:55 +01:00
568 lines
11 KiB
PHP
568 lines
11 KiB
PHP
{
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 2008 by the Free Pascal development team
|
|
|
|
This file contains some helper routines for int64 and qword
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
|
|
{$ifndef CPUAVR_16_REGS}
|
|
{$define FPC_SYSTEM_HAS_SHR_QWORD}
|
|
// Simplistic version with checking if whole bytes can be shifted
|
|
// Doesn't change bitshift portion even if possible because of byteshift
|
|
// Shorter code but not shortest execution time version
|
|
function fpc_shr_qword(value: qword; shift: ALUUInt): qword; assembler; nostackframe;
|
|
[public, alias: 'FPC_SHR_QWORD']; compilerproc;
|
|
label
|
|
byteshift, bitshift, finish;
|
|
asm
|
|
// value passed in R25...R18
|
|
// shift passed in R16
|
|
// return value in R25...R18
|
|
|
|
push R16
|
|
|
|
andi R16, 63 // mask 64 bit relevant value per generic routine
|
|
byteshift:
|
|
breq finish // shift = 0, finished
|
|
cpi R16, 8 // Check if shift is at least a byte
|
|
brlo bitshift
|
|
mov R18, R19 // if so, then shift all bytes right by 1 position
|
|
mov R19, R20
|
|
mov R20, R21
|
|
mov R21, R22
|
|
mov R22, R23
|
|
mov R23, R24
|
|
mov R24, R25
|
|
clr R25 // and clear the high byte
|
|
subi R16, 8 // subtract 8 bits from shift
|
|
rjmp byteshift // check if another byte can be shifted
|
|
|
|
bitshift: // shift all 8 bytes right by 1 bit
|
|
lsr R25
|
|
ror R24
|
|
ror R23
|
|
ror R22
|
|
ror R21
|
|
ror R20
|
|
ror R19
|
|
ror R18
|
|
|
|
dec R16
|
|
brne bitshift // until R16 = 0
|
|
|
|
finish:
|
|
pop R16
|
|
end;
|
|
function fpc_shr_qword(value: qword; shift: ALUUInt): qword; external name 'FPC_SHR_QWORD';
|
|
|
|
{$define FPC_SYSTEM_HAS_SHL_QWORD}
|
|
function fpc_shl_qword(value: qword; shift: ALUUInt): qword; assembler; nostackframe;
|
|
[public, alias: 'FPC_SHL_QWORD']; compilerproc;
|
|
label
|
|
byteshift, bitshift, finish;
|
|
asm
|
|
// value passed in R25...R18
|
|
// shift passed in R16
|
|
// return value in R25...R18
|
|
push R16
|
|
|
|
andi R16, 63 // mask 64 bit relevant value per generic routine
|
|
byteshift:
|
|
breq finish // shift = 0, finished
|
|
cpi R16, 8 // Check if shift is at least a byte
|
|
brlo bitshift
|
|
mov R25, R24 // if so, then shift all bytes left by 1 position
|
|
mov R24, R23
|
|
mov R23, R22
|
|
mov R22, R21
|
|
mov R21, R20
|
|
mov R20, R19
|
|
mov R19, R18
|
|
clr R18 // and clear the high byte
|
|
subi R16, 8 // subtract 8 bits from shift
|
|
rjmp byteshift // check if another byte can be shifted
|
|
|
|
bitshift: // shift all 8 bytes left by 1 bit
|
|
lsl R18
|
|
rol R19
|
|
rol R20
|
|
rol R21
|
|
rol R22
|
|
rol R23
|
|
rol R24
|
|
rol R25
|
|
|
|
dec R16
|
|
brne bitshift // until R16 = 0
|
|
|
|
finish:
|
|
pop R16
|
|
end;
|
|
|
|
function fpc_shl_qword(value: qword; shift: ALUUInt): qword; external name 'FPC_SHL_QWORD';
|
|
|
|
{$define FPC_SYSTEM_HAS_SHL_INT64}
|
|
function fpc_shl_int64(value: int64; shift: ALUUInt): int64;
|
|
[public, alias: 'FPC_SHL_INT64']; compilerproc; inline;
|
|
begin
|
|
Result := fpc_shl_qword(qword(value), shift);
|
|
end;
|
|
|
|
{$define FPC_SYSTEM_HAS_SHR_INT64}
|
|
// shr of signed int is same as shr of unsigned int (logical shift right)
|
|
function fpc_shr_int64(value: int64; shift: ALUUInt): int64; [public, alias: 'FPC_SHR_INT64']; compilerproc;
|
|
begin
|
|
Result := fpc_shr_qword(qword(value), shift);
|
|
end;
|
|
|
|
{$define FPC_SYSTEM_HAS_DIV_QWORD}
|
|
function fpc_div_qword(n,z : qword): qword; nostackframe; assembler; [public,alias: 'FPC_DIV_QWORD']; compilerproc;
|
|
label
|
|
start, div1, div2, div3, finish;
|
|
asm
|
|
// Symbol Name Register(s)
|
|
// z (A) dividend R17, R16, R15, R14, R13, R12, R11, R10
|
|
// n (B) divisor R25, R24, R23, R22, R21, R20, R19, R18
|
|
// r (P) remainder R9, R8, R7, R6, R5, R4, R3, R2
|
|
// i counter R26
|
|
// 1 R27
|
|
|
|
cp R25, R1
|
|
cpc R24, R1
|
|
cpc R23, R1
|
|
cpc R22, R1
|
|
cpc R21, R1
|
|
cpc R20, R1
|
|
cpc R19, R1
|
|
cpc R18, R1
|
|
|
|
brne .LNonZero
|
|
{$ifdef CPUAVR_HAS_JMP_CALL}
|
|
call fpc_divbyzero
|
|
{$else CPUAVR_HAS_JMP_CALL}
|
|
rcall fpc_divbyzero
|
|
{$endif CPUAVR_HAS_JMP_CALL}
|
|
|
|
.LNonZero:
|
|
|
|
push R17
|
|
push R16
|
|
push R15
|
|
push R14
|
|
push R13
|
|
push R12
|
|
push R11
|
|
push R10
|
|
push R9
|
|
push R8
|
|
push R7
|
|
push R6
|
|
push R5
|
|
push R4
|
|
push R3
|
|
push R2
|
|
|
|
ldi R27, 1 // needed below for OR instruction
|
|
|
|
start: // Start of division...
|
|
clr R9 // clear remainder
|
|
clr R8
|
|
clr R7
|
|
clr R6
|
|
clr R5
|
|
clr R4
|
|
clr R3
|
|
clr R2
|
|
ldi R26, 64 // iterate over 64 bits
|
|
|
|
div1:
|
|
lsl R10 // shift left A_L
|
|
rol R11
|
|
rol R12
|
|
rol R13
|
|
rol R14
|
|
rol R15
|
|
rol R16
|
|
rol R17
|
|
|
|
rol R2 // shift left P with carry from A shift
|
|
rol R3
|
|
rol R4
|
|
rol R5
|
|
rol R6
|
|
rol R7
|
|
rol R8
|
|
rol R9
|
|
|
|
sub R2, R18 // Subtract B from P, P <= P - B
|
|
sbc R3, R19
|
|
sbc R4, R20
|
|
sbc R5, R21
|
|
sbc R6, R22
|
|
sbc R7, R23
|
|
sbc R8, R24
|
|
sbc R9, R25
|
|
|
|
brlo div2
|
|
or R10, R27 // Set A[0] = 1
|
|
rjmp div3
|
|
div2: // negative branch, A[0] = 0 (default after shift), restore P
|
|
|
|
add R2, R18 // restore old value of P
|
|
adc R3, R19
|
|
adc R4, R20
|
|
adc R5, R21
|
|
adc R6, R22
|
|
adc R7, R23
|
|
adc R8, R24
|
|
adc R9, R25
|
|
|
|
div3:
|
|
dec R26
|
|
breq finish
|
|
rjmp div1
|
|
|
|
finish:
|
|
mov R25, R17 // Move answer from R17..10 to R25..18
|
|
mov R24, R16
|
|
mov R23, R15
|
|
mov R22, R14
|
|
mov R21, R13
|
|
mov R20, R12
|
|
mov R19, R11
|
|
mov R18, R10
|
|
|
|
pop R2
|
|
pop R3
|
|
pop R4
|
|
pop R5
|
|
pop R6
|
|
pop R7
|
|
pop R8
|
|
pop R9
|
|
pop R10
|
|
pop R11
|
|
pop R12
|
|
pop R13
|
|
pop R14
|
|
pop R15
|
|
pop R16
|
|
pop R17
|
|
end;
|
|
function fpc_div_qword(n,z : qword): qword; external name 'FPC_DIV_QWORD';
|
|
|
|
{$define FPC_SYSTEM_HAS_MOD_QWORD}
|
|
function fpc_mod_qword(n,z : qword): qword; nostackframe; assembler; [public,alias: 'FPC_MOD_QWORD']; compilerproc;
|
|
label
|
|
start, div1, div2, div3, finish;
|
|
asm
|
|
// Symbol Name Register(s)
|
|
// z (A) dividend R17, R16, R15, R14, R13, R12, R11, R10
|
|
// n (B) divisor R25, R24, R23, R22, R21, R20, R19, R18
|
|
// r (P) remainder R9, R8, R7, R6, R5, R4, R3, R2
|
|
// i counter R26
|
|
// 1 R27
|
|
|
|
cp R25, R1
|
|
cpc R24, R1
|
|
cpc R23, R1
|
|
cpc R22, R1
|
|
cpc R21, R1
|
|
cpc R20, R1
|
|
cpc R19, R1
|
|
cpc R18, R1
|
|
|
|
brne .LNonZero
|
|
{$ifdef CPUAVR_HAS_JMP_CALL}
|
|
call fpc_divbyzero
|
|
{$else CPUAVR_HAS_JMP_CALL}
|
|
rcall fpc_divbyzero
|
|
{$endif CPUAVR_HAS_JMP_CALL}
|
|
|
|
.LNonZero:
|
|
|
|
push R17
|
|
push R16
|
|
push R15
|
|
push R14
|
|
push R13
|
|
push R12
|
|
push R11
|
|
push R10
|
|
push R9
|
|
push R8
|
|
push R7
|
|
push R6
|
|
push R5
|
|
push R4
|
|
push R3
|
|
push R2
|
|
|
|
ldi R27, 1
|
|
start: // Start of division...
|
|
clr R9 // clear remainder
|
|
clr R8
|
|
clr R7
|
|
clr R6
|
|
clr R5
|
|
clr R4
|
|
clr R3
|
|
clr R2
|
|
ldi R26, 64 // iterate over 64 bits
|
|
|
|
div1:
|
|
lsl R10 // shift left A_L
|
|
rol R11
|
|
rol R12
|
|
rol R13
|
|
rol R14
|
|
rol R15
|
|
rol R16
|
|
rol R17
|
|
|
|
rol R2 // shift left P with carry from A shift
|
|
rol R3
|
|
rol R4
|
|
rol R5
|
|
rol R6
|
|
rol R7
|
|
rol R8
|
|
rol R9
|
|
|
|
sub R2, R18 // Subtract B from P, P <= P - B
|
|
sbc R3, R19
|
|
sbc R4, R20
|
|
sbc R5, R21
|
|
sbc R6, R22
|
|
sbc R7, R23
|
|
sbc R8, R24
|
|
sbc R9, R25
|
|
|
|
brlo div2
|
|
or R10, R27 // Set A[0] = 1
|
|
rjmp div3
|
|
div2: // negative branch, A[0] = 0 (default after shift), restore P
|
|
|
|
add R2, R18 // restore old value of P
|
|
adc R3, R19
|
|
adc R4, R20
|
|
adc R5, R21
|
|
adc R6, R22
|
|
adc R7, R23
|
|
adc R8, R24
|
|
adc R9, R25
|
|
|
|
div3:
|
|
dec R26
|
|
breq finish
|
|
rjmp div1
|
|
|
|
finish:
|
|
mov R25, R9 // Move answer from R9..2 to R25..18
|
|
mov R24, R8
|
|
mov R23, R7
|
|
mov R22, R6
|
|
mov R21, R5
|
|
mov R20, R4
|
|
mov R19, R3
|
|
mov R18, R2
|
|
|
|
pop R2
|
|
pop R3
|
|
pop R4
|
|
pop R5
|
|
pop R6
|
|
pop R7
|
|
pop R8
|
|
pop R9
|
|
pop R10
|
|
pop R11
|
|
pop R12
|
|
pop R13
|
|
pop R14
|
|
pop R15
|
|
pop R16
|
|
pop R17
|
|
end;
|
|
function fpc_mod_qword(n,z : qword): qword; external name 'FPC_MOD_QWORD';
|
|
|
|
|
|
{$define FPC_SYSTEM_HAS_DIV_INT64}
|
|
function fpc_div_int64(n,z : int64) : int64; nostackframe; assembler; [public,alias: 'FPC_DIV_INT64']; compilerproc;
|
|
label
|
|
pos1, pos2, fin;
|
|
asm
|
|
// Convert n, z to unsigned int, then call div_qword,
|
|
// Restore sign if high bits of n xor z is negative
|
|
// n divisor R25, R24, R23, R22, R21, R20, R19, R18
|
|
// z dividend R17, R16, R15, R14, R13, R12, R11, R10
|
|
// neg_result R30
|
|
// one R31
|
|
|
|
mov R30, R17 // store hi8(z)
|
|
eor R30, R25 // hi8(z) XOR hi8(n), answer must be negative if MSB set
|
|
|
|
// convert n to absolute
|
|
ldi R31, 1 // 1 in R31 used later
|
|
sub R25, r1 // subtract 0, just to check sign flag
|
|
brpl pos1
|
|
com R25
|
|
com R24
|
|
com R23
|
|
com R22
|
|
com R21
|
|
com R20
|
|
com R19
|
|
com R18
|
|
add R18, R31 // add 1
|
|
adc R19, R1 // add carry bit
|
|
adc R20, R1
|
|
adc R21, R1
|
|
adc R22, R1
|
|
adc R23, R1
|
|
adc R24, R1
|
|
adc R25, R1
|
|
pos1:
|
|
|
|
sub R17, R1
|
|
brpl pos2
|
|
com R17
|
|
com R16
|
|
com R15
|
|
com R14
|
|
com R13
|
|
com R12
|
|
com R11
|
|
com R10
|
|
add R10, R31
|
|
adc R11, R1
|
|
adc R12, R1
|
|
adc R13, R1
|
|
adc R14, R1
|
|
adc R15, R1
|
|
adc R16, R1
|
|
adc R17, R1
|
|
pos2:
|
|
|
|
{$ifdef CPUAVR_HAS_JMP_CALL}
|
|
call fpc_div_qword
|
|
{$else CPUAVR_HAS_JMP_CALL}
|
|
rcall fpc_div_qword
|
|
{$endif CPUAVR_HAS_JMP_CALL}
|
|
|
|
sbrs R30, 7 // skip if bit 7 is cleared (result should be positive)
|
|
rjmp fin
|
|
com R25 // result from FPC_DIV_WORD in R25 ... R22
|
|
com R24
|
|
com R23
|
|
com R22
|
|
com R21
|
|
com R20
|
|
com R19
|
|
com R18
|
|
|
|
ldi R31, 1
|
|
add R18, R31 // add 1
|
|
adc R19, R1 // add carry bit
|
|
adc R20, R1
|
|
adc R21, R1
|
|
adc R22, R1
|
|
adc R23, R1
|
|
adc R24, R1
|
|
adc R25, R1
|
|
fin:
|
|
end;
|
|
|
|
{$define FPC_SYSTEM_HAS_MOD_INT64}
|
|
function fpc_mod_int64(n,z : int64) : int64; nostackframe; assembler; [public,alias: 'FPC_MOD_INT64']; compilerproc;
|
|
label
|
|
pos1, pos2, fin;
|
|
asm
|
|
// Convert n, z to unsigned int, then call mod_qword,
|
|
// Restore sign if high bits of n xor z is negative
|
|
// n divisor R25, R24, R23, R22, R21, R20, R19, R18
|
|
// z dividend R17, R16, R15, R14, R13, R12, R11, R10
|
|
// neg_result R30
|
|
// one R31
|
|
|
|
mov R30, R17 // store hi8(z)
|
|
|
|
// convert n to absolute
|
|
ldi R31, 1
|
|
sub R25, r1 // subtract 0, just to check sign flag
|
|
brpl pos1
|
|
com R25
|
|
com R24
|
|
com R23
|
|
com R22
|
|
com R21
|
|
com R20
|
|
com R19
|
|
com R18
|
|
add R18, R31 // add 1
|
|
adc R19, R1 // add carry bit
|
|
adc R20, R1
|
|
adc R21, R1
|
|
adc R22, R1
|
|
adc R23, R1
|
|
adc R24, R1
|
|
adc R25, R1
|
|
pos1:
|
|
|
|
sub R17, R1
|
|
brpl pos2
|
|
com R17
|
|
com R16
|
|
com R15
|
|
com R14
|
|
com R13
|
|
com R12
|
|
com R11
|
|
com R10
|
|
add R10, R31
|
|
adc R11, R1
|
|
adc R12, R1
|
|
adc R13, R1
|
|
adc R14, R1
|
|
adc R15, R1
|
|
adc R16, R1
|
|
adc R17, R1
|
|
pos2:
|
|
|
|
{$ifdef CPUAVR_HAS_JMP_CALL}
|
|
call fpc_mod_qword
|
|
{$else CPUAVR_HAS_JMP_CALL}
|
|
rcall fpc_mod_qword
|
|
{$endif CPUAVR_HAS_JMP_CALL}
|
|
|
|
sbrs R30, 7 // Not finished if sign bit is set
|
|
rjmp fin
|
|
com R25 // Convert to 2's complement
|
|
com R24 // Complement all bits...
|
|
com R23
|
|
com R22
|
|
com R21
|
|
com R20
|
|
com R19
|
|
com R18
|
|
ldi R31, 1
|
|
add R18, R31 // ...and add 1 to answer
|
|
adc R19, R1
|
|
adc R20, R1
|
|
adc R21, R1
|
|
adc R22, R1
|
|
adc R23, R1
|
|
adc R24, R1
|
|
adc R25, R1
|
|
fin:
|
|
end;
|
|
{$endif CPUAVR_16_REGS}
|