*        Ackermann function        07/09/2015
&LAB     XDECO &REG,&TARGET
.*-----------------------------------------------------------------*
.*       THIS MACRO DISPLAYS THE REGISTER CONTENTS AS A TRUE       *
.*       DECIMAL VALUE. XDECO IS NOT PART OF STANDARD S360 MACROS! *
*------------------------------------------------------------------*
         AIF   (T'&REG EQ 'O').NOREG
         AIF   (T'&TARGET EQ 'O').NODEST
&LAB     B     I&SYSNDX               BRANCH AROUND WORK AREA
W&SYSNDX DS    XL8                    CONVERSION WORK AREA
I&SYSNDX CVD   &REG,W&SYSNDX          CONVERT TO DECIMAL
         MVC   &TARGET,=XL12'402120202020202020202020'
         ED    &TARGET,W&SYSNDX+2     MAKE FIELD PRINTABLE
         BC    2,*+12                 BYPASS NEGATIVE
         MVI   &TARGET+12,C'-'        INSERT NEGATIVE SIGN
         B     *+8                    BYPASS POSITIVE
         MVI   &TARGET+12,C'+'        INSERT POSITIVE SIGN
         MEXIT
.NOREG   MNOTE 8,'INPUT REGISTER OMITTED'
         MEXIT
.NODEST  MNOTE 8,'TARGET FIELD OMITTED'
         MEXIT
         MEND
ACKERMAN CSECT
         USING  ACKERMAN,R12       r12 : base register
         LR     R12,R15            establish base register
         ST     R14,SAVER14A       save r14
         LA     R4,0               m=0
LOOPM    CH     R4,=H'3'           do m=0 to 3
         BH     ELOOPM
         LA     R5,0               n=0
LOOPN    CH     R5,=H'8'           do n=0 to 8
         BH     ELOOPN
         LR     R1,R4              m
         LR     R2,R5              n
         BAL    R14,ACKER          r1=acker(m,n)
         XDECO  R1,PG+19
         XDECO  R4,XD
         MVC    PG+10(2),XD+10
         XDECO  R5,XD
         MVC    PG+13(2),XD+10
         XPRNT  PG,44              print buffer
         LA     R5,1(R5)           n=n+1
         B      LOOPN
ELOOPN   LA     R4,1(R4)           m=m+1
         B      LOOPM
ELOOPM   L      R14,SAVER14A       restore r14
         BR     R14                return to caller
SAVER14A DS     F                  static save r14
PG       DC     CL44'Ackermann(xx,xx) = xxxxxxxxxxxx'
XD       DS     CL12
ACKER    CNOP   0,4                function r1=acker(r1,r2)
         LR     R3,R1              save argument r1 in r3
         LR     R9,R10             save stackptr (r10) in r9 temp
         LA     R1,STACKLEN        amount of storage required
         GETMAIN RU,LV=(R1)        allocate storage for stack
         USING  STACK,R10          make storage addressable
         LR     R10,R1             establish stack addressability
         ST     R14,SAVER14B       save previous r14
         ST     R9,SAVER10B        save previous r10
         LR     R1,R3              restore saved argument r1
START    ST     R1,M               stack m
         ST     R2,N               stack n
IF1      C      R1,=F'0'           if m<>0
         BNE    IF2                then goto if2
         LR     R11,R2             n
         LA     R11,1(R11)         return n+1
         B      EXIT
IF2      C      R2,=F'0'           else if m<>0
         BNE    IF3                then goto if3
         BCTR   R1,0               m=m-1
         LA     R2,1               n=1
         BAL    R14,ACKER          r1=acker(m)
         LR     R11,R1             return acker(m-1,1)
         B      EXIT
IF3      BCTR   R2,0               n=n-1
         BAL    R14,ACKER          r1=acker(m,n-1)
         LR     R2,R1              acker(m,n-1)
         L      R1,M               m
         BCTR   R1,0               m=m-1
         BAL    R14,ACKER          r1=acker(m-1,acker(m,n-1))
         LR     R11,R1             return acker(m-1,1)
EXIT     L      R14,SAVER14B       restore r14
         L      R9,SAVER10B        restore r10 temp
         LA     R0,STACKLEN        amount of storage to free
         FREEMAIN A=(R10),LV=(R0)  free allocated storage
         LR     R1,R11             value returned
         LR     R10,R9             restore r10
         BR     R14                return to caller
         LTORG
         DROP   R12                base no longer needed
STACK    DSECT                     dynamic area
SAVER14B DS     F                  saved r14
SAVER10B DS     F                  saved r10
M        DS     F                  m
N        DS     F                  n
STACKLEN EQU    *-STACK
         YREGS
         END    ACKERMAN