• Subject: SEPT-based I/O to keyed file
  • From: Leif Svalgaard <l.svalgaard@xxxxxxxxxxxxx>
  • Date: Thu, 2 Mar 2000 10:13:50 -0600

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 thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2021 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.