RosettaCodeData/Task/Number-names/360-Assembly/number-names.360
2017-09-25 22:28:19 +02:00

183 lines
7.3 KiB
Text

* Number names 20/02/2017
NUMNAME CSECT
USING NUMNAME,R13
B 72(R15)
DC 17F'0'
STM R14,R12,12(R13)
ST R13,4(R15)
ST R15,8(R13)
LR R13,R15 end of prolog
LA R6,1 i=1
DO WHILE=(C,R6,LE,=A(NG)) do i=1 to hbound(g)
LR R1,R6 i
SLA R1,2
L R2,G-4(R1) g(i)
ST R2,N n=g(i)
L R4,N
IF LTR,R4,Z,R4 THEN if n=0 then
MVC R,=CL256'zero' r='zero'
ELSE , else
MVC R,=CL256' ' r=''
MVC D,=F'10' d=10
MVC C,=F'100' c=100
MVC K,=F'1000' k=1000
L R2,N n
LPR R2,R2 abs(n)
ST R2,A a=abs(n)
SR R7,R7 j=0
DO WHILE=(C,R7,LE,D) do j=0 to d
L R4,A a
SRDA R4,32
D R4,C /c
M R4,C *a
L R8,A a
SR R8,R5 h=a-c*a/c
IF C,R8,GT,=F'0',AND,C,R8,LT,D THEN if h>0 & h<d then
LR R1,R8 h
MH R1,=H'10'
LA R4,S(R1) @s(h+1)
MVC PG(10),0(R4) s(h+1)
MVC PG+10(246),R !!r
MVC R,PG r=s(h+1)!!' '!!r
ENDIF , endif
IF C,R8,GT,=F'9',AND,C,R8,LT,=F'20' THEN if h>9 & h<20 then
LR R1,R8 h
S R1,D -d
MH R1,=H'10'
LA R4,T(R1) @t(h-d+1)
MVC PG(10),0(R4) t(h-d+1)
MVC PG+10(246),R !!r
MVC R,PG r=t(h-d+1)!!' '!!r
ENDIF , endif
IF C,R8,GT,=F'19',AND,C,R8,LT,C THEN if h>19 & h<c then
LR R4,R8 h
SRDA R4,32
D R4,D /d
M R4,D *d
LR R1,R8 h
SR R1,R5 h-d*(h/d)
ST R1,X x=h-d*(h/d)
L R4,X x
IF LTR,R4,NZ,R4 THEN if x^=0 then
MVI Y,C'-' y='-'
ELSE , else
MVI Y,C' ' y=' '
ENDIF , endif
LR R4,R8 h
SRDA R4,32
D R4,D /d
MH R5,=H'10'
LA R4,U(R5) @u(h/d+1)
MVC PG(10),0(R4) u(h/d+1)
MVC PG+10(1),Y y
L R1,X x
MH R1,=H'10'
LA R4,S(R1) @s(x+1)
MVC PG+11(10),0(R4) s(x+1)
MVC PG+21(235),R !!r
MVC R,PG r=u(h/d+1)!!y!!s(x+1)!!r
ENDIF , endif
L R4,A a
SRDA R4,32
D R4,K a/k
M R4,K *k
L R8,A a
SR R8,R5 h=a-k*(a/k)
LR R4,R8 h
SRDA R4,32
D R4,C /c
LR R8,R5 h=h/c
IF LTR,R8,NZ,R8 THEN if h^=0 then
LR R1,R8 h
MH R1,=H'10'
LA R4,S(R1) @s(h+1)
MVC PG(10),0(R4) s(h+1)
MVC PG+10(10),=CL10' hundred '
MVC PG+20(236),R !!r
MVC R,PG r=s(h+1)!!' hundred '!!r
ENDIF , endif
L R4,A a
SRDA R4,32
D R4,K /k
ST R5,A a=a/k
L R4,A
IF LTR,R4,P,R4 THEN if a>0 then
L R4,A a
SRDA R4,32
D R4,K /k
M R4,K *k
L R8,A a
SR R8,R5 h=a-k*(a/k)
IF LTR,R8,NZ,R8 THEN if h^=0 then
LR R1,R7 j
MH R1,=H'10'
LA R4,V(R1) @v(j+1)
MVC PG(10),0(R4) v(j+1)
MVC PG+10(246),R !!r
MVC R,PG r=v(j+1)!!' '!!r
ENDIF , endif
ENDIF , endif
LA R3,1 l=0
LA R9,256 jr=256
LA R10,R ir=0
LA R11,R-1 irr=-1
LOOP CLI 0(R10),C' ' if r[ii]=' ' .....+
BNE OPT |
CLI 1(R10),C' ' if r[ii+1]=' ' |
BE ITER |
CLI 1(R10),C'-' if r[ii+1]='-' |
BE ITER |
OPT LA R11,1(R11) irr=irr+1 |
MVC 0(1,R11),0(R10) rr=rr!!ci |
LA R3,1(R3) l=l+1 |
ITER LA R10,1(R10) ir=ir+1 |
BCT R9,LOOP ...................+
LA R1,R-1 @r
AR R1,R3 +lr
MVC 0(80,R1),=CL80' ' clean the end
L R4,A a
IF LTR,R4,NP,R4 THEN if a<=0 then
B LEAVEJ leave
ENDIF , endif a<=0
LA R7,1(R7) j++
ENDDO , enddo j
LEAVEJ L R4,N n
IF LTR,R4,M,R4 THEN if n<0 then
MVC PG(6),=C'minus ' 'minus '
MVC PG+6(250),R !!r
MVC R,PG r='minus '!!r
ENDIF , endif n<0
ENDIF , endif n=0
MVC PG,=CL132' ' clear buffer
L R1,N n
XDECO R1,PG edit n
MVC PG+13(256),R r
XPRNT PG,132 print buffer
LA R6,1(R6) i++
ENDDO , enddo i
L R13,4(0,R13) epilog
LM R14,R12,12(R13)
XR R15,R15
BR R14 exit
S DC CL10' ',CL10'one',CL10'two',CL10'three',CL10'four'
DC CL10'five',CL10'six',CL10'seven',CL10'eight',CL10'nine'
T DC CL50'ten eleven twelve thirteen fourteen'
DC CL50'fifteen sixteen seventeen eighteen nineteen'
U DC CL50' twenty thirty forty'
DC CL50'fifty sixty seventy eighty ninety'
V DC CL50'thousand million billion trillion'
G DC F'0',F'2',F'19',F'20',F'21',F'99',F'100',F'101',F'-123'
DC F'9123',F'467889',F'1234567',F'2147483647'
NG EQU (*-G)/4
N DS F
D DS F
C DS F
K DS F
A DS F
X DS F
Y DS CL1
R DS CL256
XDEC DS CL12
PG DS CL256
YREGS
END NUMNAME