Long multiplication: Difference between revisions
m
→{{header|Wren}}: Minor tidy
m (Long multiplication in Run BASIC) |
m (→{{header|Wren}}: Minor tidy) |
||
| (22 intermediate revisions by 8 users not shown) | |||
Line 339:
18446744073709551616
340282366920938463463374607431768211456
</pre>
=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits <br> or android 64 bits with application Termux }}
<syntaxhighlight lang AArch64 Assembly>
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program longmulti64.s */
/* REMARK : this program use factors unsigned to 2 power 127
and the result is less than 2 power 255 */
/************************************/
/* Constantes */
/************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ BUFFERSIZE, 100
/***********************************************/
/* structures */
/**********************************************/
/* Définition multi128 */
.struct 0
multi128_N1: // 63-0
.struct multi128_N1 + 8
multi128_N2: // 127-64
.struct multi128_N2 + 8
multi128_N3: // 128-191
.struct multi128_N3 + 8
multi128_N4: // 192-255
.struct multi128_N4 + 8
multi128_end:
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessFactor: .asciz "Factor = "
szMessResult: .asciz "Result = "
szMessStart: .asciz "Program 64 bits start.\n"
szCarriageReturn: .asciz "\n"
i128test1: .quad 0,1,0,0 // 2 power 64
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip BUFFERSIZE // conversion buffer
i128Result1: .skip multi128_end
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
ldr x0,qAdrszMessStart
bl affichageMess
ldr x0,qAdri128test1 // origin number
ldr x1,qAdrsZoneConv
mov x2,#BUFFERSIZE
bl convertMultiForString // convert multi number to string
mov x2,x0 // insert conversion in message
mov x0,#3 // string number to display
ldr x1,qAdrszMessFactor
ldr x3,qAdrszCarriageReturn
bl displayStrings // display message
// multiplication
ldr x0,qAdri128test1 // factor 1
ldr x1,qAdri128test1 // factor 2
ldr x2,qAdri128Result1 // result
bl multiplierMulti128
ldr x0,qAdri128Result1
ldr x1,qAdrsZoneConv
mov x2,#BUFFERSIZE
bl convertMultiForString // conversion multi to string
mov x2,x0 // insert conversion in message
mov x0,#3 // number string to display
ldr x1,qAdrszMessResult
ldr x3,qAdrszCarriageReturn
bl displayStrings // display message
100: // standard end of the program
mov x0, #0 // return code
mov x8,EXIT
svc #0 // perform the system call
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrsZoneConv: .quad sZoneConv
qAdri128test1: .quad i128test1
qAdri128Result1: .quad i128Result1
qAdrszMessResult: .quad szMessResult
qAdrszMessFactor: .quad szMessFactor
qAdrszMessStart: .quad szMessStart
/***************************************************/
/* multiplication multi128 by multi128 */
/***************************************************/
// x0 contains address multi128 1
// x1 contains address multi128 2
// x2 contains address result multi128
// x0 return address result (= x2)
multiplierMulti128:
stp x1,lr,[sp,-16]! // save registers
mov x9,x0 // factor 1
mov x10,x1 // factor 2
mov x7,x2 // address result
mov x6,#3 // multi128 size
1:
str xzr,[x7,x6,lsl #3] // init result
subs x6,x6,#1
bge 1b
mov x5,#0 // indice loop 1
2: // loop items factor 1
ldr x0,[x9,x5,lsl #3] // load a item
mov x4,#0
mov x8,#0
3: // loop item factor 2
add x6,x4,x5 // compute result indice
ldr x1,[x10,x4,lsl #3] // load a item factor 2
mul x2,x1,x0 // multiply low 64 bits
umulh x3,x1,x0 // multiply high 64 bits
ldr x1,[x7,x6,lsl #3] // load previous item of result
adds x1,x1,x2 // add low part result multiplication
mov x11,1
csel x2,x11,xzr,cs
adds x1,x1,x8 // add high part precedente
adc x8,x3,x2 // new high part with retenue
str x1,[x7,x6,lsl #3] // store the sum in result
add x4,x4,#1
cmp x4,#3
blt 3b // and loop 2
cmp x8,#0 // high part ?
beq 5f
add x6,x6,#1
cmp x6,#2 // on last item ?
ble 4f
adr x0,szMessErrOverflow // yes -> overflow
bl affichageMess
mov x0,#0 // return 0
b 100f
4:
str x8,[x7,x6,lsl #3] // no store high part in next item
5:
add x5,x5,#1
cmp x5,#3
blt 2b // and loop 1
mov x0,x7
100:
ldp x1,lr,[sp],16 // restaur registers
ret
szMessErrOverflow: .asciz "\033[31mOverflow !!\033[0m \n"
.align 4
/***************************************************/
/* conversion multi128 unsigned to string */
/***************************************************/
// x0 contains address multi128
// x1 contains address buffer
// x2 contains buffer length
convertMultiForString:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
sub sp,sp,#multi128_end // reserve place to stack
mov fp,sp // init address to quotient
mov x5,x1 // save address buffer
mov x3,#0 // init indice
1:
ldr x4,[x0,x3,lsl #3] // load one part of number
str x4,[fp,x3,lsl #3] // copy part on stack
add x3,x3,#1
cmp x3,#4
blt 1b
2:
strb wzr,[x5,x2] // store final 0 in buffer
sub x4,x2,#1 // end number storage
3:
mov x0,fp
mov x1,#10
bl calculerModuloMultiEntier // compute modulo 10
add x0,x0,#0x30 // convert result to character
strb w0,[x5,x4] // store character on buffer
subs x4,x4,#1 //
blt 99f // buffer too low
ldr x0,[fp,#multi128_N1] // test if quotient = zero
cmp x0,#0
bne 3b
ldr x0,[fp,#multi128_N2]
cmp x0,#0
bne 3b
ldr x0,[fp,#multi128_N3]
cmp x0,#0
bne 3b
ldr x0,[fp,#multi128_N4]
cmp x0,#0
bne 3b
add x0,x5,x4 // return begin number in buffer
add x0,x0,#1
b 100f
99: // display error if buffer est toop low
adr x0,szMessErrBuffer
bl affichageMess
mov x0,#-1
100:
add sp,sp,#multi128_end // stack alignement
ldp x4,x5,[sp],16 // restaur registers
ldp x2,x3,[sp],16 // restaur registers
ldp x1,lr,[sp],16 // restaur registers
ret
szMessErrBuffer: .asciz "\033[31mBuffer de conversion trop petit !!\033[0m \n"
.align 4
/***************************************************/
/* modulo compute unsigned */
/***************************************************/
// x0 contains address multi128
// x1 contains modulo (positive)
// x0 return modulo
// ATTENTION : le multientier origine est modifié et contient le quotient
calculerModuloMultiEntier: // INFO: calculerModuloMultiEntier
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
cmp x1,#0
ble 99f
mov x4,x1 // save modulo
mov x3,#3
mov x5,x0 // multi128 address
ldr x0,[x5,x3,lsl 3] // load last part of number in low part of 128 bits
mov x1,#0 // init higt part 128 bits
1:
cmp x3,#0 // end part ?
ble 2f
mov x2,x4 // modulo
bl division64R // divide x0,x1 by x2 in x0,x1 and remainder in x2
str x0,[x5,x3,lsl #3] // store result part low
sub x3,x3,#1 // other part ?
ldr x0,[x5,x3,lsl #3] // load prev part
mov x1,x2 // store remainder on high part of 128 bits
b 1b
2:
mov x2,x4 // modulo
bl division64R
str x0,[x5] // stockage dans le 1er chunk
mov x0,x2 // return remainder
b 100f
99:
adr x0,szMessNegatif
bl affichageMess
mov x0,#-1
100: // fin standard de la fonction
ldp x4,x5,[sp],16 // restaur registers
ldp x2,x3,[sp],16 // restaur registers
ldp x1,lr,[sp],16 // restaur registers
ret
szMessNegatif: .asciz "\033[31mLe diviseur doit être positif !\033[0m\n"
.align 4
/***************************************************/
/* division 128 bits number in 2 registers by 64 bits number */
/***************************************************/
/* x0 contains dividende low part */
/* x1 contains dividende high part */
/* x2 contains divisor */
/* x0 return quotient low part */
/* x1 return quotient high part */
/* x2 return remainder */
division64R:
stp x3,lr,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
stp x6,x7,[sp,-16]! // save registers
stp x8,x9,[sp,-16]! // save registers
mov x6,#0 // init high high part of remainder !!
// x1 = high part of number in high part of remainder
mov x7,x0 // low part of number in low part of remainder
mov x3,#0 // init high part quotient
mov x4,#0 // init low part quotient
mov x5,#64
1: // begin loop
lsl x6,x6,#1 // left shift high high part of remainder
cmp x1,0 // if negative ie bit 63 = 1
orr x8,x6,1
csel x6,x8,x6,lt // add left bit high part on high high part
lsl x1,x1,#1 // left shift high part of remainder
cmp x7,0
orr x8,x1,1
csel x1,x8,x1,lt // add left bit low part on high part
lsl x7,x7,#1 // left shift low part of remainder
cmp x4,0
lsl x4,x4,#1 // left shift low part quotient
lsl x3,x3,#1 // left shift high part quotient
orr x8,x3,1
csel x3,x8,x3,lt // add left bit low part on high part
// sub divisor to high part remainder
subs x1,x1,x2
sbcs x6,x6,xzr // sub restr.quad (retenue in french)
bmi 2f // result negative ?
// positive or equal
orr x4,x4,#1 // right bit quotient to 1
b 3f
2: // negative
orr x4,x4,xzr // right bit quotient to 0
adds x1,x1,x2 // and restaure the remainder to precedent value
adc x6,x6,xzr // and restr.quad
3:
subs x5,x5,#1 // decrement indice
bgt 1b // and loop
mov x0,x4 // low part quotient
mov x2,x1 // remainder
mov x1,x3 // high part quotient
100:
ldp x8,x9,[sp],16 // restaur registers
ldp x6,x7,[sp],16 // restaur registers
ldp x4,x5,[sp],16 // restaur registers
ldp x3,lr,[sp],16 // restaur registers
ret
/***************************************************/
/* display multi strings */
/* new version 24/05/2023 */
/***************************************************/
/* x0 contains number strings address */
/* x1 address string1 */
/* x2 address string2 */
/* x3 address string3 */
/* x4 address string4 */
/* x5 address string5 */
/* x6 address string5 */
displayStrings: // INFO: displayStrings
stp x7,lr,[sp,-16]! // save registers
stp x2,fp,[sp,-16]! // save registers
add fp,sp,#32 // save paraméters address (4 registers saved * 8 bytes)
mov x7,x0 // save strings number
cmp x7,#0 // 0 string -> end
ble 100f
mov x0,x1 // string 1
bl affichageMess
cmp x7,#1 // number > 1
ble 100f
mov x0,x2
bl affichageMess
cmp x7,#2
ble 100f
mov x0,x3
bl affichageMess
cmp x7,#3
ble 100f
mov x0,x4
bl affichageMess
cmp x7,#4
ble 100f
mov x0,x5
bl affichageMess
cmp x7,#5
ble 100f
mov x0,x6
bl affichageMess
100:
ldp x2,fp,[sp],16 // restaur registers
ldp x7,lr,[sp],16 // restaur registers
ret
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeARM64.inc"
</syntaxhighlight>
{{Out}}
<pre>
Program 64 bits start.
Factor = 18446744073709551616
Result = 340282366920938463463374607431768211456
</pre>
Line 671 ⟶ 1,044:
o_form("~\n", c);</syntaxhighlight>
=={{header|ALGOL 60}}==
{{works with|GNU MARST|2.7}}
{{trans|ATS}}
<syntaxhighlight lang="algol60">
procedure multiplyBCD (m, n, u, v, w);
comment
Multiply array u of length m by array v of length n,
putting the result in array w of length (m + n). the
numbers are stored as binary coded decimal, most
significant digit first.
;
value m, n;
integer m, n;
integer array u, v, w;
begin
integer i, j, carry, t;
for j := 0 step 1 until n - 1 do
begin
if v[n - 1 - j] = 0 then
begin
comment (optional branch);
w[n - 1 - j] := 0
end
else
begin
carry := 0;
for i := 0 step 1 until m - 1 do
begin
t := (u[m - 1 - i] * v[n - 1 - j])
+ w[m + n - 1 - i - j] + carry;
carry := t % 10; comment (integer division);
w[m + n - 1 - i - j] := t - (carry * 10)
end;
w[n - 1 - j] := carry
end
end
end;
procedure printBCD (m, u);
value m;
integer m;
integer array u;
begin
integer i, j;
comment Skip leading zeros;
i := 0;
for j := i while j < m - 1 & u[j] = 0 do
i := i + 1;
comment Print the digits, and separators;
for j := i step 1 until m - 1 do
begin
if j != i & ((m - j) % 3) * 3 = m - j then
begin
comment Print UTF-8 for a narrow no-break space (U+202F);
outstring (1, "\xE2\x80\xAF")
end;
outchar (1, "0123456789", u[j] + 1)
end
end;
begin
integer array u[0 : 19];
integer array v[0 : 19];
integer array w[0 : 39];
u[0] := 1; u[1] := 8; u[2] := 4; u[3] := 4;
u[4] := 6; u[5] := 7; u[6] := 4; u[7] := 4;
u[8] := 0; u[9] := 7; u[10] := 3; u[11] := 7;
u[12] := 0; u[13] := 9; u[14] := 5; u[15] := 5;
u[16] := 1; u[17] := 6; u[18] := 1; u[19] := 6;
v[0] := 1; v[1] := 8; v[2] := 4; v[3] := 4;
v[4] := 6; v[5] := 7; v[6] := 4; v[7] := 4;
v[8] := 0; v[9] := 7; v[10] := 3; v[11] := 7;
v[12] := 0; v[13] := 9; v[14] := 5; v[15] := 5;
v[16] := 1; v[17] := 6; v[18] := 1; v[19] := 6;
multiplyBCD (20, 20, u, v, w);
outstring (1, "u = "); printBCD (20, u); outstring (1, "\n");
outstring (1, "v = "); printBCD (20, v); outstring (1, "\n");
outstring (1, "u × v = "); printBCD (40, w); outstring (1, "\n")
end
</syntaxhighlight>
{{out}}
<pre>$ marst long_mult_task.algol60 > algol60-code.c && cc algol60-code.c -lalgol && ./a.out
u = 18 446 744 073 709 551 616
v = 18 446 744 073 709 551 616
u × v = 340 282 366 920 938 463 463 374 607 431 768 211 456</pre>
=={{header|ALGOL 68}}==
Line 989 ⟶ 1,456:
<pre>
2^128: 340282366920938463463374607431768211456
</pre>
=={{header|APL}}==
{{works with|Dyalog APL}}
This function takes two digit vectors of arbitrary size.
<syntaxhighlight lang="apl">longmul←{⎕IO←0
sz←⌈/≢¨x y←↓⌽↑⌽¨⍺⍵
ds←+⌿↑(⌽⍳sz)⌽¨↓(¯2×sz)↑[1]x∘.×y
mlt←{(1⌽⌊⍵÷10)+10|⍵}⍣≡⊢ds
0=≢mlt←(∨\0≠mlt)/mlt:,0
mlt
}</syntaxhighlight>
{{out}}
<syntaxhighlight lang="apl"> ⎕←input←longmul⍣63⍨⊢,2 ⍝ construct 2*64
1 8 4 4 6 7 4 4 0 7 3 7 0 9 5 5 1 6 1 6
⎕←longmul⍨input ⍝ calculate 2*128
3 4 0 2 8 2 3 6 6 9 2 0 9 3 8 4 6 3 4 6 3 3 7 4 6 0 7 4 3 1 7 6 8 2 1 1 4 5 6</syntaxhighlight>
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi <br> or android 32 bits with application Termux}}
<syntaxhighlight lang ARM Assembly>
/* ARM assembly Raspberry PI */
/* program longmulti.s */
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* REMARK 2 : this program use factors unsigned to 2 power 95
and the result is less than 2 power 159 */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"
.equ BUFFERSIZE, 64
/***********************************************/
/* structures */
/**********************************************/
/* Définition multi128 */
.struct 0
multi128_N1: // 31-0
.struct multi128_N1 + 4
multi128_N2: // 63-32
.struct multi128_N2 + 4
multi128_N3: // 95-64
.struct multi128_N3 + 4
multi128_N4: // 127-96
.struct multi128_N4 + 4
multi128_N5: // 159-128
.struct multi128_N5 + 4
multi128_end:
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessFactor: .asciz "Factor = "
szMessResult: .asciz "Result = "
szMessStart: .asciz "Program 32 bits start.\n"
szCarriageReturn: .asciz "\n"
i128test1: .int 0,0,1,0,0 // 2 power 64
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip BUFFERSIZE // conversion buffer
i128Result1: .skip multi128_end
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
ldr r0,iAdrszMessStart
bl affichageMess
ldr r0,iAdri128test1 @ origin number
ldr r1,iAdrsZoneConv
mov r2,#BUFFERSIZE
bl convertMultiForString @ convert multi number to string
mov r2,r0 @ insert conversion in message
mov r0,#3 @ string number to display
ldr r1,iAdrszMessFactor
ldr r3,iAdrszCarriageReturn
bl displayStrings @ display message
@ multiplication
ldr r0,iAdri128test1 @ factor 1
ldr r1,iAdri128test1 @ factor 2
ldr r2,iAdri128Result1 @ result
bl multiplierMulti128
ldr r0,iAdri128Result1
ldr r1,iAdrsZoneConv
mov r2,#BUFFERSIZE
bl convertMultiForString @ conversion multi to string
mov r2,r0 @ insert conversion in message
mov r0,#3 @ number string to display
ldr r1,iAdrszMessResult
ldr r3,iAdrszCarriageReturn
bl displayStrings @ display message
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
iAdrsZoneConv: .int sZoneConv
iAdri128test1: .int i128test1
iAdri128Result1: .int i128Result1
iAdrszMessResult: .int szMessResult
iAdrszMessFactor: .int szMessFactor
iAdrszMessStart: .int szMessStart
/***************************************************/
/* multiplication multi128 by multi128 */
/***************************************************/
// r0 contains address multi128 1
// r1 contains address multi128 2
// r2 contains address result multi128
// r0 return address result (= r2)
multiplierMulti128:
push {r1-r10,lr} @ save registers
mov r9,r0 @ factor 1
mov r10,r1 @ factor 2
mov r7,r2 @ address result
mov r6,#4 @ multi128 size
mov r5,#0
1:
str r5,[r7,r6,lsl #2] @ init result
subs r6,r6,#1
bge 1b
mov r5,#0 @ indice loop 1
2: @ loop items factor 1
ldr r0,[r9,r5,lsl #2] @ load a item
mov r4,#0
mov r8,#0
3: @ loop item factor 2
add r6,r4,r5 @ compute result indice
ldr r1,[r10,r4,lsl #2] @ oad a item factor 2
umull r2,r3,r1,r0 @ multiply long 32 bits
ldr r1,[r7,r6,lsl #2] @ load previous item of result
adds r1,r1,r2 @ add low part result multiplication
movcc r2,#0 @ high retain
movcs r2,#1
adds r1,r1,r8 @ add high part precedente
adc r8,r3,r2 @ new high part with retenue
str r1,[r7,r6,lsl #2] @ store the sum in result
add r4,r4,#1
cmp r4,#3
blt 3b @ and loop 2
cmp r8,#0 @ high part ?
beq 4f
add r6,r6,#1
cmp r6,#4 @ on last item ?
strle r8,[r7,r6,lsl #2] @ no store high part in next item
ble 4f
adr r0,szMessErrOverflow @ yes -> overflow
bl affichageMess
mov r0,#0 @ return 0
b 100f
4:
add r5,r5,#1
cmp r5,#3
blt 2b @ and loop 1
mov r0,r7
100:
pop {r1-r10,pc} @ restaur registers
szMessErrOverflow: .asciz "\033[31mOverflow !!\033[0m \n"
.align 4
/***************************************************/
/* display multi strings */
/***************************************************/
/* r0 contains number strings address */
/* r1 address string1 */
/* r2 address string2 */
/* r3 address string3 */
/* other address on the stack */
/* thinck to add number other address * 4 to add to the stack */
displayStrings: @ INFO: displayStrings
push {r1-r4,fp,lr} @ save des registres
add fp,sp,#24 @ save paraméters address (6 registers saved * 4 bytes)
mov r4,r0 @ save strings number
cmp r4,#0 @ 0 string -> end
ble 100f
mov r0,r1 @ string 1
bl affichageMess
cmp r4,#1 @ number > 1
ble 100f
mov r0,r2
bl affichageMess
cmp r4,#2
ble 100f
mov r0,r3
bl affichageMess
cmp r4,#3
ble 100f
mov r3,#3
sub r2,r4,#4
1: @ loop extract address string on stack
ldr r0,[fp,r2,lsl #2]
bl affichageMess
subs r2,#1
bge 1b
100:
pop {r1-r4,fp,pc}
/***************************************************/
/* conversion multi128 unsigned to string */
/***************************************************/
// r0 contains address multi128
// r1 contains address buffer
// r2 contains buffer length
convertMultiForString:
push {r1-r5,fp,lr} @ save des registres
sub sp,sp,#multi128_end @ reserve place to stack
mov fp,sp @ init address to quotient
mov r5,r1 @ save address buffer
mov r3,#0 @ init indice
1:
ldr r4,[r0,r3,lsl #2] @ load one part of number
str r4,[fp,r3,lsl #2] @ copy part on stack
add r3,#1
cmp r3,#5
blt 1b
2:
mov r0,#0
strb r0,[r5,r2] @ store final 0 in buffer
sub r4,r2,#1 @ end number storage
3:
mov r0,fp
mov r1,#10
bl calculerModuloMultiEntier @ compute modulo 10
add r0,r0,#0x30 @ convert result to character
strb r0,[r5,r4] @ store character on buffer
subs r4,r4,#1 @
blt 99f @ buffer too low
ldr r0,[fp,#multi128_N1] @ test if quotient = zero
cmp r0,#0
bne 3b
ldr r0,[fp,#multi128_N2]
cmp r0,#0
bne 3b
ldr r0,[fp,#multi128_N3]
cmp r0,#0
bne 3b
ldr r0,[fp,#multi128_N4]
cmp r0,#0
bne 3b
ldr r0,[fp,#multi128_N5]
cmp r0,#0
bne 3b
add r0,r5,r4 @ return begin number in buffer
add r0,r0,#1
b 100f
99: @ display error if buffer est toop low
adr r0,szMessErrBuffer
bl affichageMess
mov r0,#-1
100:
add sp,sp,#multi128_end @ stack alignement
pop {r1-r5,fp,pc} @ restaur registers
szMessErrBuffer: .asciz "\033[31mBuffer de conversion trop petit !!\033[0m \n"
.align 4
/***************************************************/
/* modulo compute unsigned */
/***************************************************/
// r0 contains address multi128
// r1 contains modulo (positive)
// r0 return modulo
// ATTENTION : le multientier origine est modifié et contient le quotient
calculerModuloMultiEntier: @ INFO: calculerModuloMultiEntier
push {r1-r5,lr} @ save des registres
cmp r1,#0
ble 99f
mov r4,r1 @ save modulo
mov r3,#4
mov r5,r0 @ multi128 address
ldr r0,[r5,r3,lsl #2] @ load last part of number in low part of 64 bits
mov r1,#0 @ init higt part 64 bits
1:
cmp r3,#0 @ end part ?
ble 2f
mov r2,r4 @ modulo
bl division32R @ divide r0,r1 by r2 in r0,r1 and remainder in r2
str r0,[r5,r3,lsl #2] @ store result part low
sub r3,r3,#1 @ other part ?
ldr r0,[r5,r3,lsl #2] @ load prev part
mov r1,r2 @ store remainder un high part of 64 bits
b 1b
2:
mov r2,r4 @ modulo
bl division32R
str r0,[r5] @ stockage dans le 1er chunk
mov r0,r2 @ return remainder
b 100f
99:
adr r0,szMessNegatif
bl affichageMess
mov r0,#-1
100: @ fin standard de la fonction
pop {r1-r5,pc} @ restaur des registres
szMessNegatif: .asciz "\033[31mLe diviseur doit être positif !\033[0m\n"
.align 4
/***************************************************/
/* division 64 bits number in 2 registers by 32 bits number */
/***************************************************/
/* r0 contains dividende low part */
/* r1 contains dividende high part */
/* r2 contains divisor */
/* r0 return quotient low part */
/* r1 return quotient high part */
/* r2 return remainder */
division32R:
push {r3-r7,lr} @ save registers
mov r6,#0 @ init high high part of remainder !!
@ r1 = high part of number in high part of remainder
mov r7,r0 @ low part of number in low part of remainder
mov r3,#0 @ init high part quotient
mov r4,#0 @ init low part quotient
mov r5,#32
1: @ begin loop
lsl r6,#1 @ left shift high high part of remainder
lsls r1,#1 @ left shift high part of remainder
orrcs r6,#1 @ add left bit high part on high high part
lsls r7,#1 @ left shift low part of remainder
orrcs r1,#1 @ add left bit low part on high part
lsls r4,#1 @ left shift low part quotient
lsl r3,#1 @ left shift high part quotient
orrcs r3,#1 @ add left bit low part on high part
@ sub divisor to high part remainder
subs r1,r2
sbcs r6,#0 @ sub restraint (retenue in french)
bmi 2f @ result negative ?
@ positive or equal
orr r4,#1 @ right bit quotient to 1
b 3f
2: @ negative
orr r4,#0 @ right bit quotient to 0
adds r1,r2 @ and restaure the remainder to precedent value
adc r6,#0 @ and restraint
3:
subs r5,#1 @ decrement indice
bgt 1b @ and loop
mov r0,r4 @ low part quotient
mov r2,r1 @ remainder
mov r1,r3 @ high part quotient
100: @
pop {r3-r7,pc} @ restaur registers
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"
</syntaxhighlight>
{{Out}}
<pre>
Program 32 bits start.
Factor = 18446744073709551616
Result = 340282366920938463463374607431768211456
</pre>
=={{header|Arturo}}==
{{trans|ATS}}
The program is written to operate on strings containing digits and spaces.
<syntaxhighlight lang="arturo">
; The following two functions assume the 7-bit encoding is ASCII.
char2BCD: function [c] [
return (and (to :integer c) 15) % 10
]
BCD2char: function [i] [
return (to :char (or i 48))
]
multiplyBCD: function [u v] [
m: size u
n: size v
w: array.of: (m + n) `0`
predm: m - 1
predn: n - 1
predszw: (size w) - 1
; Long multiplication. See Algorithm 4.3.1M in Volume 2 of Knuth,
; ‘The Art of Computer Programming’. Here b = 10. Only the less
; significant nibble of a character is considered. Thus zero can be
; represented by either `0` or ` `, and other digits by their
; respective ASCII characters.
loop 0..predn 'j [
vj: char2BCD v\[predn - j]
if? vj = 0 [
set w (predn - j) `0`
] else [
carry: 0
loop 0..predm 'i [
ui: char2BCD u\[predm - i]
wij: char2BCD w\[predszw - (i + j)]
t: (ui * vj) + wij + carry
[carry digit]: divmod t 10
set w (predszw - (i + j)) (BCD2char digit)
]
set w (predn - j) (BCD2char carry)
]
]
return join w
]
twoRaised64: "18446744073709551616"
twoRaised128: multiplyBCD twoRaised64 twoRaised64
print twoRaised128
</syntaxhighlight>
{{out}}
<pre>
=={{header|ATS}}==
I perform both binary long multiplication (designed for efficiency) and decimal arithmetic.
The example numbers, though fine for testing decimal arithmetic, are ''very'' bad for testing binary multiplication. For example, they never require a carry. So I have added (for binary multiplication) the example 79 228 162 514 264 337 593 543 950 335 squared equals 6 277 101 735 386 680 763 835 789 423 049 210 091 073 826 769 276 946 612 225. The first number is 96 one-bits.
<syntaxhighlight lang="ats">
(* This is Algorithm 4.3.1M in Volume 2 of Knuth, ‘The Art of Computer
Programming’. *)
#include "share/atspre_staload.hats"
#define NIL list_nil ()
#define :: list_cons
(********************** FOR BINARY ARITHMETIC ***********************)
(* We need to choose a radix for the multiplication, small enough that
intermediate results can be represented, but big for efficiency. To
stay within the POSIX types, I choose 2**32 as my radix. Thus
‘digits’ are stored in uint32 and intermediate results are stored
in uint64.
A number is stored as an array of uint32, with the least
significant uint32 first. *)
extern fn
long_multiplication (* Multiply u and v, giving w. *)
{m, n : int}
(m : size_t m,
n : size_t n,
u : &array (uint32, m),
v : &array (uint32, n),
w : &array (uint32?, m + n) >> array (uint32, m + n))
:<!refwrt> void
%{^
#include <stdint.h>
%}
extern castfn i2u32 : int -<> uint32
extern castfn u32_2i : uint32 -<> int
extern castfn i2u64 : int -<> uint64
extern castfn u32u64 : uint32 -<> uint64
extern castfn u64u32 : uint64 -<> uint32
macdef zero32 = i2u32 0
macdef zero64 = i2u64 0
macdef one32 = i2u32 1
macdef ten32 = i2u32 10
macdef mask32 = $extval (uint32, "UINT32_C (0xFFFFFFFF)")
(* The following implementation is precisely the algorithm suggested
by Knuth, although specialized for b=2**32 and for unsigned
integers of precisely 32 bits. *)
implement
long_multiplication {m, n} (m, n, u, v, w) =
let
(* Establish that the arrays have non-negative lengths. *)
prval () = lemma_array_param u
prval () = lemma_array_param v
(* Knuth initializes only part of the w array. However, if we
initialize ALL of w now, then we will not have to deal with
complicated array views later. *)
val () = array_initize_elt<uint32> (w, m + n, zero32)
(* The following function includes proof of termination. *)
fun
jloop {j : nat | j <= n} .<n - j>.
(u : &array (uint32, m),
v : &array (uint32, n),
w : &array (uint32, m + n),
j : size_t j)
:<!refwrt> void =
if j = n then
()
else if v[j] = zero32 then (* This branch is optional. *)
begin
w[j + m] := zero32;
jloop (u, v, w, succ j)
end
else
let
fun
iloop {i : nat | i <= m} .<m - i>.
(u : &array (uint32, m),
v : &array (uint32, n),
w : &array (uint32, m + n),
i : size_t i,
k : uint64) (* carry *)
:<!refwrt> void =
if i = m then
w[j + m] := u64u32 k
else
let
val t = (u32u64 u[i] * u32u64 v[j])
+ u32u64 w[i + j] + k
in
(* The mask here is not actually needed, if uint32
really is treated by the C compiler as 32 bits. *)
w[i + j] := (u64u32 t) land mask32;
iloop (u, v, w, succ i, t >> 32)
end
in
iloop (u, v, w, i2sz 0, zero64);
jloop (u, v, w, succ j)
end
in
jloop (u, v, w, i2sz 0)
end
fn
big_integer_iseqz (* Is a big integer equal to zero? *)
{m : int}
(m : size_t m,
u : &array (uint32, m))
:<!ref> bool =
let
prval () = lemma_array_param u
fun
loop {n : nat | n <= m} .<n>.
(u : &array (uint32, m),
n : size_t n)
:<!ref> bool =
if n = i2sz 0 then
true
else if u[pred n] = zero32 then
loop (u, pred n)
else
false
in
loop (u, m)
end
(* To print the number in decimal, we need division by 10. So here is
‘short division’: Exercise 4.3.1.16 in Volume 2 of Knuth. *)
fn
short_division
{m : int}
(m : size_t m,
u : &array (uint32, m),
v : uint32,
q : &array (uint32?, m) >> array (uint32, m),
r : &uint32? >> uint32)
:<!refwrt> void =
let
prval () = lemma_array_param u
val () = array_initize_elt<uint32> (q, m, zero32)
val () = r := zero32
fun
loop {i1 : nat | i1 <= m} .<i1>.
(u : &array (uint32, m),
q : &array (uint32, m),
i1 : size_t i1,
r : &uint32)
:<!refwrt> void =
if i1 <> i2sz 0 then
let
val i = pred i1
val tmp = (u32u64 r << 32) lor (u32u64 u[i])
val tmp_q = tmp / u32u64 v and tmp_r = tmp mod (u32u64 v)
in
q[i] := u64u32 tmp_q;
r := u64u32 tmp_r;
loop (u, q, i, r)
end
in
loop (u, q, m, r)
end
fn
fprint_big_integer
{m : int}
(f : FILEref,
m : size_t m,
u : &array (uint32, m))
: void =
let
fun
loop1 (v : &array (uint32, m),
q : &array (uint32, m),
lst : List0 char,
i : uint)
: List0 char =
let
var r : uint32
val () = short_division (m, v, ten32, q, r)
val r = g1ofg0 (u32_2i r)
val () = assertloc ((0 <= r) * (r <= 9))
val digit = int2digit r
in
if big_integer_iseqz (m, q) then
digit :: lst
else if i = 2U then
(* Insert UTF-8 for narrow no-break space U+202F *)
loop1 (q, v, '\xE2' :: '\x80' :: '\xAF' :: digit :: lst, 0U)
else
loop1 (q, v, digit :: lst, succ i)
end
fun
loop2 {n : nat} .<n>.
(lst : list (char, n))
: void =
case+ lst of
| NIL => ()
| hd :: tl => (fprint! (f, hd); loop2 tl)
in
if big_integer_iseqz (m, u) then
fprint! (f, "0")
else
let
val @(pf, pfgc | p) = array_ptr_alloc<uint32> m
val @(qf, qfgc | q) = array_ptr_alloc<uint32> m
val () = array_copy<uint32> (!p, u, m)
val () = array_initize_elt<uint32> (!q, m, zero32)
val () = loop2 (loop1 (!p, !q, NIL, 0U))
val () = array_ptr_free (pf, pfgc | p)
val () = array_ptr_free (qf, qfgc | q)
in
end
end
fn
example_binary (f : FILEref) : void =
let
var u = @[uint32][3] (zero32, zero32, one32)
var v = @[uint32][3] (zero32, zero32, one32)
var w : @[uint32][6]
in
long_multiplication (i2sz 3, i2sz 3, u, v, w);
fprint! (f, "\nBinary long multiplication (b = 2³²)\n\n");
fprint! (f, "u = ");
fprint_big_integer (f, i2sz 3, u);
fprint! (f, "\nv = ");
fprint_big_integer (f, i2sz 3, v);
fprint! (f, "\nu × v = ");
fprint_big_integer (f, i2sz 6, w);
fprint! (f, "\n")
end
fn
test_binary (f : FILEref) : void =
let
var u = @[uint32][3] (mask32, mask32, mask32)
var v = @[uint32][3] (mask32, mask32, mask32)
var w : @[uint32][6]
in
long_multiplication (i2sz 3, i2sz 3, u, v, w);
fprint! (f, "\nThe example numbers specified in the task\n",
"are actually VERY bad for testing binary\n",
"multiplication, because they never need a carry.\n",
"So here is a multiplication full of carries,\n",
"with b = 2³²\n\n");
fprint! (f, "u = ");
fprint_big_integer (f, i2sz 3, u);
fprint! (f, "\nv = ");
fprint_big_integer (f, i2sz 3, v);
fprint! (f, "\nu × v = ");
fprint_big_integer (f, i2sz 6, w);
fprint! (f, "\n")
end
(************** FOR BINARY CODED DECIMAL ARITHMETIC *****************)
(* The following will operate on arrays of BCD digits, with the most
significant digit first. Only the least four bits of a byte will be
considered. This has at least two benefits: any ASCII digit is
treated as its BCD equivalent, and SPACE is treated as zero. *)
extern fn
bcd_multiplication (* Multiply u and v, giving w. *)
{m, n : int}
(m : size_t m,
n : size_t n,
u : &array (char, m),
v : &array (char, n),
w : &array (char?, m + n) >> array (char, m + n))
:<!refwrt> void
fn {}
char2bcd (c : char) :<> intBtwe (0, 9) =
let
val c = char2uchar1 (g1ofg0 c)
val i = g1uint_of_uchar1 c
val i = i mod 16U
val i = i mod 10U (* Guarantees the digit be BCD. *)
in
u2i i
end
extern castfn bcd2char (i : intBtwe (0, 9)) :<> char
(* The following implementation is precisely the algorithm suggested
by Knuth, specialized for b=10. *)
implement
bcd_multiplication {m, n} (m, n, u, v, w) =
let
(* Establish that the arrays have non-negative lengths. *)
prval () = lemma_array_param u
prval () = lemma_array_param v
(* Knuth initializes only part of the w array. However, if we
initialize ALL of w now, then we will not have to deal with
complicated array views later. *)
val () = array_initize_elt<char> (w, m + n, '\0')
(* The following function includes proof of termination. *)
fun
jloop {j : nat | j <= n} .<n - j>.
(u : &array (char, m),
v : &array (char, n),
w : &array (char, m + n),
j : size_t j)
:<!refwrt> void =
if j = n then
()
else if char2bcd v[pred n - j] = 0 then (* Optional branch. *)
begin
w[pred n - j] := '\0';
jloop (u, v, w, succ j)
end
else
let
fun
iloop {i : nat | i <= m} .<m - i>.
(u : &array (char, m),
v : &array (char, n),
w : &array (char, m + n),
i : size_t i,
k : intBtwe (0, 9)) (* carry *)
:<!refwrt> void =
if i = m then
w[pred n - j] := bcd2char k
else
let
val ui = char2bcd u[pred m - i]
and vj = char2bcd v[pred n - j]
and wij = char2bcd w[pred (m + n) - (i + j)]
val t = (ui * vj) + wij + k
(* This will prove that 0 <= t *)
prval [ui : int] EQINT () = eqint_make_gint ui
prval [vj : int] EQINT () = eqint_make_gint vj
prval [t : int] EQINT () = eqint_make_gint t
prval () = mul_gte_gte_gte {ui, vj} ()
prval () = prop_verify {0 <= t} ()
(* But I do not feel like proving that t / 10 <= 9. *)
val t_div_10 = t \ndiv 10 and t_mod_10 = t \nmod 10
val () = $effmask_exn assertloc (t_div_10 <= 9)
in
w[pred (m + n) - (i + j)] := bcd2char t_mod_10;
iloop (u, v, w, succ i, t_div_10)
end
in
iloop (u, v, w, i2sz 0, 0);
jloop (u, v, w, succ j)
end
in
jloop (u, v, w, i2sz 0)
end
fn
fprint_bcd {m : int}
(f : FILEref,
m : size_t m,
u : &array (char, m))
: void =
let
prval () = lemma_array_param u
fun
skip_zeros {i : nat | i <= m} .<m - i>.
(u : &array (char, m),
i : size_t i)
:<!ref> [i : nat | i <= m] size_t i =
if i = m then
i
else if char2bcd u[i] = 0 then
skip_zeros (u, succ i)
else
i
val [i : int] i = skip_zeros (u, i2sz 0)
fun
loop {j : int | i <= j; j <= m} .<m - j>.
(u : &array (char, m),
j : size_t j)
: void =
if j <> m then
begin
if j <> i && (m - j) mod (i2sz 3) = i2sz 0 then
(* Print UTF-8 for narrow no-break space U+202F *)
fprint! (f, "\xE2\x80\xAF");
fprint! (f, int2digit (char2bcd u[j]));
loop (u, succ j)
end
in
if i = m then
fprint! (f, "0")
else
loop (u, i)
end
fn
string2bcd {n : int}
(s : string n)
: [p : agz]
@(array_v (char, p, n), mfree_gc_v p | ptr p) =
let
val n = strlen s
val @(pf, pfgc | p) = array_ptr_alloc<char> n
implement
array_initize$init<char> (i, x) =
let
val i = g1ofg0 i
prval () = lemma_g1uint_param i
val () = assertloc (i < n)
in
x := s[i]
end
val () = array_initize<char> (!p, n)
in
@(pf, pfgc | p)
end
fn
example_bcd (f : FILEref) : void =
let
val s = g1ofg0 "18446744073709551616"
val m = strlen s
val @(pf_u, pfgc_u | p_u) = string2bcd s
val @(pf_v, pfgc_v | p_v) = string2bcd s
val @(pf_w, pfgc_w | p_w) = array_ptr_alloc<char> (m + m)
macdef u = !p_u
macdef v = !p_v
macdef w = !p_w
in
bcd_multiplication (m, m, u, v, w);
fprint! (f, "\nDecimal long multiplication (b = 10)\n\n");
fprint! (f, "u = ");
fprint_bcd (f, m, u);
fprint! (f, "\nv = ");
fprint_bcd (f, m, v);
fprint! (f, "\nu × v = ");
fprint_bcd (f, m + m, w);
fprint! (f, "\n");
array_ptr_free (pf_u, pfgc_u | p_u);
array_ptr_free (pf_v, pfgc_v | p_v);
array_ptr_free (pf_w, pfgc_w | p_w)
end
(********************************************************************)
implement
main () =
begin
example_binary (stdout_ref);
println! ();
example_bcd (stdout_ref);
println! ();
test_binary (stdout_ref);
println! ();
0
end
</syntaxhighlight>
{{out}}
<pre>$ patscc -std=gnu2x -g -O2 -DATS_MEMALLOC_LIBC long_mult_task.dats && ./a.out
Binary long multiplication (b = 2³²)
u = 18 446 744 073 709 551 616
v = 18 446 744 073 709 551 616
u × v = 340 282 366 920 938 463 463 374 607 431 768 211 456
Decimal long multiplication (b = 10)
u = 18 446 744 073 709 551 616
v = 18 446 744 073 709 551 616
u × v = 340 282 366 920 938 463 463 374 607 431 768 211 456
The example numbers specified in the task
are actually VERY bad for testing binary
multiplication, because they never need a carry.
So here is a multiplication full of carries,
with b = 2³²
u = 79 228 162 514 264 337 593 543 950 335
v = 79 228 162 514 264 337 593 543 950 335
u × v = 6 277 101 735 386 680 763 835 789 423 049 210 091 073 826 769 276 946 612 225
</pre>
=={{header|AutoHotkey}}==
Line 1,413 ⟶ 2,799:
700 IF E THEN V = VAL ( MID$ (D$,E,1)) + C:C = V > 9:V = V - 10 * C:E$ = STR$ (V) + E$:E = E - 1: GOTO 700
720 RETURN</syntaxhighlight>
=={{header|BASIC256}}==
{{trans|Liberty BASIC}}
<syntaxhighlight lang="freebasic">print "2^64"
a$ = "1"
for i = 1 to 64
a$ = multByD$(a$, 2)
next
print a$
print "(check with native BASIC-256)"
print 2^64
print "(looks OK)"
#now let's do b$*a$ stuff
print
print "2^64*2^64"
print longMult$(a$, a$)
print "(check with native BASIC-256)"
print 2^64*2^64
print "(looks OK)"
end
function max(a, b)
if a > b then
return a
else
return b
end if
end function
function longMult$(a$, b$)
signA = 1
if left(a$,1) = "-" then
a$ = mid(a$,2,1)
signA = -1
end if
signB = 1
if left(b$,1) = "-" then
b$ = mid(b$,2,1)
signB = -1
end if
c$ = ""
t$ = ""
shift$ = ""
for i = length(a$) to 1 step -1
d = fromradix((mid(a$,i,1)),10)
t$ = multByD$(b$, d)
c$ = addLong$(c$, t$+shift$)
shift$ += "0"
next
if signA * signB < 0 then c$ = "-" + c$
return c$
end function
function multByD$(a$, d)
#multiply a$ by digit d
c$ = ""
carry = 0
for i = length(a$) to 1 step -1
a = fromradix((mid(a$,i,1)),10)
c = a * d + carry
carry = int(c/10)
c = c mod 10
c$ = string(c) + c$
next
if carry > 0 then c$ = string(carry) + c$
return c$
end function
function addLong$(a$, b$)
#add a$ + b$, for now only positive
l = max(length(a$), length(b$))
a$ = pad$(a$,l)
b$ = pad$(b$,l)
c$ = "" #result
carry = 0
for i = l to 1 step -1
a = fromradix((mid(a$,i,1)),10)
b = fromradix((mid(b$,i,1)),10)
c = a + b + carry
carry = int(c/10)
c = c mod 10
c$ = string(c) + c$
next
if carry > 0 then c$ = string(carry) + c$
return c$
end function
function pad$(a$,n) #pad$ from right with 0 to length n
pad$ = a$
while length(pad$) < n
pad$ = "0" + pad$
end while
end function
</syntaxhighlight>
{{out}}
<pre>2^64
18446744073709551616
(check with native BASIC-256)
1.84467440737e+19
(looks OK)
2^64*2^64
340282366920938463463374607431768211456
(check with native BASIC-256)
3.40282366921e+38
(looks OK)</pre>
=={{header|Batch File}}==
Line 2,286 ⟶ 3,780:
<pre>340282366920938463463374607431768211456
340282366920938463463374607431768211456</pre>
=={{header|EasyLang}}==
<syntaxhighlight lang="easylang">
func$ mult a$ b$ .
a[] = number strchars a$
b[] = number strchars b$
len r[] len a[] + len b[]
for ib = len b[] downto 1
h = 0
for ia = len a[] downto 1
h += r[ia + ib] + b[ib] * a[ia]
r[ia + ib] = h mod 10
h = h div 10
.
r[ib] += h
.
r$ = ""
for i = 1 to len r[]
if r$ <> "" or r[i] <> 0 or i = len r[]
r$ &= r[i]
.
.
return r$
.
print mult "18446744073709551616" "18446744073709551616"
</syntaxhighlight>
=={{header|EchoLisp}}==
Line 2,776 ⟶ 4,296:
* <code>buildDecimal</code> (translates a list of decimal digits - possibly including "carry" - to the corresponding extended precision number):
<syntaxhighlight lang="j"> (+ 10x&*)/|. 1 4 10 12 9
15129</syntaxhighlight>
or
<syntaxhighlight lang="j"> 10 #. 1 4 10 12 9
15129</syntaxhighlight>
Line 5,411 ⟶ 6,934:
<pre>
340282366920938463463374607431768211456
</pre>
=={{header|RPL}}==
To solve the task, we need to develop part of a BigInt library to handle very long integers as strings. Addition has been optimized with a 10-digit batch size, but multiplication is long (and slow), as required.
{| class="wikitable"
! RPL code
! Comment
|-
|
≪ → a
≪ 1 '''WHILE''' a OVER DUP SUB "0" == '''REPEAT''' 1 + '''END'''
a SWAP OVER SIZE SUB
≫ ≫ ‘<span style="color:blue">NoZero’</span> STO
≪ '''WHILE''' DUP '''REPEAT''' "0" ROT + SWAP 1 - '''END''' DROP
≫ ‘<span style="color:blue">ZeroFill</span>' STO
≪ DUP2 SIZE SWAP SIZE → sb sa
≪ '''IF''' sa sb < '''THEN''' SWAP '''END'''
sa sb - ABS
≫ ≫ '<span style="color:blue">Swap→Zero</span>' STO
≪ <span style="color:blue">Swap→Zero ZeroFill</span> → a b
≪ "" 1 CF
a SIZE 1 '''FOR''' j
1 FS?C
a j 9 - j SUB STR→ + b j 9 - j SUB STR→ +
'''IF''' DUP 1E10 ≥ '''THEN''' 1E10 - 1 SF '''END'''
→STR 10 OVER SIZE - <span style="color:blue">ZeroFill</span> SWAP +
-10 '''STEP'''
1 FS? →STR SWAP + <span style="color:blue">NoZero </span>
≫ ≫ ‘<span style="color:blue">ADDbig</span>’ STO
≪ → a d
≪ "" 0
a SIZE 1 '''FOR''' j
a j DUP SUB STR→ d * +
10 MOD LAST / IP
SWAP →STR ROT + SWAP
-1 '''STEP'''
'''IF THEN''' LAST →STR SWAP + '''END'''
≫ ≫ ‘<span style="color:blue">DigitMul</span>’ STO
≪ <span style="color:blue">Swap→Zero</span> DROP → a b
≪ "0" b SIZE 1 '''FOR''' j
a b j DUP SUB STR→ <span style="color:blue">DigitMul</span>
"" b SIZE j - <span style="color:blue">ZeroFill</span> + <span style="color:blue">ADDbig</span>
-1 '''STEP'''
≫ ≫ ‘<span style="color:blue">MULbig’ STO
|
<span style="color:blue">NoZero</span> ''( "0..0xyz" → "xyz" ) ''
count leading zeros
keep the rest
<span style="color:blue">ZeroFill</span> ''( "xyz" n → "0..0xyz" ) ''
<span style="color:blue">Swap→Zero</span> ''( a b → a b Δlength ) ''
swap a and b if length(a) < length(b)
return length difference
<span style="color:blue">ADDbig</span> ''( "a" "b" → "a+b" ) ''
res = "" ; carry = 0
for j = length(a) downto 1 step 10
digits = carry
digits += a[j-9..j] + b[j-9..j]
if b > 1E10 then digits -= 1E10 ; carry = 1
convert digits to 10-char string with leading zeros
next j
prepend carry and remove leading zeros
<span style="color:blue">DigitMul</span> ''( "a" d → "a*d" ) ''
res = "" ; carry = 0
for j = length(a) downto 1
digit = a[j]*d
carry = digit // 10
digit %= 10
next j
prepend carry
<span style="color:blue">MULbig</span> ''( "a" "b" → "a*b" ) ''
sum = "0" ; for j = length(b) downto 1
tmp = a * b[j]
shift left tmp length(b)-j times, then add to sum
next j
|}
"18446744073709551616" DUP <span style="color:blue">MULbig</span>
{{out}}
<pre>
1: "340282366920938463463374607431768211456"
</pre>
Line 6,068 ⟶ 7,686:
340282366920938463463374607431768211456
340282366920938463463374607431768211456</pre>
=={{header|uBasic/4tH}}==
{{Trans|Liberty BASIC}}
<syntaxhighlight lang="basic">' now, count 2^64
Print "2^64"
a := "1"
For i = 1 To 64
a = FUNC(_multByD (a, 2))
Next
Print Show (a)
Print "(check with known value)"
Print "18446744073709551616"
Print "(looks OK)"
' now let's do b*a stuff
Print
Print "2^64*2^64"
Print Show (FUNC (_longMult (a, a)))
Print "(check with known value)"
Print "340282366920938463463374607431768211456"
Print "(looks OK)"
End
' ---------------------------------------
_longMult
Param (2)
Local (7)
c@ = 1
If Peek (a@, 0) = Ord ("-") Then a@ = Chop (a@, 1) : c@ = -1
d@ = 1
If Peek (b@, 0) = Ord ("-") Then b@ = Chop (b@, 1) : d@ = -1
e@ := ""
f@ := ""
g@ := ""
For h@ = Len(a@)-1 To 0 Step -1
i@ = Peek (a@, h@) - Ord ("0")
f@ = FUNC(_multByD (b@, i@))
e@ = FUNC(_addLong (e@, Join (f@, g@)))
g@ = Join (g@, "0")
Next ' print i@, f@, e@
' print e@
If c@*d@ < 0 Then e@ = Join ("-", e@)
Return (e@)
_multByD
Param (2) ' multiply a@ by digit b@
Local (5)
c@ := ""
d@ = 0
For e@ = Len (a@)-1 To 0 Step -1
f@ = Peek (a@, e@) - Ord ("0")
g@ = f@*b@ + d@
d@ = g@ / 10)
g@ = g@ % 10
' print f@, g@
c@ = Join (Str (g@), c@)
Next
If d@ > 0 Then c@ = Join (Str (d@), c@)
Return (c@) ' print c@
_addLong ' add a@ + b@, for now only positive
Param (2)
Local (7)
c@ = Max (Len(a@), Len(b@))
a@ = FUNC(_Pad (a@, c@))
b@ = FUNC(_Pad (b@, c@))
d@ := "" ' result
e@ = 0
For f@ = c@-1 To 0 Step -1
g@ = Peek (a@, f@) - Ord ("0")
h@ = Peek (b@, f@) - Ord ("0")
i@ = g@ + h@ + e@
e@ = i@ / 10
i@ = i@ % 10
' print g@, h@, i@
d@ = Join (Str (i@), d@)
Next
' print d@
If e@ > 0 Then d@ = Join (Str (e@), d@)
Return (d@)
_Pad ' pad from right with 0 to length n
Param (2)
Do While Len (a@) < b@
a@ = Join("0", a@)
Loop
Return (a@)</syntaxhighlight>
{{Out}}
<pre>2^64
18446744073709551616
(check with known value)
18446744073709551616
(looks OK)
2^64*2^64
340282366920938463463374607431768211456
(check with known value)
340282366920938463463374607431768211456
(looks OK)
0 OK, 0:478</pre>
=={{header|UNIX Shell}}==
Line 6,243 ⟶ 7,972:
{{trans|Go}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="
// argument validation
| |||