|
midrange.com
Here is an example of how to do I/O to a keyed file using SEPT entries.
I generated the file with no level check. If you want level check you should
fill in the following two variables with the name of the FORMAT and the
level check sequence number (DSPPF will show these):
DCL DD LFCB-FORMAT-NAME CHAR(10) DEF(LFCB) POS(215);
DCL DD LFCB-FORMAT-SEQN CHAR(13) DEF(LFCB) POS(225);
--------------------------------------------------------------
Here is the code:
DCL SPCPTR .ODP-ROOT;
DCL SPC ODP-ROOT BAS(.ODP-ROOT);
DCL DD ODP-STATUS CHAR(4) DIR;
DCL DD ODP-DEV-LENGTH BIN(4) DIR;
DCL DD ODP-OPEN-SIZE BIN(4) DIR;
DCL DD ODP.OPEN-FEEDBCK BIN(4) DIR;
DCL DD ODP.DEV-NAMELIST BIN(4) DIR;
DCL DD ODP.IO-FEEDBACK BIN(4) DIR;
DCL DD ODP.LOCK-LIST BIN(4) DIR;
DCL DD ODP.SPOOL-OUTPUT BIN(4) DIR;
DCL DD ODP.MBR-DESCR BIN(4) DIR;
DCL DD ODP.CUR-IN-REC BIN(4) DIR;
DCL DD ODP.CUR-OUT-REC BIN(4) DIR;
DCL DD ODP.OPEN-DMCQ BIN(4) DIR;
DCL DD ODP.OUTSTANDINGS BIN(4) DIR;
DCL DD * CHAR(12) DIR;
DCL SYSPTR .ODP-CURSOR DIR;
DCL SPCPTR * DIR;
DCL SPCPTR .ODP-CDM-ERROR DIR;
DCL SPCPTR .ODP-INPUT-BUFFER DIR;
DCL SPCPTR .ODP-OUTPUT-BUFFER DIR;
DCL DD ODP.CDM-CLOSING BIN(2) DIR;
DCL DD ODP-DEV-NAME-IDX BIN(2) DIR;
DCL DD ODP-NBR-OF-DEVS BIN(2) DIR;
DCL DD ODP-SEQUENCE-NBR BIN(4) DIR;
DCL DD ODP-REC-LENGTH BIN(2) DIR;
DCL DD ODP-REC-LENGTH2 BIN(2) DIR;
DCL DD ODP-NBR-OF-*RDS BIN(2) DIR;
DCL DD ODP-RELEASE-NBR BIN(2) DIR;
DCL DD ODP-OPEN-POSN CHAR(1) DIR;
DCL DD ODP-OVR-REC-LEN BIN(2) DIR;
DCL DD ODP-COM-DEV-CNT BIN(2) DIR;
DCL DD ODP.INPUT-BPCA BIN(4) DIR;
DCL DD ODP.OUTPUT-BPCA BIN(4) DIR;
DCL DD ODP............ CHAR(1) DIR;
DCL SPCPTR .DEV-CONTROL-BLOCK;
DCL SPC DEV-CONTROL-BLOCK BAS(.DEV-CONTROL-BLOCK);
DCL DD DCB-MAX-NBR-OF-DEVICES BIN( 2) DIR;
DCL DD DCB-DEVICES-IN-THE-ODP BIN( 2) DIR;
DCL DD DCB-DEVICE-NAME CHAR(10) DIR;
DCL DD DCB-OFFSET-TO-FM-WORK BIN( 4) DIR;
DCL DD DCB-LENGTH-OF-FM-WORK BIN( 4) DIR;
DCL DD DCB-INDEX-FOR-LUD-PTR BIN( 2) DIR;
DCL DD DCB-GET BIN( 2) DIR;
DCL DD DCB-GET-BY-RRN BIN( 2) DIR;
DCL DD DCB-GET-BY-KEY BIN( 2) DIR;
DCL DD * BIN( 2) DIR;
DCL DD DCB-PUT BIN( 2) DIR;
DCL DD DCB-PUT-GET BIN( 2) DIR;
DCL DD DCB-UPDATE BIN( 2) DIR;
DCL DD DCB-DELETE BIN( 2) DIR;
DCL DD DCB-FORCE-EOD BIN( 2) DIR;
DCL DD DCB-FORCE-EOV BIN( 2) DIR;
DCL DD * BIN( 2) DIR;
DCL DD * BIN( 2) DIR;
DCL DD DCB-FREE-REC-LOCK BIN( 2) DIR;
DCL DD * BIN( 2) DIR;
DCL DD * BIN( 2) DIR;
DCL DD * BIN( 2) DIR;
DCL DD DCB-CLOSE BIN( 2) DIR;
DCL DD DCB-OPEN BIN( 2) DIR;
DCL DD DCB-SPTB BIN( 2) DIR;
/* THE I/O IS DONE BY USING THE CALLX INSTRUCTION REFERENCING */
/* A SYSTEM POINTER THAT IS OBTAINED FROM THE ENTRY POINT */
/* TABLE. THE ENTRY POINT TABLE CONTAINS PRE-RESOLVED SYSTEM */
/* POINTERS (THOUSANDS...). THE SYSTEM ENTRY POINT TABLE */
/* IS ADDRESSED BY THE POINTER BASED ON THE PROCESS COMMUNI- */
/* CATION OBJECT (PCO): */
/* PCO POINTER --> POINTER TO SEPT --> PTR TO OS FUNCTION 1 */
/* PTR TO OS FUNCTION 2 */
/* ... */
/* THE SIZE OF THE SEPT (6440) IS VERSION DEPENDENT. IT KEEPS */
/* GOING UP... */
DCL DD PCO CHAR(80) BASPCO;
DCL SPCPTR .@SEPT DEF(PCO) POS( 1);
DCL SYSPTR .QTEMP DEF(PCO) POS(65);
DCL SYSPTR .SEPT(6440) BAS(.@SEPT);
/* THE USER FILE CONTROL BLOCK (UFCB) DEFINES THE FILE NAME, */
/* BUFFER SPACES AND ALL NECESSARY CONTROL INFORMATION NEEDED */
/* TO MANAGE THE FILE. IT ALSO PROVIDES THE FEEDBACKS NEEDED */
/* TO ACCESS VARIOUS STRUCTURES, SUCH AS THE ODP (THE OPEN */
/* DATA PATH). */
/* LIST FILE PARAMETERS */
DCL SPCPTR .LFCB INIT(LFCB);
DCL DD LFCB CHAR(256) BDRY(16);
DCL SPCPTR .LFCB-ODP DEF(LFCB) POS( 1);
DCL SPCPTR .LFCB-INBUF DEF(LFCB) POS( 17);
DCL SPCPTR .LFCB-OUTBUF DEF(LFCB) POS( 33);
DCL SPCPTR .LFCB-OPEN-FEEDBACK DEF(LFCB) POS( 49);
DCL SPCPTR .LFCB-IO-FEEDBACK DEF(LFCB) POS( 65);
DCL SPCPTR .LFCB-NEXT-UFCB DEF(LFCB) POS( 81);
DCL DD * CHAR(32) DEF(LFCB) POS( 97);
DCL DD LFCB-FILE CHAR(10) DEF(LFCB) POS(129);
DCL DD LFCB-LIB-ID BIN(2) DEF(LFCB) POS(139);
DCL DD LFCB-LIBRARY CHAR(10) DEF(LFCB) POS(141);
DCL DD LFCB-MBR-ID BIN(2) DEF(LFCB) POS(151);
DCL DD LFCB-MEMBER CHAR(10) DEF(LFCB) POS(153);
DCL DD LFCB-DEVICE-NAME CHAR(10) DEF(LFCB) POS(163);
DCL DD LFCB-DEVICE-INDEX BIN(2) DEF(LFCB) POS(173);
DCL DD LFCB-FLAGS-1 CHAR(1) DEF(LFCB) POS(175) INIT(X'80');
DCL DD LFCB-FLAGS-2 CHAR(1) DEF(LFCB) POS(176) INIT(X'10');
DCL DD LFCB-REL-VERSION CHAR(4) DEF(LFCB) POS(177) INIT("0100");
DCL DD LFCB-INV-MK-COUNT BIN (4) DEF(LFCB) POS(181) INIT(1);
DCL DD LFCB-MULTI-RECS CHAR(1) DEF(LFCB) POS(185) INIT(X'00');
DCL DD LFCB-TAPE-CLOSE CHAR(1) DEF(LFCB) POS(186) INIT(X'40');
DCL DD * CHAR(2) DEF(LFCB) POS(187);
DCL DD LFCB-BIT-FLAGS CHAR(1) DEF(LFCB) POS(189) INIT(X'20');
DCL DD * CHAR(19) DEF(LFCB) POS(190);
DCL DD LFCB-FORMAT-ID BIN (2) DEF(LFCB) POS(209) INIT(7);
DCL DD * BIN (2) DEF(LFCB) POS(211) INIT(1);
DCL DD LFCB-NBR-OF-FMTS BIN (2) DEF(LFCB) POS(213) INIT(1);
DCL DD LFCB-FORMAT-NAME CHAR(10) DEF(LFCB) POS(215);
DCL DD LFCB-FORMAT-SEQN CHAR(13) DEF(LFCB) POS(225);
DCL DD LFCB-RECORD-ID BIN (2) DEF(LFCB) POS(238) INIT(1);
DCL DD LFCB-RECORD-LENGTH BIN (2) DEF(LFCB) POS(240) INIT(26);
DCL DD LFCB-NO-MORE-PARMS BIN (2) DEF(LFCB) POS(242) INIT(32767);
DCL OL OPEN-L(.LFCB);
DCL OL CLOSE-L(.LFCB);
DCL SPCPTR .NULL;
DCL SPCPTR .LBUF;
DCL DD LBUF CHAR(26) BAS(.LBUF);
DCL DD LBUF-KEY CHAR(16) DEF(LBUF) POS( 1);
DCL DD LBUF-WORD CHAR(10) DEF(LBUF) POS(17);
DCL DD L-PUT BIN(2);
DCL DD PUT-OPT-L BIN(4) INIT(H'10000005');
DCL SPCPTR .PUT-OPT-L INIT(PUT-OPT-L);
DCL OL PUT-L(.LFCB, .PUT-OPT-L, .NULL);
DCL CON CLOSE BIN(2) INIT(11);
DCL CON OPEN BIN(2) INIT(12);
DCL CON *LIBL BIN(2) INIT(-75);
DCL CON *FIRST BIN(2) INIT(-71);
DCL CON THE-LIB BIN(2) INIT(72);
DCL CON THE-MBR BIN(2) INIT(73);
/**************************************************************/
ENTRY * EXT;
PREPARE-FILES:
CPYBWP .NULL, *;
CPYBLAP LFCB-LIBRARY,"VDG", " ";
CPYBLAP LFCB-FILE, "KEYFILE", " ";
CPYNV LFCB-LIB-ID, THE-LIB;
CPYNV LFCB-MBR-ID, THE-MBR;
CPYBLA LFCB-MEMBER, LFCB-FILE;
OPEN-LIST-FILE:
CALLX .SEPT(OPEN), OPEN-L, *;
BRK "1";
CPYBWP .LBUF, .LFCB-OUTBUF;
CPYBWP .ODP-ROOT, .LFCB-ODP;
ADDSPP .DEV-CONTROL-BLOCK, .ODP-ROOT, ODP.DEV-NAMELIST;
CPYNV L-PUT, DCB-PUT;
WRITE-LIST-RECORD:
CPYBLA LBUF-KEY , "0123456789ABCDEF";
CPYBLA LBUF-WORD, "STUFF";
CALLX .SEPT(L-PUT), PUT-L, *;
CLOSE-FILE:
CALLX .SEPT(CLOSE), CLOSE-L, *;
RTX *;
PEND;
+---
| This is the MI Programmers Mailing List!
| To submit a new message, send your mail to MI400@midrange.com.
| To subscribe to this list send email to MI400-SUB@midrange.com.
| To unsubscribe from this list send email to MI400-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: dr2@cssas400.com
+---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
