Assembler Code Highlighter added!

DASSXB64 TITLE 'DASSXB64: BASE-64 CONVERSION PROGRAM (DEREK)'
**********************************************************************
**
** MODULE NAME : DASSXB64
** MODULE TYPE : CALLABLE SUBROUTINE
** MODULE PURPOSE: CONVERT EBCDIC VALUES TO BASE-64 AND VICE VERSA
** THIS IS USED PRODOMINANTLY WITH WEB PROCESSING FOR
** THINGS LIKE COOKIE DATA SO THAT IT'S NOT VIEWABLE
** BY THE NAKED EYE.
**
***********************************************************************
*
*
*********
*
* EQUATE LIST
*
*********
EQUR R REGISTER EQUATES
IAR EQU R4 INPUT PARAMETERS WORK REG
OAR EQU R5 OUTPUT PARAMETERS WORK REG
PPR EQU R6 PARAMETERS POINTER REG
OAEND EQU R3 END ADDRESS OF OUTPUT AREA
IAEND EQU R7 END ADDRESS OF INPUT ARGS
NULLSW EQU R10 USED AS A SWITCH HOLDER
NULL1 EQU 1 SWITCH VALUE NEED 1 NULL CHAR
NULL2 EQU 2 SWITCH VALUE NEED 2 NULL CHARS
*
*
* REGISTER UTILIZATION
*
* R0 - WORK
* R1 - PARAMETER LIST POINTER ON ENTRY/WORK
* R2 - WORK
* R3 - OAEND
* R4 - INPUT ARGUMENT WORK REG - IAR
* R5 - OUTPUT ARGUMENT WORK REG - OAR
* R6 - PASSED PARAMETER AREA DSECT BASE REGISTER
* R7 - IAEND
* R8 - WORK
* R9 - WORK
* R10- NULLSW
* R11- BASE REG, PRIMED FROM R15 ON ENTRY
* R12- LE CAA (COMMON ANCHOR AREA) BASE REG
* R13- CALLERS DSA (DYNAMIC STORAGE AREA) BASE REG
* R14- RETURN ADDRESS ON ENTRY/WORK
* R15- ENTRY POINT ADDRESS ON ENTRY/WORK
*
**
**************************************************************
* ON ENTRY IT IS ASSUMED:
* R1 IS THE ADDRESS OF THE PARAMETER LIST ADDRESS. THE PARAMETER
* LIST IS EXPECTED TO BE IN THE FORMAT:
* A(FROM) CALLER SUPPLIED ADDRESS OF FIRST OCTET TO BE CONVERTED.
* A(TO) CALLER SUPPLIED ADDRESS OF AREA TO HOLD CONVERTED RESULT.
* H(FROMLEN) CALLER SUPPLIED LENGTH OF THE NUMBER OF OCTETS TO
* CONVERT.
* H(TOLEN) CALLER SUPPLIED LENGTH OF DATA AREA FOR HOLDING
* CONVERTED DATA THIS SUBROUTINE WILL SUPPLY.
* ON RETURN THIS FIELD WILL BE UPDATED TO EQUAL THE NUMBER
* OF OCTETS RETURNED.
* H(CODE) CALLER SUPPLIED CONVERSION CODE:
* 0001 = CONVERT FROM BASE64
* 0002 = CONVERT TO BASE64
*
* RETURN CONDITION CODES. ON RETURN REGISTER 15 WILL CONTAIN
* A RETURN CODE.
* CC = 0 NORMAL RETURN CODE, DATA CONVERTED, NO ERRORS FOUND.
* CC = 100 CONVERSION NOT ATTEMPTED.
* INVALID CONVERSTION CODE SUPPLIED.
* CC = 101 CONVERSION NOT ATTEMPTED.
* PARAMETER LIST NOT SUPPLIED OR NOT CORRECT FORMAT.
* CC = 102 CONVERSION ABORTED.
* THE SIZE OF OUTPUT AREA NOT LARGE ENOUGH TO CONTAIN
* THE CONVERTED DATA.
* 1. FOR CONVERSION FROM BASE64 THE OUTPUT AREA IS
* EXPECTED TO BE AT LEAST 66% THE SIZE OF THE INPUT
* AREA.
* 2. FOR CONVERSION TO BASE64 THE OUTPUT AREA IS
* EXPECTED TO BE AT LEAST 133% THE SIZE OF THE
* INPUT AREA.
* CC = 200 CONVERSION ABORTED.
* 1. WHILE CONVERTING FROM BASED 64 AN INVALID CHARACTER
* WAS DETECTED. THAT IS THE CHARACTER FOUND WAS
* GREATER THAT X'3F'. BASE64 CHARACTERS ARE IN THE
* RANGE X'00' TO X'3F' OR 00 TO 63 DECIMAL.
* CC = 201 CONVERSION ABORTED.
* WHILE CONVERTING FROM BASE64 AN UNEXPECTED END OF
* INPUT WAS DETECTED, INDICATING THE INPUT DATA
* WAS NOT IN THE CORRECT FORMAT AND THE INPUT AS
* DESCRIBED UNDER CC = 202 WAS NOT FOUND TO BE TRUE.
* CC = 202 CONVERSION ABORTED.
* WHILE CONVERTING FROM BASE64 A NULL CHARACTER
* (= SIGN) WAS DETECTED UNEXPECTEDLY, INDICATING THE
* FOLLOWING WAS NOT FOUND TO BE TRUE.
* IN BASE64 ONLY THE FOLLOWING CAN BE VALID, SINCE
* ALL BASE64 INPUT IS AN INTEGRAL NUMBER OF OCTETS:
* 1. THE FINAL QUANTUM OF ENCODING IS AN INTEGRAL
* MULTIPLE OF 24 BITS, HENCE THE FINAL UNIT OF
* CODED BASED64 OCTETS WILL BE A MULTIPLE OF 4
* CHARACTERS WITH NO "=" PADDING CHARACTERS.
* 2. THE FINAL QUANTUM OF ENCODING IS EXACTLY 8 BITS,
* HENCE THE FINAL UNIT OF CODED BASED64 OCTETS WILL
* BE TWO CHARACTERS FOLLOWED BY TWO "=" PADDING
* CHARACTERS.
* 3. THE FINAL QUANTUM OF ENCODING IS EXACTLY 16 BITS,
* HENCE THE FINAL UNIT OF CODED BASED64 OCTETS WILL
* BE THREE CHARACTERS FOLLOWED BY ONE "=" PADDING
* CHARACTER.
**************************************************************
SPACE 4
***
*
* PARAMETER AREA DSECT
*
***
PWA DSECT
USING *,PPR
IAADR DS F ADDRESS OF AREA TO CONVERT
OAADR DS F ADDRESS OF WHERE TO PUT RESULT
IALEN DS H LENGTH OF AREA TO CONVERT
OALEN DS H LENGTH OF CONVERTED DATA
IAFLG DS H CONVERSION FLAG
IAF64 EQU 1 CONVERT FROM BASE 64
IAT64 EQU 2 CONVERT TO BASE 64
PWAL EQU *-PWA LENGTH OF AREA
EJECT
****
*
* RESUME CSECT
*
****
DASSXB64 CEEENTRY PPA=CXBPPA,MAIN=NO,BASE=(R11),NAB=NO,PARMREG=PPR
LTR PPR,PPR ANY PARMS?
BZ SETCC101 NO
L PPR,0(,PPR) GET ADR OF PARAMETERS
L OAR,OAADR GET OUTPUT ARG ADR
L IAR,IAADR GET INPUT ARG ADR
LH R1,IALEN GET INPUT ARG AREA LENGTH
LTR R1,R1 ANY?
BNP SETCC101 YES,NO-ERROR, PARAMETER MISSING
LA IAEND,0(IAR,R1) COMPUTE END ADDRESS
CLC IAFLG,=AL2(IAF64) CONVERSION FROM BASE 64?
BE B64FROM YES
CLC IAFLG,=AL2(IAT64) CONVERSION TO BASE 64?
BE B64TO YES
B SETCC100 INVALID CODE CC=100
*******
* EXIT POINTS
*******
SETCC100 DS 0H
CEETERM RC=100
SETCC101 DS 0H
CEETERM RC=101
SETCC102 DS 0H
CEETERM RC=102
SETCC200 DS 0H
CEETERM RC=200
SETCC201 DS 0H
CEETERM RC=201
SETCC202 DS 0H
CEETERM RC=202
*******
* FINAL EXIT POINTS
*******
EXITCC0 DS 0H
CEETERM RC=0
SPACE 2
********
*
* CONVERSION FROM BASE64 - BEGIN PROCESSING
*
********
B64FROM DS 0H
LH OAEND,OALEN CAL END ADR OF OUTPUT AREA
LA OAEND,0(OAEND,OAR)
***
B64F1 DS 0H
SR R8,R8 HK THE REG
* GET 1ST OF 4 CHARACTERS
CR IAR,IAEND AT END OF INPUT ARGS?
BNL B64F4 YES
CLI 0(IAR),X'7E' NULL PREMATURELY?
BE SETCC202 YES, ERROR EXIT
SR R9,R9
IC R9,0(IAR) GET FIRST OF FOUR
LA IAR,1(IAR) BUMP FROM POINTER
IC R9,FX(R9) TRANSLATE FROM B64 ALPHABET
LA R15,FX(R9) POINT TO CHARACTER
CLI 0(R15),X'3F' VALID CHAR
BH SETCC200 NO, CC=200
SLL R9,26 SHIFT OUT THE HI ORDER 2 BITS
SLDL R8,6 MERGE 6 BITS OF R9 INTO WORK REG
* GET 2ND OF 4 CHARACTERS
CR IAR,IAEND END OF INPUT PREMATURELY?
BNL SETCC201 YES, NOT MULT OF 4
CLI 0(IAR),X'7E' NULL PREMATURELY?
BE SETCC202 YES, ERROR EXIT
SR R9,R9 HK REG
IC R9,0(IAR) GET FIRST OF FOUR
LA IAR,1(IAR) BUMP FROM POINTER
IC R9,FX(R9) TRANSLATE FROM B64 ALPHABET
LA R15,FX(R9) POINT TO CHARACTER
CLI 0(R15),X'3F' VALID CHAR
BH SETCC200 NO, CC=200
SLL R9,26 SHIFT OUT THE HI ORDER 2 BITS
SLDL R8,6 MERGE 6 BITS OF R9 INTO WORK REG
* GET 3RD OF 4 CHARACTERS
CR IAR,IAEND END OF INPUT PREMATURELY?
BNL SETCC201 YES, NOT MULT OF 4
CLI 0(IAR),X'7E' NULL CHAR, NEAR END?
BE B64F2 NO
SR R9,R9
IC R9,0(IAR) GET FIRST OF FOUR
LA IAR,1(IAR) BUMP FROM POINTER
IC R9,FX(R9) TRANSLATE FROM B64 ALPHABET
LA R15,FX(R9) POINT TO CHARACTER
CLI 0(R15),X'3F' VALID CHAR
BH SETCC200 NO, CC=200
SLL R9,26 SHIFT OUT THE HI ORDER 2 BITS
SLDL R8,6 MERGE 6 BITS OF R9 INTO WORK REG
* GET 4TH OF 4 CHARACTERS
CR IAR,IAEND END OF INPUT PREMATURELY?
BNL SETCC201 YES, NOT MULT OF 4
CLI 0(IAR),X'7E' NULL CHAR, NEAR END?
BE B64F3 NO
SR R9,R9
IC R9,0(IAR) GET FIRST OF FOUR
LA IAR,1(IAR) BUMP FROM POINTER
IC R9,FX(R9) TRANSLATE FROM B64 ALPHABET
LA R15,FX(R9) POINT TO CHARACTER
CLI 0(R15),X'3F' VALID CHAR
BH SETCC200 NO, CC=200
SLL R9,26 SHIFT OUT THE HI ORDER 2 BITS
SLDL R8,6 MERGE 6 BITS OF R9 INTO WORK REG
* PROCESS THE 3 CHARACTERS IN THE WORK REG
LA R0,3(OAR) CHECK FOR ENUF ROOM
CR R0,OAEND ROOM ENUF?
BH SETCC102 NO
STCM R8,7,0(OAR) SAVE GROUP OF 3
TR 0(3,OAR),A2E TRANSLATE TO EBCDIC
LA OAR,3(OAR) INCREMENT OUT ARG POINTER
B B64F1 GO AGAIN
B64F2 DS 0H
* PROCESS THE CHARACTERS IN THE WORK REG
SLL R8,12 SHIFT A NULL DIGIT IN
LA IAR,1(IAR) BUMP INPUT POINTER
CR IAR,IAEND END OF INPUT PREMATURELY?
BNL SETCC201 YES, NOT MULT OF 4
CLI 0(IAR),X'7E' NULL CHAR, NEAR END?
BNE SETCC202 NO
LA R0,1(OAR) CHECK FOR ENUF ROOM
CR R0,OAEND ROOM ENUF?
BH SETCC102 NO
STCM R8,4,0(OAR) SAVE SINGLE OCTET
TR 0(1,OAR),A2E TRANSLATE TO EBCDIC
LA OAR,1(OAR) INCREMENT OUT ARG POINTER
B B64F4
B64F3 DS 0H
SLL R8,6 SHIFT A NULL DIGIT IN
LA IAR,1(IAR) BUMP INPUT POINTER
* PROCESS THE CHARACTERS IN THE WORK REG
LA R0,2(OAR) CHECK FOR ENUF ROOM
CR R0,OAEND ROOM ENUF?
BH SETCC102 NO
STCM R8,6,0(OAR) SAVE GROUP OF 2
TR 0(2,OAR),A2E TRANSLATE TO EBCDIC
LA OAR,2(OAR) INCREMENT OUT ARG POINTER
B64F4 DS 0H
LR R0,OAR CALC NEW LENGTH
S R0,OAADR CALC NEW OUTPUT LENGTH
STH R0,OALEN SAVE NEW OUTPUT LENGTH
B EXITCC0
SPACE 2
********
*
* CONVERSION TO BASE64 - BEGIN PROCESSING
* NOTES:
* 1. REQUIRES THE OUTPUT AREA TO BE ABOUT 1/3 LARGER THAN THE
* INPUT AREA.
*
********
B64TO DS 0H
LH OAEND,OALEN CAL END ADR OF OUTPUT AREA
LA OAEND,0(OAEND,OAR)
***
B64T1 DS 0H
SR R9,R9 HK THE REG
CR IAR,IAEND AT END OF INPUT ARGS?
BNL B64TDONE YES
* PUT 1ST OF 3 CHARS IN APPROPRIATE POSITION OF WORK REG
SR R8,R8 HK REG
IC R8,0(IAR) GET OCTET FOR TRANSLATION
LA IAR,1(IAR) BUMP TO NEXT
IC R8,E2A(R8) TRANSLATE TO ASCII
SLL R8,24 SHIFT TO HI ORDER POS IN REG
OR R9,R8 MERGE IN 1ST CHAR
LA NULLSW,NULL2 INDICATE TWO PADDING CHARS
* PUT 2ND OF 3 CHARS IN APPROPRIATE POSITION OF WORK REG
CR IAR,IAEND AT END OF INPUT ARGS?
BNL B64T3A YES
SR R8,R8 HK REG
IC R8,0(IAR) GET OCTET FOR TRANSLATION
LA IAR,1(IAR) BUMP TO NEXT
IC R8,E2A(R8) TRANSLATE TO ASCII
SLL R8,16 SHIFT TO 3RD POS OF REG
OR R9,R8 MERGE IN 2ND CHAR
LA NULLSW,NULL1 INDICATE ONE PADDING CHAR
* PUT 3RD OF 3 CHARS IN APPROPRIATE POSITION OF WORK REG
CR IAR,IAEND AT END OF INPUT ARGS?
BNL B64T3A YES
SR R8,R8 HK REG
IC R8,0(IAR) GET OCTET FOR TRANSLATION
LA IAR,1(IAR) BUMP TO NEXT
IC R8,E2A(R8) TRANSLATE TO ASCII
SLL R8,8 SHIFT TO 2ND CHAR OF REG
OR R9,R8 MERGE IN 3RD CHAR
LA NULLSW,0 INDICATE NO PADDING CHARACTERS
B64T3A DS 0H
* CREATE FOUR B64 OUTPUT CHARACTERS IN THE FORM CC== FROM
* A SINGLE 8 BIT OCTET - CHAR 1=6 BITS, CHAR 2=2 BITS
CLM NULLSW,1,=AL1(NULL2) NEED TWO PAD CHARS?
BNE B64T4A NO
LA R8,0 HK THE REG
SLDL R8,6 GET A DIGIT
IC R8,TX(R8) TRANSLATE FROM B64 ALPHABET
LA R0,4(OAR) CHECK FOR ENUF ROOM
CR R0,OAEND ROOM ENUF?
BH SETCC102 NO
STC R8,0(OAR) SAVE THE OUTPUT
LA R8,0 HK THE REG
SLDL R8,6 GET A DIGIT
IC R8,TX(R8) TRANSLATE FROM B64 ALPHABET
STC R8,1(OAR) SAVE THE OUTPUT
MVC 2(2,OAR),=C'==' INSERT NULLS
LA OAR,4(OAR) INC OUTPUT POINTER
B B64TDONE
B64T4A DS 0H
* CREATE FOUR B64 OUTPUT CHARACTERS IN THE FORM CCC= FROM
* TWO 8 BIT OCTETS, CHAR 1=6 BITS, CHAR 2=6 BITS, CHAR 3=4 BITS
CLM NULLSW,1,=AL1(NULL1) ONE PAD CHAR?
BNE B64T4B NO
LA R8,0 HK THE REG
SLDL R8,6 GET A DIGIT
IC R8,TX(R8) TRANSLATE FROM B64 ALPHABET
LA R0,4(OAR) CHECK FOR ENUF ROOM
CR R0,OAEND ROOM ENUF?
BH SETCC102 NO
STC R8,0(OAR) SAVE THE OUTPUT
LA R8,0 HK THE REG
SLDL R8,6 GET A DIGIT
IC R8,TX(R8) TRANSLATE FROM B64 ALPHABET
STC R8,1(OAR) SAVE THE OUTPUT
LA R8,0 HK THE REG
SLDL R8,6 GET A DIGIT
IC R8,TX(R8) TRANSLATE FROM B64 ALPHABET
STC R8,2(OAR) SAVE THE OUTPUT
MVI 3(OAR),C'=' PLACE NULL
LA OAR,4(OAR) BUMP OUTPUT POINTER
B B64TDONE
B64T4B DS 0H
* CREATE FOUR B64 OUTPUT CHARACTERS IN THE FORM CCCC FROM
* THREE 8 BIT OCTETS, CHAR 1,2,3,4=6 BITS EACH
LA R8,0 HK THE REG
SLDL R8,6 GET A DIGIT
IC R8,TX(R8) TRANSLATE FROM B64 ALPHABET
LA R0,4(OAR) CHECK FOR ENUF ROOM
CR R0,OAEND ROOM ENUF?
BH SETCC102 NO
STC R8,0(OAR) SAVE THE OUTPUT
LA R8,0 HK THE REG
SLDL R8,6 GET A DIGIT
IC R8,TX(R8) TRANSLATE FROM B64 ALPHABET
STC R8,1(OAR) SAVE THE OUTPUT
LA R8,0 HK THE REG
SLDL R8,6 GET A DIGIT
IC R8,TX(R8) TRANSLATE FROM B64 ALPHABET
STC R8,2(OAR) SAVE THE OUTPUT
LA R8,0 HK THE REG
SLDL R8,6 GET A DIGIT
IC R8,TX(R8) TRANSLATE FROM B64 ALPHABET
STC R8,3(OAR) SAVE THE OUTPUT
LA OAR,4(OAR) BUMP OUTPUT POINTER
B B64T1
B64TDONE DS 0H
LR R0,OAR CALC NEW LENGTH
S R0,OAADR CALC NEW OUTPUT LENGTH
STH R0,OALEN SAVE NEW OUTPUT LENGTH
B EXITCC0
***
SPACE 2
***
*
* CONSTANTS
*
***
FX DC XL256'FF' TRANSLATE BASE64 ALPHABET
ORG FX+X'C1' EBCDIC UC A
DC X'000102030405060708'
ORG FX+X'D1' EBCDIC UC J
DC X'090A0B0C0D0E0F1011'
ORG FX+X'E2' EBCDIC UC S
DC X'1213141516171819'
ORG FX+X'81' EBCDIC LC A
DC X'1A1B1C1D1E1F202122'
ORG FX+X'91' EBCDIC LC J
DC X'232425262728292A2B'
ORG FX+X'A2' EBCDIC LC S
DC X'2C2D2E2F30313233'
ORG FX+X'F0' EBCDIC 0
DC X'3435363738393A3B3C3D'
ORG FX+X'4E' EBCDIC + SIGN
DC X'3E'
ORG FX+X'61' EBCDIC / SIGN
DC X'3F'
ORG
SPACE 2
TX DC XL256'FF' TRANSLATE BASE64 ALPHABET
ORG TX+X'00' EBCDIC UC A
DC X'C1C2C3C4C5C6C7C8C9'
ORG TX+X'09' EBCDIC UC J
DC X'D1D2D3D4D5D6D7D8D9'
ORG TX+X'12' EBCDIC UC S
DC X'E2E3E4E5E6E7E8E9'
ORG TX+X'1A' EBCDIC LC A
DC X'818283848586878889'
ORG TX+X'23' EBCDIC LC J
DC X'919293949596979899'
ORG TX+X'2C' EBCDIC LC S
DC X'A2A3A4A5A6A7A8A9'
ORG TX+X'34' EBCDIC 0
DC X'F0F1F2F3F4F5F6F7F8F9'
ORG TX+X'3E' EBCDIC + SIGN
DC X'4E'
ORG TX+X'3F' EBCDIC / SIGN
DC X'61'
ORG
SPACE 2
A2E DC XL256'0' TRANSLATE ASCII TO EBCDIC
ORG A2E+X'20' ASCII SPACE,!"#$%&'()
DC X'405A7F7B5B6C507D4D5D'
ORG A2E+X'2A' ASCII *+,-./
DC X'5C4E6B604B61'
ORG A2E+X'30' ASCII 0123456789
DC X'F0F1F2F3F4F5F6F7F8F9'
ORG A2E+X'3A' ASCII :;<=>?@
DC X'7A5E4C7E6E6F7C'
ORG A2E+X'41' ASCII UC ABCDEFGHI
DC X'C1C2C3C4C5C6C7C8C9'
ORG A2E+X'4A' ASCII UC JKLMNOPQR
DC X'D1D2D3D4D5D6D7D8D9'
ORG A2E+X'53' ASCII UC STUVWXYZ
DC X'E2E3E4E5E6E7E8E9'
ORG A2E+X'5B' ASCII Ý\¨NOT SIGN_`
DC X'BAE0BB5F6D79'
ORG A2E+X'61' ASCII LC ABCDEFGHI
DC X'818283848586878889'
ORG A2E+X'6A' ASCII LC JKLMNOPQR
DC X'919293949596979899'
ORG A2E+X'73' ASCII LC STUVWXYZ
DC X'A2A3A4A5A6A7A8A9'
ORG A2E+X'7B' ASCII {¦}~DEL
DC X'C06AD0A107'
ORG
SPACE 2
E2A DC XL256'0' TRANSLATE EBCDIC TO ASCII
* EBCDIC NUL,SOH,STX,ETX
ORG E2A+X'00'
DC X'00010203'
* EBCDIC HT
ORG E2A+X'05'
DC X'09'
* EBCDIC DEL
ORG E2A+X'07'
DC X'7F'
* EBCDIC VT,FF,CR,SO,SI,DLE,DC1,DC2,DC3
ORG E2A+X'0B'
DC X'0B0C0D0E0F10111213'
* EBCDIC BS
ORG E2A+X'16'
DC X'08'
* EBCDIC CAN,EM
ORG E2A+X'18'
DC X'1819'
* EBCDIC FS
ORG E2A+X'22'
DC X'1C'
* EBCDIC LF,ETB,ESC
ORG E2A+X'25'
DC X'0A171B'
* EBCDIC ENQ,ACK,BEL
ORG E2A+X'2D'
DC X'050607'
* EBCDIC SYN
ORG E2A+X'32'
DC X'16'
* EBCDIC EOT
ORG E2A+X'37'
DC X'04'
* EBCDIC DC4,NAK
ORG E2A+X'3C'
DC X'1415'
* EBCDIC SUB
ORG E2A+X'3F'
DC X'1A'
ORG E2A+X'40' EBCDIC SPACE
DC X'20'
ORG E2A+X'4B' EBCDIC .<(+
DC X'2E3C282B'
ORG E2A+X'50' EBCDIC &
DC X'26'
ORG E2A+X'5A' EBCDIC !$*);NOT SIGN-/
DC X'21242A293B5E2D2F'
ORG E2A+X'6A' EBCDIC ¦,%_>?
DC X'7C2C255F3E3F'
ORG E2A+X'79' EBCDIC `:#@'="
DC X'603A2340273D22'
ORG E2A+X'81' EBCDIC LC ABCDEFGHI
DC X'616263646566676869'
ORG E2A+X'91' EBCDIC LC JKLMNOPQR
DC X'6A6B6C6D6E6F707172'
ORG E2A+X'A1' EBCDIC LC ~STUVWXYZ
DC X'7E737475767778797A'
ORG E2A+X'C0' EBCDIC UC {ABCDEFGHI
DC X'7B414243444546474849'
ORG E2A+X'D0' EBCDIC UC }JKLMNOPQR
DC X'7D4A4B4C4D4E4F505152'
ORG E2A+X'E0' EBCDIC UC \
DC X'5C'
ORG E2A+X'E2' EBCDIC UC STUVWXYZ
DC X'535455565758595A'
ORG E2A+X'F0' EBCDIC 0123456789
DC X'30313233343536373839'
ORG
SPACE 2
***
*
***
SPACE 2
LTORG
SPACE 4
CXBPPA CEEPPA ,
CEEDSA ,
CEECAA ,
END