RosettaCodeData/Task/Factorial/360-Assembly/factorial.360

65 lines
1.8 KiB
Plaintext

FACTO CSECT
USING FACTO,R13
SAVEAREA B STM-SAVEAREA(R15)
DC 17F'0'
DC CL8'FACTO'
STM STM R14,R12,12(R13)
ST R13,4(R15)
ST R15,8(R13)
LR R13,R15 base register and savearea pointer
ZAP N,=P'1' n=1
LOOPN CP N,NN if n>nn
BH ENDLOOPN then goto endloop
LA R1,PARMLIST
L R15,=A(FACT)
BALR R14,R15 call fact(n)
ZAP F,0(L'R,R1) f=fact(n)
DUMP EQU *
MVC S,MASK
ED S,N
MVC WTOBUF+5(2),S+30
MVC S,MASK
ED S,F
MVC WTOBUF+9(32),S
WTO MF=(E,WTOMSG)
AP N,=P'1' n=n+1
B LOOPN
ENDLOOPN EQU *
RETURN EQU *
L R13,4(0,R13)
LM R14,R12,12(R13)
XR R15,R15
BR R14
FACT EQU * function FACT(l)
L R2,0(R1)
L R3,12(R2)
ZAP L,0(L'N,R2) l=n
ZAP R,=P'1' r=1
ZAP I,=P'2' i=2
LOOP CP I,L if i>l
BH ENDLOOP then goto endloop
MP R,I r=r*i
AP I,=P'1' i=i+1
B LOOP
ENDLOOP EQU *
LA R1,R return r
BR R14 end function FACT
DS 0D
NN DC PL16'29'
N DS PL16
F DS PL16
C DS CL16
II DS PL16
PARMLIST DC A(N)
S DS CL33
MASK DC X'40',29X'20',X'212060' CL33
WTOMSG DS 0F
DC H'80',XL2'0000'
WTOBUF DC CL80'FACT(..)=................................ '
L DS PL16
R DS PL16
I DS PL16
LTORG
YREGS
END FACTO