User I/O Interface
The user interface for I/O allows FLAM to use user-defined file access methods instead of the operating system defined ones. This is possible when using the FLAM utility for the original file and when using the FLAM record interface for both original file and compressed FLAM file.
One possibility is to pass the compressed records immediately to post-processing routines without creating a compressed file. During decompression, the compressed records may be received from pre-processing step instead of reading them from a file.
A direct application could be the integration of FLAM with a file transfer application, avoiding the creation of intermediate files.
Generally this interface allows intercepting all input and output data of both FLAM and FLAMUP. This allows the user to adapt FLAM easily to specific access methods.
Using user I/O interface
The user can replace the FLAM file accesses methods with custom file access methods by using the User I/O interface. These access methods are used by the FLAM utility for accessing the original file, the compressed file and the target file.
In the record level interface, however, only access routines for the compressed file exist.
The use of user-defined access routines can be specified for each file
separately via the parameters DEVICE=USER or IDEVCE, ODEVICE.
However, the user-provided I/O routines must be linked to the FLAM
utility or to the FLAM record level interface before.
The following routines must be provided by the user:
- Open and Close (USROPN, USRCLS)
- Sequential Read and Write (USRPUT, USRGET)
- Optionally random access Read and Write (USRPKY, USRGKY)
- Delete and Positioning (USRDEL, USRPOS).
How does it work
|
For each allocated file this function is called once and only once. A working area of 1024 bytes is passed to the routine. This working area acts as file-specific memory and is passed from function to function until USRCLS is called. Files are identified via symbolic file names. The access
mode is specified in parameter Via pre-defined and user-defined return codes, the successful execution as well as special status information and errors can be reported to the higher layers. |
|---|---|
|
This function is called to close the file. The 1024 bytes working area reserved for this file is de-allocated after returning control to FLAM. |
|
This function is called to retrieve the next record. The
maximum amount of characters that may be returned
is specified in parameter |
|
This function is called to write a record. If it is not
possible to write the record in full length, the return
code record truncated must be reported to the higher
layers. Another possibility is to fill the record with the
padding character ( |
|
This function is called to move the current read or write pointer. Relative positioning (forward and backward) from the current position as well as absolute positioning from file start or file end is possible. |
|
With this function, a record with a specified key is read.
The corresponding key is contained in the record area
at the position and in the length as specified with the
parameter |
|
With this function, a record with a specified key is updated or inserted. If the record has the same key as the record last read, the old record is replaced with the new record. Otherwise, the record is inserted. If this is not possible (duplicate keys may be forbidden), this must be signalled via an appropriate return code. The writing of records with a key also updates the position of the current write pointer. |
|
With this function the last read record is deleted. |
Compression (schematic)
Parameter for FLAM or FLAMUP: COMPRESS, IDEVICE = USER, DEVICE = USER
Decompression (schematic)
Parameter for FLAM or FLAMUP: DECOMPRESS, ODEVICE = USER, DEVICE = USER
Examples
ASSEMBLER example
This example sets up a DUMMY device that returns
immediately the return code END OF FILE during read.
During write, all records are accepted and OK is always
returned without actually writing the records to a
storage medium. The functions USRGKY and USRPOS
always end with the return code INVALID KEY or
INVALID POSITION. The function USRDEL always
returns the code INVALID FUNCTION.
This functionality is equivalent to a file assignment of DUMMY.
By filling in appropriate code into the sequences marked with three periods, this routine can be used as a template for specific user written I/O routines.
FLAMUIO START
TITLE 'FLAMUIO: USER-I/O-MODULE FOR FLAM'
***********************************************************************
* NAME: FLAMUIO *
* FUNCTION: *
* DUMMY MODULE AS EXAMPLE FOR AN USER-IO-MODULE *
* INTERFACES: *
* USROPN OPEN DATA SET *
* USRCLS CLOSE DATA SET *
* USRGET READ SEQUENTIAL *
* USRGKY READ WITH KEY *
* USRPUT WRITE SEQUENTIAL *
* USRPKY WRITE WITH KEY *
* USRDEL DELETE ACTUAL RECORD *
* USRPOS POSITION IN DATA SET *
* NOTES: *
* ALL FUNCTIONS ARE REENTRANT. *
* WE NEED NO RUNTIME SYSTEM. *
* INDEPENDENT FROM ANY /370-SYSTEM. *
***********************************************************************
*
* ADDRESSING -/ RESIDENCY MODE
*
FLAMUIO AMODE ANY
FLAMUIO RMODE ANY
*
* RETURN CODES
*
OK EQU 0 NO ERROR
* EQU -1 REQM-ERROR; INVALID HANDLE
* OR INVALID FUNCTION
CUT EQU 1 RECORD TRUNCATED
EOF EQU 2 END OF DATA SET
GAP EQU 3 GAP IN RELATIVE DATA SET
FILL EQU 4 RECORD PADDED
INVKEY EQU 5 KEY NOT FOUND
RCEMPTY EQU 30 INPUT DATA SET EMPTY
RCNEXIST EQU 31 DATA SET DOES NOT EXIST
RCOPENMO EQU 32 INVALID OPEN MODE
RCFCBTYP EQU 33 INVALID FILE FORMAT
RCRECFOR EQU 34 INVALID RECORD FORMAT
RCRECSIZ EQU 35 INVALID RECORD LENGTH
RCBLKSIZ EQU 36 INVALID BLOCK SIZE
RCKEYPOS EQU 37 INVALID KEY POSITION
RCKEYLEN EQU 38 INVALID KEY LENGTH
RCDSN EQU 39 INVALID DATA SET NAME
* EQU X'0FXXXXXX' OTHER ERRORS
*
***********************************
* REGISTER EQUATES *
***********************************
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
* DC C'*** MODULE FLAMUIO. '
DC C'USER-I/O-MODULE FOR FLAM '
DC C'TIME - DATE ASSEMBLED: '
DC C'&SYSDATE - &SYSTIME ***'
TITLE 'USROPN'
USROPN DS 0D
ENTRY USROPN
USING USROPN,R10
*************************************************************************
* NAME: USROPN *
* FUNCTION: *
* OPEN DATA SET *
* PARAMETER: *
* 1 <-> WORKAREA 256F WORK AREA, INITIALIZED WITH X'00'. *
* THIS AREA IS CONNECTED TO THIS DATA SET. *
* USABLE AS WORK AREA DURING THE DIFFERENT CALLS *
* FOR THE ACTUAL DATA SET. *
* 2 <- RETCO F RETURN CODE *
* = 0 NO ERROR *
* = 30 INPUT DATA SET IS EMPTY *
* = 31 DATA SET NOT CONNECTED OR DOES NOT EXIST *
* = 32 ILLEGAL OPEN MODE *
* = 33 ILLEGAL DSORG *
* = 34 ILLEGAL RECORD FORMAT *
* = 35 ILLEGAL RECORD LENGTH *
* = 36 ILLEGAL BLOCK SIZE *
* = 37 ILLEGAL KEY POSITION *
* = 38 ILLEGAL KEY LENGTH *
* = -1 UNSUPPORTED FUNCTION; GETMAIN ERROR *
* = X'0FXXXXXX' OTHER ERROR CODE *
* 3 -> OPENMODE F OPEN MODE *
* = 0 INPUT (SEQUENTIAL READ) *
* (DATA SET MUST EXIST) *
* = 1 OUTPUT (SEQUENTIAL WRITE) *
* (DATA SET WILL BE OVERWRITTEN) *
* = 2 INOUT (READ OR WRITE SEQUENTIAL OR WITH KEY) *
* (DATA SET MUST EXIST) *
* = 3 OUTIN (WRITE OR READ SEQUENTIAL OR WITH KEY) *
* (DATA SET WILL BE OVERWRITTEN) *
* 4 -> DDNAME CL8 DD-NAME *
* 5 <-> DSORG F DATA SET ORGANIZATION *
* = 0; 8; 16 ... SEQUENTIAL *
* = 1; 9; 17 ... INDEX SEQUENTAIL *
* = 2; 10; 18 ... RELATIVE *
* = 3; 11; 19 ... DIRECT *
* = 4; 12; 20 ... UNSTRUCTURED *
* = 5; 13; 21 ... LIBRARY *
* 6 <-> RECFORM F RECORD FORMAT *
* = 0; 8; 16 ... VARIABELE (V) *
* 8 = BLOCKED 16 = BLOCKED/SPAN NED *
* = 1; 9; 17 ... FIX (F) *
* 9 = BLOCKED 17 = BLOCKED/SPANNED *
* = 2; 10; 18 ... UNDEFINED (U) *
* *
* = 3; 11; 19 ... STREAM (S) *
* 11 = DELIMITER 19 RECORD DESCRIPTOR WORD *
* 7 <-> RECSIZE F DATA LENGTH (WITHOUT DELIMTER OR RDW) *
* = 0 - 32767 *
* RECFORM = V: MAX. RECORD LENGTH OR 0 *
* RECFORM = F: RECORD LENGTH *
* RECFORM = U: MAX. RECORD LENGTH OR 0 *
* RECFORM = S: LENGTH DELIMITER OR RDW *
* 8 <-> BLKSIZE F BLOCK SIZE *
* = 0 UNBLOCKED *
* 9 <-> KEYDESC STRUCT KEY DESCRIPTION *
* *
* KEYFLAGS F OPTIONS *
* = 0 NO DUPLICATE KEYS *
* = 1 DUPLICATES ALLOWED *
* KEYPARTS F NUMBER OF KEY PARTS *
* = 0 - 8 *
* KEYPOS1 F 1. BYTE OF 1. KEYPART *
* = 1 - 32766 *
* KEYLEN1 F LENGTH OF 1. KEYPART *
* = 1 - 255 *
* KEYTYPE1 F DATA TYPE OF 1. KEYPART *
* = 0 PRINTABLE CHARACTER *
* = 1 BINARY *
* . *
* . *
* . *
* KEYPOS8 F 1. BYTE OF 8. KEYPART *
* = 1 - 32766 *
* KEYLEN8 F LENGTH OF 8. KEYPART *
* = 1 - 255 *
* KEYTYPE8 F DATA TYPE OF 8. KEYPART *
* = 0 PRINTABLE CHARACTER *
* = 1 BINARY *
* *
* 10 <-> DEVICE F DEVICE TYPE *
* = 7; 15; 23 USER DEFINED *
* 11 <-> RECDELIM XL RECORD DELIMITER *
* 12 -> PADCHAR XL1 PADDING CHARACTER *
* 13 <-> PRCTRL F PRINTER CONTROL CHARACTER *
* = 0 NONE *
* = 1 ASA-CHARACTER *
* = 2 MACHINE SPECIFIC CHARACTER *
* 14 -> CLOSDISP F CLOSE PROCESSING *
* = 0 REWIND *
* = 1 UNLOAD *
* = 2 RETAIN / LEAVE *
* 15 -> ACCESS F ACCESS METHOD *
* = 0 LOGICAL (RECORD BY RECORD) *
* = 1 PHYSICAL *
* 16 <-> DSNLEN F LENGTH OF DATA SET NAME OR BUFFER FOR NAME *
* 17 <-> DSN CL DATA SET NAME *
* (DATA SET NAME SHOULD BE RETURNED, IF 1. BYTE *
* OF GIVEN NAME IS C' ' OR A DIFFERENT DATA SET *
* IS ALLOCATED). *
************************************************************************
*
* SAVE REGISTER AND LOAD PROGRAM REGISTER
*
STM R14,R12,12(R13)
LR R10,R15
*
* LOAD PARAMETER
*
LM R1,R2,0(R1)
*
* ADDRESS WORK AREA
*
LR R12,R1
USING WORKAREA,R12
*
* OPEN DATA SET
*
* .
* .
* .
*
* SET RETURN CODE TO 'NO ERROR'
*
LA R0,OK
ST R0,0(R2)
*
* RETURN
*
LM R14,R12,12(R13)
BR R14
*
* RELEASE WORK AREA REGISTER
*
DROP R12
*
***********************************************************************
* LOCAL CONSTANTS *
***********************************************************************
*
LTORG
DROP R10
TITLE 'USRCLS'
USRCLS DS 0D
ENTRY USRCLS
USING USRCLS,R10
***********************************************************************
* NAME: USRCLS *
* FUNCTION: *
* CLOSE DATA SET *
* PARAMETER: *
* 1 <-> WORKAREA 256F WORK AREA *
* 2 <- RETCO F RETURN CODE *
* = 0 NO ERROR *
* = -1 UNSUPPORTED FUNCTION *
* = X'0FXXXXXX' ELSE *
* OR DMS-ERROR CODE *
***********************************************************************
*
* SAVE REGISTER AND LOAD PROGRAM REGISTER
*
STM R14,R12,12(R13)
LR R10,R15
*
* LOAD PARAMETER
*
LM R1,R2,0(R1)
*
* ADDRESS WORK AREA
*
LR R12,R1
USING WORKAREA,R12
*
* CLOSE DATA SET
*
* .
* .
* .
*
* SET RETURN CODE TO 'NO ERROR'
*
LA R0,OK
ST R0,0(R2)
*
* RETURN
*
LM R14,R12,12(R13)
BR R14
*
* RELEASE WORK AREA REGISTER
*
DROP R12
*
***********************************************************************
* LOCAL CONSTANTS *
***********************************************************************
*
LTORG
DROP R10
TITLE 'USRGET'
USRGET DS 0D
ENTRY USRGET
USING USRGET,R10
***********************************************************************
* NAME: USRGET *
* FUNCTION: *
* READ A RECORD (SEQUENTIAL) *
* PARAMETER: *
* 1 <-> WORKAREA 256F WORK AREA *
* 2 <- RETCO F RETURN CODE *
* = 0 NO ERROR *
* = 1 RECORD TRUNCATED *
* = 2 END OF FILE *
* = 3 EMPTY SLOT IN RELATIVE RECORD DATA SET *
* = -1 UNSUPPORTED FUNCTION *
* = X'0FXXXXXX' ELSE *
* 3 <- RECLEN F RECORD LENGTH IN BYTES *
* 4 <- RECORD XL RECORD *
* 5 -> BUFLEN F LENGTH OF RECORD BUFFER IN BYTES *
***********************************************************************
*
* SAVE REGISTER AND LOAD PROGRAM REGISTER
*
STM R14,R12,12(R13)
LR R10,R15
*
* LOAD PARAMETER
*
LM R1,R5,0(R1)
*
* ADDRESS WORK AREA
*
LR R12,R1
USING WORKAREA,R12
*
* READ A RECORD
*
* .
* .
* .
*
* HERE: RETURN CODE 'END OF FILE'
*
LA R0,EOF
ST R0,0(R2)
*
* RETURN
*
LM R14,R12,12(R13)
BR R14
*
* RELEASE WORK AREA REGISTER
*
DROP R12
*
***********************************************************************
* LOCAL CONSTANTS *
***********************************************************************
*
LTORG
DROP R10
TITLE 'USRGKY'
USRGKY DS 0D
ENTRY USRGKY
USING USRGKY,R10
***********************************************************************
* NAME: USRGKY *
* FUNCTION: *
* READ RECORD WITH GIVEN RECORD-KEY *
* PARAMETER: *
* 1 <-> WORKAREA 256F WORK AREA *
* 2 <- RETCO F RETURN CODE *
* = 0 NO ERROR *
* = 1 RECORD TRUNCATED *
* = 2 END OF FILE *
* = 5 KEY NOT FOUND *
* = -1 UNSUPPORTED FUNCTION *
* = X'0FXXXXXX' ELSE *
* 3 <- RECLEN F RECORD LENGTH IN BYTES *
* 4 <- RECORD XL RECORD WITH SEARCH KEY *
* 5 -> BUFLEN F LENGTH OF RECORD BUFFER IN BYTES *
***********************************************************************
*
* SAVE REGISTER AND LOAD PROGRAM REGISTER
*
STM R14,R12,12(R13)
LR R10,R15
*
* LOAD PARAMETER
*
LM R1,R5,0(R1)
*
* ADDRESS WORK AREA
*
LR R12,R1
USING WORKAREA,R12
*
* READ RECORD
*
* .
* .
* .
*
* HERE: RETURN CODE 'RECORD NOT FOUND'
*
LA R0,INVKEY
ST R0,0(R2)
*
* RETURN
*
LM R14,R12,12(R13)
BR R14
*
* RELEASE WORK AREAS REGISTER
*
DROP R12
*
***********************************************************************
* LOCAL CONSTANTS *
***********************************************************************
*
LTORG
DROP R10
TITLE 'USRPUT'
USRPUT DS 0D
ENTRY USRPUT
USING USRPUT,R10
***********************************************************************
* NAME: USRPUT *
* FUNCTION: *
* WRITE A RECORD (SEQUENTIAL) *
* PARAMETER: *
* 1 <-> WORKAREA 256F WORK AREA *
* 2 <- RETCO F RETURN CODE *
* = 0 NO ERROR *
* = 1 RECORD TRUNCATED *
* = 4 RECORD FILLED WITH PADDING CHARACTER *
* = -1 UNSUPPORTED FUNCTION *
* = X'0FXXXXXX' ELSE *
* 3 -> RECLEN F RECORD LENGTH IN BYTES *
* 4 -> RECORD XL RECORD *
***********************************************************************
*
* SAVE REGISTER AND LOAD PROGRAM REGISTER
*
STM R14,R12,12(R13)
LR R10,R15
*
* LOAD PARAMETER
*
LM R1,R4,0(R1)
*
* ADDRESS WORK AREA
*
LR R12,R1
USING WORKAREA,R12
*
* WRITE THE RECORD
*
* .
* .
* .
*
* RETURN CODE: 'NO ERROR'
*
LA R0,OK
ST R0,0(R2)
*
* RETURN
*
LM R14,R12,12(R13)
BR R14
*
* RELEASE WORK AREA REGISTER
*
DROP R12
*
***********************************************************************
* LOCAL CONSTANTS *
**********************************************************************
*
LTORG
DROP R10
TITLE 'USRPKY'
USRPKY DS 0D
ENTRY USRPKY
USING USRPKY,R10
***********************************************************************
* NAME: USRPKY *
* FUNCTION: *
* WRITE A RECORD WITH GIVEN KEY (INDEX SEQUENTIAL) *
* PARAMETER: *
* 1 <-> WORKAREA 256F WORK AREA *
* 2 <- RETCO F RETURN CODE *
* = 0 NO ERROR *
* = 1 RECORD TRUNCATED *
* = 4 RECORD FILLED WITH PADDING CHARACTER *
* = 5 INVALID KEY *
* = -1 UNSUPPORTED FUNCTION *
* = X'0FXXXXXX' ELSE *
* 3 -> RECLEN F RECORD LENGTH IN BYTES *
* 4 -> RECORD XL RECORD *
* NOTES: *
* IF THE GIVEN KEY IS THE SAME LIKE THE LAST KEY READ *
* THE RECORD SHALL BE OVERWRITTEN (REWRITE). *
* OTHERWISE THE RECORD SHALL BE INSERTED. *
***********************************************************************
*
* SAVE REGISTER AND LOAD PROGRAM REGISTER
*
STM R14,R12,12(R13)
LR R10,R15
*
* LOAD PARAMETER
*
LM R1,R5,0(R1)
*
* ADDRESS WORK AREA
*
LR R12,R1
USING WORKAREA,R12
*
* WRITE THE RECORD
*
* .
* .
* .
*
* RETURN CODE: 'NO ERROR'
*
LA R0,OK
ST R0,0(R2)
*
* RETURN
*
LM R14,R12,12(R13)
BR R14
*
* RELEASE WORK AREA REGISTER
*
DROP R12
*
***********************************************************************
* LOCAL CONSTANTS *
***********************************************************************
*
LTORG
DROP R10
TITLE 'USRDEL'
USRDEL DS 0D
ENTRY USRDEL
USING USRDEL,R10
***********************************************************************
* NAME: USRDEL *
* FUNCTION: *
* DELETE ACTUAL RECORD *
* PARAMETER: *
* 1 <-> WORKAREA 256F WORK AREA *
* 2 <- RETCO F RETURN CODE *
* = 0 NO ERROR *
* = 5 NO ACTUAL RECORD READ *
* = -1 UNSUPPORTED FUNCTION *
* = X'0FXXXXXX' ELSE *
***********************************************************************
*
* SAVE REGISTER AND LOAD PROGRAM REGISTER
*
STM R14,R12,12(R13)
LR R10,R15
*
* LOAD PARAMETER
*
LM R1,R2,0(R1)
*
* ADDRESS WORK AREA
*
LR R12,R1
USING WORKAREA,R12
*
* DELETE RECORD
*
* .
* .
* .
*
* HERE: RETURN CODE 'NO ACTUAL = RECORD READ'
*
LA R0,INVKEY
ST R0,0(R2)
*
* RETURN TO CALLER
*
LM R14,R12,12(R13)
BR R14
*
* RELEASE WORK AREA REGISTER
*
DROP R12
*
***********************************************************************
* LOCAL CONSTANTS *
***********************************************************************
*
LTORG
DROP R10
TITLE 'USRPOS'
USRPOS DS 0D
ENTRY USRPOS
USING USRPOS,R10
***********************************************************************
* NAME: USRPOS *
* FUNCTION: *
* POSITION IN DATA SET *
* PARAMETER: *
* 1 <-> WORKAREA F WORK AREA *
* 2 <- RETCO F RETURN CODE *
* = 0 OK *
* = 5 ILLEGAL POSITION *
* = -1 UNSUPPORTED FUNCTION *
* = X'0FXXXXXX' ELSE *
* 3 -> POSITION F RELATIVE POSITION *
* = 0 NO NEW POSITION *
* = - MAXINT TO BEGINNING OF DATA SET *
* ( -2147483648 OR X'80000000') *
* = + MAXINT TO END OF DATA SET *
* ( +2147483647 OR X'7FFFFFFF') *
* = - N N RECORDS BACKWARD *
* = + N N RECORDS FORWARD *
* NOTES: *
* YOU CAN CREATE EMPTY SLOTS (GAPS) USING FORWARD POSITIONING *
* IN A RELATIVE DATA SET IN OUTPUT MODE. *
***********************************************************************
*
* SAVE REGISTERS AND LOAD PROGRAM REGISTER
*
STM R14,R12,12(R13)
LR R10,R15
*
* LOAD PARAMETER
*
LM R1,R5,0(R1)
*
* ADDRESS WORK AREA
*
LR R12,R1
USING WORKAREA,R12
*
* POSITION RECORD
*
* .
* .
* .
*
* HERE: RETURN CODE -1 UNSUPPORTED FUNCTION
*
LA R0,0
BCTR R0,0
ST R0,0(R2)
*
* RETURN
*
LM R14,R15,12(R13)
BR R14
*
* RELEASE WORK AREA REGISTER
DROP R12
*
***********************************************************************
* LOCAL CONSTANTS *
***********************************************************************
LTORG
DROP R10
TITLE 'FLAMUIO: DUMMY SECTIONS'
***********************************************************************
* DUMMY SECTIONS *
***********************************************************************
*
WORKAREA DSECT
***********************************************************************
* WORK AREA ON DOUBLE WORD BOUNDARY *
***********************************************************************
*
DS XL1024
*
LWORK EQU *-WORKAREA LENGTH; MAXIMAL 1024 BYTES
EJECT
***********************************************************************
* DUMMY SECTION *
***********************************************************************
OPNPAR DSECT
***********************************************************************
* PARAMETERLIST FOR USROPN
* NOTE: ADDRESSES ARE GIVEN, NOT THE VALUES.
***********************************************************************
ADWORKA DS A WORK AREA
ADRETCO DS A RETCO
ADOPMO DS A OPENMODE
ADDDN DS A DDNAME
ADDSORG DS A DSORG
ADRECFO DS A RECFORM
ADRECSI DS A RECSIZE
ADBLKSI DS A BLKSIZE
ADKEYDE DS A KEYDESC
ADEVICE DS A DEVICE
ADRECDE DS A RECDELIM
ADPADC DS A PADCHAR
ADPRCTL DS A PRCNTRL
ADCLOSDI DS A CLOSDISP
ADACC DS A ACCESS
ADDSNLEN DS A LENGTH DSN
ADDSN DS A DATA SET NAME
EJECT
***********************************************************************
* DUMMY SECTION *
***********************************************************************
KEYDESC DSECT KEY DESCRIPTION
KEYFLAGS DS F KEYFLAGS
KEYPARTS DS F NUMBER OF KEYPARTS
KEYPOS1 DS F KEYPOSITION OF 1. KEYPART
KEYLEN1 DS F LENGTH OF 1. KEYPART
KEYTYPE1 DS F DATATYPE OF 1. KEYPART
KEYPOS2 DS F
KEYLEN2 DS F
KEYTYPE2 DS F
KEYPOS3 DS F
KEYLEN3 DS F
KEYTYPE3 DS F
KEYPOS4 DS F
KEYLEN4 DS F
KEYTYPE4 DS F
KEYPOS5 DS F
KEYLEN5 DS F
KEYTYPE5 DS F
KEYPOS6 DS F
KEYLEN6 DS F
KEYTYPE6 DS F
KEYPOS7 DS F
KEYLEN7 DS F
KEYTYPE7 DS F
KEYPOS8 DS F KEYPOSITION OF 8. KEYPART
KEYLEN8 DS F LENGTH OF 8. KEYPART
KEYTYPE8 DS F DATATYPE OF 8. KEYPART
END
COBOL example
The user I/O can also be implemented in COBOL or in another higher programming language. The following example implements two different functions that can be selected via the symbolic file name (LINKNAME or DDNAME).
Using the DD-name DATBASE, ten records can be read with the content: "THIS IS A DATA BASE RECORD FROM THE USER I/O"
Then return code END OF FILE is returned.
Using DD-name "USER...", 20 records can be read with the content: "THIS IS A USER RECORD FROM THE USER I/O"
Then return code END OF FILE is returned.
In both cases, the call protocols are written to the terminal. This allows to observe precisely the sequence of the different calls.
IDENTIFICATION DIVISION.
PROGRAM-ID. USERIO.
AUTHOR. LIMES DATENTECHNIK GMBH.
*
* USERIO IS AN EXAMPLE FOR AN USER I/O MODULE TO CONNECT
* TO FLAM.
*
* THE PROGRAM IS WRITTEN TO SUPPORT 2 DIFFERENT DATA SETS IN
* THE SAME MODULE DISTINGUISHED BY THE DD-NAME (DATBASE OR
* USER....)
*
ENVIRONMENT DIVISION.
*
CONFIGURATION SECTION.
*
SPECIAL-NAMES.
SYSOUT IS OUT-PUT.
*
DATA DIVISION.
*
WORKING-STORAGE SECTION.
*
77 ALL-OK PIC S9(8) COMP VALUE 0.
77 FUNCTION-ERR PIC S9(8) COMP VALUE -1.
77 REC-TRUNCATED PIC S9(8) COMP VALUE 1.
77 END-OF-FILE PIC S9(8) COMP VALUE 2.
77 REC-NOT-FOUND PIC S9(8) COMP VALUE 5.
77 NEW-HEADER PIC S9(8) COMP VALUE 6.
77 FILE-EMPTY PIC S9(8) COMP VALUE 30.
77 FILE-NOT-EXIST PIC S9(8) COMP VALUE 31.
77 OPEN-MODE-ERR PIC S9(8) COMP VALUE 32.
77 FILE-NAME-ERR PIC S9(8) COMP VALUE 39.
*
77 EXAMPLE-USER-RECORD PIC X(72) VALUE
"THIS IS A USER RECORD FROM THE USER I/O".
77 EXAMPLE-DATBAS-RECORD PIC X(72) VALUE
"THIS IS A DATA-BASE RECORD FROM THE USER I/O".
77 RECLEN PIC S9(8) COMP VALUE 80.
****************************************************
/
LINKAGE SECTION.
*
01 USER-WORK.
03 W-DDNAME PIC X(8).
03 W-COUNTER PIC S9(7) COMP-3.
03 W-ELSE PIC X(1012).
01 RETCO PIC S9(8) COMP.
01 OPENMODE PIC S9(8) COMP.
88 OP-INPUT VALUE 0.
88 OP-OUTPUT VALUE 1.
01 DDNAME.
03 DDNAME-1 PIC X(4).
03 FILLER PIC X(4).
*
* IN THIS EXAMPLE WE DO NOT NEED THE FOLLOWING PARAMETERS
*
*01 DSORG PIC S9(8) COMP.
*01 RECFORM PIC S9(8) COMP.
*01 RECSIZE PIC S9(8) COMP.
*01 BLKSIZE PIC S9(8) COMP.
*01 KEYDESC.
* 03 KEYFLAGS PIC S9(8) COMP.
* 03 KEYPARTS PIC S9(8) COMP.
* 03 KEYENTRY OCCURS 8 TIMES.
* 05 KEYPOS PIC S9(8) COMP.
* 05 KEYLEN PIC S9(8) COMP.
* 05 KEYTYPE PIC S9(8) COMP.
*01 DEVICE PIC S9(8) COMP.
*01 RECDELIM PIC X(4).
*01 PADCHAR PIC X.
*01 PRCTRL PIC S9(8) COMP.
*01 CLOSMODE PIC S9(8) COMP.
*01 ACCESS PIC S9(8) COMP.
*01 DSNLEN PIC S9(8) COMP.
*01 DATA-SET-NAME PIC X(44).
*
* USED FOR READING
*
01 DATALEN PIC S9(8) COMP.
01 DATA-AREA.
03 DATA-1 PIC X(72).
03 DATA-2 PIC X(8).
01 BUFFLEN PIC S9(8) COMP.
*
/
PROCEDURE DIVISION.
*
USROPN-MAIN SECTION.
*
* OPEN ROUTINE
*
USROPN-MAIN-1.
ENTRY "USROPN" USING USER-WORK, RETCO,
OPENMODE, DDNAME.
*
* IN THIS EXAMPLE WE DO NOT USE THE OTHER PARAMETERS, SO IT IS
* NOT NECESSARY TO MENTION THEM.
* FLAM STANDARDS ARE USED:
* SEQUENTIAL,
* VARIABLE LENGTH UP TO 32752 BYTE (BUT WE ONLY USE 80 BYTE)
*
*
* WE ONLY SUPPORT OPEN INPUT IN THIS EXAMPLE,
* CHECK THE OPEN MODE
*
IF OP-INPUT
THEN NEXT SENTENCE
ELSE MOVE OPEN-MODE-ERR TO RETCO
DISPLAY "USER I/O CANNOT WRITE TO " DDNAME
UPON OUT-PUT
GO TO USROPN-MAIN-99.
*
* FOR FURTHER USE, WE STORE THE DD-NAME IN THE
* GIVEN WORKAREA
*
MOVE DDNAME TO W-DDNAME.
*
* WE SUPPORT DIFFERENT DATA SETS,
* CHECK FOR DDNAME "DATBASE", OR THE FIRST 4 BYTE FOR "USER"
*
IF DDNAME = "DATBASE"
THEN PERFORM OPN-DATBASE
ELSE IF DDNAME-1 = "USER"
THEN PERFORM OPN-USER
ELSE MOVE FILE-NAME-ERR TO RETCO
DISPLAY "USER I/O DOES NOT SUPPORT " DDNAME
UPON OUT-PUT.
USROPN-MAIN-99.
*
* GO BACK TO FLAM
*
GO BACK.
/
OPN-DATBASE SECTION.
*
* OPEN-ROUTINE FOR A DATA BASE
*
OPN-DATBASE-1.
*
* HERE YOU HAVE TO PROCESS THE OPEN,
*
*
* INITIALISE COUNTER-FIELD IN WORK AREA
*
MOVE ZERO TO W-COUNTER.
*
* WE ONLY DISPLAY A MESSAGE
*
DISPLAY "USER I/O: OPEN FOR DATABASE IS DONE"
UPON OUT-PUT.
OPN-DATBASE-90.
*
* SET THE RETURN CODE
*
MOVE ALL-OK TO RETCO.
OPN-DATBASE-99.
EXIT.
/
OPN-USER SECTION.
*
* OPEN ROUTINE FOR THE OTHER EXAMPLE
*
OPN-USER-1.
*
* HERE YOU HAVE TO PROCESS THE OPEN,
*
* INITIALISE COUNTER-FIELD IN WORK AREA
*
MOVE ZERO TO W-COUNTER.
*
* WE ONLY DISPLAY A MESSAGE
*
DISPLAY "USER I/O: OPEN FOR " DDNAME " IS DONE"
UPON OUT-PUT.
OPN-USER-90.
*
* SET THE RETURN CODE
*
MOVE ALL-OK TO RETCO.
OPN-USER-99.
EXIT.
/
USRCLS-MAIN SECTION.
*
* CLOSE ROUTINE
*
USRCLS-MAIN-1.
ENTRY "USRCLS" USING USER-WORK, RETCO.
*
* WE SUPPORT DIFFERENT DATA SETS,
* CHECK FOR DDNAME
*
IF W-DDNAME = "DATBASE"
THEN PERFORM CLS-DATBASE
ELSE PERFORM CLS-USER.
USRCLS-MAIN-99.
*
* GO BACK TO FLAM
*
GO BACK.
/
CLS-USER SECTION.
*
* CLOSE ROUTINE FOR THE OTHER EXAMPLE
*
CLS-USER-1.
*
* HERE YOU HAVE TO PROCESS THE CLOSE,
*
* WE ONLY DISPLAY A MESSAGE
*
DISPLAY "USER I/O: CLOSE FOR " W-DDNAME " IS DONE"
UPON OUT-PUT.
CLS-USER-90.
*
* SET THE RETURN CODE
*
MOVE ALL-OK TO RETCO.
CLS-USER-99.
EXIT.
/
CLS-DATBASE SECTION.
*
* CLOSE ROUTINE FOR A DATA BASE
*
CLS-DATBASE-1.
*
* HERE YOU HAVE TO PROCESS THE CLOSE,
*
* WE ONLY DISPLAY A MESSAGE
*
DISPLAY "USER I/O: CLOSE FOR DATA BASE IS DONE"
UPON OUT-PUT.
CLS-DATBASE-90.
*
* SET THE RETURN CODE
*
MOVE ALL-OK TO RETCO.
CLS-DATBASE-99.
EXIT.
/
USRGET-MAIN SECTION.
*
* ROUTINE FOR READING RECORDS
*
USRGET-MAIN-1.
ENTRY "USRGET" USING USER-WORK, RETCO,
DATALEN, DATA-AREA, BUFFLEN.
*
* WE SUPPORT DIFFERENT DATA SETS,
* CHECK FOR DDNAME
*
IF W-DDNAME = "DATBASE"
THEN PERFORM GET-DATBASE
ELSE PERFORM GET-USER.
USRGET-MAIN-99.
*
* GO BACK TO FLAM
*
GO BACK.
/
GET-DATBASE SECTION.
*
* GET-ROUTINE FOR A DATA BASE
*
GET-DATBASE-1.
*
* WE RETURN ALWAYS THE SAME RECORD
*
* AFTER THE 10. RECORD WE FINISH (EOF)
*
IF W-COUNTER +10
THEN MOVE EXAMPLE-DATBAS-RECORD TO DATA-1
MOVE W-DDNAME TO DATA-2
MOVE RECLEN TO DATALEN
ADD +1 TO W-COUNTER
MOVE ALL-OK TO RETCO
ELSE MOVE ZERO TO DATALEN
MOVE END-OF-FILE TO RETCO.
GET-DATBASE-99.
EXIT.
/
GET-USER SECTION.
*
* GET ROUTINE FOR THE OTHER EXAMPLE,
*
GET-USER-1.
*
* WE RETURN ALWAYS THE SAME RECORD,
*
* AFTER THE 20. RECORD WE FINISH (EOF)
*
IF W-COUNTER +20
THEN MOVE EXAMPLE-USER-RECORD TO DATA-1
MOVE W-DDNAME TO DATA-2
MOVE RECLEN TO DATALEN
ADD +1 TO W-COUNTER
MOVE ALL-OK TO RETCO
ELSE MOVE ZERO TO DATALEN
MOVE END-OF-FILE TO RETCO.
GET-USER-99.
EXIT.