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.
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:
USROPN
|
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. |
---|---|
USRCLS
|
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. |
USRGET
|
This function is called to retrieve the next record. The
maximum amount of characters that may be returned
is specified in parameter |
USRPUT
|
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 ( |
USRPOS
|
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. |
USRGKY
|
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 |
USRPKY
|
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. |
USRDEL
|
With this function the last read record is deleted. |
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
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.