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

Data commit

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

108
Task/Hamming-numbers/360-Assembly/hamming-numbers.360 Normal file
View file

@ -0,0 +1,108 @@
* Hamming numbers 12/03/2017
HAM CSECT
USING HAM,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
STM R14,R12,12(R13) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
LA R6,1 ii=1
DO WHILE=(C,R6,LE,=F'20') do ii=1 to 20
BAL R14,PRTHAM call prtham
LA R6,1(R6) ii++
ENDDO , enddo ii
LA R6,1691 ii=1691
BAL R14,PRTHAM call prtham
L R13,4(0,R13) restore previous savearea pointer
LM R14,R12,12(R13) restore previous context
XR R15,R15 rc=0
BR R14 exit
PRTHAM EQU * ---- prtham
ST R14,R14PRT save return addr
LR R1,R6 ii
XDECO R1,XDEC edit
MVC PG+2(4),XDEC+8 output ii
LR R1,R6 ii
BAL R14,HAMMING call hamming(ii)
XDECO R0,XDEC edit
MVC PG+8(10),XDEC+2 output hamming(ii)
XPRNT PG,L'PG print buffer
L R14,R14PRT restore return addr
BR R14 ---- return
HAMMING EQU * ---- hamming(ll)
ST R14,R14HAM save return addr
ST R1,LL ll
MVC HH,=F'1' h(1)=1
SR R0,R0 0
ST R0,I i=0
ST R0,J j=0
ST R0,K k=0
MVC X2,=F'2' x2=2
MVC X3,=F'3' x3=3
MVC X5,=F'5' x5=5
LA R7,1 n=1
L R2,LL ll
BCTR R2,0 -1
ST R2,LLM1 ll-1
DO WHILE=(C,R7,LE,LLM1) do n=1 to ll-1
L R4,X2 m=x2
IF C,R4,GT,X3 THEN if m>x3 then
L R4,X3 m=x3
ENDIF , endif
IF C,R4,GT,X5 THEN if m>x5 then
L R4,X5 m=x5
ENDIF , endif
LR R1,R7 n
SLA R1,2 *4
ST R4,HH(R1) h(n+1)=m
IF C,R4,EQ,X2 THEN if m=x2 then
L R1,I i
LA R1,1(R1) i+1
ST R1,I i=i+1
SLA R1,2 *4
L R2,HH(R1) h(i+1)
MH R2,=H'2' *2
ST R2,X2 x2=2*h(i+1)
ENDIF , endif
IF C,R4,EQ,X3 THEN if m=x3 then
L R1,J j
LA R1,1(R1) j+1
ST R1,J j=j+1
SLA R1,2 *4
L R2,HH(R1) h(j+1)
MH R2,=H'3' *3
ST R2,X3 x3=3*h(j+1)
ENDIF , endif
IF C,R4,EQ,X5 THEN if m=x5 then
L R1,K k
LA R1,1(R1) k+1
ST R1,K k=k+1
SLA R1,2 *4
L R2,HH(R1) h(k+1)
MH R2,=H'5' *5
ST R2,X5 x5=5*h(k+1)
ENDIF , endif
LA R7,1(R7) n++
ENDDO , enddo n
L R1,LL ll
SLA R1,2 *4
L R0,HH-4(R1) return h(ll)
L R14,R14HAM restore return addr
BR R14 ---- return
R14HAM DS A return addr of hamming
R14PRT DS A return addr of print
LL DS F ll
LLM1 DS F ll-1
I DS F i
J DS F j
K DS F k
X2 DS F x2
X3 DS F x3
X5 DS F x5
PG DC CL80'H(xxxx)=xxxxxxxxxx'
XDEC DS CL12 temp
LTORG positioning literal pool
HH DS 1691F array h(1691)
YREGS
END HAM