72 lines
3.1 KiB
Text
72 lines
3.1 KiB
Text
* Stern-Brocot sequence - 12/03/2019
|
|
STERNBR CSECT
|
|
USING STERNBR,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 R4,SB+2 k=2; @sb(k)
|
|
LA R2,SB+2 i=1; @sb(k-i)
|
|
LA R3,SB+0 j=2; @sb(k-j)
|
|
LA R1,NN/2 loop counter
|
|
LOOP LA R4,2(R4) @sb(k)++
|
|
LH R0,0(R2) sb(k-i)
|
|
AH R0,0(R3) sb(k-i)+sb(k-j)
|
|
STH R0,0(R4) sb(k)=sb(k-i)+sb(k-j)
|
|
LA R3,2(R3) @sb(k-j)++
|
|
LA R4,2(R4) @sb(k)++
|
|
LH R0,0(R3) sb(k-j)
|
|
STH R0,0(R4) sb(k)=sb(k-j)
|
|
LA R2,2(R2) @sb(k-i)++
|
|
BCT R1,LOOP end loop
|
|
LA R9,15 n=15
|
|
MVC PG(5),=CL80'FIRST'
|
|
XDECO R9,XDEC edit n
|
|
MVC PG+5(3),XDEC+9 output n
|
|
XPRNT PG,L'PG print buffer
|
|
LA R10,PG @pg
|
|
LA R6,1 i=1
|
|
DO WHILE=(CR,R6,LE,R9) do i=1 to n
|
|
LR R1,R6 i
|
|
SLA R1,1 ~
|
|
LH R2,SB-2(R1) sb(i)
|
|
XDECO R2,XDEC edit sb(i)
|
|
MVC 0(4,R10),XDEC+8 output sb(i)
|
|
LA R10,4(R10) @pg+=4
|
|
LA R6,1(R6) i++
|
|
ENDDO , enddo i
|
|
XPRNT PG,L'PG print buffer
|
|
LA R7,1 j=1
|
|
DO WHILE=(C,R7,LE,=A(11)) do j=1 to 11
|
|
IF C,R7,EQ,=F'11' THEN if j=11 then
|
|
LA R7,100 j=100
|
|
ENDIF , endif
|
|
LA R6,1 i=1
|
|
DO WHILE=(C,R6,LE,=A(NN)) do i=1 to nn
|
|
LR R1,R6 i
|
|
SLA R1,1 ~
|
|
LH R2,SB-2(R1) sb(i)
|
|
CR R2,R7 if sb(i)=j
|
|
BE EXITI then leave i
|
|
LA R6,1(R6) i++
|
|
ENDDO , enddo i
|
|
EXITI MVC PG,=CL80'FIRST INSTANCE OF'
|
|
XDECO R7,XDEC edit j
|
|
MVC PG+17(4),XDEC+8 output j
|
|
MVC PG+21(7),=C' IS AT '
|
|
XDECO R6,XDEC edit i
|
|
MVC PG+28(4),XDEC+8 output i
|
|
XPRNT PG,L'PG print buffer
|
|
LA R7,1(R7) j++
|
|
ENDDO , enddo j
|
|
L R13,4(0,R13) restore previous savearea pointer
|
|
RETURN (14,12),RC=0 restore registers from calling sav
|
|
LTORG
|
|
NN EQU 2400 nn
|
|
PG DC CL80' ' buffer
|
|
XDEC DS CL12 temp for xdeco
|
|
SB DC (NN)H'1' sb(nn)
|
|
REGEQU
|
|
END STERNBR
|