aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

YAPC::EU 2018 Glasgow Update!

Browse source
This commit is contained in:
Ingy döt Net 2018-08-17 15:15:24 +01:00
parent 22f33d4004
commit 4e2d22a71d
1170 changed files with 15042 additions and 3047 deletions
Download patch file Download diff file Expand all files Collapse all files

51
Task/Fibonacci-sequence/360-Assembly/fibonacci-sequence-1.360 Normal file
View file

@ -0,0 +1,51 @@
* Fibonacci sequence 05/11/2014
* integer (31 bits) = 10 decimals -> max fibo(46)
FIBONACC CSECT
USING FIBONACC,R12 base register
SAVEAREA B STM-SAVEAREA(R15) skip savearea
DC 17F'0' savearea
DC CL8'FIBONACC' eyecatcher
STM STM R14,R12,12(R13) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R12,R15 set addressability
* ----
LA R1,0 f(n-2)=0
LA R2,1 f(n-1)=1
LA R4,2 n=2
LA R6,1 step
LH R7,NN limit
LOOP EQU * for n=2 to nn
LR R3,R2 f(n)=f(n-1)
AR R3,R1 f(n)=f(n-1)+f(n-2)
CVD R4,PW n convert binary to packed (PL8)
UNPK ZW,PW packed (PL8) to zoned (ZL16)
MVC CW,ZW zoned (ZL16) to char (CL16)
OI CW+L'CW-1,X'F0' zap sign
MVC WTOBUF+5(2),CW+14 output
CVD R3,PW f(n) binary to packed decimal (PL8)
MVC ZN,EM load mask
ED ZN,PW packed dec (PL8) to char (CL20)
MVC WTOBUF+9(14),ZN+6 output
WTO MF=(E,WTOMSG) write buffer
LR R1,R2 f(n-2)=f(n-1)
LR R2,R3 f(n-1)=f(n)
BXLE R4,R6,LOOP endfor n
* ----
LM R14,R12,12(R13) restore previous savearea pointer
XR R15,R15 return code set to 0
BR R14 return to caller
* ---- DATA
NN DC H'46' nn max n
PW DS PL8 15num
ZW DS ZL16
CW DS CL16
ZN DS CL20
* ' b 0 0 0 , 0 0 0 , 0 0 0 , 0 0 0 , 0 0 0' 15num
EM DC XL20'402020206B2020206B2020206B2020206B202120' mask
WTOMSG DS 0F
DC H'80',XL2'0000'
* fibo(46)=1836311903
WTOBUF DC CL80'fibo(12)=1234567890'
REGEQU
END FIBONACC

48
Task/Fibonacci-sequence/360-Assembly/fibonacci-sequence-2.360 Normal file
View file

