Data commit

This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions

View file

@ -0,0 +1,88 @@
* Fibonacci n-step number sequences - 14/04/2020
FIBONS CSECT
USING FIBONS,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
LA R6,2 i=2
DO WHILE=(C,R6,LE,=F'7') do i=2 to 7
ST R6,IR ir=i
IF C,R6,EQ,=F'7' THEN if i=7 then - Lucas
LA R0,2 2
ST R0,IR ir=2
ENDIF , endif
LA R0,1 1
ST R0,T t(1)=1
IF C,R6,EQ,=F'7' THEN if i=7 then - Lucas
LA R0,2 2
ST R0,T t(1)=2
ENDIF , endif
LA R0,1 1
ST R0,T+4 t(2)=1
LA R7,3 j=3
DO WHILE=(C,R7,LE,=A(NMAX)) do j=3 to nmax
SR R0,R0 0
ST R0,SUM sum=0
LR R11,R7 j
S R11,IR j-ir
LR R8,R7 k=j
BCTR R8,0 k=j-1
DO WHILE=(CR,R8,GE,R11) do k=j-1 to j-ir by -1
IF LTR,R8,P,R8 THEN if k>0 then
LR R1,R8 k
SLA R1,2 ~
L R2,T-4(R1) t(k)
L R1,SUM sum
AR R1,R2 +
ST R1,SUM sum=sum+t(k)
ENDIF , endif
BCTR R8,0 k--
ENDDO , enddo k
L R0,SUM sum
LR R1,R7 j
SLA R1,2 ~
ST R0,T-4(R1) t(j)=sum
LA R7,1(R7) j++
ENDDO , enddo j
MVC PG,=CL120' ' clear buffer
LA R9,PG @buffer
LR R1,R6 i
BCTR R1,0 i-1
MH R1,=H'5' ~
LA R4,BONACCI-5(R1) @bonacci(i-1)
MVC 0(5,R9),0(R4) output bonacci(i-1)
LA R9,5(R9) @buffer
IF C,R6,NE,=F'7' THEN if i<>7 then
MVC 0(7,R9),=C'nacci: ' output 'nacci: '
ELSE , else
MVC 0(7,R9),=C' : ' output ' : '
ENDIF , endif
LA R9,7(R9) @buffer
LA R7,1 j=1
DO WHILE=(C,R7,LE,=A(NMAX)) do j=1 to nmax
LR R1,R7 j
SLA R1,2 ~
L R2,T-4(R1) t(j)
XDECO R2,XDEC edit t(j)
MVC 0(6,R9),XDEC+6 output t(j)
LA R9,6(R9) @buffer
LA R7,1(R7) j++
ENDDO , enddo j
XPRNT PG,L'PG print buffer
LA R6,1(R6) i++
ENDDO , enddo i
L R13,4(0,R13) restore previous savearea pointer
RETURN (14,12),RC=0 restore registers from calling sav
NMAX EQU 18 sequence length
BONACCI DC CL5' fibo',CL5'tribo',CL5'tetra',CL5'penta',CL5' hexa'
DC CL5'lucas' bonacci(6)
IR DS F ir
SUM DS F sum
T DS (NMAX)F t(nmax)
XDEC DS CL12 temp for xdeco
PG DS CL120 buffer
REGEQU
END FIBONS