Loading...
Select Version
&pagelevel(3)&pagelevel
This example uses the interfaces IEDTGTM, IEDTPARL and IEDTEXE to read marked file names from the current work file and import the associated files in sequence into free work areas.
TITLE 'BEISPIEL6'
********************************************************************
* *
* Example 6 *
* *
* This example implements a user routine which makes it *
* possible to read in multiple files which have been marked *
* in a list of file names. *
* It uses the iedtgtm interface to read all the marked records *
* from the current work area. *
* It is expected that the records contain file names which, for *
* example, were created with SHOW F=* TO 1. *
* *
* The example program performs the following actions: *
* *
* 1) Execute a loop in which all the marked records in the *
* work file are read. *
* 2) For each marked file, iedtparl is called to search for *
* a free work file. *
* 3) If a free work file is available, the file is read in using *
* @COPY FILE= (via iedtexe) *
* *
********************************************************************
*
CMULTI CSECT
CMULTI AMODE ANY
CMULTI RMODE ANY
GPARMOD 31
*
STM R14,R12,12(R13) * SAVE REGISTERS
LR R10,R15 * ENTER VALUES IN BASE REGISTER
USING CMULTI,R10
*
* ENTER VALUES IN PL USING THE SUPPLIED GLCB
*
L R11,0(,R1) GLCB FROM EDT
ST R11,EXEPL -> TO THE EXE PL
ST R11,PARLPL -> TO THE PARL PL
ST R11,GTMPL -> TO THE GTM PL
USING EDTGLCB,R11
*
* SUPPLY SAVE AREA FOR UP CALLS
*
LR R7,R13 SAVE R13
LA R13,SAVEAREA
*
* SUPPLY AMCB FOR GTM
*
MVC EAMFILE,EGLFILE CURRENT WORK FILE FROM GLCB
MVC EAMDISP,=A(1) READ RECORD BY KEY
MVC EAMLKEY1,=Y(8) ENTER VALUES IN LENGTH FIELDS
MVC EAMPKEY,=Y(8)
MVC EAMPREC,=Y(54)
*
* SUPPLY AMCB FOR PARL
*
MVC PAMFILE(3),=C'L00' WORK FILE FOR PARL
MVC PAMLKEY1,=Y(8) ENTER VALUES IN LENGTH FIELDS
MVC PAMPKEY,=Y(8)
MVC PAMPREC,=Y(EPLPARLL)
*
* LOOP THROUGH ALL MARKED RECORDS
*
LA R3,0(0,0) COUNTER FOR WORK FILES
LOOP DS 0Y
LA R1,GTMPL ADDRESS OF EDT STATEMENT
L R15,=V(IEDTGTM) GTM ROUTINE
BALR R14,R15
CLC EGLMRET,=Y(EAMRETOK) GTM OK ?
LA R1,ERRGTM ERROR MESSAGE
BNE LOOPERR ERROR OUTPUT
CLI EGLSR1,EAMOK12 LAST MARKED RECORD?
BE LOOPEX NORMAL OUTPUT
*
* SEARCH FOR FREE WORK FILE
*
LOOPI DS 0Y
LA R4,ARBDATNR PRINTABLE NUMBERS
LA R4,0(R3,R4) ADD COUNTERS
MVC PAMFILE+1(2),0(R4) TRANSFER NUM TO AMCB
LA R1,PARLPL FOR PARL CALL
L R15,=V(IEDTGET) GET ROUTINE (PARL)
BALR R14,R15
CLC EGLMRET,=Y(EAMRETOK) PARL OK?
LA R1,ERRPARL
BNE LOOPERR ERROR OUTPUT
CLI EPLEMPTY,'1' WORK FILE EMPTY?
BE LOOPIEX EXIT LOOP
LA R3,2(,R3) NEXT WORK FILE IN 2ND STEP BECAUSE
* 2-DIGIT IN WORK FILE NO.
CH R3,=Y(44) LAST WORK FILE REACHED?
BH LOOPEX NORMAL OUTPUT
B LOOPI TRY NEXT
*
LOOPIEX DS 0Y
MVC ADAT,PAMFILE+1 WORK FILE IN SETF STATEMENT
MVI FILE,' ' PRELIMINARY DELETE OF FILE NAME
MVC FILE+1(53),FILE
LH R15,EAMLREC LENGTH OF READ RECORD
BCTR R15,0 MINUS 1 FOR EX
EX R15,EXMVCFIL FILE NAME IN @COPY STATEMENT
LA R1,EXEPL FOR EXE CALL
L R15,=V(IEDTEXE)
BALR R14,R15
CLC EGLMRET,=Y(EUPRETOK) EXE OK?
LA R1,ERREXE
BNE LOOPERR ERROR OUTPUT
MVC KEY1(8),KEY NEW BASIS IS READ RECORD --- (1)
B LOOP
*
LOOPEX DS 0Y
MVC EGLMRET,=Y(EUPRETOK) RC OK
MVI EGLSR1,EUPOK00
LR R13,R7 RESTORE R13
LM R14,R12,12(R13)
BR R14 RETURN TO EDT
*
LOOPERR DS 0Y --------------------- (2)
MVC EGLMRET,=Y(EUPRTERR) ERROR IN USER PROGRAM
MVI EGLSR1,EUPOK00
MVC EGLRMSG(ERRMSGL+2),0(R1)
LR R13,R7 RESTORE R13
LM R14,R12,12(R13)
BR R14
**********************************************************************
* INITIALIZATION ROUTINE *
**********************************************************************
ENTRY CMULTI@I
CMULTI@I DS 0D -------------------------------- (3)
STM R14,R12,12(R13)
USING CMULTI@I,R15
L R11,0(,R1) ADDRESS OF GLCB
USING EDTGLCB,R11
MVC EGLCCSN,=C'EDF041 '
LM R14,R12,12(R13)
BR R14
DROP R11,R15
EJECT
**********************************************************************
* *
* CONSTANTS *
* *
**********************************************************************
*
* REGISTER DEFINITIONS
*
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
EJECT
**********************************************************************
* *
* FIELDS *
* *
**********************************************************************
SAVEAREA DS 18F SAVE AREA
*
EXMVCFIL MVC FILE(0),REC FILE NAME IN COPY STATEMENT
*
REC DS CL54 AREA FOR FILE NAMES
*
ERRGTM DC Y(ERRMSGL)
DC 'FEHLER BEI IEDTGTM '
ERRMSGL EQU *-ERRGTM-2
ERRPARL DC Y(ERRMSGL)
DC 'FEHLER BEI IEDTPARL '
ERREXE DC Y(ERRMSGL)
DC 'FEHLER BEI IEDTEXE '
*
CMD1 DC Y(CMD1END-CMD1) EDT STATEMENT: COPY
DS CL2
DC C'@SETF('
ADAT DC C'00'
DC ');@COPY FILE='
FILE DC CL54' '
CMD1END EQU *
*
ARBDATNR DC C'00010203040506070809101213141516171819202122'
*
* PARAMETER LIST FOR THE EDT EXE INTERFACE
*
EXEPL DC A(0) EDTGLCB ADDRESS
DC A(CMD1) ADDRESS OF STATEMENT
*
* PARAMETER LIST FOR THE EDT GTM INTERFACE
*
GTMPL DC A(0) EDTGLCB ADDRESS
DC A(EDTAMCB) EDTAMCB ADDRESS
DC A(KEY1) KEY1 (IN) ADDRESS
DC A(KEY) KEY (OUT) ADDRESS
DC A(REC) ADDRESS OF READ RECORD
*
* PARAMETER LIST FOR THE EDT PARL INTERFACE
*
PARLPL DC A(0) EDTGLCB ADDRESS
DC A(PEDTAMCB) EDTAMCB ADDRESS
DC A(KEY1) KEY1 (IN) ADDRESS
DC A(KEY) KEY (OUT) ADDRESS
DC A(EDTPARL) ADDRESS OF INFO OUTPUT
*
KEY1 DC 2A(0) KEY FOR GTM
KEY DC 2A(0) KEY (RETURN VALUE)
*
* EDT-SPECIFIC INTERFACE MACROS IN V17.0A
*
IEDTAMCB C,VERSION=2
*
IEDTAMCB C,P,VERSION=2
*
IEDTPARL C,VERSION=4
*
IEDTGLCB D,VERSION=2
CMULTI CSECT
END
Explanations
| (1) | EDTGTM reads starting from the specified key in the direction specified by EAMDISP (here forwards). As a result, the new key must become the new starting point. |
| (2) | For reasons of clarity, there is only a brief indication of the error handling mechanisms. However, at the very least, the original return code provided by the interface should be prepared and output. |
| (3) | Specifying the initialization routine also causes CMULTI to be called with the V17 GLCB. |
If the procedure explained in “Producing user routines in Assembler” is stored in a file named ASSMOD.DO in BS2000 and the source file
is stored as the S element ANWEND2.ASS in the library EDT.BEISPIELE then the above program can be compiled and linked with
/CALL-PROC ASSMOD.DO,(2)
The generated program can then be loaded from EDT with
@USE COMMAND='*',ELEMENT=CMULTI,MODLIB=EDT.BEISPIELE
The procedure ASSMOD.DO generates output resembling the following:
% BLS0523 ELEMENT 'ASSEMBH', VERSION '012', TYPE 'C' FROM LIBRARY ':MARS: $TSOS.SYSPRG.ASSEMBH.012' IN PROCESS % BLS0500 PROGRAM 'ASSEMBH', VERSION '01.2C00' OF '2002-03-06' LOADED % BLS0552 COPYRIGHT (C) FUJITSU SIEMENS COMPUTERS GMBH 2002. ALL RIGHTS RESERVED % ASS6010 V01.2C00 OF BS2000 ASSEMBH READY % ASS6011 ASSEMBLY TIME: 480 MSEC % ASS6018 0 FLAGS, 0 PRIVILEGED FLAGS, 0 MNOTES % ASS6019 HIGHEST ERROR-WEIGHT: NO ERRORS % ASS6006 LISTING GENERATOR TIME: 12 MSEC % ASS6012 END OF ASSEMBH
The operation of the routine will be demonstrated in L mode, i.e. EDT must already be loaded and be waiting for input in L mode:
1. @SHOW F=* TO 1 ----------- (1) 550. @O&F'BEISPIEL' ----------- (2) 550. @USE COM='*',E=CMULTI,M=EDT.BEISPIELE ----------- (3) 550. *CMULTI ----------- (4) % EDT5999 FEHLER BEI IEDTEXE ----------- (5) 1. @PROC 22 1. @STA=PAR TO 1 ----------- (6) 254. @ON & P '$ =' 7.0000 % = 1.0000 $ = 549.0000 * = 550.0000 ? = 22.0000 18.0000 % = 1.0000 $ = 309.0000 * = 310.0000 ? = 0.0000 29.0000 % = 1.0000 $ = 187.0000 * = 188.0000 ? = 0.0000 40.0000 % = 1.0000 $ = 179.0000 * = 180.0000 ? = 0.0000 51.0000 % = 1.0000 $ = 235.0000 * = 236.0000 ? = 0.0000 62.0000 % = 1.0000 $ = 1.0000 * = 1.0000 ? = 0.0000 ....
Explanations
| (1) | The file list is constructed in the work file. Here, for example, the list has 549 entries. |
| (2) | All files which have the name component BEISPIEL are searched for and marked. |
| (3) | The user routine CMULTI is loaded from the library EDT.BEISPIELE and is used to process user statements which start with '*' . |
| (4) | The user routine is called. Since it does not evaluate the input string, it could be called with any other statement, e.g. *XXX. |
| (5) | The message comes from the user routine since IEDTEXE has supplied a return code. The library EDT.BEISPIELE is also found. This cannot be read using @COPY. |
| (6) | @STA=PAR provides a view of file occupancy and makes it clear that files have been read into work files 1 to 4. |