*        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