fpc/rtl/avr/int64p.inc

{
    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}