@ -0,0 +1,48 @@
* Fibonacci sequence 31/07/2018
* packed dec (PL8) = 15 decimals => max fibo(73)
FIBOWTOP CSECT
USING FIBOWTOP,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
SAVE (14,12) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
* ----
ZAP FNM2,=P'0' f(0)=0
ZAP FNM1,=P'1' f(1)=1
LA R4,2 n=2
LA R6,1 step
LH R7,NN limit
LOOP EQU * for n=2 to nn
ZAP FN,FNM1 f(n)=f(n-2)
AP FN,FNM2 f(n)=f(n-1)+f(n-2)
CVD R4,PW n
MVC ZN,EM load mask
ED ZN,PW packed dec (PL8) to char (CL16)
MVC WTOBUF+5(2),ZN+L'ZN-2 output
MVC ZN,EM load mask
ED ZN,FN packed dec (PL8) to char (CL16)
MVC WTOBUF+9(L'ZN),ZN output
WTO MF=(E,WTOMSG) write buffer
ZAP FNM2,FNM1 f(n-2)=f(n-1)
ZAP FNM1,FN f(n-1)=f(n)
BXLE R4,R6,LOOP endfor n
* ----
L R13,4(0,R13) restore previous savearea pointer
RETURN (14,12),RC=0 restore registers from calling sav
* ---- DATA
NN DC H'73' nn
FNM2 DS PL8 f(n-2)
FNM1 DS PL8 f(n-1)
FN DS PL8 f(n)
PW DS PL8 15num
ZN DS CL20
* ' b 0 0 0 , 0 0 0 , 0 0 0 , 0 0 0 , 0 0 0' 15num
EM DC XL20'402020206B2020206B2020206B2020206B202120' mask
WTOMSG DS 0F
DC H'80',XL2'0000'
* fibo(73)=806515533049393
WTOBUF DC CL80'fibo(12)=123456789012345 '
REGEQU
END FIBOWTOP

49
Task/Fibonacci-sequence/360-Assembly/fibonacci-sequence.360
View file

@ -1,49 +0,0 @@
FIBONACC CSECT
USING FIBONACC,R12
SAVEAREA B STM-SAVEAREA(R15)
DC 17F'0'
DC CL8'FIBONACC'
STM STM R14,R12,12(R13)
ST R13,4(R15)
ST R15,8(R13)
LR R12,R15
* ---- CODE
LA R1,0 f1=0
LA R2,1 f2=1
LA R4,1 i=1
LA R6,1
LH R7,N
LOOP BXH R4,R6,ENDLOOP for i=2 to n
LR R3,R2
AR R3,R1 f3=f1+f2
CVD R4,P i
UNPK Z,P
MVC C,Z
OI C+L'C-1,X'F0'
MVC WTOBUF+5(5),C+11
CVD R3,P f3
UNPK Z,P
MVC C,Z
OI C+L'C-1,X'F0'
MVC WTOBUF+12(10),C+6
WTO MF=(E,WTOMSG)
LR R1,R2 f1=f2
LR R2,R3 f2=f3
B LOOP next i
ENDLOOP EQU *
* ---- END CODE
RETURN EQU *
LM R14,R12,12(R13)
XR R15,R15
BR R14
* ---- DATA
N DC H'46' max i
P DS PL8
Z DS ZL16
C DS CL16
WTOMSG DS 0F
DC H'80'
DC H'0'
WTOBUF DC CL80'fibo(12345)=1234567890 '
YREGS
END FIBONACC

3
Task/Fibonacci-sequence/Common-Lisp/fibonacci-sequence-7.lisp
View file

@ -1,7 +1,4 @@
;; Project : Fibonacci sequence
;; Date : 2018/03/05
;; Author : Gal Zsolt [~ CalmoSoft ~]
;; Email : <calmosoft@gmail.com
(defun fibonacci (nr)
(cond ((= nr 0) 1)

44
Task/Fibonacci-sequence/Fortran/fibonacci-sequence-1.f
View file

@ -1,24 +1,22 @@
FUNCTION IFIB(N)
IF (N.EQ.0) THEN
ITEMP0=0
ELSE IF (N.EQ.1) THEN
ITEMP0=1
ELSE IF (N.GT.1) THEN
ITEMP1=0
ITEMP0=1
DO 1 I=2,N
ITEMP2=ITEMP1
ITEMP1=ITEMP0
ITEMP0=ITEMP1+ITEMP2
1 CONTINUE
ELSE
ITEMP1=1
ITEMP0=0
DO 2 I=-1,N,-1
ITEMP2=ITEMP1
ITEMP1=ITEMP0
ITEMP0=ITEMP2-ITEMP1
2 CONTINUE
END IF
IFIB=ITEMP0
C FIBONACCI SEQUENCE - FORTRAN IV
NN=46
DO 1 I=0,NN
1 WRITE(*,300) I,IFIBO(I)
300 FORMAT(1X,I2,1X,I10)
END
C
FUNCTION IFIBO(N)
IF(N) 9,1,2
1 IFN=0
GOTO 9
2 IF(N-1) 9,3,4
3 IFN=1
GOTO 9
4 IFNM1=0
IFN=1
DO 5 I=2,N
IFNM2=IFNM1
IFNM1=IFN
5 IFN=IFNM1+IFNM2
9 IFIBO=IFN
END

33
Task/Fibonacci-sequence/Fortran/fibonacci-sequence-2.f
View file

@ -1,11 +1,24 @@
EXTERNAL IFIB
CHARACTER*10 LINE
PARAMETER ( LINE = '----------' )
WRITE(*,900) 'N', 'F[N]', 'F[-N]'
WRITE(*,900) LINE, LINE, LINE
DO 1 N = 0, 10
WRITE(*,901) N, IFIB(N), IFIB(-N)
1 CONTINUE
900 FORMAT(3(X,A10))
901 FORMAT(3(X,I10))
FUNCTION IFIB(N)
IF (N.EQ.0) THEN
ITEMP0=0
ELSE IF (N.EQ.1) THEN
ITEMP0=1
ELSE IF (N.GT.1) THEN
ITEMP1=0
ITEMP0=1
DO 1 I=2,N
ITEMP2=ITEMP1
ITEMP1=ITEMP0
ITEMP0=ITEMP1+ITEMP2
1 CONTINUE
ELSE
ITEMP1=1
ITEMP0=0
DO 2 I=-1,N,-1
ITEMP2=ITEMP1
ITEMP1=ITEMP0
ITEMP0=ITEMP2-ITEMP1
2 CONTINUE
END IF
IFIB=ITEMP0
END

23
Task/Fibonacci-sequence/Fortran/fibonacci-sequence-3.f
View file

@ -1,12 +1,11 @@
module fibonacci
contains
recursive function fibR(n) result(fib)
integer, intent(in) :: n
integer :: fib
select case (n)
case (:0); fib = 0
case (1); fib = 1
case default; fib = fibR(n-1) + fibR(n-2)
end select
end function fibR
EXTERNAL IFIB
CHARACTER*10 LINE
PARAMETER ( LINE = '----------' )
WRITE(*,900) 'N', 'F[N]', 'F[-N]'
WRITE(*,900) LINE, LINE, LINE
DO 1 N = 0, 10
WRITE(*,901) N, IFIB(N), IFIB(-N)
1 CONTINUE
900 FORMAT(3(X,A10))
901 FORMAT(3(X,I10))
END

26
Task/Fibonacci-sequence/Fortran/fibonacci-sequence-4.f
View file

@ -1,20 +1,12 @@
function fibI(n)
module fibonacci
contains
recursive function fibR(n) result(fib)
integer, intent(in) :: n
integer, parameter :: fib0 = 0, fib1 = 1
integer :: fibI, back1, back2, i
integer :: fib
select case (n)
case (:0); fibI = fib0
case (1); fibI = fib1
case default
fibI = fib1
back1 = fib0
do i = 2, n
back2 = back1
back1 = fibI
fibI = back1 + back2
end do
end select
end function fibI
end module fibonacci
case (:0); fib = 0
case (1); fib = 1
case default; fib = fibR(n-1) + fibR(n-2)
end select
end function fibR

25
Task/Fibonacci-sequence/Fortran/fibonacci-sequence-5.f
View file

@ -1,7 +1,20 @@
program fibTest
use fibonacci
function fibI(n)
integer, intent(in) :: n
integer, parameter :: fib0 = 0, fib1 = 1
integer :: fibI, back1, back2, i
do i = 0, 10
print *, fibr(i), fibi(i)
end do
end program fibTest
select case (n)
case (:0); fibI = fib0
case (1); fibI = fib1
case default
fibI = fib1
back1 = fib0
do i = 2, n
back2 = back1
back1 = fibI
fibI = back1 + back2
end do
end select
end function fibI
end module fibonacci

7
Task/Fibonacci-sequence/Fortran/fibonacci-sequence-6.f Normal file
View file

@ -0,0 +1,7 @@
program fibTest
use fibonacci
do i = 0, 10
print *, fibr(i), fibi(i)
end do
end program fibTest

2
Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-2.pari
View file

@ -1 +1 @@
fibo(n)=([1,1;1,0]^n)[1,2]
fib(n)=([1,1;1,0]^n)[1,2]

34
Task/Fibonacci-sequence/VAX-Assembly/fibonacci-sequence.vax Normal file
View file

@ -0,0 +1,34 @@
0000 0000 1 .entry main,0
7E 7CFD 0002 2 clro -(sp) ;result buffer
5E DD 0005 3 pushl sp ;pointer to buffer
10 DD 0007 4 pushl #16 ;descriptor: len of buffer
5B 5E D0 0009 5 movl sp, r11 ;-> descriptor
000C 6
7E 01 7D 000C 7 movq #1, -(sp) ;init 0,1
000F 8 loop:
7E 6E 04 AE C1 000F 9 addl3 4(sp), (sp), -(sp) ;next element on stack
17 1D 0014 10 bvs ret ;vs - overflow set, exit
0016 11
5B DD 0016 12 pushl r11 ;-> descriptor by ref
04 AE DF 0018 13 pushal 4(sp) ;-> fib on stack by ref
00000000'GF 02 FB 001B 14 calls #2, g^ots$cvt_l_ti ;convert integer to string
5B DD 0022 15 pushl r11 ;
00000000'GF 01 FB 0024 16 calls #1, g^lib$put_output ;show result
E2 11 002B 17 brb loop
002D 18 ret:
04 002D 19 ret
002E 20 .end main
$ run fib
...
14930352
24157817
39088169
63245986
102334155
165580141
267914296
433494437
701408733
1134903170
1836311903
$

28
Task/Fibonacci-sequence/Visual-Basic-.NET/fibonacci-sequence-3.visual Normal file
View file

@ -0,0 +1,28 @@
Function FiboBig(ByVal n As Integer) As BigInteger
' Fibonacci sequence with BigInteger
Dim fibn2, fibn1, fibn As BigInteger
Dim i As Integer
fibn = 0
fibn2 = 0
fibn1 = 1
If n = 0 Then
Return fibn2
ElseIf n = 1 Then
Return fibn1
ElseIf n >= 2 Then
For i = 2 To n
fibn = fibn2 + fibn1
fibn2 = fibn1
fibn1 = fibn
Next i
Return fibn
End If
Return 0
End Function 'FiboBig
Sub fibotest()
Dim i As Integer, s As String
i = 2000000 ' 2 millions
s = FiboBig(i).ToString
Console.WriteLine("fibo(" & i & ")=" & s & " - length=" & Len(s))
End Sub 'fibotest