MTHNAME z/OS BAL Assembler Implementation

Note:

This sample is stored in hlq.HOME.ETC(MTHNAMAS) for PDS deployment and as home/etc/src3gl/mthname.x on all other platforms.
GENCPGM for BAL is only supported on z/OS and the sample on disk is only provided for reference for all other platforms.
On PDS deployment use "-o mthname" to build using alternate source name of MTHNAMAS.

Source:

*
* MTHNAME: Sample User Written Routine in z/OS BAL Assembler
*
* If this is used as a source read directly from an HFS file
* system the extension must be .x for assembler files.
*
MTHNAME  CSECT
MTHNAME  AMODE 31
MTHNAME  RMODE ANY
         STM   14,12,12(13)        save registers
         BALR  12,0                load base reg
         USING *,12
*
         L     3,0(0,1)            load addr of first arg into R3
         LD    4,=D'0.0'           clear out FPR4 and FPR5
         LE    6,0(0,3)            FP number in FPR6
         LPER  4,6                 abs value in FPR4
         AW    4,=D'0.00001'       add rounding constant
         AW    4,DZERO             shift out fraction
         STD   4,FPNUM             move to memory
         L     2,FPNUM+4           integer part in R2
         TM    0(3),B'10000000'    check sign of original no
         BNO   POS                 branch if positive
         LCR   2,2                 complement if negative
*
POS      LR    3,2                 copy month number into R3
         C     2,=F'0'             is it zero or less?
         BNP   INVALID             yes. so invalid
         C     2,=F'12'            is it greater than 12?
         BNP   VALID               no. so valid
INVALID  LA    3,13(0,0)           set R3 to point to item @13 (error)
*

VALID    SR    2,2                 clear out R2
         M     2,=F'9'             multiply by shift in table
*
         LA    6,MTH(3)            get addr of item in R6
         L     4,4(0,1)            get addr of second arg in R4
         MVC   0(9,4),0(6)         move in text
*
         LM    14,12,12(13)        recover regs
         BR    14 return
*
         DS    0D                  alignment
FPNUM    DS    D                   floating point number
DZERO    DC    X'4E00000000000000' shift constant
MTH      DC    CL9'dummyitem'      month table
         DC    CL9'January'
         DC    CL9'February'
         DC    CL9'March'
         DC    CL9'April'
         DC    CL9'May'
         DC    CL9'June'
         DC    CL9'July'
         DC    CL9'August'
         DC    CL9'September'
         DC    CL9'October'
         DC    CL9'November'
         DC    CL9'December'
         DC    CL9'**ERROR**'
         END   MTHNAME

	WebFOCUS