-- ----------------------------------------------------------------- --
-- This program illustrates how Data Window services are invoked --
-- using ADA. Note that the data object referenced in this program --
-- is permanent and already allocated, and is defined by the DD --
-- statement CSRDD1 in the JCL. --
-- --
-- This program must be linkedited with the CSR linkage-assist --
-- routines (also known as stubs) in SYS1.CSSLIB. --
-- ----------------------------------------------------------------- --
with EBCDIC; use EBCDIC;
with System;
with Text_Io;
with Unchecked_Conversion;
with Td_Standard; use Td_Standard;
procedure CRTPAN06 is
subtype Str3 is EString (1..3);
subtype Str5 is EString (1..5);
subtype Str6 is EString (1..6);
subtype Str7 is EString (1..7);
subtype Str8 is EString (1..8);
subtype Str9 is EString (1..9);
function Integer_Address is new Unchecked_Conversion
(System.Address, Integer);
function Int_To_32 is new Unchecked_Conversion
(Integer, Integer_32);
Orig, -- Index to indicate the 'start'
-- of an array
Ad, I : Integer; -- Temporary variables
Voffset, -- Offset passed as parameter
Vofset2, -- Offset passed as parameter
Vobjsiz, -- Object size, as parameter
Vwinsiz, -- Window size, as parameter
High_Offset, -- Size of object in pages
New_Hi_Offset, -- New max size of the object
Return_Code, -- Return code
Reason_Code : Integer_32; -- Reason code
Object_Id : Str8; -- Identifying token
Cscroll : Str3; -- Scroll area YES/NO
Cobstate : Str3; -- Object state NEW/OLD
Coptype : Str5; -- Operation type BEGIN/END
Caccess : Str6; -- Access RANDOM/SEQ
Cusage : Str6; -- Usage READ/UPDATE
Cdisp : Str7; -- Disposition RETAIN/REPLACE
Csptype : Str9; -- Object type DSNAME/DDNAME/TEMPSPACE
Cobname : Str7; -- Object name
K : constant Integer := 1024; -- One kilo-byte
Pagesize : constant Integer := 4 * K; -- Page (4K) boundary
Offset : constant Integer_32 := 0; -- Start of permanent object
Window_Size : constant Integer := 40; -- Window size in pages
Num_Win_Elem : constant Integer := Window_Size*K; -- Num of 4-byte
-- elements in window
Object_Size : constant Integer := 3*Window_Size; -- Chosen object
-- size in pages
Num_Sp_Elem : constant Integer := (Window_Size+1)*K; -- Num of
-- 4-byte elements in space
type S is array (positive range <>) of Integer; -- Define byte
-- aligned space
Sp : S (1..Num_Sp_Elem); -- Space allocated for window
procedure CSRIDAC (Op_Type : in Str5;
Object_Type : in Str9;
Object_Name : in Str7;
Scroll_Area : in Str3;
Object_State: in Str3;
Access_Mode : in Str6;
Vobjsiz : in Integer_32;
Object_Id : out Str8;
High_Offset : out Integer_32;
Return_Code : out Integer_32;
Reason_Code : out Integer_32);
pragma Interface (Assembler, CSRIDAC);
procedure CSRVIEW (Op_Type : in Str5;
Object_Id : in Str8;
Offset : in Integer_32;
Window_Size : in Integer_32;
Window_Name : in S;
Usage : in Str6;
Disposition : in Str7;
Return_Code : out Integer_32;
Reason_Code : out Integer_32);
pragma Interface (Assembler, CSRVIEW);
procedure CSRSCOT (Object_Id : in Str8;
Offset : in Integer_32;
Span : in Integer_32;
Return_Code : out Integer_32;
Reason_Code : out Integer_32);
pragma Interface (Assembler, CSRSCOT);
procedure CSRSAVE (Object_Id : in Str8;
Offset : in Integer_32;
Span : in Integer_32;
New_Hi_Offset : out Integer_32;
Return_Code : out Integer_32;
Reason_Code : out Integer_32);
pragma Interface (Assembler, CSRSAVE);
procedure CSRREFR (Object_Id : in Str8;
Offset : in Integer_32;
Span : in Integer_32;
Return_Code : out Integer_32;
Reason_Code : out Integer_32);
pragma Interface (Assembler, CSRREFR);
begin
Text_Io.Put_Line ("<<Begin Window Services Interface Validation>>");
Text_Io.New_Line;
Vobjsiz := Int_To_32(Object_Size); -- Set object size in variable
Voffset := Offset; -- Set offset to 0 for 1st map
Vwinsiz := Int_To_32(Window_Size); -- Set window size in variable
Vofset2 := Offset+Vwinsiz; -- Set offset to 40 for 2nd map
Coptype := "BEGIN";
Csptype := "DDNAME ";
Cobname := "CSRDD1 ";
Cscroll := "YES";
Cobstate := "OLD";
Caccess := "UPDATE";
CSRIDAC (Coptype, -- Set up access to the
Csptype, -- permanent object and
Cobname, -- request a scroll area
Cscroll,
Cobstate,
Caccess,
Vobjsiz,
Object_Id,
High_Offset,
Return_Code,
Reason_Code);
-- When you want to map a window to your object, data window services
-- expects the address of the start of the window to be on a page (4K)
-- boundary, and the length of the window to be a multiple of 4096 bytes.
-- If your window is an array, the address of the first element
-- of the array must be on a page boundary. If this is not the case,
-- you can appropriately choose one slice of your array that starts
-- on a 4K boundary and is a multiple of 4096 bytes in length to map
-- onto your object.
-- To illustrate, consider the array A(1..max_len). If the address of
-- A(1) is not on page boundary, you cannot map A(1..max_len) to your
-- object. You can, however, map A(n..m) to your object if you choose
-- some appropriate values n and m such that A(n) starts on a 4K
-- boundary and A(n..m) is a multiple of 4096 bytes in length.
Ad := Integer_Address(Sp(1)'Address); -- Get address of start of array
-- Determine the first element whose address is on page boundary
-- and use that element as the origin of the array.
Orig := (Ad mod Pagesize); -- See where the start of
-- array is in page
if Orig = 0 then -- If already on page boundary
Orig := 1; -- Keep the old origin
else
Orig := (Pagesize - Orig) / 4 + 1; -- Need new origin
end if;
Coptype := "BEGIN";
Cusage := "RANDOM";
Cdisp := "REPLACE";
-- You can pass an array slice as a parameter to a non-Ada subprogram,
-- and because the slice is a composite object, the parameter list
-- contains the actual address of the first element in the slice.
-- To elaborate further:
-- Scalar data is passed by copy, but composite data is passed by
-- reference. If the scalar value was passed as a scalar, the assemble\
-- program would receive the address of the copy and not the address of
-- the scalar. By passing the scalar value as an array slice, a
-- composite data type is being passed and thus is passed by reference.
-- Using this technique, the assembler code receives the actual address
-- of the scalar, not a copy of the scalar.
CSRVIEW (Coptype, -- Now map a window (the array)
Object_Id, -- to the permanent object.
Voffset, -- (Actually, CSRVIEW will map the
Vwinsiz, -- window to the blocks in the
Sp(Orig..Num_Sp_Elem), -- scroll area and map the scroll
Cusage, -- area to the object.)
Cdisp,
Return_Code,
Reason_Code);
for I in 0 .. Num_Win_Elem-1 loop -- Put data in window area
Sp(I+Orig) := I+1;
end loop;
CSRSCOT (Object_Id, -- Capture the view in window.
Voffset, -- Note: only the scroll area
Vwinsiz, -- is updated, the permanent
Return_Code, -- object remains unchanged.
Reason_Code);
Coptype := "END ";
Cusage := "RANDOM";
Cdisp := "RETAIN ";
CSRVIEW (Coptype, -- End the view in window
Object_Id,
Voffset,
Vwinsiz,
Sp(Orig..Num_Sp_Elem),
Cusage,
Cdisp,
Return_Code,
Reason_Code);
Coptype := "BEGIN";
Cusage := "RANDOM";
Cdisp := "REPLACE";
CSRVIEW (Coptype, -- Now map the same window
Object_Id, -- to different part of the
Vofset2, -- permanent object.
Vwinsiz,
Sp(Orig..Num_Sp_Elem),
Cusage,
Cdisp,
Return_Code,
Reason_Code);
for I in 0 .. Num_Win_Elem-1 loop -- Put data in window area
Sp(I+Orig) := I+1;
end loop;
CSRSAVE (Object_Id, -- Capture the view in window.
Vofset2, -- Note: this time the permanent
Vwinsiz, -- object is updated with the
New_Hi_Offset, -- changes.
Return_Code,
Reason_Code);
Coptype := "END ";
CUsage := "RANDOM";
Cdisp := "RETAIN ";
CSRVIEW (Coptype, -- End the current view in
Object_Id, -- the window
Vofset2,
Vwinsiz,
Sp(Orig..Num_Sp_Elem),
Cusage,
Cdisp,
Return_Code,
Reason_Code);
Coptype := "BEGIN";
Cusage := "RANDOM";
Cdisp := "REPLACE";
CSRVIEW (Coptype, -- Now go back to reestablish
Object_Id, -- the 1st map using the same
Voffset, -- window area
Vwinsiz,
Sp(Orig..Num_Sp_Elem),
Cusage,
Cdisp,
Return_Code,
Reason_Code);
CSRREFR (Object_Id, -- Refresh the data in the window
Voffset,
Vwinsiz,
Return_Code,
Reason_Code);
Coptype := "END ";
Cusage := "RANDOM";
Cdisp := "RETAIN ";
CSRVIEW (Coptype, -- End the view in window
Object_Id,
Voffset,
Vwinsiz,
Sp(Orig..Num_Sp_Elem),
Cusage,
Cdisp,
Return_Code,
Reason_Code);
Coptype := "END ";
Csptype := "DDNAME ";
Cobname := "CSRDD1 ";
Cscroll := "YES";
Cobstate := "OLD";
Caccess := "UPDATE";
CSRIDAC (Coptype, -- Terminate access to the
Csptype, -- permanent object
Cobname,
Cscroll,
Cobstate,
Caccess,
Vwinsiz,
Object_Id,
High_Offset,
Return_Code,
Reason_Code);
end CRTPAN06;
//ADAJOB JOB 00000100
//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00000500
//* JCL USED TO COMPILE, LINK, AND EXECUTE THE ADA PROGRAM CRTPAN06 00000600
//* THAT USES DATA WINDOW SERVICES 00000700
//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00000800
/*JOBPARM T=2,L=99 00050000
//ADACOBI EXEC PGM=IKJEFT01,DYNAMNBR=133 00055813
//SYSTSPRT DD SYSOUT=* 00055913
//SYSTSIN DD * 00056008
ALLOC FI(SYSLIB) DS('SYS1.CSSLIB') SHR 00056147
EX 'HLQ.SEVGEXE1(ADA)' 'USERID.DWS.ADA'' (MAI CRE' 00056251
/* 00057008
//ADARUN EXEC PGM=CRTPAN06,DYNAMNBR=133 00070036
//STEPLIB DD DISP=SHR,DSN=HLQ.SEVHMOD1 00100051
// DD DISP=SHR,DSN=USERID.LOAD 00110051
//CSRDD1 DD DSN=USERID.ADA.DWSTEST.DATA,DISP=SHR 00120051
//CONOUT DD SYSOUT=*, 00130013
// DCB=(LRECL=133,RECFM=F) 00140027
z/OS MVS Programming: Callable Services for High-Level Languages
Copyright IBM Corporation 1990, 2014