|
midrange.com
> Compress data is an interesting opportunity for archiving data. Have you a
> MI pgm example ?
>
[Leif Svalgaard] Certainly, below is the COMPRESS program. We often
have
the problem of transferring LARGE (100 MB or more) print image files
(RECLEN=132 chars). The COMPRES program cuts the transfer time
significantly. It can, of course, also decompress at the other end.
A major part of the program is how to read/write files with MI.
This is a major topic in itself, but please ignore that code for
now.
/*******************************************************************/
/* LEIF SVALGAARD *
*/
/* WRITTEN: 1999/07/23 * Compress/Decompress a File
*/
/* REVISED: 1999/07/26 *
*/
/*******************************************************************/
DCL SPCPTR .PARM1 PARM;
DCL DD PARM-OPERATION CHAR(1) BAS(.PARM1);
DCL SPCPTR .PARM2 PARM;
DCL DD PARM-IN-FILE CHAR(10) BAS(.PARM2);
DCL SPCPTR .PARM3 PARM;
DCL DD PARM-IN-LIB CHAR(10) BAS(.PARM3);
DCL SPCPTR .PARM4 PARM;
DCL DD PARM-OUT-FILE CHAR(10) BAS(.PARM4);
DCL SPCPTR .PARM5 PARM;
DCL DD PARM-OUT-LIB CHAR(10) BAS(.PARM5);
DCL OL PARMS(.PARM1, .PARM2, .PARM3, .PARM4, .PARM5) EXT PARM
MIN(5);
DCL SPCPTR .INPUT-SPACE INIT(INPUT-SPACE);
DCL DD INPUT-SPACE (5000) CHAR(132) BDRY(16);
DCL SPCPTR .OUTPUT-SPACE INIT(OUTPUT-SPACE);
DCL DD OUTPUT-SPACE (5000) CHAR(132) BDRY(16);
DCL SPCPTR .COMPRESS INIT(COMPRESS);
DCL DD COMPRESS CHAR(64) BDRY(16);
DCL DD CMPR-INPUT-LENGTH BIN(4) DEF(COMPRESS) POS( 1);
DCL DD CMPR-OUTPUT-LENGTH BIN(4) DEF(COMPRESS) POS( 5);
DCL DD CMPR-ACTUAL-LENGTH BIN(4) DEF(COMPRESS) POS( 9);
DCL DD CMPR-ALGORITHM BIN(2) DEF(COMPRESS) POS(13);
DCL DD * CHAR(18) DEF(COMPRESS) POS(15);
DCL SPCPTR .CMPR-INPUT DEF(COMPRESS) POS(33);
DCL SPCPTR .CMPR-OUTPUT DEF(COMPRESS) POS(49);
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 */
/* ... */
DCL SYSPTR .SEPT(6440) BAS(..SEPT);
DCL DD PCO CHAR(80) BASPCO;
DCL SPCPTR ..SEPT DEF(PCO) POS( 1);
DCL SYSPTR .QTEMP DEF(PCO) POS(65);
/* 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). */
DCL DD IFCB CHAR(214) BDRY(16);
DCL SPCPTR .IFCB-ODP DEF(IFCB) POS( 1);
DCL SPCPTR .IFCB-INBUF DEF(IFCB) POS( 17);
DCL SPCPTR .IFCB-OUTBUF DEF(IFCB) POS( 33);
DCL SPCPTR .IFCB-OPEN-FEEDBACK DEF(IFCB) POS( 49);
DCL SPCPTR .IFCB-IO-FEEDBACK DEF(IFCB) POS( 65);
DCL SPCPTR .IFCB-NEXT-UFCB DEF(IFCB) POS( 81);
DCL DD * CHAR(32) DEF(IFCB) POS( 97);
DCL DD IFCB-FILE CHAR(10) DEF(IFCB) POS(129);
DCL DD IFCB-LIB-ID BIN(2) DEF(IFCB) POS(139);
DCL DD IFCB-LIBRARY CHAR(10) DEF(IFCB) POS(141);
DCL DD IFCB-MBR-ID BIN(2) DEF(IFCB) POS(151);
DCL DD IFCB-MEMBER CHAR(10) DEF(IFCB) POS(153);
DCL DD IFCB-DEVICE-NAME CHAR(10) DEF(IFCB) POS(163);
DCL DD IFCB-DEVICE-INDEX BIN(2) DEF(IFCB) POS(173);
DCL DD IFCB-FLAGS-1 CHAR(1) DEF(IFCB) POS(175)
INIT(X'80');
DCL DD IFCB-FLAGS-2 CHAR(1) DEF(IFCB) POS(176)
INIT(X'20');
DCL DD IFCB-REL-VERSION CHAR(4) DEF(IFCB) POS(177);
DCL DD IFCB-INV-MK-COUNT BIN (4) DEF(IFCB) POS(181);
DCL DD IFCB-MORE-FLAGS CHAR(1) DEF(IFCB) POS(185);
DCL DD * CHAR(23) DEF(IFCB) POS(186);
DCL DD IFCB-RECORD-ID BIN (2) DEF(IFCB) POS(209) INIT(1);
DCL DD IFCB-RECORD-LENGTH BIN (2) DEF(IFCB) POS(211) INIT(132);
DCL DD IFCB-NO-MORE-PARMS BIN (2) DEF(IFCB) POS(213)
INIT(32767);
DCL SPCPTR .IFCB INIT(IFCB);
DCL OL OPEN-I(.IFCB);
DCL OL CLOSE-I(.IFCB);
DCL DD OFCB CHAR(214) BDRY(16);
DCL SPCPTR .OFCB-ODP DEF(OFCB) POS( 1);
DCL SPCPTR .OFCB-INBUF DEF(OFCB) POS( 17);
DCL SPCPTR .OFCB-OUTBUF DEF(OFCB) POS( 33);
DCL SPCPTR .OFCB-OPEN-FEEDBACK DEF(OFCB) POS( 49);
DCL SPCPTR .OFCB-IO-FEEDBACK DEF(OFCB) POS( 65);
DCL SPCPTR .OFCB-NEXT-UFCB DEF(OFCB) POS( 81);
DCL DD * CHAR(32) DEF(OFCB) POS( 97);
DCL DD OFCB-FILE CHAR(10) DEF(OFCB) POS(129);
DCL DD OFCB-LIB-ID BIN(2) DEF(OFCB) POS(139);
DCL DD OFCB-LIBRARY CHAR(10) DEF(OFCB) POS(141);
DCL DD OFCB-MBR-ID BIN(2) DEF(OFCB) POS(151);
DCL DD OFCB-MEMBER CHAR(10) DEF(OFCB) POS(153);
DCL DD OFCB-DEVICE-NAME CHAR(10) DEF(OFCB) POS(163);
DCL DD OFCB-DEVICE-INDEX BIN(2) DEF(OFCB) POS(173);
DCL DD OFCB-FLAGS-1 CHAR(1) DEF(OFCB) POS(175)
INIT(X'80');
DCL DD OFCB-FLAGS-2 CHAR(1) DEF(OFCB) POS(176)
INIT(X'10');
DCL DD OFCB-REL-VERSION CHAR(4) DEF(OFCB) POS(177);
DCL DD OFCB-INV-MK-COUNT BIN (4) DEF(OFCB) POS(181);
DCL DD OFCB-MORE-FLAGS CHAR(1) DEF(OFCB) POS(185);
DCL DD * CHAR(23) DEF(OFCB) POS(186);
DCL DD OFCB-RECORD-ID BIN (2) DEF(OFCB) POS(209) INIT(1);
DCL DD OFCB-RECORD-LENGTH BIN (2) DEF(OFCB) POS(211) INIT(132);
DCL DD OFCB-NO-MORE-PARMS BIN (2) DEF(OFCB) POS(213)
INIT(32767);
DCL SPCPTR .OFCB INIT(OFCB);
DCL OL OPEN-O(.OFCB);
DCL OL CLOSE-O(.OFCB);
DCL DD GET-ENTRY BIN(2);
DCL DD PUT-ENTRY BIN(2);
DCL CON CLOSE-ENTRY BIN(2) INIT(11);
DCL CON OPEN-ENTRY BIN(2) INIT(12);
DCL CON *LIBL BIN(2) INIT(-75); /* S/38: -72 */
DCL CON *FIRST BIN(2) INIT(-71); /* S/38: -73 */
DCL CON THE-LIB BIN(2) INIT(72);
DCL CON THE-MBR BIN(2) INIT(73);
DCL EXCM * EXCID(H'5001')
BP(ERROR-DETECTED) CV("CPF") IMD;
DCL SPCPTR .INBUF;
DCL DD INBUF CHAR(132) BAS(.INBUF);
DCL DD INBUF-SYSTEM CHAR(10) DEF(INBUF) POS( 1);
DCL DD INBUF-LIB CHAR(10) DEF(INBUF) POS(12);
DCL DD INBUF-FILE CHAR(10) DEF(INBUF) POS(23);
DCL DD INBUF-BYTES ZND(10,0) DEF(INBUF) POS(34);
DCL DD INBUF-RECS ZND(10,0) DEF(INBUF) POS(45);
DCL SPCPTR .OUTBUF;
DCL DD OUTBUF CHAR(132) BAS(.OUTBUF);
DCL DD OUTBUF-SYSTEM CHAR(10) DEF(OUTBUF) POS( 1);
DCL DD OUTBUF-LIB CHAR(10) DEF(OUTBUF) POS(12);
DCL DD OUTBUF-FILE CHAR(10) DEF(OUTBUF) POS(23);
DCL DD OUTBUF-BYTES ZND(10,0) DEF(OUTBUF) POS(34);
DCL DD OUTBUF-RECS ZND(10,0) DEF(OUTBUF) POS(45);
DCL SPCPTR .NULL;
DCL DD GET-PARM BIN(4) INIT(H'03000001');
DCL SPCPTR .GET-PARM INIT(GET-PARM);
DCL OL GET-OPERATION(.IFCB, .GET-PARM, .NULL);
DCL DD PUT-PARM BIN(4) INIT(H'10000005');
DCL SPCPTR .PUT-PARM INIT(PUT-PARM);
DCL OL PUT-OPERATION(.OFCB, .PUT-PARM, .NULL);
DCL DD INPUT-EOF CHAR(1);
DCL DD INPUT-RECS BIN(4);
DCL DD CURRENT-REC BIN(4);
DCL DD OUTPUT-RECS BIN(4);
DCL DD OUTPUT-BYTES BIN(4);
DCL DD NBR-OF-RECS BIN(4);
DCL DD NBR-OF-BYTES BIN(4);
DCL SPCPTR .NETWORK-ATTR INIT(NETWORK-ATTR);
DCL DD NETWORK-ATTR CHAR(32);
DCL DD NETWORK-ATTR-NBR BIN(4) DEF(NETWORK-ATTR) POS( 1);
DCL DD NETWORK-ATTR-OFFSET BIN(4) DEF(NETWORK-ATTR) POS( 5);
DCL DD NWA-ATTR-NAME CHAR(10) DEF(NETWORK-ATTR) POS( 9);
DCL DD NWA-ATTR-TYPE CHAR(1) DEF(NETWORK-ATTR) POS(19);
DCL DD NWA-ATTR-STS CHAR(1) DEF(NETWORK-ATTR) POS(20);
DCL DD NWA-ATTR-SIZE BIN(4) DEF(NETWORK-ATTR) POS(21);
DCL DD NWA-SYSNAME CHAR(8) DEF(NETWORK-ATTR) POS(25);
DCL SPCPTR .LENGTH-NETWORK-ATTR INIT(LENGTH-NETWORK-ATTR);
DCL DD LENGTH-NETWORK-ATTR BIN(4) INIT(32);
DCL SPCPTR .NBR-OF-NETWORK-ATTR INIT(NBR-OF-NETWORK-ATTR);
DCL DD NBR-OF-NETWORK-ATTR BIN(4) INIT(1);
DCL SPCPTR .NAME-NETWORK-ATTR INIT(NAME-NETWORK-ATTR);
DCL DD NAME-NETWORK-ATTR CHAR(10) INIT("SYSNAME");
DCL SPCPTR .ERROR-CODE INIT(ERROR-CODE);
DCL DD ERROR-CODE BIN(4) INIT(0);
DCL OL QWCRNETA(.NETWORK-ATTR,
.LENGTH-NETWORK-ATTR,
.NBR-OF-NETWORK-ATTR,
.NAME-NETWORK-ATTR,
.ERROR-CODE);
/**************************************************************/
ENTRY * (PARMS) EXT;
CALLX .SEPT(4938), QWCRNETA, *;
CPYBWP .NULL, *; /* MAKE NULL PTR */
OPEN-INPUT-FILE:
CPYBLA IFCB-FILE, PARM-IN-FILE;
CPYNV IFCB-LIB-ID, THE-LIB;
CPYBLA IFCB-LIBRARY, PARM-IN-LIB;
CPYNV IFCB-MBR-ID, THE-MBR;
CPYBLA IFCB-MEMBER, PARM-IN-FILE;
CALLX .SEPT(OPEN-ENTRY), OPEN-I, *;
CPYBWP .INBUF, .IFCB-INBUF;
CPYBWP .ODP-ROOT, .IFCB-ODP;
ADDSPP .DEV-CONTROL-BLOCK, .ODP-ROOT, ODP.DEV-NAMELIST;
CPYNV GET-ENTRY, DCB-GET;
CPYNV INPUT-RECS, 0;
CPYBLA INPUT-EOF, " ";
OPEN-OUTPUT-FILE:
CPYBLA OFCB-FILE, PARM-OUT-FILE;
CPYNV OFCB-LIB-ID, THE-LIB;
CPYBLA OFCB-LIBRARY, PARM-OUT-LIB;
CPYNV OFCB-MBR-ID, THE-MBR;
CPYBLA OFCB-MEMBER, PARM-OUT-FILE;
CALLX .SEPT(OPEN-ENTRY), OPEN-O, *;
CPYBWP .OUTBUF, .OFCB-OUTBUF;
CPYBWP .ODP-ROOT, .OFCB-ODP;
ADDSPP .DEV-CONTROL-BLOCK, .ODP-ROOT, ODP.DEV-NAMELIST;
CPYNV PUT-ENTRY, DCB-PUT;
CMPBLA(B) PARM-OPERATION, "D"/EQ(DECOMPRESS-FILE);
COMPRESS-FILE:
READ-UNCOMPRESSED-RECORD:
CMPNV(B) INPUT-RECS, 5000/EQ(COMPRESS-CHUNK);
CALLX .SEPT(GET-ENTRY), GET-OPERATION, *;
ADDN(S) INPUT-RECS, 1;
CPYBLA INPUT-SPACE(INPUT-RECS), INBUF;
B READ-UNCOMPRESSED-RECORD;
ERROR-DETECTED:
CPYBLA INPUT-EOF, "Y";
CMPBLA(B) PARM-OPERATION, "D"/EQ(CLOSE-ALL-FILES);
COMPRESS-CHUNK:
MULT CMPR-INPUT-LENGTH, INPUT-RECS, 132;
CPYNV INPUT-RECS, 0;
CPYNV CMPR-OUTPUT-LENGTH, 660000;
CPYNV CMPR-ALGORITHM, 2;
CPYBWP .CMPR-INPUT, .INPUT-SPACE;
CPYBWP .CMPR-OUTPUT, .OUTPUT-SPACE;
CPRDATA .COMPRESS;
WRITE-HEADER-RECORD:
CPYBREP OUTBUF, " ";
CPYBLA OUTBUF-SYSTEM, NWA-SYSNAME;
CPYBLA OUTBUF-LIB, IFCB-LIBRARY;
CPYBLA OUTBUF-FILE, IFCB-FILE;
CPYNV OUTBUF-BYTES, CMPR-ACTUAL-LENGTH;
ADDN OUTPUT-BYTES, CMPR-ACTUAL-LENGTH, 131;
DIV OUTPUT-RECS, OUTPUT-BYTES, 132;
CPYNV OUTBUF-RECS, OUTPUT-RECS;
CALLX .SEPT(PUT-ENTRY), PUT-OPERATION, *;
CPYNV CURRENT-REC, 0;
WRITE-COMPRESSED-RECORD:
ADDN(S) CURRENT-REC, 1;
CPYBLA OUTBUF, OUTPUT-SPACE(CURRENT-REC);
CALLX .SEPT(PUT-ENTRY), PUT-OPERATION, *;
SUBN(SB) OUTPUT-RECS, 1/NZER(WRITE-COMPRESSED-RECORD);
CMPBLA(B) INPUT-EOF, "Y"/NEQ(READ-UNCOMPRESSED-RECORD);
B CLOSE-ALL-FILES;
DECOMPRESS-FILE:
READ-COMPRESSED-HEADER:
CALLX .SEPT(GET-ENTRY), GET-OPERATION, *;
CPYNV(B) NBR-OF-RECS, INBUF-RECS/EQ(CLOSE-ALL-FILES);
CPYNV NBR-OF-BYTES, INBUF-BYTES;
CPYNV INPUT-RECS, 0;
READ-COMPRESSED-RECORD:
CMPNV(B) INPUT-RECS, NBR-OF-RECS/EQ(DECOMPRESS-CHUNK);
CALLX .SEPT(GET-ENTRY), GET-OPERATION, *;
ADDN(S) INPUT-RECS, 1;
CPYBLA INPUT-SPACE(INPUT-RECS), INBUF;
B READ-COMPRESSED-RECORD;
DECOMPRESS-CHUNK:
CPYNV CMPR-INPUT-LENGTH, 0;
CPYNV CMPR-OUTPUT-LENGTH, 660000;
CPYNV CMPR-ALGORITHM, 0;
CPYBWP .CMPR-INPUT, .INPUT-SPACE;
CPYBWP .CMPR-OUTPUT, .OUTPUT-SPACE;
DCPDATA .COMPRESS;
DIV OUTPUT-RECS, CMPR-ACTUAL-LENGTH, 132;
CPYNV CURRENT-REC, 0;
WRITE-UNCOMPRESSED-RECORD:
ADDN(S) CURRENT-REC, 1;
CPYBLA OUTBUF, OUTPUT-SPACE(CURRENT-REC);
CALLX .SEPT(PUT-ENTRY), PUT-OPERATION, *;
SUBN(SB) OUTPUT-RECS, 1/NZER(WRITE-UNCOMPRESSED-RECORD);
B READ-COMPRESSED-HEADER;
CLOSE-ALL-FILES:
CALLX .SEPT(CLOSE-ENTRY), CLOSE-I, *;
CALLX .SEPT(CLOSE-ENTRY), CLOSE-O, *;
DEACTPG *;
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.
