When I joined GE in October 1989 I went from a TSO/ISPF environment to one that was using CA/ROSCOE. There were several challenges to overcome to adjust to the different environment. One distinct difference between TSO/ROSCOE is that ROSCOE libraries/members are stored in a proprietary format - they can not be accessed the same as a PDS (Partitioned Data Set) member by adding a DD (Data Definition) in your JCL. A ROSCOE member must be exported to a sequential file which can be cumbersome and completely unnecessary. After doing some research I found ROSCOE is delivered with User Library Interface (LIBI) macros. See CA/ROSCOE PDF.
Instead of incorporating these LIBI macros in each application program that needed to read a Roscoe Member I took a better approach & encapsulated them in an all-purpose subroutine. It can be accesses by Assembler, COBOL, Eazytrieve or any other language that supports Assembler Calls.
I named the new module GETROS since it's function is to "Get Roscoe Records". When you supply a Prefix (in my case "TD") and a library member name it will locate the member & upon each call return a single record. The GETROS routine should be placed within a simple loop that will end once an End-Of-File condition is returned (Basic instructions are included in the GETROS program header).
GETROS Code:
TITLE 'GETROS - READ ROSCOE MEMBER INPUT CARDS // TONY DELIA'
***********************************************************************
* *
* MODULE: GETROS. *
* AUTHOR: TONY DELIA. *
* DATE: 01/03/1990. *
* DESC: READ ROSCOE INPUT MEMBER (SIMILAR TO GETCARD). *
* FORMAT: CALL GETROS,(ROSAREA) *
* PARMS: ROSAREA CONSISTS OF THE FOLLOWING- *
* *
* ROSAREA DC A(ROSEOF) -END-OF-FILE ADDRESS *
* ROSABND DC A(ROSAB) -ABEND ADDRESS *
* ROSPFX DC CL2'XX' -USER PREFIX *
* ROSMEM DC CL8'XXXXXXXX' -MEMBER NAME *
* ROSREC DC CL256' ' -RECORD BUFFER AREA *
* *
* NOTE: IN THE EVENT OF AN ABEND, 'ROSREC' AREA IS FILLED *
* WITH A 26-BYTE MESSAGE INDICATING CAUSE OF ABEND. *
* *
* IF NO EOF OR ABEND ADDRESS IS PROVIDED, ROSAREA *
* AND ROSABND MUST BE SET TO ZERO. WHEN EOF IS *
* REACHED, ROSAREA = 'END*'. WHEN ABEND CONDITION, *
* ROSABND = 'ABND'. THESE CAN BE TESTED FROM WITHIN *
* THE CALLING PROGRAM. *
* *
***********************************************************************
EJECT
***********************************************************************
* G E T R O S P R O G R A M *
***********************************************************************
GETROS CSECT BEGIN PROGRAM
STM 14,12,12(13) SAVE REGISTERS
LR 12,15 LOAD PROGRAM ENTRY POINT
USING GETROS,12 SET UP BASE NUMBER 1
L 11,BASE2 LOAD BASE 2 ADDRESS
USING GETROS+4096*1,11 SET UP BASE NUMBER 2
L 10,BASE3 LOAD BASE 3 ADDRESS
USING GETROS+4096*2,10 SET UP BASE NUMBER 3
ST 13,SAVE+4 SAVE EXTERNAL SAVE AREA
LR 14,13 HOLD EXTERNAL ADDR IN R14
LA 13,SAVE LOAD INTERNAL SAVE AREA
ST 13,8(14) SAVE INTERNAL ADDRESS
B GO GO TO MAINLINE PROCESSING
***********************************************************************
RETURN EQU *
L 13,SAVE+4 RESTORE EXTERNAL SAVE ADDR
LM 14,12,12(13) RESTORE ORIGINAL REGISTERS
BR 14 BRANCH BACK TO CALLING PGM
***********************************************************************
SAVE DC 18F'0' REGISTER PRESERVATION AREA
BASE2 DC A(GETROS+4096*1) BASE REGISTER 2 ADDRESS
BASE3 DC A(GETROS+4096*2) BASE REGISTER 3 ADDRESS
EODAD DC A(0) EOF RETURN ADDRESS
ABADDR DC A(0) ABEND RETURN ADDRESS
***********************************************************************
R0 EQU 0 R0 USED BY LIBI MACRO
R15 EQU 15 R15 USED BY LIBI MACRO
***********************************************************************
EJECT
***********************************************************************
* MAINLINE SECTION *
***********************************************************************
GO EQU *
PRINT NOGEN
L 3,0(1) LOAD CALLING PGM PARMAREA
USING XAREA,3 USE XAREA DSECT
LA 4,ROSPARM POINT TO ROSCOE PARM AREA
USING LBPMDEF,4 USE ROSCOE PARM DSECT
*
BC 0,READ AFTER 1ST, GO TO READ
OI *-3,X'F0' SET BRANCH INSTRUCTION
*
MVC EODAD,XEODAD MOVE END-OF-FILE ADDRESS
MVC ABADDR,XABEND MOVE ABEND ADDRESS
MVC PFX,XPFX MOVE PREFIX TO SAVE AREA
MVC MEMBER,XMEM MOVE INPUT MEMBER NAME
BAL 6,ROSINIT ROSCOE INITIALIZATION
BAL 6,ROSFIND FIND ROSCOE MEMBER
READ EQU *
BAL 6,ROSREAD READ ROSCOE MEMBER
MVC XREC,LBPMLINE MOVE RECORD TO TARGET
B RETURN RETURN TO CALLING PROGRAM
EOF EQU *
BAL 6,ROSDONE WRAP UP ROSCOE FUNCTION
L 13,SAVE+4 RESTORE EXTERNAL SAVE ADDR
*
MVC XEODAD,=C'END*' MOVE E-O-F LITERAL SWITCH
L 6,EODAD LOAD EOF-ADDRESS
LTR 6,6 WAS EOF-ADDRESS PROVIDED??
BZ RETURN NO - RETURN VIA R14
MVC 12(4,13),EODAD ALTER RETURN ADDRESS (EOF)
B RETURN RETURN TO CALLING PROGRAM
***********************************************************************
EJECT
***********************************************************************
* ROSCOE "LIBI" FUNCTIONS *
***********************************************************************
* INITIALIZE BATCH INTERFACE / ALLOCATE RESOURCES *
***********************************************************************
CNOP 0,4
ROSINIT EQU *
LIBI FUNC=INITX,LBRB=ROSLBRB
*
LTR 15,15 RETURN CODE = ZERO?
BNZ ERRINITX NO - ERROR ROUTINE
*
LIBI FUNC=ACTIVATE,LBRB=ROSLBRB,PARM=ROSPARM
*
LTR 15,15 RETURN CODE = ZERO?
BNZ ERRACTV NO - ERROR ROUTINE
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
* FIND <PFX>.<MEMBER> / ADD INDEX TO PARAMETER LIST *
***********************************************************************
CNOP 0,4
ROSFIND EQU *
MVI ROSPARM,X'00' HEX ZEROES 1ST BYTE
MVC ROSPARM+1(2),PFX MOVE USER PREFIX
MVI ROSPARM+3,C' ' MOVE BLANK 4TH BYTE
MVC ROSPARM+4(8),MEMBER MOVE DIRECTORY MEMBER
*
LIBI FUNC=FIND,LBRB=ROSLBRB,PARM=ROSPARM
*
LTR 15,15 RETURN CODE = ZERO?
BNZ ERRFIND NO - ERROR ROUTINE
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
* GET NEXT LOGICAL RECORD FROM LIBRARY MEMBER *
***********************************************************************
CNOP 0,4
ROSREAD EQU *
LIBI FUNC=GET,LBRB=ROSLBRB,PARM=ROSPARM
*
LTR 15,15 RETURN CODE = ZERO?
BZ 0(6) YES - BRANCH BAL/REGISTER
CH 15,=H'4' RETURN CODE = 4?
BNE ERRGET NO - ERROR ROUTINE
*
CLI ROSLBRB+(LBRBXRC-LBRB),LBRBXEOF END FILE CONDITION?
BNE ERRGET NO - ERROR ROUTINE
B EOF YES - END OF FILE
***********************************************************************
* FREE LIBRARY RESOURCES / TERMINATE LIBI INTERFACE *
***********************************************************************
ROSDONE EQU *
LIBI FUNC=FREE,LBRB=ROSLBRB
*
LTR 15,15 RETURN CODE = ZERO?
BNZ ERRFREE NO - ERROR ROUTINE
*
LIBI FUNC=TERM,LBRB=ROSLBRB
*
LTR 15,15 RETURN CODE = ZERO?
BNZ ERRTERM NO - ERROR ROUTINE
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* ROSCOE ERROR ROUTINES *
***********************************************************************
ERRINITX EQU *
MVC XREC(26),AB111 MOVE ABEND MESSAGE 111
B ABENDIT GO TO ABEND ROUTINE
ERRACTV EQU *
MVC XREC(26),AB222 MOVE ABEND MESSAGE 222
B ABENDIT GO TO ABEND ROUTINE
ERRFIND EQU *
MVC AB333+14(2),PFX MOVE PREFIX TO AB333
MVC AB333+17(8),MEMBER MOVE MEMBER TO AB333
MVC XREC(26),AB333 MOVE ABEND MESSAGE 333
B ABENDIT GO TO ABEND ROUTINE
ERRGET EQU *
MVC AB444+14(2),PFX MOVE PREFIX TO AB444
MVC AB444+17(8),MEMBER MOVE MEMBER TO AB444
MVC XREC(26),AB444 MOVE ABEND MESSAGE 444
B ABENDIT GO TO ABEND ROUTINE
ERRFREE EQU *
MVC XREC(26),AB555 MOVE ABEND MESSAGE 555
B ABENDIT GO TO ABEND ROUTINE
ERRTERM EQU *
MVC XREC(26),AB666 MOVE ABEND MESSAGE 555
ABENDIT EQU *
L 13,SAVE+4 RESTORE EXTERNAL SAVE ADDR
MVC XABEND,=C'ABND' MOVE ABEND LITERAL SWITCH
L 6,ABADDR LOAD ABEND ADDRESS
LTR 6,6 WAS ABEND ADDR PROVIDED??
BZ RETURN NO - RETURN VIA R14
MVC 12(4,13),ABADDR ALTER RETURN ADDRESS (AB)
B RETURN RETURN TO CALLING PROGRAM
***********************************************************************
AB111 DC CL26'FUNC=INITX '
AB222 DC CL26'FUNC=ACTIVATE '
AB333 DC CL26'FUNC=FIND (XX.XXXXXXXX)'
AB444 DC CL26'FUNC=GET (XX.XXXXXXXX)'
AB555 DC CL26'FUNC=FREE '
AB666 DC CL26'FUNC=TERM '
***********************************************************************
EJECT
***********************************************************************
* WORKING STORAGE *
***********************************************************************
LTORG
***********************************************************************
ROSLBRB DC 8F'0' ROSCOE LIBI FULLWORDS
ROSPARM DC 265C' ' ROSCOE PARM AREA
PFX DC CL2'XX' ROSCOE LIBRARY PREFIX
MEMBER DC CL8'XXXXXXXX' ROSCOE LIBRARY MEMBER
***********************************************************************
LBRB
LBPMDEF
***********************************************************************
XAREA DSECT
XEODAD DS F END-OF-FILE ADDRESS
XABEND DS F ABEND ADDRESS
XPFX DS CL2 USER PREFIX
XMEM DS CL8 MEMBER NAME
XREC DS CL256 TARGET RECORD AREA
***********************************************************************
END GETROS
To validate my GETROS load module I created several Calling Programs - one in Assembler, COBOL & Eazytrieve. Unfortunately I no longer possess many of my older programs including the Eazytrieve version. I lost a lot of brilliant work between 1985 and the early 1990's simply due to lack of reliable storage media. Faulty 5.25 inch disks as well as a totally useless magnetic tape reel (with no tape drive to read it) contributed greatly to the loss... but not everything was gone. Below are the Assembler & COBOL versions (COBOL & Easytrieve are very similar).
Calling Program - Assembler Test - GETROSX:
The READ Loop executes the call as follows: CALL GETROS,(ROSAREA).
No explicit exit from the loop is required since the ROSAREA defintion contains the EOF Address as well as the ABEND address. GETROS will branch to the appropriate address.
TITLE 'GETROSX - GETROS SUBROUTINE TESTING // TONY DELIA'
***********************************************************************
* *
* MODULE: GETROSX. *
* AUTHOR: TONY DELIA. *
* DATE: 01/03/1990. *
* DESC: TEST 'GETROS' ROSCOE INPUT READER. *
* NOTE: PREFIX/MEMBER PASSED VIA JCL EXEC PARM. *
* *
***********************************************************************
EJECT
***********************************************************************
* G E T R O S X P R O G R A M *
***********************************************************************
GETROSX SETUP REGS=(12,11,10) BEGIN PROGRAM
***********************************************************************
* MAINLINE SECTION *
***********************************************************************
PRINT NOGEN
L 3,0(1) LOAD 'EXEC' PARM ADDRESS
MVC PFX,2(3) SAVE PREFIX PARAMETER
MVC MEMBER,5(3) SAVE MEMBER PARAMETER
MVC PRT,PRT-1 CLEAR PRINT LINE
BAL 6,W8B PRINT - PAGE EJECT
***********************************************************************
READ EQU *
CALL GETROS,(ROSAREA) READ ROSCOE INPUT
MVC PRT,RECORD MOVE ROSCOE RECORD TO PRT
BAL 6,W09 PRINT - SPACE 1 LINE
B READ READ NEXT RECORD
***********************************************************************
EOF EQU *
BAL 6,WXX CLOSE PRINT FILE
B RETURN EXIT PROGRAM
***********************************************************************
* ABEND ROUTINE *
***********************************************************************
ABENDIT EQU *
MVC PRT,PRT-1 CLEAR PRINT LINE
BAL 6,W8B PRINT - PAGE EJECT
MVC PRT+1(26),ABTITLE MOVE TITLE LINE
BAL 6,W19 PRINT - SPACE 3 LINES
MVC PRT+1(26),RECORD MOVE ABEND MESSAGE
BAL 6,W09 PRINT - SPACE 1 LINE
BAL 6,WXX CLOSE PRINT FILE
ABEND 111 ISSUE ABEND NO. 111
***********************************************************************
ABTITLE DC CL26'GETROS: READ UTILITY ABEND'
***********************************************************************
EJECT
***********************************************************************
* WORKING STORAGE *
***********************************************************************
TPRNT
LTORG
***********************************************************************
ROSAREA DC A(EOF)
ROSABND DC A(ABENDIT)
PFX DC CL2'**'
MEMBER DC CL8'********'
RECORD DC CL256' '
***********************************************************************
END GETROSX
Calling Program - COBOL Test - GETROSY:
In the COBOL test program the ROSCOE records are read within the ROS-LOOP using this call: CALL 'GETROS' USING ROSAREA. The address fullwords for End-Of-File & Abend Routine are set to zero. The GETROS load module detects this & passes a code of 'EOF*' or 'ABND' instead of branching to an address. The conditions are then 'explicitly' tested & handled appropriately.
******************************************************************
* *
* MODULE: GETROSY.CBL *
* AUTHOR: TONY DELIA. *
* DATE: 01/30/1990. *
* DESC: TEST 'GETROS' ROSCOE INPUT READER. *
* *
******************************************************************
INSTALLATION. TRANSPORT INTERNATIONAL POOL.
*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FILOT ASSIGN TO UT-S-FILOT.
*
DATA DIVISION.
FILE SECTION.
FD FILOT
RECORD CONTAINS 132 CHARACTERS
RECORDING MODE IS F
LABEL RECORDS ARE STANDARD
DATA RECORD IS OUT-RECORD.
01 OUT-RECORD PIC X(132).
*
WORKING-STORAGE SECTION.
*
01 ROSAREA SYNC.
05 ROSEOF PIC 9(8) COMP SYNC.
05 ROSEOF-X REDEFINES ROSEOF PIC X(4).
05 ROSAB PIC 9(8) COMP SYNC.
05 ROSAB-X REDEFINES ROSAB PIC X(4).
05 ROSPFX PIC X(2).
05 ROSMEM PIC X(8).
05 ROSREC PIC X(256).
*
PROCEDURE DIVISION.
*
OPEN OUTPUT FILOT.
MOVE 'TD' TO ROSPFX.
MOVE 'ZZZZZPRT' TO ROSMEM.
*****************************************************************
* READ ROSCOE MEMBER / LOOP UNTIL END-OF-FILE *
*****************************************************************
ROS-LOOP.
CALL 'GETROS' USING ROSAREA.
IF ROSEOF-X = 'END*' GO TO END-OF-JOB.
IF ROSAB-X = 'ABND' GO TO ABEND-JOB.
MOVE ROSREC TO OUT-RECORD.
WRITE OUT-RECORD.
GO TO ROS-LOOP.
*****************************************************************
* ABEND DETECTED *
*****************************************************************
ABEND-JOB.
MOVE ROSREC TO OUT-RECORD.
WRITE OUT-RECORD.
*****************************************************************
* END OF JOB *
*****************************************************************
END-OF-JOB.
CLOSE FILOT.
STOP RUN.
*****************************************************************
* END OF PROGRAM *
*****************************************************************
A pretty simple exercise but it ultimately saved countless hours as well as system resources. I was able to directly access the data I needed without the trouble of exporting, creating new datasets & constantly refreshing them as the data changed. The old adage is true, "If you want something done right you have to do it yourself".
This blog post brings back some great memories...
