RosettaCodeData/Task/Pascal-matrix-generation/360-Assembly/pascal-matrix-generation.360

135 lines
6.0 KiB
Plaintext

* Pascal matrix generation - 10/06/2018
PASCMATR CSECT
USING PASCMATR,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
MVC MAT,=F'1' mat(1,1)=1
LA R6,1 i=1
DO WHILE=(C,R6,LE,N) do i=1 to n;
LA R7,1 j=1
DO WHILE=(C,R7,LE,N) do j=1 to n;
LR R2,R6 i
LA R3,1(R7) r3=j+1
LR R1,R6 i
BCTR R1,0 -1
MH R1,NN *nn
AR R1,R7 ~(i,j)
SLA R1,2 *4
L R4,MAT-4(R1) r4=mat(i,j)
LR R5,R6 i
MH R5,NN *nn
AR R5,R7 ~(i+1,j)
SLA R5,2 *4
L R5,MAT-4(R5) r5=mat(i+1,j)
AR R4,R5 r4=mat(i,j)+mat(i+1,j)
MH R2,NN *nn
AR R2,R3 ~(i+1,j+1)
SLA R2,2 *4
ST R4,MAT-4(R2) mat(i+1,j+1)=mat(i,j)+mat(i+1,j)
LA R7,1(R7) j++
ENDDO , enddo j
LA R6,1(R6) i++
ENDDO , enddo i
MVC TITLE,=CL20'Upper:'
BAL R14,PRINTMAT call printmat
MVC MAT,=F'1' mat(1,1)=1
LA R6,1 i=1
DO WHILE=(C,R6,LE,N) do i=1 to n;
LA R7,1 j=1
DO WHILE=(C,R7,LE,N) do j=1 to n;
LR R2,R6 i
LA R3,1(R7) r3=j+1
LR R1,R6 i
BCTR R1,0 -1
MH R1,NN *nn
LR R0,R7 j
AR R1,R0 ~(i,j)
SLA R1,2 *4
L R4,MAT-4(R1) r4=mat(i,j)
LA R5,1(R7) j+1
LR R1,R6 i
BCTR R1,0 -1
MH R1,NN *nn
AR R1,R5 ~(i,j+1)
SLA R1,2 *4
L R5,MAT-4(R1) r5=mat(i,j+1)
AR R4,R5 mat(i,j)+mat(i,j+1)
MH R2,NN *nn
AR R2,R3 ~(i+1,j+1)
SLA R2,2 *4
ST R4,MAT-4(R2) mat(i+1,j+1)=mat(i,j)+mat(i,j+1)
LA R7,1(R7) j++
ENDDO , enddo j
LA R6,1(R6) i++
ENDDO , enddo i
MVC TITLE,=CL20'Lower:'
BAL R14,PRINTMAT call printmat
MVC MAT+24,=F'1' mat(2,1)=1
LA R6,1 i=1
DO WHILE=(C,R6,LE,N) do i=1 to n;
LA R7,1 j=1
DO WHILE=(C,R7,LE,N) do j=1 to n;
LR R2,R6 i
LA R3,1(R7) r3=j+1 j
LR R1,R6 i
BCTR R1,0 -1
MH R1,NN *nn
AR R1,R3 ~(i,j+1)
SLA R1,2 *4
L R4,MAT-4(R1) r4=mat(i,j+1)
LR R5,R6 i
MH R5,NN *nn
AR R5,R7 j
SLA R5,2 *4
L R5,MAT-4(R5) r5=mat(i+1,j)
AR R4,R5 mat(i,j+1)+mat(i+1,j)
MH R2,NN *nn
AR R2,R3 ~(i+1,j+1)
SLA R2,2 *4
ST R4,MAT-4(R2) mat(i+1,j+1)=mat(i,j+1)+mat(i+1,j)
LA R7,1(R7) j++
ENDDO , enddo j
LA R6,1(R6) i++
ENDDO , enddo i
MVC TITLE,=CL20'Symmetric:'
BAL R14,PRINTMAT call printmat
L R13,4(0,R13) restore previous savearea pointer
RETURN (14,12),RC=0 restore registers from calling sav
PRINTMAT XPRNT TITLE,L'TITLE print title -----------------------
LA R10,PG pgi=0
LA R6,1 i=1
DO WHILE=(C,R6,LE,N) do i=1 to n;
LA R7,1 j=1
DO WHILE=(C,R7,LE,N) do j=1 to n;
LR R2,R6 i
LR R3,R7 j
LA R3,1(R3) j+1
MH R2,NN *nn
AR R2,R3 ~(i+1,j+1)
SLA R2,2 *4
L R2,MAT-4(R2) mat(i+1,j+1)
XDECO R2,XDEC edit mat(i+1,j+1)
MVC 0(5,R10),XDEC+7 output mat(i+1,j+1)
LA R10,5(R10) pgi+=5
LA R7,1(R7) j++
ENDDO , enddo j
XPRNT PG,L'PG print
LA R10,PG pgi=0
LA R6,1(R6) i++
ENDDO , enddo i
BR R14 return to caller -------------------
X EQU 5 matrix size
N DC A(X) n=x
NN DC AL2(X+1) nn=x+1
MAT DC ((X+1)*(X+1))F'0' mat(x+1,x+1)
TITLE DC CL20' ' title
PG DC CL80' ' buffer
PGI DC H'0' buffer index
XDEC DS CL12 temp
YREGS
END PASCMATR