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