74 lines
3.2 KiB
Plaintext
74 lines
3.2 KiB
Plaintext
* Identity matrix 31/03/2017
|
|
INDENMAT CSECT
|
|
USING INDENMAT,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
|
|
L R1,N n
|
|
MH R1,N+2 n*n
|
|
SLA R1,2 *4
|
|
ST R1,LL amount of storage required
|
|
GETMAIN RU,LV=(R1) allocate storage for matrix
|
|
USING DYNA,R11 make storage addressable
|
|
LR R11,R1 set addressability
|
|
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
|
|
IF CR,R6,EQ,R7 THEN if i=j then
|
|
LA R2,1 k=1
|
|
ELSE , else
|
|
LA R2,0 k=0
|
|
ENDIF , endif
|
|
LR R1,R6 i
|
|
BCTR R1,0 -1
|
|
MH R1,N+2 *n
|
|
AR R1,R7 (i-1)*n+j
|
|
BCTR R1,0 -1
|
|
SLA R1,2 *4
|
|
ST R2,A(R1) a(i,j)=k
|
|
LA R7,1(R7) j++
|
|
ENDDO , enddo j
|
|
LA R6,1(R6) i++
|
|
ENDDO , enddo i
|
|
LA R6,1 i=1
|
|
DO WHILE=(C,R6,LE,N) do i=1 to n
|
|
LA R10,PG pgi=0
|
|
LA R7,1 j=1
|
|
DO WHILE=(C,R7,LE,N) do j=1 to n
|
|
LR R1,R6 i
|
|
BCTR R1,0 -1
|
|
MH R1,N+2 *n
|
|
AR R1,R7 (i-1)*n+j
|
|
BCTR R1,0 -1
|
|
SLA R1,2 *4
|
|
L R2,A(R1) a(i,j)
|
|
XDECO R2,XDEC edit
|
|
MVC 0(1,R10),XDEC+11 output
|
|
LA R10,1(R10) pgi+=1
|
|
LA R7,1(R7) j++
|
|
ENDDO , enddo j
|
|
XPRNT PG,L'PG print
|
|
LA R6,1(R6) i++
|
|
ENDDO , enddo i
|
|
LA R1,A address to free
|
|
LA R2,LL amount of storage to free
|
|
FREEMAIN A=(R1),LV=(R2) free allocated storage
|
|
DROP R11 drop register
|
|
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
|
|
NN EQU 10 parameter n (90=>32K)
|
|
N DC A(NN) n
|
|
LL DS F n*n*4
|
|
PG DC CL(NN)' ' buffer
|
|
XDEC DS CL12 temp
|
|
DYNA DSECT
|
|
A DS F a(n,n)
|
|
YREGS
|
|
END INDENMAT
|