アセンブラー H

         TITLE 'SAMPLE ENCIPHER/DECIPHER S/370 PROGRAM.'
*=====================================================================*
*       SYSTEM/370 ASSEMBLER H EXAMPLE                                *
*                                                                     *
*=====================================================================*
         SPACE
SAMPLE   START 0
         DS    0H
         STM   14,12,12(13)     SAVE REGISTERS
         BALR  12,0             USE R12 AS BASE REGISTER
         USING *,12             PROVIDE SAVE AREA FOR SUBROUTINE
         LA    14,SAVE          PERFORM SAVE AREA CHAINING
         ST    13,4(14)           "
         ST    14,8(13)           "
         LR    13,14              "
*
         CALL  CSFKGN,(RETCD,                                          *
               RESCD,                                                  *
               EXDATAL,                                                *
               EXDATA,                                                 *
               KEY_FORM,                                               *
               KEY_LEN,                                                *
               KEYTYP1,                                                *
               KEYTYP2,                                                *
               KEK_ID1,                                                *
               KEK_ID2,                                                *
               DATA_ID,                                                *
               NULL_ID)
         CLC   RETCD,=F'0'      CHECK RETURN CODE
         BNE   BACK             OUTPUT RETURN/REASON CODE AND STOP
         CLC   RESCD,=F'0'      CHECK REASON CODE
         BNE   BACK             OUTPUT RETURN/REASON CODE AND STOP
*
* CALL ENCIPHER WITH THE KEY JUST GENERATED
*  OPERATIONAL FORM
*
         MVC   RULEAC,=F'1'           SET RULE ARRAY COUNT
         MVC   RULEA,=CL8'CUSP    '   BUILD RULE ARRAY
         CALL CSFENC,(RETCD,                                           *
               RESCD,                                                  *
               EXDATAL,                                                *
               EXDATA,                                                 *
               DATA_ID,                                                *
               TEXTL,                                                  *
               TEXT,                                                   *
               ICV,                                                    *
               RULEAC,                                                 *
               RULEA,                                                  *
               PAD_CHAR,                                               *
               OCV,                                                    *
               CIPHER_TEXT)
         CLC   RETCD,=F'0'      CHECK RETURN CODE
         BNE   BACK             OUTPUT RETURN/REASON CODE AND STOP
         CLC   RESCD,=F'0'      CHECK REASON CODE
         BNE   BACK             OUTPUT RETURN/REASON CODE AND STOP
         CALL CSFDEC,(RETCD,                                           *
               RESCD,                                                  *
               EXDATAL,                                                *
               EXDATA,                                                 *
               DATA_ID,                                                *
               TEXTL,                                                  *
               CIPHER_TEXT,                                            *
               ICV,                                                    *
               RULEAC,                                                 *
               RULEA,                                                  *
               OCV,                                                    *
               NEW_TEXT)
         CLC   RETCD,=F'0'      CHECK RETURN CODE
         BNE   BACK             OUTPUT RETURN/REASON CODE AND STOP
         CLC   RESCD,=F'0'      CHECK REASON CODE
         BNE   BACK             OUTPUT RETURN/REASON CODE AND STOP
*
COMPARE  EQU   *                         COMPARE START AND END TEXT
         CLC   TEXT,NEW_TEXT
         BE    GOODENC
         WTO   'DECIPHERED TEXT DOES NOT MATCH STARTING TEXT'
         B      BACK
GOODENC  WTO   'DECIPHERED TEXT MATCHES STARTING TEXT'
*
*
         WTO   'TEST PROGRAM TERMINATING'
         B     RETURN
*
*----------------------------------------------------
* CONVERT RETURN/REASON CODES FROM BINARY TO EBCDIC
*----------------------------------------------------
BACK     DS    0F                OUTPUT RETURN & REASON CODE
         L     5,RETCD           LOAD RETURN CODE
         L     6,RESCD           LOAD REASON CODE
         CVD   5,BCD1            CONVERT TO PACK-DECIMAL
         CVD   6,BCD2
         UNPK  ORETCD,BCD1       CONVERT TO EBCDIC
         UNPK  ORESCD,BCD2
         OI    ORETCD+7,X'F0'    CORRECT LAST DIGIT
         OI    ORESCD+7,X'F0'
*
         MVC   ERROUT+21(4),ORETCD+4
         MVC   ERROUT+41(4),ORESCD+4
ERROUT   WTO   'ERROR CODE =     , REASON CODE =     '
RETURN   EQU   *
         L     13,4(13)          SAVE AREA RESTORATION
         MVC   16(4,13),RETCD    SAVE RETURN CODE
         LM    14,12,12(13)
         BR    14                RETURN TO CALLER
*
BCD1     DS    D                 CONVERT TO BCD TEMP AREA
BCD2     DS    D                 CONVERT TO BCD TEMP AREA
ORETCD   DS    CL8'0'            OUTPUT RETURN CODE
ORESCD   DS    CL8'0'            OUTPUT REASON CODE
*
KEY_FORM DC    CL8'OP      '     KEY FORM
KEY_LEN  DC    CL8'SINGLE  '     KEY LENGTH
KEYTYP1  DC    CL8'DATA    '     KEY TYPE 1
KEYTYP2  DC    CL8'        '     KEY TYPE 2
TEXT     DC    C'ABCDEFGHIJKLMNOPQRSTUV0987654321'
TEXTL    DC    F'32'             TEXT LENGTH
CIPHER_TEXT DC CL32' '
NEW_TEXT DC    CL32' '
DATA_ID  DC    XL64'00'          DATA KEY TOKEN
NULL_ID  DC    XL64'00'          NULL KEY TOKEN - UNFILLED
KEK_ID1  DC    XL64'00'          KEK1 KEY TOKEN
KEK_ID2  DC    XL64'00'          KEK2 KEY TOKEN
RETCD    DS    F'0'              RETURN CODE
RESCD    DS    F'0'              REASON CODE
EXDATAL  DC    F'0'              EXIT DATA LENGTH
EXDATA   DS    0C                EXIT DATA
RULEA    DS    1CL8              RULE ARRAY
RULEAC   DS    F'0'              RULE ARRAY COUNT
ICV      DC    XL8'00'           INITIAL CHAINING VECTOR
OCV      DC    XL18'00'          OUTPUT CHAINING VECTOR
PAD_CHAR DC    F'0'              PAD CHARACTER
SAVE     DS    18F               SAVE REGISTER AREA
         END   SAMPLE