********************************************************************
* *
* *
* FORTRAN EXAMPLE. THE FORTRAN EXAMPLE IS FOLLOWED BY AN *
* ASSEMBLER PROGRAM CALLED ADDR. YOU MUST LINKEDIT THIS *
* ASSEMBLER PROGRAM WITH THE FORTRAN PROGRAM OBJECT *
* CODE AND THE CSR STUBS. THE ASSEMBLER PROGRAM ENSURES *
* THAT YOUR WINDOW IS ALIGNED ON A 4K BOUNDARY . *
* *
********************************************************************
@PROCESS DC(WINCOM)
PROGRAM CRTFON01
C
C Test Program for Data Window Services
C
C Window size chosen to be 40 pages
PARAMETER (NWINPG = 40)
C Window composed of 4-byte elements
PARAMETER (NWINEL = 1024*NWINPG)
C Window may not begin at array element 1, so leave room
PARAMETER (NWLAST = 1024*NWINPG+1023)
C In the following, arbitrarily set object size = 3 windows worth
PARAMETER (NOBJPG = 3*NWINPG)
C Windows will begin origin-ing at offset 0 in data object
INTEGER WINOFF
PARAMETER (WINOFF = 0)
C
INTEGER RETRN1, REASON, HIOFF, NEWOFF, OBSIZ, OFF
INTEGER ADDR, PAGE, A
INTEGER JUNK /-1599029040/
REAL*8 TOKEN
COMMON /WINCOM/ A(NWLAST)
C
C
WRITE (6, 91)
91 FORMAT('1*** Begin Data Windowing Services Interface Validation')
C
C Set up access to a Hiperspace object
CALL CSRIDAC('BEGIN',
* 'TEMPSPACE',
* 'MY FIRST HIPERSPACE',
* 'YES',
* 'NEW',
* 'UPDATE',
* NOBJPG,
* TOKEN,
* OBSIZ,
* RETRN1,
* REASON )
C
C Determine first page-boundary element in Window Array "A"
PAGE = ADDR(A(1))
PAGE = MOD(PAGE, 4096)
IF (PAGE .NE. 0) PAGE = (4096 - PAGE) / 4
PAGE = PAGE + 1
C
C Put data into the window
DO 100 K = 1, NWINEL
A(K+PAGE-1) = JUNK
100 CONTINUE
C
C Now view data in the window
CALL CSRVIEW('BEGIN',
* TOKEN,
* WINOFF,
* NWINPG,
* A(PAGE),
* 'RANDOM',
* 'REPLACE',
* RETRN1,
* REASON )
C
C Calculate a value in the window area
DO 101 K = 1, NWINEL
A(K+PAGE-1) = K
101 CONTINUE
C
C Capture the view in the window
CALL CSRSCOT( TOKEN,
* WINOFF,
* NWINPG,
* RETRN1,
* REASON )
C
C End the view in the window
CALL CSRVIEW('END ',
* TOKEN,
* WINOFF,
* NWINPG,
* A(PAGE),
* 'RANDOM',
* 'RETAIN ',
* RETRN1,
* REASON )
C
C Now view other data (2nd window's worth of data) in window
CALL CSRVIEW('BEGIN',
* TOKEN,
* WINOFF + NWINPG,
* NWINPG,
* A(PAGE),
* 'RANDOM',
* 'REPLACE',
* RETRN1,
* REASON )
C
C Calculate a new value in the window
DO 102 K = 1, NWINEL
A(K+PAGE-1) = -K
102 CONTINUE
C
C Capture the view in the window
CALL CSRSCOT( TOKEN,
* WINOFF + NWINPG,
* NWINPG,
* RETRN1,
* REASON )
C
C Now end the current view in window
CALL CSRVIEW('END ',
* TOKEN,
* WINOFF + NWINPG,
* NWINPG,
* A(PAGE),
* 'RANDOM',
* 'RETAIN ',
* RETRN1,
* REASON )
C
C Now go back to the first view in the window
CALL CSRVIEW('BEGIN',
* TOKEN,
* WINOFF,
* NWINPG,
* A(PAGE),
* 'RANDOM',
* 'REPLACE',
* RETRN1,
* REASON )
C
C Refresh the data in the window for this view
CALL CSRREFR( TOKEN,
* WINOFF,
* NWINPG,
* RETRN1,
* REASON )
C
C Now end the view in the window
CALL CSRVIEW('END ',
* TOKEN,
* WINOFF,
* NWINPG,
* A(PAGE),
* 'RANDOM',
* 'RETAIN ',
* RETRN1,
* REASON )
C
C Terminate access to the Hiperspace object
CALL CSRIDAC('END ',
* 'TEMPSPACE',
* 'MY FIRST HIPERSPACE ENDS HERE ',
* 'YES',
* 'NEW',
* 'UPDATE',
* NOBJPG,
* TOKEN,
* OBSIZ,
* RETRN1,
* REASON )
C
STOP
END
********************************************************************
* *
* *
* THIS ASSEMBLER PROGRAM ENSURES THAT YOUR WINDOW IS ALIGNED *
* ON A 4K BOUNDARY. ASSEMBLE THIS PROGRAM AND LINKEDIT THE *
* OBJECT CODE WITH THE FORTRAN CODE AND THE CSR STUBS. *
* *
********************************************************************
ADDR TITLE 'LOC/ADDR Function for Fortran'
*
* Calling Sequence:
*
* INTEGER ADDR
* - - -
* L = LOC(x)
* L = ADDR(x)
*
* Returns address of "x" in R0, with high-order bit set to zero
*
ADDR CSECT
ENTRY LOC
LOC EQU *
USING *,15
L 0,0(,1) Get pointer to x
N 0,MASK Set sign bit to 0
BR 14 Return
MASK DC A(X'7FFFFFFF') Mask with high-order bit 0
END
********************************************************************
* *
* JCL TO COMPILE AND LINKEDIT THE ASSEMBLER PROGRAM, THE *
* FORTRAN PROGRAM, AND THE STUBS. *
* *
********************************************************************
//FORTJOB JOB 00255013
//* 00003100
//* 00003100
//* Compile and linkedit for FORTRAN 00003100
//* 00003100
//* 00003100
//VSF2CL PROC FVPGM=FORTVS2,FVREGN=2100K,FVPDECK=NODECK, 00001000
// FVPOLST=NOLIST,FVPOPT=0,FVTERM='SYSOUT=A', 00002000
// PGMNAME=MAIN,PGMLIB='&&GOSET',FVLNSPC='3200,(25,6)' 00003000
//* 00003100
//* PARAMETER DEFAULT-VALUE USAGE 00003900
//* 00004000
//* FVPGM FORTVS2 COMPILER NAME 00005000
//* FVREGN 2100K FORT-STEP REGION 00006000
//* FVPDECK NODECK COMPILER DECK OPTION 00007000
//* FVPOLST NOLIST COMPILER LIST OPTION 00008000
//* FVPOPT 0 COMPILER OPTIMIZATION 00009000
//* FVTERM SYSOUT=A FORT.SYSTERM OPERAND 00010000
//* FVLNSPC 3200,(25,6) FORT.SYSLIN SPACE 00011000
//* PGMLIB &&GOSET LKED.SYSLMOD DSNAME 00012000
//* PGMNAME MAIN LKED.SYSLMOD MEMBER NAME 00013000
//* 00014000
//FORT EXEC PGM=&FVPGM,REGION=&FVREGN,COND=(4,LT), 00015000
// PARM='&FVPDECK,&FVPOLST,OPT(&FVPOPT)' 00016000
//STEPLIB DD DSN=HLLDS.FORT230.VSF2COMP,DISP=SHR 00017000
//SYSPRINT DD SYSOUT=A,DCB=BLKSIZE=3429 00018000
//SYSTERM DD &FVTERM 00019000
//SYSPUNCH DD SYSOUT=B,DCB=BLKSIZE=3440 00020000
//SYSLIN DD DSN=&&LOADSET,DISP=(MOD,PASS),UNIT=SYSDA, 00021000
// SPACE=(&FVLNSPC),DCB=BLKSIZE=3200 00022000
//LKED EXEC PGM=HEWL,REGION=768K,COND=(4,LT), 00023000
// PARM='LET,LIST,XREF' 00024000
//SYSPRINT DD SYSOUT=A 00025000
//SYSLIB DD DSN=CEE.SCEELKED,DISP=SHR 00026000
//SYSUT1 DD UNIT=SYSDA,SPACE=(1024,(200,20)) 00027000
//SYSLMOD DD DSN=&PGMLIB.(&PGMNAME),DISP=(,PASS),UNIT=SYSDA, 00028000
// SPACE=(TRK,(10,10,1),RLSE) 00029000
//SYSLIN DD DSN=&&LOADSET,DISP=(OLD,DELETE) 00030000
// DD DDNAME=SYSIN 00040000
// PEND
// EXEC VSF2CL,FVTERM='SYSOUT=H',
// PGMNAME=CRTFON01,PGMLIB='WINDOW.USER.LOAD' 00003000
//FORT.SYSIN DD DSN=WINDOW.XAMPLE.LIB(CRTFON01),DISP=SHR
//LKED.SYSLIB DD DSN=CEE.SCEELKED,DISP=SHR 00026000
//LKED.SYSLMOD DD DSN=WINDOW.USER.LOAD,DISP=SHR,UNIT=3380,
// VOL=SER=VM2TSO
//LKED.SYSIN DD *
LIBRARY IN(CSRSCOT,CSRSAVE,CSRREFR,CSRSAVE,CSRVIEW,CSRIDAC,ADDR)
NAME CRTFON01(R)
/*
//* The CSR stubs are available in SYS1.CSSLIB.
//* The object code for the ADDR routine is in
//* TEST.OBJ
//*
//LKED.IN DD DSN=SYS1.CSSLIB,DISP=SHR
// DD DSN=WINDOW.TEST.OBJ,DISP=SHR
//*
//*
********************************************************************
* *
* JCL TO EXECUTE THE FORTRAN PROGRAM. *
* *
********************************************************************
//FON01 JOB MSGLEVEL=(1,1)
//VSF2G PROC GOPGM=MAIN,GOREGN=100K, 00001000
// GOF5DD='DDNAME=SYSIN', 00002000
// GOF6DD='SYSOUT=A', 00003000
// GOF7DD='SYSOUT=B' 00004000
//* 00005000
//* PARAMETER DEFAULT-VALUE USAGE 00007000
//* 00008000
//* GOPGM MAIN PROGRAM NAME 00009000
//* GOREGN 100K GO-STEP REGION 00010000
//* GOF5DD DDNAME=SYSIN GO.FT05F001 DD OPERAND 00011000
//* GOF6DD SYSOUT=A GO.FT06F001 DD OPERAND 00012000
//* GOF7DD SYSOUT=B GO.FT07F001 DD OPERAND 00013000
//* 00014000
//* 00015000
//GO EXEC PGM=&GOPGM,REGION=&GOREGN,COND=(4,LT) 00016000
//STEPLIB DD DSN=CEE.SCEERUN,DISP=SHR 00017000
//FT05F001 DD &GOF5DD 00018000
//FT06F001 DD &GOF6DD 00019000
//FT07F001 DD &GOF7DD 00020000
// PEND
//GO EXEC VSF2G,GOPGM=CRTFON01,GOREGN=999K
//GO.STEPLIB DD DSN=CEE.SCEERUN,DISP=SHR 00017000
// DD DSN=WINDOW.USER.LOAD,DISP=SHR,VOL=SER=VM2TSO,UNIT=3380
z/OS MVS Programming: Callable Services for High-Level Languages
Copyright IBM Corporation 1990, 2014