**********************************************************************
* *
* *
* PASCAL example. The data object is permanent and already *
* allocated. A scroll area is used. *
* *
* *
* *
**********************************************************************
program CRTPAN06;
const
K = 1024; (* One kilo-byte *)
PAGESIZE = 4 * K; (* 4K page boundary *)
OFFSET = 0; (* Windows starts *)
WINDOW_SIZE = 40; (* Window size in pages *)
NUM_WIN_ELEM = WINDOW_SIZE*K; (* Num of 4-byte elements *)
OBJECT_SIZE = 3*WINDOW_SIZE; (* Chosen object size in pages*)
SPACE_SIZE = (WINDOW_SIZE+1)*4*K; (* Space allocated for window *)
type
S = space[SPACE_SIZE] of INTEGER; (* Define byte aligned space *)
STR3 = packed array (. 1..3 .) of CHAR;
STR5 = packed array (. 1..5 .) of CHAR;
STR6 = packed array (. 1..6 .) of CHAR;
STR7 = packed array (. 1..7 .) of CHAR;
STR9 = packed array (. 1..9 .) of CHAR;
STR44 = packed array (. 1..44 .) of CHAR;
var
SP : @S; (* Declare pointer to space *)
ORIG, (* Start address of window *)
AD, I, (* 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; (* Reason code *)
OBJECT_ID : REAL; (* 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 : STR44; (* Object name *)
procedure CSRIDAC ( var OP_TYPE : STR5;
var OBJECT_TYPE : STR9;
var OBJECT_NAME : STR44;
var SCROLL_AREA : STR3;
var OBJECT_STATE : STR3;
var ACCESS_MODE : STR6;
var VOBJSIZ : INTEGER;
var OBJECT_ID : REAL;
var HIGH_OFFSET : INTEGER;
var RETURN_CODE : INTEGER;
var REASON_CODE : INTEGER); FORTRAN;
procedure CSRVIEW ( var OP_TYPE : STR5;
var OBJECT_ID : REAL;
var OFFSET : INTEGER;
var WINDOW_SIZE : INTEGER;
var WINDOW_NAME : INTEGER;
var USAGE : STR6;
var DISPOSITION : STR7;
var RETURN_CODE : INTEGER;
var REASON_CODE : INTEGER); FORTRAN;
procedure CSRSCOT ( var OBJECT_ID : REAL;
var OFFSET : INTEGER;
var SPAN : INTEGER;
var RETURN_CODE : INTEGER;
var REASON_CODE : INTEGER ); FORTRAN;
procedure CSRSAVE ( var OBJECT_ID : REAL;
var OFFSET : INTEGER;
var SPAN : INTEGER;
var NEW_HI_OFFSET : INTEGER;
var RETURN_CODE : INTEGER;
var REASON_CODE : INTEGER ); FORTRAN;
procedure CSRREFR ( var OBJECT_ID : REAL;
var OFFSET : INTEGER;
var SPAN : INTEGER;
var RETURN_CODE : INTEGER;
var REASON_CODE : INTEGER ); FORTRAN;
begin
TERMOUT(OUTPUT); (* Output to terminal *)
WRITELN ('<< Begin Data Windowing Services Interface Validation >>');
WRITELN;
VOBJSIZ := OBJECT_SIZE; (* Set object size variable *)
VOFFSET := OFFSET; (* Set offset variable to 0 *)
VWINSIZ := WINDOW_SIZE; (* Set window size variable *)
VOFSET2 := OFFSET+WINDOW_SIZE; (* Set offset variable to 0 *)
COPTYPE := 'BEGIN' ;
CSPTYPE := 'DDNAME ' ;
COBNAME := 'CSRDD1 ' ;
CSCROLL := 'YES' ;
COBSTATE := 'NEW' ;
CACCESS := 'UPDATE' ;
CSRIDAC (COPTYPE, (* Set up access to a *)
CSPTYPE, (* hiperspace object *)
COBNAME,
CSCROLL,
COBSTATE,
CACCESS,
VOBJSIZ,
OBJECT_ID,
HIGH_OFFSET,
RETURN_CODE,
REASON_CODE);
NEW(SP); (* Allocate space *)
AD := ADDR(SP@); (* or ORD(SP) *) (* Get address of space *)
ORIG := AD mod PAGESIZE; (* See where space is in page *)
if ORIG <> 0 then (* If not on page boundary *)
ORIG := PAGESIZE-ORIG; (* then locate page boundary *)
for I := 0 to NUM_WIN_ELEM-1 do (* Put data into window *)
SP@[4*I+ORIG] := 999999; (* area *)
COPTYPE := 'BEGIN' ;
CUSAGE := 'RANDOM' ;
CDISP := 'REPLACE' ;
CSRVIEW (COPTYPE, (* Now view data in 1st *)
OBJECT_ID, (* window *)
VOFFSET,
VWINSIZ,
SP@[ORIG],
CUSAGE,
CDISP,
RETURN_CODE,
REASON_CODE);
for I := 0 to NUM_WIN_ELEM-1 do (* Calculate a value in 1st *)
SP@[4*I+ORIG] := I+1; (* window *)
CSRSCOT( OBJECT_ID, (* Capture the view in 1st *)
VOFFSET, (* window *)
VWINSIZ,
RETURN_CODE,
REASON_CODE);
COPTYPE := 'END' ;
CUSAGE := 'RANDOM' ;
CDISP := 'RETAIN' ;
CSRVIEW (COPTYPE, (* End the view in 1st window *)
OBJECT_ID,
VOFFSET,
VWINSIZ,
SP@[ORIG],
CUSAGE,
CDISP,
RETURN_CODE,
REASON_CODE);
COPTYPE := 'BEGIN' ;
CUSAGE := 'RANDOM' ;
CDISP := 'REPLACE' ;
CSRVIEW (COPTYPE, (* Now view other data in the *)
OBJECT_ID, (* 2nd window *)
VOFSET2,
VWINSIZ,
SP@[ORIG],
CUSAGE,
CDISP,
RETURN_CODE,
REASON_CODE);
for I := 0 to NUM_WIN_ELEM-1 do (* Calculate a new value in *)
SP@[4*I+ORIG] := I-101; (* the window *)
CSRSAVE (OBJECT_ID,
VOFSET2,
VWINSIZ,
NEW_HI_OFFSET,
RETURN_CODE,
REASON_CODE);
COPTYPE := 'END' ;
CUSAGE := 'RANDOM' ;
CDISP := 'RETAIN' ;
CSRVIEW (COPTYPE, (* End the current view in *)
OBJECT_ID, (* window *)
VOFSET2,
VWINSIZ,
SP@[ORIG],
CUSAGE,
CDISP,
RETURN_CODE,
REASON_CODE);
COPTYPE := 'BEGIN' ;
CUSAGE := 'RANDOM' ;
CDISP := 'REPLACE' ;
CSRVIEW (COPTYPE, (* Now go back to the view in *)
OBJECT_ID, (* the 1st window *)
VOFFSET,
VWINSIZ,
SP@[ORIG],
CUSAGE,
CDISP,
RETURN_CODE,
REASON_CODE);
CSRREFR (OBJECT_ID, (* Refresh the data in 1st *)
VOFFSET, (* window *)
VWINSIZ,
RETURN_CODE,
REASON_CODE);
COPTYPE := 'END' ;
CUSAGE := 'RANDOM' ;
CDISP := 'RETAIN' ;
CSRVIEW (COPTYPE, (* End the view in 1st window *)
OBJECT_ID,
VOFFSET,
VWINSIZ,
SP@[ORIG],
CUSAGE,
CDISP,
RETURN_CODE,
REASON_CODE);
COPTYPE := 'END' ;
CSPTYPE := 'DDNAME ' ;
COBNAME := 'CSRDD1 ' ;
CSCROLL := 'YES' ;
COBSTATE := 'NEW' ;
CACCESS := 'UPDATE' ;
CSRIDAC (COPTYPE, (* Terminate access to the *)
CSPTYPE, (* Hiperspace object *)
COBNAME,
CSCROLL,
COBSTATE,
CACCESS,
VWINSIZ,
OBJECT_ID,
HIGH_OFFSET,
RETURN_CODE,
REASON_CODE);
end.
**********************************************************************
* *
* JCL to compile and linkedit *
* *
**********************************************************************
//PASC1JOB JOB 00010005
//GO EXEC PAS22CL 00050000
//* 00050102
//* Compile and linkedit for PASCAL 00050202
//* 00050302
//PASC.SYSIN DD DSN=WINDOW.XAMPLE.LIB(CRTPAN06),DISP=SHR 00060006
//LKED.SYSLMOD DD DSN=WINDOW.USER.LOAD,DISP=SHR,UNIT=3380, 00560000
// VOL=SER=VM2TSO 00570000
//LKED.SYSIN DD * 00580000
LIBRARY IN(CSRSCOT,CSRSAVE,CSRREFR,CSRSAVE,CSRVIEW,CSRIDAC) 00590000
NAME CRTPAN06(R) 00600006
/* 00610000
//* SYS1.CSSLIB is the source of the CSR stubs 00620002
//* 00650002
//LKED.IN DD DSN=SYS1.CSSLIB,DISP=SHR 00690000
**********************************************************************
* *
* JCL to execute. A DD statement, CSRDD1, is needed to define *
* the permanent object which already exists. *
* *
* *
**********************************************************************
//PASC2JOB JOB MSGLEVEL=(1,1) 00010000
//GO EXEC PGM=CRTPAN06 00020002
//STEPLIB DD DSN=WINDOW.PASCAL22.LINKLIB, 00030000
// DISP=SHR,UNIT=3380, 00040000
// VOL=SER=VM2TSO 00050000
// DD DSN=WINDOW.USER.LOAD, 00060000
// DISP=SHR,UNIT=3380, 00070000
// VOL=SER=VM2TSO 00080000
//CSRDD1 DD DSN=DIV.TESTDS01,DISP=SHR
//OUTPUT DD SYSOUT=A,DCB=(RECFM=VBA,LRECL=133) 00090000
//SYSPRINT DD SYSOUT=A,DCB=(RECFM=VBA,LRECL=133) 00100000
z/OS MVS Programming: Callable Services for High-Level Languages
Copyright IBM Corporation 1990, 2014