RosettaCodeData/Task/Prime-decomposition/360-Assembly/prime-decomposition.360

77 lines
2.2 KiB
Plaintext

PRIMEDE CSECT
USING PRIMEDE,R13
B 80(R15) skip savearea
DC 17F'0' savearea
DC CL8'PRIMEDE'
STM R14,R12,12(R13)
ST R13,4(R15)
ST R15,8(R13)
LR R13,R15 end prolog
LA R2,0
LA R3,1023
LA R4,1024
MR R2,R4
ST R3,N n=1023*1024
LA R5,WBUFFER
LA R6,0
L R1,N n
XDECO R1,0(R5)
LA R5,12(R5)
MVC 0(3,R5),=C' : '
LA R5,3(R5)
LA R0,2
ST R0,I i=2
WHILE1 EQU * do while(i<=n/2)
L R2,N
SRA R2,1
L R4,I
CR R4,R2 i<=n/2
BH EWHILE1
WHILE2 EQU * do while(n//i=0)
L R3,N
LA R2,0
D R2,I
LTR R2,R2 n//i=0
BNZ EWHILE2
ST R3,N n=n/i
ST R3,M m=n
L R1,I i
XDECO R1,WDECO
MVC 0(5,R5),WDECO+7
LA R5,5(R5)
MVI OK,X'01' ok
B WHILE2
EWHILE2 EQU *
L R4,I
CH R4,=H'2' if i=2 then
BNE NE2
LA R0,3
ST R0,I i=3
B EIFNE2
NE2 L R2,I else
LA R2,2(R2)
ST R2,I i=i+2
EIFNE2 B WHILE1
EWHILE1 EQU *
CLI OK,X'01' if ^ok then
BE NOTPRIME
MVC 0(7,R5),=C'[prime]'
LA R5,7(R5)
B EPRIME
NOTPRIME L R1,M m
XDECO R1,WDECO
MVC 0(5,R5),WDECO+7
EPRIME XPRNT WBUFFER,80 put
L R13,4(0,R13) epilog
LM R14,R12,12(R13)
XR R15,R15
BR R14
N DS F
I DS F
M DS F
OK DC X'00'
WBUFFER DC CL80' '
WDECO DS CL16
YREGS
END PRIMEDE