VLOAD CSECT 00010000 PRINT NOGEN OR PRINT GEN 00020000 STM R14,R12,12(R13) SAVE ALL CALLER REGS IN CALLER AREA 00022000 LR R12,R15 GET ENTRY ADDRESS TO MY PROG 00023000 USING VLOAD,R12 SET BASE R12 00024000 LA R8,SAVEAREA GET SAVE AREA ADDRESS 00025000 ST R13,4(R8) SAVE CALLER SAVE AREA ADDRESS 00026000 ST R8,8(R13) SAVE MINE TOO 00027000 LR R13,R8 NOW LET R13 POINT TO MINE 00028000 *********************************************************************** 00028100 * BOB BARNES 3/9/93 OPEN (VFILE,OUTPUT) 00000025 LTR R15,R15 BNZ OCERROR OPEN (FFILE,INPUT) GET FFILE,KEY 00000032 LOOP EQU * MVC *+20(10),KEY WTO '----------------------------------------',ROUTCDE=11 PUT RPL=VDIR 00000033 CVD R15,VDOUBLE UNPK CH15,VDOUBLE MVC *+20(15),CH15 WTO '-------------------------------------RC-',ROUTCDE=11 LTR R15,R15 00000034 BNZ VERROR 00000035 TESTCB RPL=VDIR,FDBK=8 BNE NEXTTEST WTO 'DUP KEY ',ROUTCDE=11 NEXTTEST TESTCB RPL=VDIR,FDBK=28 BNE GETNEXT WTO 'OUT OF SPACE!!!!',ROUTCDE=11 GETNEXT GET FFILE,KEY B LOOP OCERROR DS 0H * SHOWCB RPL=VFILE,FIELDS=ERROR,AREA=ERRCODE,LENGTH=4 * L R15,ERRCODE WTO 'ERROR IN ACB',ROUTCDE=11 B BYE VERROR DS 0H 00000040 WTO 'ERROR IN RPL ',ROUTCDE=11 SHOWCB RPL=VDIR,FIELDS=FDBK,AREA=FEEDBACK,LENGTH=4 L R15,FEEDBACK CVD R5,VDOUBLE UNPK CH15,VDOUBLE MVC *+16,CH15 WTO '----------------------------------------',ROUTCDE=11 B BYE EOF EQU * 00000036 CLOSE (VFILE) 00000036 LTR R15,R15 BNZ VERROR CLOSE (FFILE) 00000042 *********************************************************************** 00037103 BYE L R13,4(R13) LOAD CALLER SAVE AREA BACK TO REG13 00038000 LM R14,R12,12(R13) RESTORE ALL CALLER REGS 00038100 SR R15,R15 ZEROS R15 - RETURN CODE 00038200 BR R14 00038300 LTORG 00000052 R0 EQU 0 00038500 R1 EQU 1 00038600 R2 EQU 2 00038700 R3 EQU 3 00038800 R4 EQU 4 00038900 R5 EQU 5 00039000 R6 EQU 6 00039100 R7 EQU 7 00039200 R8 EQU 8 00039300 R9 EQU 9 00039400 R10 EQU 10 00039500 R11 EQU 11 00039600 R12 EQU 12 00039700 R13 EQU 13 00039800 R14 EQU 14 00039900 R15 EQU 15 00040000 DS 0F INSURE DOUBLEWORD BOUNDARIES 00040100 SAVEAREA DS 18F REGISTER SAVE AREA 00040200 BLANKS DC CL1' ' 00000054 OREC DS 0CL10 KEY DS CL10 00000054 IIN DS CL10 VDOUBLE DS D CH15 DS CL15' ' ERRCODE DS F FEEDBACK DS F LTORG 00000062 VFILE ACB AM=VSAM,DDNAME=VDATA,MACRF=(SEQ,OUT) 00000063 VDIR RPL ACB=VFILE,AM=VSAM,AREALEN=10,AREA=OREC, X00000064 KEYLEN=10,RECLEN=10,OPTCD=(SEQ,MVE,KEY,FWD),ARG=KEY 00000065 FFILE DCB DSORG=PS,DDNAME=FDATA,EODAD=EOF,MACRF=GM END VLOAD 01120000