kolusu
Site Admin
Joined: 26 Nov 2002
Posts: 12378
Topics: 75
Location: San Jose
|
 Posted: Thu Mar 09, 2006 11:01 am Post subject: |
 |
|
issac1029,
An assembler code from naspa or cbttape , not sure which one.
| Code: |
TITLE 'PRMEVSAM - PRIME VSAM - STEVE WENTWORTH'
***********************************************************************
* *
* P R I M E V S A M C L U S T E R *
* *
* THIS PROGRAM WRITES A KEYED RECORD TO A VSAM CLUSTER. *
* THE KEY AND DATA ARE ALL X'00'. *
* *
* THIS PROGRAM THEN READS THIS RECORD AND THEN DELETES THE RECORD. *
* *
* COBOL PROGRAMS CAN NOW OPEN THIS VSAM CLUSTER FOR I/O. *
* THERE IS NO LONGER A NEED FOR A SPECIAL 'INITIAL RECORD DELETE' *
* STEP OR PROCESSING CODE TO SKIP THE FIRST RECORD OF THIS CLUSTER. *
* *
***********************************************************************
*
*
*
***********************************************************************
* *
* S A M P L E E X E C U T I O N J C L *
* *
*// JOB *
*//* STEPNAME TASK *
*//* -------- -------------------------------------------- *
*//* IDC1 DEFINE BASE CLUSTER WITH INDEX AND DATA. *
*//* DISPLAY CATALOG INFORMATION. *
*//* NOTE HI-USED RBA. *
*//* PRMEVSAM WRITE RECORD WITH X'00' KEY AND DATA. *
*//* DELETE THIS RECORD. *
*//* IDC2 DISPLAY CATALOG INFORMATION. *
*//* NOTE HI-USED RBA. *
*//* *
*//IDC1 EXEC PGM=IDCAMS *
*//SYSPRINT DD SYSOUT=* *
*//SYSIN DD * *
* DELETE (VSAM.SAMPLE.C) *
* DEFINE CLUSTER(NAME(VSAM.SAMPLE.C) + *
* VOLUME(VSAM00) + *
* RECORDSIZE(80,80) + *
* RECORDS(100,50) + *
* INDEXED + *
* KEYS(5,0) + *
* SHAREOPTIONS(1,3) ) + *
* INDEX(NAME(VSAM.SAMPLE.I) + *
* CISZ(2048) ) + *
* DATA(NAME(VSAM.SAMPLE.D) + *
* CISZ(4096) ) *
* LISTC LEVEL(VSAM.SAMPLE) + *
* ALL *
*//PRMEVSAM EXEC PGM=PRMEVSAM *
*//DS DD DSN=VSAM.SAMPLE.C,DISP=SHR *
*//SYSUDUMP DD SYSOUT=* *
*//IDC2 EXEC PGM=IDCAMS *
*//SYSPRINT DD SYSOUT=* *
*//SYSIN DD * *
* LISTC LEVEL(VSAM.SAMPLE) + *
* ALL *
* *
***********************************************************************
*
*
*
***********************************************************************
* *
* R E G I S T E R U S A G E *
* *
* R0: ABEND MACRO *
* R1: SYSTEM SERVICES MACROS AND IO MACROS *
* R4: ADDRESS OF LOGICAL RECORD AREA *
* R5: LENGTH OF LOGICAL RECORD *
* R6: SECOND OPERAND ADDRESS (X'00000000') FOR MVCL *
* R7: PADDING BYTE AND LENGTH (X'00000000') FOR MVCL *
* R12: PROGRAM BASE ADDRESS REGISTER *
* R13: ADDRESS OF REGISTER SAVE AREA *
* R14: RETURN ADDRESS *
* R15: ENTRY POINT ADDRESS/RETURN CODE *
* *
***********************************************************************
*
*
*
***********************************************************************
* *
* L O A D M O D U L E A T T R I B U T E S *
* *
* NOT REENTERABLE *
* ADDRESSING MODE = 24 *
* RESIDENCY MODE = 24 *
* *
***********************************************************************
*
*
*
***********************************************************************
* *
* C H A N G E H I S T O R Y *
* *
* 31-JUL-91/0900 VERSION 1 RELEASE 0 *
* *
***********************************************************************
EJECT
MACRO
CPYRIGHT &VER=1,&REL=0
USING &SYSECT,15
B CPYR&SYSNDX BRANCH OVER IDENTIFIER AND COPYRIGHT
DROP 15
DC CL8'&SYSECT' CSECT NAME
DC C'VERSION &VER' VERSION LEVEL
DC C'RELEASE &REL' RELEASE LEVEL
DC C'&SYSDATE' ASSEMBLY DATE
DC C'&SYSTIME' ASSEMBLY TIME
DC C'STEVE WENTWORTH' AUTHOR NAME
DC C'COPYRIGHT 1991' COPYRIGHT NOTICE
CPYR&SYSNDX CNOP 0,4
MEND
MACRO
REGEQU
LCLA &RN
&RN SETA 0
.GENEQU ANOP
R&RN EQU &RN
&RN SETA &RN+1
AIF (&RN NE 16).GENEQU
MEND
MACRO
BEGPGM
STM 14,12,12(13) SAVE CALLER'S REGISTER CONTENTS
LR 12,15 PLACE BASE ADDRESS INTO REGISTER 12
USING &SYSECT,12 ESTABLISH ADDRESSABILITY
LA 2,RSVE&SYSNDX R2 ==> THIS CSECT'S REG SAVE AREA
ST 2,8(,13) CALLER'S SAVE ==> THIS SAVE AREA
ST 13,4(,2) THIS SAVE ==> CALLER'S SAVE AREA
LR 13,2 R13 ==> THIS CSECT'S REG SAVE AREA
B RSVE&SYSNDX+(4*18) BRANCH OVER REGISTER SAVE AREA
RSVE&SYSNDX DC 18F'0' REGISTER SAVE AREA
MEND
MACRO
ENDPGM
L 13,4(,13) R13 ==> CALLER'S REGISTER SAVE AREA
LM 14,12,12(13) RESTORE CALLER'S REGISTER CONTENTS
XR 15,15 SET RETURN CODE TO ZERO
BR 14 RETURN TO CALLER
MEND
MACRO
&L PATCH &NBYTES=64,&PRINT=NOGEN
PUSH PRINT
PRINT &PRINT
&L DS 0F
DC &NBYTES.S(*)
POP PRINT
MEND
EJECT
PRMEVSAM CSECT
REGEQU R0 EQU 0, ETC.
CPYRIGHT IDENTIFIER AND COPYRIGHT
EJECT
BEGPGM BEGIN PROGRAM EXECUTION
*
* CREATE AND WRITE THE NULL RECORD
*
OPEN (DS) CONNECT VSAM CLUSTER TO PROGRAM
LTR R15,R15 OK OPEN?
BNZ OPENERR NO
SHOWCB ACB=DS, OBTAIN LRECL X
AREA=RECLEN, X
LENGTH=4, X
FIELDS=(LRECL)
LTR R15,R15 OK SHOWCB?
BNZ SHOWERR NO
GETSTOR GETMAIN EU, ACQUIRE STORAGE FOR LOGICAL RECORD X
LV=RECLEN, X
A=@AREA, X
RELATED=(FREESTOR,'GET STORAGE')
LTR R15,R15 OK GETMAIN?
BNZ GETMNERR NO
L R4,@AREA R4 ==> LOGICAL RECORD AREA
L R5,RECLEN R5 CONTAINS LOGICAL RECORD LENGTH
MODCB RPL=RPL, MODIFY THE RPL CONTROL BLOCK X
AREA=(4), X
AREALEN=(5), X
RECLEN=(5)
LTR R15,R15 OK MODCB?
BNZ MODERR NO
XR R6,R6 SET SECOND OPERAND ADDRESS FOR MVCL
XR R7,R7 SET PAD AND LENGTH TO X'00' FOR MVCL
MVCL R4,R6 PLACE ALL X'00' INTO LOGICAL RECORD
PUT RPL=RPL WRITE A LOGICAL RECORD
LTR R15,R15 OK PUT?
BNZ PUTERR NO
CLOSE (DS) DISCONNECT VSAM CLUSTER FROM PROGRAM
LTR R15,R15 OK CLOSE?
BNZ CLOSEERR NO
*
* READ AND DELETE THE NULL RECORD
*
MODCB ACB=DS, MODIFY THE ACCESS CONTROL BLOCK X
MACRF=(KEY,SEQ,OUT)
LTR R15,R15 OK MODCB?
BNZ MODERR NO
MODCB RPL=RPL, MODIFY THE REQUEST PARAMETER LIST X
OPTCD=(KEY,SEQ,UPD)
LTR R15,R15 OK MODCB?
BNZ MODERR NO
OPEN (DS) CONNECT VSAM CLUSTER TO PROGRAM
LTR R15,R15 OK OPEN?
BNZ OPENERR NO
GET RPL=RPL READ LOGICAL RECORD
LTR R15,R15 OK GET?
BNZ GETERR NO
ERASE RPL=RPL DELETE LOGICAL RECORD
LTR R15,R15 OK ERASE?
BNZ ERASEERR NO
CLOSE (DS) DISCONNECT VSAM CLUSTER FROM PROGRAM
LTR R15,R15 OK CLOSE?
BNZ CLOSEERR NO
FREESTOR FREEMAIN EU, RELEASE STORAGE X
LV=RECLEN, X
A=@AREA, X
RELATED=(GETSTOR,'FREE STORAGE')
LTR R15,R15 OK FREEMAIN?
BNZ FREEMNER NO
ENDPGM END PROGRAM EXECUTION
PATCH PRINT=GEN PATCH AREA
EJECT
DS ACB AM=VSAM, ACCESS CONTROL BLOCK X
DDNAME=DS, X
MACRF=(DIR,OUT)
RPL RPL AM=VSAM, REQUEST PARAMETER LIST X
ACB=DS
@AREA DC F'0' ADDRESS OF LOGICAL RECORD AREA
RECLEN DC F'0' LENGTH OF LOGICAL RECORD
EJECT
OPENERR ABEND 101,DUMP ERROR PROCESSING
SHOWERR ABEND 102,DUMP
MODERR ABEND 103,DUMP
PUTERR ABEND 104,DUMP
GETERR ABEND 105,DUMP
ERASEERR ABEND 106,DUMP
CLOSEERR ABEND 107,DUMP
GETMNERR ABEND 108,DUMP
FREEMNER ABEND 109,DUMP
END
|
Hope this helps...
Cheers
Kolusu
_________________
Kolusu
www.linkedin.com/in/kolusu |
|
FAQ
Search
Quick Manuals
Register
Profile
Log in to check your private messages
Log in
