× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.


  1.  Home
  2. MI400
  3. February 2002

Re: CCITT group 4 decompression

You might tell Gene this is for Binary images only.

Leif Svalgaard wrote:

> From: Leif Svalgaard <leif@leif.org>
> > From: <Gene_Gaunt@ReviewWorks.com>
> > > Does anyone have an MI example of CCITT group 4 decompression?
> > Yes, I wrote one for Harry Williams.
>
> you, of course, need a program to test the decompressor (DCMP) with.
> Below is one:
>
> > > here is my test:
> > > 1) ftp a tiff image to AS/400:
> > > put 112.tif tif112
> > > 2) uncompress:
> > > call pgm(dcmptiff) parm(lsvalgaard tif112)
> > > 3)ftp result down to PC
> > > get outtiff u112.tif
> > >
> > > go look at image u112.tif, e.g. with Windows explorer.
> > > The u112.tif should look just like 112.tif.
>
> /* DECOMPRESS TIFF FILE WITH T6 */
> /* LEIF SVALGAARD, 2002/02/04   */
>
> DCL SPCPTR .PARM1 PARM;
> DCL DD PARM-LIB   CHAR(10) BAS(.PARM1);
>
> DCL SPCPTR .PARM2 PARM;
> DCL DD PARM-TIFF  CHAR(10) BAS(.PARM2);
>
> DCL SPCPTR .PARM3 PARM;
> DCL DD PARM-DEBUG CHAR(10) BAS(.PARM3);
>
> DCL OL PARMS(.PARM1, .PARM2, .PARM3) EXT PARM MIN(2);
> DCL DD NBR-OF-PARMS BIN(2);
>
> DCL SPCPTR .CONTROL INIT(CONTROL);
> DCL DD CONTROL CHAR(64);
>     DCL DD ROW-WIDTH    BIN(2) DEF(CONTROL) POS( 1);
>     DCL DD NBR-OF-ROWS  BIN(2) DEF(CONTROL) POS( 3);
>     DCL DD FIRST-TIME  CHAR(1) DEF(CONTROL) POS( 5);
>     DCL DD DEBUG-ON    CHAR(1) DEF(CONTROL) POS( 6);
>     DCL DD DEBUG-LIB  CHAR(10) DEF(CONTROL) POS( 7);
>     DCL DD DEBUG-FILE CHAR(10) DEF(CONTROL) POS(17);
>     DCL DD DEBUG-MBR  CHAR(10) DEF(CONTROL) POS(27);
>
> DCL SPCPTR .SOURCE;
>
> DCL DD FILE-BLOCK BIN(2);
> DCL SPCPTR .FILE INIT(FILE);
> DCL DD FILE CHAR(256000) BDRY(16);
>     DCL DD BLOCK(500) CHAR(512) DEF(FILE) POS(1);
>
> DCL SPCPTR .RESULT INIT(RESULT);
> DCL DD RESULT CHAR(300) BDRY(16);
>
> DCL OL DCMP(.CONTROL, .SOURCE, .RESULT) ARG;
> DCL SYSPTR .DCMP;
> DCL DD RESOLVE CHAR(34);
>     DCL DD RESOLVE-TYPE   CHAR(2) DEF(RESOLVE) POS( 1);
>     DCL DD RESOLVE-NAME  CHAR(30) DEF(RESOLVE) POS( 3);
>     DCL DD RESOLVE-AUTH   CHAR(2) DEF(RESOLVE) POS(33);
>
> DCL SPCPTR .ODP;
> DCL SPC     ODP BAS(.ODP);
>     DCL DD  ODP.DCB  BIN(4) DEF(ODP) POS(17);
>
> DCL SPCPTR .DCB;
> DCL SPC     DCB BAS(.DCB);
>     DCL DD  DCB-GET  BIN(2) DEF (DCB) POS(25);
>     DCL DD  DCB-PUT  BIN(2) DEF (DCB) POS(33);
>
> DCL SPCPTR .NULL;
> DCL SPCPTR ..SEPT BASPCO;
> DCL SYSPTR .SEPT(6440) BAS(..SEPT);
>
> DCL CON CLOSE-ENTRY BIN(2)   INIT(11);
> DCL CON OPEN-ENTRY  BIN(2)   INIT(12);
>
> DCL SPCPTR .IFCB INIT(IFCB);
> DCL DD IFCB CHAR(214) BDRY(16);
>     DCL SPCPTR .IFCB-ODP               DEF(IFCB) POS(  1);
>     DCL SPCPTR .IFCB-INBUF             DEF(IFCB) POS( 17);
>     DCL DD IFCB-FILE          CHAR(10) DEF(IFCB) POS(129);
>     DCL DD IFCB-LIB-ID        BIN(2)   DEF(IFCB) POS(139) INIT(72);
>     DCL DD IFCB-LIBRARY       CHAR(10) DEF(IFCB) POS(141);
>     DCL DD IFCB-MBR-ID        BIN(2)   DEF(IFCB) POS(151) INIT(73);
>     DCL DD IFCB-MEMBER        CHAR(10) DEF(IFCB) POS(153);
>     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-RECORD-ID     BIN (2)  DEF(IFCB) POS(209) INIT(1);
>     DCL DD IFCB-RECORD-LENGTH BIN (2)  DEF(IFCB) POS(211) INIT(512);
>     DCL DD IFCB-NO-MORE-PARMS BIN (2)  DEF(IFCB) POS(213) INIT(32767);
>
> DCL OL  OPEN-I(.IFCB);
> DCL OL CLOSE-I(.IFCB);
>
> DCL DD GET-ENTRY BIN(2);
> DCL DD INBUF CHAR(512)  BAS(.IFCB-INBUF);
> DCL DD      GET-OPTION  BIN(4) INIT(H'03000001');
> DCL SPCPTR .GET-OPTION         INIT(GET-OPTION);
> DCL OL GET-OPERATION(.IFCB, .GET-OPTION, .NULL);
>
> DCL EXCM * EXCID(H'5001') BP(HAVE-DATA) CV("CPF") IMD;
>
> DCL DD TIFF-HEADER CHAR(8) DEF(FILE) POS(1);
>     DCL DD TIFF-BYTE-ORDER CHAR(2) DEF(TIFF-HEADER) POS(1);
>     DCL DD TIFF-VERSION     BIN(2) DEF(TIFF-HEADER) POS(3);
>     DCL DD TIFF-IFD-OFFSET  BIN(4) DEF(TIFF-HEADER) POS(5);
>
> DCL SPCPTR .BIN;
> DCL DD ENTRY-NBR BIN(2);
> DCL SPCPTR .IFD;
> DCL DD IFD CHAR(602) BAS(.IFD);
>     DCL DD IFD-NBR-OF-ENTRIES  BIN(2) DEF(IFD) POS(1);
>     DCL DD IFD-ENTRY(50)     CHAR(12) DEF(IFD) POS(3);
>
> DCL DD NBR-OF-ENTRIES BIN(2);
> DCL SPCPTR .THE-ENTRY;
> DCL DD THE-ENTRY CHAR(12) BAS(.THE-ENTRY);
>     DCL DD ENTRY-TAG      BIN(2) DEF(THE-ENTRY) POS(1);
>     DCL DD ENTRY-TYPE     BIN(2) DEF(THE-ENTRY) POS(3);
>     DCL DD ENTRY-COUNT    BIN(4) DEF(THE-ENTRY) POS(5);
>     DCL DD ENTRY-VALUE    BIN(4) DEF(THE-ENTRY) POS(9);
>
> DCL DD THE-TAG   BIN(2);
> DCL DD THE-TYPE  BIN(2);
> DCL DD THE-COUNT BIN(4);
> DCL DD THE-VALUE BIN(4);
>
> ENTRY * (PARMS) EXT;
>     STPLLEN     NBR-OF-PARMS;
>
> RESOLVE-TO-DECOMPRESSOR:
>     CPYBLA      RESOLVE-TYPE, X'0201';
>     CPYBLAP     RESOLVE-NAME, "DCMP", " ";
>     CPYBLA      RESOLVE-AUTH, X'0000';
>     RSLVSP     .DCMP, RESOLVE, *, *;
>
> OPEN-INPUT-FILE:
>     CPYBLA      IFCB-LIBRARY, PARM-LIB;
>     CPYBLA      IFCB-FILE,    PARM-TIFF;
>     CPYBLA      IFCB-MEMBER,  PARM-TIFF;
>     CALLX      .SEPT(OPEN-ENTRY), OPEN-I, *;
>
>     CPYBWP     .ODP, .IFCB-ODP;
>     ADDSPP     .DCB, .ODP, ODP.DCB;
>     CPYNV       GET-ENTRY, DCB-GET;
>
>     CPYBWP     .NULL, *;
>     CPYNV       FILE-BLOCK, 1;
> GET-INPUT-DATA:
>     CALLX      .SEPT(GET-ENTRY), GET-OPERATION, *;
>     CPYBLA      BLOCK(FILE-BLOCK), INBUF;
>     ADDN(SB)    FILE-BLOCK, 1/POS(GET-INPUT-DATA);
>
> HAVE-DATA:
>     CALLX      .SEPT(CLOSE-ENTRY), CLOSE-I, *;
>
> FIND-DIRECTORY:
>     SETSPP     .BIN, TIFF-IFD-OFFSET;
>     CALLI       ENDIAN-4, *, .ENDIAN;
>     ADDSPP     .IFD, .FILE, BIN4;
>
>     SETSPP     .BIN, IFD-NBR-OF-ENTRIES;
>     CALLI       ENDIAN-2, *, .ENDIAN;
>     CPYNV       NBR-OF-ENTRIES, BIN2;
>
>     CPYNV       ENTRY-NBR, 0;
> PARSE-ENTRY:
>     ADDN(S)     ENTRY-NBR, 1;
>     SETSPP     .THE-ENTRY, IFD-ENTRY(ENTRY-NBR);
>
> GET-TAG:
>     SETSPP     .BIN, ENTRY-TAG;
>     CALLI       ENDIAN-2, *, .ENDIAN;
>     CPYNV       THE-TAG,  BIN2;
>
> GET-TYPE:
>     SETSPP     .BIN, ENTRY-TYPE;
>     CALLI       ENDIAN-2, *, .ENDIAN;
>     CPYNV       THE-TYPE, BIN2;
>
> GET-COUNT:
>     SETSPP     .BIN, ENTRY-COUNT;
>     CALLI       ENDIAN-4, *, .ENDIAN;
>     CPYNV       THE-COUNT, BIN4;
>
> GET-VALUE:
>     SETSPP     .BIN, ENTRY-VALUE;
>     CMPNV(B)    THE-TYPE, 3/NEQ(=+3);
>     CALLI       ENDIAN-2, *, .ENDIAN; /* SHORT INT  */
>     CPYNV(B)    THE-VALUE, BIN2/NNEG(=+3);:
>     CALLI       ENDIAN-4, *, .ENDIAN; /* ALL OTHERS */
>     CPYNV       THE-VALUE, BIN4;:
>
> PERFORM-ACTION-FOR-TAG:
>     CMPNV(B)    THE-TAG, H'0100'/NEQ(=+2);
>     CPYNV(B)    ROW-WIDTH,   THE-VALUE/POS(NEXT-ENTRY);:
>
>     CMPNV(B)    THE-TAG, H'0101'/NEQ(=+2);
>     CPYNV(B)    NBR-OF-ROWS, THE-VALUE/POS(NEXT-ENTRY);:
>
>     CMPNV(B)    THE-TAG, H'0103'/NEQ(=+2);
>     CMPNV(B)    THE-VALUE, 4/NEQ(INVALID-FILE);:
>
>     CMPNV(B)    THE-TAG, H'0111'/NEQ(=+2);
>     ADDSPP     .SOURCE, .FILE, THE-VALUE;:
>
>     CMPNV(B)    THE-TAG, H'0116'/NEQ(=+2);
>     CMPNV(B)    NBR-OF-ROWS, THE-VALUE/NEQ(INVALID-FILE);:
>
>     CMPNV(B)    THE-TAG, H'0117'/NEQ(=+2);
>     CMPNV(B)    THE-COUNT, 1/NEQ(INVALID-FILE);:
>
>     CMPNV(B)    THE-TAG, H'011A'/NEQ(=+4);
>     CALLI       GET-RATIONAL, *, .RATIONAL;
>     CPYNV       X-NUMERATOR,   NUMERATOR;
>     CPYNV(B)    X-DENOMINATOR, DENOMINATOR/POS(NEXT-ENTRY);:
>
>     CMPNV(B)    THE-TAG, H'011B'/NEQ(=+4);
>     CALLI       GET-RATIONAL, *, .RATIONAL;
>     CPYNV       Y-NUMERATOR,   NUMERATOR;
>     CPYNV(B)    Y-DENOMINATOR, DENOMINATOR/POS(NEXT-ENTRY);:
>
>     CMPNV(B)    THE-TAG, H'0128'/NEQ(=+2);
>     CPYNV(B)    UNITS, THE-VALUE/POS(NEXT-ENTRY);:
>
>  NEXT-ENTRY:
>     CMPNV(B)    ENTRY-NBR, NBR-OF-ENTRIES/LO(PARSE-ENTRY);
>
> SETUP-DECOMPRESSOR:
>     CPYBREP     TIME-USED, X'00';
>     CPYBLA      FIRST-TIME, "Y";
>     CPYBLA      DEBUG-ON,   "N";
>
>     CMPNV(B)    NBR-OF-PARMS, 3/NEQ(SETUP-OUTPUT);
>     CPYBLA      DEBUG-ON,   "Y";
>     CPYBLA      DEBUG-LIB,  PARM-LIB;
>     CPYBLA      DEBUG-FILE, PARM-DEBUG;
>     CPYBLA      DEBUG-MBR,  PARM-DEBUG;:
>
> SETUP-OUTPUT:
>     CALLI       PREPARE-OUTPUT, *, .OUTPUT;
>     CPYNV       ROOM-LEFT, 256;
>     SUBN(B)     TO, 513, ROOM-LEFT/POS(DECOMPRESS-A-ROW);
>
> GET-AVAILABLE:
>     ADDN        AVAILABLE, BYTE-WIDTH, 1;
>     SUBN(S)     AVAILABLE, FROM;
>     CPYNV(B)    TO-MOVE, AVAILABLE/ZER(DECOMPRESS-A-ROW);
>     CMPNV(B)    TO-MOVE, ROOM-LEFT/NHI(=+2);
>     CPYNV       TO-MOVE, ROOM-LEFT;:
> MOVE-BYTES:
>     CPYBLA      OUT-BLOCK(TO:TO-MOVE), RESULT(FROM:TO-MOVE);
>     ADDN(S)     FROM, TO-MOVE;
>     ADDN(S)     TO,   TO-MOVE;
>
> COMPUTE-ROOM-LEFT:
>     SUBN(B)     ROOM-LEFT, 513, TO/POS(GET-AVAILABLE);
>     CALLX      .SEPT(PUT-ENTRY), PUT-OPERATION, *;
>     CPYBREP     OUTBUF, X'00';
>     CPYNV(B)    TO, 1/POS(COMPUTE-ROOM-LEFT);
>
> DECOMPRESS-A-ROW:
>     MATPRATR   .PROCESS-ATTR, *, X'21';
>     CPYBLA      START-TIME, MAT-CPU-USED;
>
>     CALLX      .DCMP, DCMP, *;
>     CALLI       UPDATE-TIME-USED, *, .UPDATE;
>     CPYNV       FROM, 1;
>     CMPBLA(B)   FIRST-TIME, "E"/NEQ(GET-AVAILABLE);
>
> DONE:
>     CALLX      .SEPT(PUT-ENTRY), PUT-OPERATION, *;
>
> CLOSE-OUTPUT-FILE:
>     CALLX      .SEPT(CLOSE-ENTRY), CLOSE-O, *;
>
> INVALID-FILE:
> SHOW-TIME-USED:
>     MULT        TIMESTAMP, TIME-USED-HI, TWO**32;
>     ADDN(S)     TIMESTAMP, TIME-USED-LO;
>     DIV(R)      MILLISECONDS, TIMESTAMP, 4096000;
>     CPYBLAP     MSG-TEXT, "Milliseconds:", " ";
>     EDIT        MSG-TEXT(16:9), MILLISECONDS, ZZZZZZZZ9;
>     CALLX      .SEPT(4268), QMHSNDM, *;
>     RTX         *;
>
> DCL DD BIN4-CHARS   CHAR(4) BDRY(4);
>     DCL DD BIN4 BIN(4) DEF(BIN4-CHARS) POS(1);
>
> DCL DD BIN2-CHARS   CHAR(2) BDRY(2);
>     DCL DD BIN2 BIN(2) DEF(BIN2-CHARS) POS(1);
>
> DCL DD BIN-ORIGINAL CHAR(4) BAS(.BIN);
> DCL INSPTR .ENDIAN;
>
> ENTRY ENDIAN-4 INT;
>     CMPBLA(B)   TIFF-BYTE-ORDER, X'4949'/EQ(INTEL-4);
>     CMPBLA(B)   TIFF-BYTE-ORDER, X'4D4D'/NEQ(INVALID-FILE);
>     CPYBLA      BIN4-CHARS, BIN-ORIGINAL; /* MOTOROLA */
>     B          .ENDIAN;
>
> INTEL-4:
>     CPYBLA      BIN4-CHARS(1:1), BIN-ORIGINAL(4:1);
>     CPYBLA      BIN4-CHARS(2:1), BIN-ORIGINAL(3:1);
>     CPYBLA      BIN4-CHARS(3:1), BIN-ORIGINAL(2:1);
>     CPYBLA      BIN4-CHARS(4:1), BIN-ORIGINAL(1:1);
>     B          .ENDIAN;
>
> ENTRY ENDIAN-2 INT;
>     CMPBLA(B)   TIFF-BYTE-ORDER, X'4949'/EQ(INTEL-2);
>     CMPBLA(B)   TIFF-BYTE-ORDER, X'4D4D'/NEQ(INVALID-FILE);
>     CPYBLA      BIN2-CHARS, BIN-ORIGINAL; /* MOTOROLA */
>     B          .ENDIAN;
>
> INTEL-2:
>     CPYBLA      BIN2-CHARS(1:1), BIN-ORIGINAL(2:1);
>     CPYBLA      BIN2-CHARS(2:1), BIN-ORIGINAL(1:1);
>     B          .ENDIAN;
>
> DCL DD NUMERATOR   BIN(4);
> DCL DD DENOMINATOR BIN(4);
> DCL INSPTR .RATIONAL;
> ENTRY GET-RATIONAL INT;
>     ADDSPP     .BIN, .FILE, THE-VALUE;
>     CALLI       ENDIAN-4, *, .ENDIAN;
>     CPYNV       NUMERATOR,    BIN4;
>
>     ADDSPP     .BIN, .BIN, 4;
>     CALLI       ENDIAN-4, *, .ENDIAN;
>     CPYNV(B)    DENOMINATOR,  BIN4/POS(.RATIONAL);
>
> DCL DD RESOLUTIONS CHAR(16);
>     DCL DD X-NUMERATOR     BIN(4) DEF(RESOLUTIONS) POS( 1);
>     DCL DD X-DENOMINATOR   BIN(4) DEF(RESOLUTIONS) POS( 5);
>     DCL DD Y-NUMERATOR     BIN(4) DEF(RESOLUTIONS) POS( 9);
>     DCL DD Y-DENOMINATOR   BIN(4) DEF(RESOLUTIONS) POS(13);
>
> DCL DD OUT-ENTRY  CHAR(12) BDRY(8);
>     DCL DD OUT-ENTRY-BIN2  BIN(2) DEF(OUT-ENTRY) POS(9);
>     DCL DD OUT-ENTRY-BIN4  BIN(4) DEF(OUT-ENTRY) POS(9);
>
> DCL DD BYTE-WIDTH BIN(4);
> DCL DD UNITS      BIN(2);
>
> DCL DD ROOM-LEFT  BIN(2);
> DCL DD AVAILABLE  BIN(2);
> DCL DD TO-MOVE    BIN(2);
> DCL DD FROM       BIN(2);
> DCL DD TO         BIN(2);
>
> DCL INSPTR .OUTPUT;
> ENTRY PREPARE-OUTPUT INT;
> OPEN-OUTPUT-FILE:
>     CPYBLA      OFCB-LIBRARY, PARM-LIB;
>     CPYBLAP     OFCB-FILE,   "OUTTIFF", " ";
>     CPYBLA      OFCB-MEMBER,  OFCB-FILE;
>     CALLX      .SEPT(OPEN-ENTRY), OPEN-O, *;
>
>     CPYBWP     .ODP, .OFCB-ODP;
>     ADDSPP     .DCB, .ODP, ODP.DCB;
>     CPYNV       PUT-ENTRY, DCB-PUT;
>
> INITIALIZE-OUTPUT-HEADER:
>     CPYBREP     OUT-BLOCK,  X'00';
>     CPYBLA      OUT-BYTE-ORDER, X'4D4D'; /* MM = MOTOROLA */
>     CPYNV       OUT-VERSION,   42;
>     CPYNV       OUT-IFD-OFFSET, 8;
>
>     CPYBLA      OUT-IFD-ENTRY( 1), X'00FE00040000000100000000';
>
>     CPYBLA      OUT-ENTRY,         X'010000030000000100000000';
>     CPYBRA      OUT-ENTRY-BIN2,                     ROW-WIDTH ;
>     CPYBLA      OUT-IFD-ENTRY( 2), OUT-ENTRY;
>
>     CPYBLA      OUT-ENTRY,         X'010100030000000100000000';
>     CPYBRA      OUT-ENTRY-BIN2,                   NBR-OF-ROWS ;
>     CPYBLA      OUT-IFD-ENTRY( 3), OUT-ENTRY;
>
>     CPYBLA      OUT-IFD-ENTRY( 4), X'010200030000000100010000';
>     CPYBLA      OUT-IFD-ENTRY( 5), X'010300030000000100010000';
>     CPYBLA      OUT-IFD-ENTRY( 6), X'010600030000000100000000';
>     CPYBLA      OUT-IFD-ENTRY( 7), X'011100040000000100000100';
>     CPYBLA      OUT-IFD-ENTRY( 8), X'011500030000000100010000';
>
>     CPYBLA      OUT-ENTRY,         X'011600030000000100000000';
>     CPYBRA      OUT-ENTRY-BIN2,                   NBR-OF-ROWS ;
>     CPYBLA      OUT-IFD-ENTRY( 9), OUT-ENTRY;
>
>     CPYBLA      OUT-ENTRY,         X'011700040000000100000000';
>     ADDN        BIN4, ROW-WIDTH,  7;
>     CPYBTRLS    BYTE-WIDTH, BIN4, 3;
>     MULT        OUT-ENTRY-BIN4, NBR-OF-ROWS, BYTE-WIDTH;
>     CPYBLA      OUT-IFD-ENTRY(10), OUT-ENTRY;
>
>     CPYBLA      OUT-IFD-ENTRY(11), X'011A000500000001000000E0';
>     CPYBLA      OUT-IFD-ENTRY(12), X'011B000500000001000000E4';
>     CPYBLA      OUT-RESOLUTIONS, RESOLUTIONS;
>
>     CPYBLA      OUT-ENTRY,         X'012800030000000100000000';
>     CPYBRA      OUT-ENTRY-BIN2,                         UNITS ;
>     CPYBLA      OUT-IFD-ENTRY(13), OUT-ENTRY;
>
>     CPYBLA      OUT-IFD-ENTRY(14), X'013B000200000001000000F0';
>     CPYNV       OUT-IFD-ENTRIES, 14;
>     CPYBLA      OUT-ARTIST, X'4C656966205376616C67616172640000';
>     B          .OUTPUT;   /*   L e i f   S v a l g a a r d <0>*/
>
> DCL SPCPTR .OFCB INIT(OFCB);
> DCL DD OFCB CHAR(217) BDRY(16);
>     DCL SPCPTR .OFCB-ODP               DEF(OFCB) POS(  1);
>     DCL SPCPTR .OFCB-OUTBUF            DEF(OFCB) POS( 33);
>     DCL DD OFCB-FILE          CHAR(10) DEF(OFCB) POS(129);
>     DCL DD OFCB-LIB-ID        BIN(2)   DEF(OFCB) POS(139) INIT(72);
>     DCL DD OFCB-LIBRARY       CHAR(10) DEF(OFCB) POS(141);
>     DCL DD OFCB-MBR-ID        BIN(2)   DEF(OFCB) POS(151) INIT(73);
>     DCL DD OFCB-MEMBER        CHAR(10) DEF(OFCB) POS(153);
>     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-RECORD-ID     BIN (2)  DEF(OFCB) POS(209) INIT(1);
>     DCL DD OFCB-RECORD-LENGTH BIN (2)  DEF(OFCB) POS(211) INIT(512);
>     DCL DD OFCB-CLEAR-ID      BIN (2)  DEF(OFCB) POS(213) INIT(8);
>     DCL DD OFCB-CLEAR-YES     CHAR(1)  DEF(OFCB) POS(215) INIT(X'80');
>     DCL DD OFCB-NO-MORE-PARMS BIN (2)  DEF(OFCB) POS(216) INIT(32767);
>
> DCL OL  OPEN-O (.OFCB) ARG;
> DCL OL  CLOSE-O(.OFCB) ARG;
>
> DCL DD PUT-ENTRY BIN(2);
> DCL DD OUTBUF    CHAR(512) BAS(.OFCB-OUTBUF);
> DCL DD OUT-BLOCK CHAR(512) DEF(OUTBUF) POS(1);
>     DCL DD OUT-BYTE-ORDER     CHAR(2) DEF(OUT-BLOCK) POS(1);
>     DCL DD OUT-VERSION         BIN(2) DEF(OUT-BLOCK) POS(3);
>     DCL DD OUT-IFD-OFFSET      BIN(4) DEF(OUT-BLOCK) POS(5);
>     DCL DD OUT-IFD-ENTRIES     BIN(2) DEF(OUT-BLOCK) POS(9);
>     DCL DD OUT-IFD-ENTRY(14) CHAR(12) DEF(OUT-BLOCK) POS(11);
>     DCL DD OUT-RESOLUTIONS   CHAR(16) DEF(OUT-BLOCK) POS(H'E1');
>     DCL DD OUT-ARTIST        CHAR(16) DEF(OUT-BLOCK) POS(H'F1');
>
> DCL DD      PUT-OPTION BIN(4) INIT(H'10000005');
> DCL SPCPTR .PUT-OPTION        INIT(PUT-OPTION);
> DCL OL PUT-OPERATION(.OFCB, .PUT-OPTION, .NULL);
>
> DCL SPCPTR .PROCESS-ATTR INIT(PROCESS-ATTR);
> DCL DD      PROCESS-ATTR CHAR(20) BDRY(16);
>     DCL DD  MAT-MAX-SIZE   BIN(4) DEF(PROCESS-ATTR) POS( 1) INIT(20);
>     DCL DD  MAT-ACT-SIZE   BIN(4) DEF(PROCESS-ATTR) POS( 5);
>     DCL DD  MAT-CPU-USED  CHAR(8) DEF(PROCESS-ATTR) POS(13);
>
> DCL DD TIMESTAMP     PKD(21,0);
> DCL DD TIMESTAMP-HI  PKD(11,0);
> DCL DD TIMESTAMP-LO  PKD(11,0);
> DCL DD TWO**32       PKD(11,0) INIT(P'4294967296');
> DCL DD MILLISECONDS  PKD(09,0);
>
> DCL DD START-TIME       CHAR(8);
> DCL DD TIME-USED        CHAR(8);
>     DCL DD TIME-USED-HI BIN(4) UNSGND DEF(TIME-USED) POS(1);
>     DCL DD TIME-USED-LO BIN(4) UNSGND DEF(TIME-USED) POS(5);
>
> DCL INSPTR .UPDATE;
> ENTRY UPDATE-TIME-USED INT;
>     MATPRATR   .PROCESS-ATTR, *, X'21';
>     ADDLC(S)    TIME-USED, MAT-CPU-USED;
>     SUBLC(S)    TIME-USED, START-TIME;
>     B          .UPDATE;
>
> DCL DD ZZZZZZZZ9 CHAR(13) INIT(X'B140AEAEB2B2B2B2B2B2B2B2AA');
>
> DCL SPCPTR .MSG-ID   INIT(MSG-ID);
> DCL DD      MSG-ID   CHAR (7) INIT(" ");
>
> DCL SPCPTR .MSG-FILE INIT(MSG-FILE);
> DCL DD      MSG-FILE CHAR(20) INIT(" ");
>
> DCL SPCPTR .MSG-TEXT INIT(MSG-TEXT);
> DCL DD      MSG-TEXT CHAR(70);
>
> DCL SPCPTR .MSG-SIZE INIT(MSG-SIZE);
> DCL DD      MSG-SIZE BIN( 4)  INIT(70);
>
> DCL SPCPTR .MSG-TYPE INIT(MSG-TYPE);
> DCL DD      MSG-TYPE CHAR(10) INIT("*INFO");
>
> DCL SPCPTR .MSG-QS   INIT(MSG-QS);
> DCL DD      MSG-QS   CHAR(20) INIT("*REQUESTER");
>
> DCL SPCPTR .MSG-QSN  INIT(MSG-QSN);
> DCL DD      MSG-QSN  BIN( 4)  INIT(1);
>
> DCL SPCPTR .REPLY-Q  INIT(REPLY-Q);
> DCL DD      REPLY-Q  CHAR(20) INIT(" ");
>
> DCL SPCPTR .MSG-KEY  INIT(MSG-KEY);
> DCL DD      MSG-KEY  CHAR( 4);
>
> DCL SPCPTR .ERR-CODE INIT(ERR-CODE);
> DCL DD      ERR-CODE BIN( 4) INIT(0);
>
> DCL OL QMHSNDM (.MSG-ID,   .MSG-FILE, .MSG-TEXT, .MSG-SIZE,
>                 .MSG-TYPE, .MSG-QS,   .MSG-QSN,  .REPLY-Q,
>                 .MSG-KEY,  .ERR-CODE)  ARG;
>
> _______________________________________________
> This is the MI Programming on the AS400 / iSeries (MI400) mailing list
> To post a message email: MI400@midrange.com
> To subscribe, unsubscribe, or change list options,
> visit: http://lists.midrange.com/cgi-bin/listinfo/mi400
> or email: MI400-request@midrange.com
> Before posting, please take a moment to review the archives
> at http://archive.midrange.com/mi400.

As an Amazon Associate we earn from qualifying purchases.

This thread ...
Follow-Ups:
Replies:
Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

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