Will the madness ever end? I knew I had a working subroutine someplace that
did the fullword to 8-character conversion. I found it over the weekend.
It was used "back in the day" by some COBOL programs for who knows what and
is 35 years old. I tested it last evening under MVS 3.8J and it worked just
fine. The entire CSECT is X'90' in length.
V100 TITLE 'CSECT --> BIN2CHAR, CONVERT FULLWORD TO 8 CHARACTERS'
BIN2CHAR CSECT , SET &SYSECT TO AVOID PRIVATE CSECT
SPACE 3
* * --> CSECT : CONVERT FULLWORD TO AN 8 CHARACTER STRING * * * * * * *
* THIS ROUTINE WILL GENERATE AN 8 CHARACTER STRING FROM A *
* FULLWORD BINARY STRING. *
* ENTRY CONDITIONS : *
* R15 --> EP ADDRESS. *
* R14 --> RET ADDRESS. *
* R13 --> STANDARD 72 BYTE SAVE AREA. *
* R1 --> PARM LIST. *
* PARM1 -> INPUT FULLWORD VALUE. *
* PARM2 -> OUTPUT 8 BYTE STRING BUFFER. *
* EXIT CONDITIONS : *
* NO REGISTERS ALTERED. *
* OUTPUT BUFFER SET. *
* R15 --> 0 SUCCESSFUL COMPLETION. *
* 8 PARM ERROR. *
* CALLS SUBROUTINES : -NONE- *
* USES DSECTS : SAVESECT,WORKSECT. *
* ISSUES MACROS : YREGS. *
* *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* *
* M O D I F I C A T I O N L O G : *
* *
* DATE WHO REASON *
* 01/03/77 D K SKOMSKY INITIAL PROGRAM CREATION. *
* *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
SPACE 3
SAVESECT DSECT , SAVE AREA DSECT
SAVESEST EQU * BEGINNING OF DSECT
SAVENOTU DS F NOT USED
SAVEPREV DS A PREVIOUS SAVE AREA POINTER
SAVENEXT DS A NEXT SAVE AREA POINTER
SAVER14 DS F R14
SAVER15 DS F R15
SAVER0 DS F R0
SAVER1 DS F R1
SAVER2 DS F R2
SAVER3 DS F R3
SAVER4 DS F R4
SAVER5 DS F R5
SAVER6 DS F R6
SAVER7 DS F R7
SAVER8 DS F R8
SAVER9 DS F R9
SAVER10 DS F R10
SAVER11 DS F R11
SAVER12 DS F R12
SAVESELN EQU *-SAVESEST LENGTH OF DSECT
SPACE 1
WORKSECT DSECT , OUR WORK AREA BUFFER
WORKSEST EQU * BEGINNING OF DSECT
WORKBIN DS F,CL1 OUR INPUT WORD
WORKVALU DS CL8,CL1 HOLD OUR OUTPUT VALUE
WORKSELN EQU *-WORKSEST LENGTH OF DSECT
SPACE 1
BIN2CHAR CSECT , CONTINUE OUR CSECT
USING BIN2CHAR,R15 DEFINE TEMP BASE
B BIN2STRT SKIP OVER THE DC'S
DC AL1(9),CL9'&SYSECT' EYE CATCHER
DC C' - ',C'&SYSDATE' TO FIND
DC C'@',C'&SYSTIME' IN A DUMP
SPACE 1
BIN2STRT DS 0H START OF OUR CODE
USING SAVESECT,R13 OVERLAY SAVE AREA DSECT
STM R14,R12,SAVER14 SAVE ALL REGISTERS
LR R12,R15 GET EP ADDRESS
USING BIN2CHAR,R12 SET NEW PGM BASE
DROP R15 KILL TEMP BASE
SR R15,R15 ANTICIPATE A GOOD RC
LM R10,R11,0(R1) ADDRESS OUR PARMS
LTR R10,R10 CHECK FIRST PARM
BM BIN2ERR IF TAGGED, ERROR
LTR R11,R11 CHECK SECOND PARM
BNM BIN2ERR MUST BE TAGGED
LA R9,SAVER5 POINT INTO REGISTER SAVE AREA
* THIS AREA USED FOR OUR WORK AREA
USING WORKSECT,R9 OVERLAY OUR WORKAREA
MVC WORKBIN,0(R10) FETCH OUR INPUT WORD
UNPK WORKVALU(L'WORKVALU+1),WORKBIN(L'WORKBIN+1) ALL NIBBLES
MVZ WORKVALU,=(L'WORKVALU)X'00' ZAP ALL HIGH ORDER NIBBLES
* WITHIN OUR OUTPUT DATA BUFFER
TR WORKVALU,=CL16'0123456789ABCDEF' CONVERT TO CHAR VALUE
MVC 0(L'WORKVALU,R11),WORKVALU MOVE ANSWER TO CALLER
DROP R9 DROP WORKAREA BASE REGISTER
STM R5,R8,SAVER5 RELOAD ZAPPED REGISTER SAVE AREA
* THAT WAS USED FOR OUR WORK AREA
B BIN2RTRN TIME TO END IT ALL
SPACE 1
BIN2ERR DS 0H ERROR WITH PARAMETER LIST
LA R15,8 SET ERROR RETURN CODE
SPACE 1
BIN2RTRN DS 0H RETURN TO CALLER
L R14,SAVER14 RESTORE RETURN ADDRESS
* R15 HAS OUR RETURN CODE
LM R0,R12,SAVER0 RESTORE REST OF THE REGISTERS
MVI SAVER14,X'FF' MARK SAVE AREA AS INACTIVE
SPM R14 RESTORE CALLERS CC, ILC, AND MASK
BR R14 AND RETURN TO CALLER
DROP R12 DROP PROGRAM BASE
DROP R13 DROP SAVE AREA OVERLAY
LTORG , NICE PLACE FOR THE LITERAL POOL
SPACE 1
YREGS , STD EQUATES
END , END ASSEMBLY
-----Original Message-----
From: IBM Mainframe Assembler List [mailto:[email protected]]
On Behalf Of Tom Marchant
Sent: Tuesday, August 14, 2012 8:04 AM
To: [email protected]
Subject: Re: Printing a return code
On Mon, 13 Aug 2012 22:00:24 +0000, Hall, Keven wrote:
>That may be so but the DC statement I posted generates the same
>data as the statements in the original posting I was responding to.
No, it doesn't. Yours generates X'0001020304050607...'.
The post that you replied to had C'0001020304050607...'.
--
Tom Marchant
>
>>From: Lennie J Dymoke-Bradshaw
>>
>>That would generate a 256 byte table in Hex.
>>For the TROT translation we need a 512 byte table in char.
>>
>>From: "Hall, Keven" <[email protected]>
>>>
>>>Or like so:
>>>
>>>HEX2CHAR DC 256AL1(*-HEX2CHAR)
>>>
>>>From: Steve Smith
>>>>
>>>>Using TROT is a great idea, but why not code the table like so:
>>>>
>>>>HEX2CHAR DC C'000102030405060708090A0B0C0D0E0F'
>>>> DC C'101112131415161718191A1B1C1D1E1F'
>>>> DC C'202122232425262728292A2B2C2D2E2F'
>>>>
>>>>On Wed, Aug 8, 2012 at 9:24 AM, Rob Scott wrote:
>>>>>
>>>>> I use the "TROT" instruction ...
>>>>> DC X'F0F0F0F1F0F2F0F3F0F4F0F5F0F6F0F7' 00-07
>>>>> DC X'F0F8F0F9F0C1F0C2F0C3F0C4F0C5F0C6' 08-0F
>>>>> DC X'F1F0F1F1F1F2F1F3F1F4F1F5F1F6F1F7' 10-17
>>>>> DC X'F1F8F1F9F1C1F1C2F1C3F1C4F1C5F1C6' 18-1F
