REXXFUNC AMODE 31
REXXFUNC RMODE ANY
* ---------------------------------------------------------------------
* REXX demo: Writing External Function Code
*
*            translates the first character of the first argument
*            into its hexadecimal EBCDIC representation
* ---------------------------------------------------------------------
REXXFUNC CSECT
R0       EQU   0                       ADDRESS OF ENVIRONMENT BLOCK
R1       EQU   1                       PARAMETER REGISTER
R2       EQU   2                       ADDR. OF EXT. FUNCT. PAR. LIST
R6       EQU   6
R7       EQU   7                       WORK REGISTER
R8       EQU   8                       ADDRESS OF ARGUMENT LIST
R9       EQU   9                       ADDRESS OF EVALUATION BLOCK
R10      EQU   10                      BASE REGISTER
R11      EQU   11
R12      EQU   12
R13      EQU   13                      ADDRESS OF CALLER SAVEAREA
R14      EQU   14                      ADDRESS OF CALLER RETURN POINT
R15      EQU   15                      RETURN CODE
* -------------start of module processing------------------------------
         STM   R14,R12,12(R13)
         BALR  R10,R0
         USING *,R10                   BASE REG 10
         B     GOON
EYECAT1  DC    CL16'****REXXFUNC****'
* -------------parameter checking--------------------------------------
GOON     LR    R2,R1
         USING EFPL,R2                 POINT TO PARMLIST
         L     R8,EFPLARG              SAVE ARGUMENT LIST POINTER
         USING ARGTABLE_ENTRY,R8
         L     R7,ARGTABLE_ARGSTRING_PTR  POINTER TO FIRST ARGUMENT
         LTR   R7,R7
         LTR   R7,R7
         BNP   DEFAULT                 IF 'FFFFFFFF'X THEN DEFAULT
* -------------conversion----------------------------------------------
         L     R7,0(R7)                FIRST ARGUMENT
         SRL   R7,20
         ST    R7,TEMP8+4
         OI    TEMP8+7,X'0F'
         UNPK  TEMP8,TEMP8
         MVC   RESULT+1(2),TEMP8+6
         TR    RESULT+1(2),TRTABLE     TRANSLATE FX-VALUES
* -------------function result processing------------------------------
DEFAULT  L     R9,EFPLEVAL             SAVE EVALUATION BLOCK POINTER
         LA    R7,RESULT               RETURN VALUE
         L     R9,0(R9)                POINT TO EVALBLOCK
         USING EVALBLOCK,R9
         LA    R6,X'00000005'          SET REPLY LENGTH
         ST    R6,EVALBLOCK_EVLEN      STORE REPLY LENGTH IN EVALBLOCK
         MVC   EVALBLOCK_EVDATA(5),0(R7)
* -------------end of module processing--------------------------------
         SR    R15,R15                 SET R15 TO ZERO
         ST    R15,16(R13)             SAVE R15 IN SAVE AREA
         LM    R14,R12,12(R13)         RETURN TO CALLER
         BR    R14
* -------------data----------------------------------------------------
         DS    0F
TEMP8    DS    CL8                     WORK AREA
RESULT   DC    C'''00''X'              RESULT AREA
TRTABLE  DS    CL240                   TRANSLATION TABLE
TRTABLE1 DC    X'F0F1F2F3F3F5F6F7F8F9C1C2C3C4C5C6'
         LTORG
         DS    0F
         ARXARGTB                      ARGUMENT LIST
         ARXEFPL                       EXTERNAL FUNCTION PARAMETER LIST
         ARXEVALB                      EVALUATION BLOCK
         END