Processing a data-in-virtual object
The following example shows a program that processes a data-in-virtual
object. The first part of the program identifies the data set and
accesses the object. Then it obtains the virtual storage where it
will place the window.
SAMPLE CSECT ,
SAMPLE AMODE 31
SAMPLE RMODE ANY
*
* FUNCTION: OBTAIN VIRTUAL STORAGE. THEN IDENTIFY AND
* ACCESS THE LINEAR DATA SET. THEN MAP AND PROCESS THE
* VIRTUAL STORAGE, AND STORE DATA INTO IT. THEN DO SAVES &
* RESETS. FINISH UP WITH AN UNMAP, AN UNACCESS AND AN
* UNIDENTIFY. ALL INVOCATIONS OF DATA-IN-VIRTUAL IN THIS
* PROGRAM DEFAULT TO 'RETAIN = NO'.
*
* DESCRIPTION: THIS JOB MAKES CHANGES IN THE LINEAR DATASET
* CLUSTER, 'DIV.SAMPLE', WHICH IS TREATED AS A LINEAR
* DATASET. AFTER THIS JOB IS RUN, THE DATASET WILL CONTAIN
* SEVEN PAGES OF ONES, FOLLOWED BY ONE PAGE OF ZEROES,
* FOLLOWED BY EIGHT PAGES OF FIVES. IT IS ASSUMED THE
* DATASET WAS CREATED BY A DEFINE CLUSTER COMMAND AND THAT
* IT CONTAINS ZEROES WHEN THIS PROGRAM BEGINS TO EXECUTE.
*
@MAINENT DS 0H
USING *,R15
B @PROLOG
DC AL1(14)
DC C'SAMPLE PROGRAM'
DROP R15
@PROLOG STM R14,R12,12(R13) STD ENTRY LINKAGE
LR R12,R15
USING SAMPLE,R12
ST R13,SAVEAREA+4
LR R2,R13
LA R13,SAVEAREA
ST R13,8(R2)
SR R15,R15 CLEAR R15
*
* GET STORAGE FOR THE WINDOW
*
GETMAIN RU,LV=16*4096,SP=0,BNDRY=PAGE
ST R1,MAPPTR1 PTR TO STORAGE
*
* INVOKE IDENTIFY SERVICE OF DIV MACRO
*
DIV IDENTIFY,DDNAME=DDAREA,TYPE=DA,ID=TESTID
LTR R15,R15 CHECK IF RC IS ZERO
BNZ ERROR IDENTIFY FAILED
*
* INVOKE ACCESS SERVICE OF DIV MACRO
*
DIV ACCESS,MODE=UPDATE,ID=TESTID
LTR R15,R15 CHECK IF RC IS ZERO
BNZ ERROR ACCESS FAILEDThe program maps the data set object. The resulting virtual storage
window is eight pages long, and it corresponds to the second eight
blocks of the object. The window is situated in the virtual storage
obtained earlier by the GETMAIN macro. The program fills the window
with fives, then saves the window back into the second eight blocks
of the object. The program eliminates the window by invoking UNMAP.
* INVOKE THE MAP SERVICE OF THE DIV MACRO
* TO SKIP THE FIRST EIGHT BLOCKS OF THE OBJECT
*
L R3,EIGHT GET SPAN
ST R3,SPVALUE INITIALIZE SPAN
ST R3,OFFS INITIALIZE OFFSET
DIV MAP,ID=TESTID,AREA=MAPPTR1, x
SPAN=SPVALUE,OFFSET=OFFS
LTR R15,R15 CHECK IF RC IS ZERO
BNZ ERROR MAP FAILED
*
* FILL IN 5'S FOR ALL EIGHT MAPPED BLOCKS
*
L R1,MAPPTR1 POINTS TO WINDOW
LR R2,R1 POINTS TO MAP
SR R5,R5 COUNTER 32 KBYTES
L R6,PAGE8 COUNTER MAXIMUM
IC R3,N55 5S USED AS FILLER
LOOP1 STC R3,0(,R2) STORE INTO MAP
LA R2,1(,R2) POINTS NEXT BYTE
LA R5,1(,R5) COUNT UP ONE BYTE
CR R5,R6 LAST BYTE OF MAP?
BM LOOP1 DO AGAIN IF NOT
*
* INVOKE THE SAVE SERVICE OF THE DIV MACRO
*
DIV SAVE,ID=TESTID,SIZE=OBJSIZE
LTR R15,R15 CHECK ZERO RC
BNZ ERROR SAVE FAILED
*
* INVOKE THE UNMAP SERVICE OF THE DIV MACRO
*
DIV UNMAP,ID=TESTID,AREA=MAPPTR1
LTR R15,R15 CHECK ZERO RC
BNZ ERROR UNMAP FAILED
*
* OBJECT NOW HAS . CONTIGUOUS PAGES OF 5'S
*The program creates a new window that includes the first eight
blocks of the object. This map omits OFFSET, causing a default offset
of zero to be used with the specified span of eight blocks. After
filling the window with ones, the program invokes RESET against the
eighth block of the object which corresponds to the eighth page of
the window. Because the information provided by the reset comes from
the object which still contains zeroes, the eighth page in the window
is set to zeros.
* INVOKE MAP SERVICE FOR FIRST EIGHT 4K
* BLOCKS OF DATASET, WITH DEFAULT OFFSET.
*
L R3,EIGHT GET VALUE OF SPAN
ST R3,SPVALUE INITIALIZE SPAN
DIV MAP,ID=TESTID,AREA=MAPPTR1, x
SPAN=SPVALUE
LTR R15,R15 CHECK ZERO RC
BNZ ERROR MAP FAILED
*
* FILL IN DATA - 1'S FOR THE FIRST 8 PAGES
*
L R1,MAPPTR1 POINTS TO WINDOW
LR R2,R1 POINTS TO MAP
SR R5,R5 COUNTER 32 KBYTES
L R6,PAGE8 COUNTER MAXIMUM
IC R3,N11 1S USED AS FILLER
LOOP2 STC R3,0(,R2) STORE INTO MAP
LA R2,1(,R2) POINTS TO NEXT BYTE
LA R5,1(,R5) COUNT UP ONE BYTE
CR R5,R6 LAST BYTE OF MAP?
BM LOOP2 DO AGAIN IF NOT
*
* RESET 8TH VIRTUAL BLOCK FROM THE CORRESPONDING
* BLOCK ON DASD. THIS BLOCK NOW CONTAINS ZEROES
* SINCE THE PROGRAM HAS NOT YET INVOKED ANY
* SAVE SERVICES AFFECTING IT.
*
L R3,SEVEN
ST R3,OFFS INITIALIZE OFFSET
L R3,ONE
ST R3,SPVALUE INITIALIZE SPAN
DIV RESET,ID=TESTID, x
SPAN=SPVALUE,OFFSET=OFFS
LTR R15,R15 CHECK IF RC IS ZERO
BNZ ERROR RESET FAILEDThe program saves the window in the first eight blocks of the object
by issuing the DIV macro, specifying SAVE. Then it terminates its
use of the object by invoking the UNMAP, UNACCESS, and UNIDENTIFY
services of the DIV macro.
* INVOKE SAVE, USING DEFAULTS FOR SPAN AND
* OFFSET. THIS SAVES ALL MAPPED BLOCKS ON
* THE OBJECT. THE FIRST SEVEN ARE FILLED
* WITH X'11' AND THE LAST HAS ALL BINARY
* ZEROES.
*
DIV SAVE,ID=TESTID,SIZE=OBJSIZE
LTR R15,R15 CHECK ZERO RC
BNZ ERROR SAVE FAILED
*
* INVOKE THE UNMAP SERVICE
*
DIV UNMAP,ID=TESTID,AREA=MAPPTR1
LTR R15,R15 CHECK IF RC IS ZERO
BNZ ERROR UNMAP FAILED
*
* THE OBJECT NOW HAS SEVEN CONTIGUOUS BLOCKS OF
* 1'S, FOLLOWED BY ONE BLOCK OF 0'S, FOLLOWED BY
* EIGHT BLOCKS OF 5'S. NOW INVOKE UNACCESS.
*
DIV UNACCESS,ID=TESTID
LTR R15,R15 CHECK IF RC IS ZERO
BNZ ERROR UNACCESS FAILED
*
* INVOKE THE UNIDENTIFY SERVICE
*
B EXIT SKIP ERROR PROCESSING
ERROR EQU *
L R15,SIXTEEN BAD RETURN CODE
ST R15,SAVER15 HOLD R15 VALUE
EXIT EQU *
DIV UNIDENTIFY,ID=TESTID
LTR R15,R15 CHECK IF RC IS ZERO
BZ FREE IF SO, LEAVE RC GOOD
L R15,SIXTEEN SET BAD RETURN CODE
ST R15,SAVER15 HOLD R15 VALUEFinally, the program frees its virtual storage and goes through
a standard exit linkage sequence.
* FREE STORAGE AND EXIT
*
FREE EQU *
FREEMAIN RU,A=MAPPTR1,LV=16*4096,SP=0
L R15,SAVER15 RETRIEVE R15
L R13,4(R13) STD EXIT LINKAGE
L R14,12(R13)
LM R0,R12,20(R13) SAVE RETURN CODE
BR R14
SPACE 2
*
* DECLARE VARIABLES
*
MAPPTR1 DS A PTR TO GETMAINED STORAGE
OBJSIZE DS F SIZE RETURNED FROM ACCESS
OFFS DS A POSITION IN OBJECT
SPVALUE DS A LENGTH TO BE MAPPED-RESET
SAVER15 DS F'0' RC VALUE IN REG 15
SAVEAREA DS CL72 USED BY DATA-IN-VIRTUAL
TESTID DS CL8 ID RETURNED FROM IDENTIFY
DDAREA DS CL8
ORG DDAREA
DC AL1(7) LENGTH OF DDNAME
DC CL7'DYNAMIC' NAME USED IN JCL
ORG DDAREA+8
SPACE 2
*
* CONSTANTS
*
N11 DC X'11' HEX ONES
N55 DC X'55' HEX FIVES
ONE DC F'1' ONE
SEVEN DC F'7' SEVEN
EIGHT DC F'8' EIGHT
SIXTEEN DC F'16' SIXTEEN
PAGE8 DC F'32768' 8 TIMES 4096
*
* REGISTERS
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R5 EQU 5
R6 EQU 6
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
EJECT
END SAMPLE