IBM Version 4 manual Int, Retexcpd

B PARM1;

PARM2: CPYBLA FILNAM, FIL;

PARM1: CPYBLA MBRNAM,MBR;

CMPBLA(B) READY, '1' / EQ(SKIP);

CPYBWP CONTEXT, QTEMP@;

CRTS USRSPC@, CRTSTMPLT@;

SETSPPFP USRSPC,USRSPC@;

CPYBLA READY, '1';

SKIP: CPYNV RECNUM, 1;

MORE: CALLX QCMDEXC, QCMDOVROL, \;

CPYNV OFFSET,1;

CALLX CLð6, CLð6OL, \;

SUBN(S) OFFSET, 1;

ADDN(S) BINOFFSET, OFFSET;

SETSPPO USRSPC, BINOFFSET;

ADDN(S) RECNUM, 2ð;

CALLX QCMDEXC, QCMDDLTOL, \;

CMPNV(B) OFFSET, 16ðð /EQ(MORE);

CPYBLA PGMNAM, MBR;

SETSPPO USRSPC, ð;

CALLX QPRCRTPG, QPRCRTPGOL, \;

RTX \;

/\	Entry point for internal exception		handler	\/
ENTRY M14ð1		INT;
/\	Exception	description template for	RETEXCPD	\/

DCL DD EXCPDBUF CHAR(2ðð) BDRY(16);

DCL DD BYTPRV BIN(4) DEF(EXCPDBUF) POS(1) INIT(2ðð);

DCL DD BYTAVL BIN(4) DEF(EXCPDBUF) POS(5);

DCL DD EXCPID CHAR(2) DEF(EXCPDBUF) POS(9);

DCL DD CMPLEN BIN(2) DEF(EXCPDBUF) POS(11);

DCL DD CMPDTA CHAR(32) DEF(EXCPDBUF) POS(13);

DCL DD MSGKEY CHAR(4) DEF(EXCPDBUF) POS(45);

DCL DD EXCDTA CHAR(5ð) DEF(EXCPDBUF) POS(49);

DCL SYSPTR EXC_OBJ@ DEF(EXCDTA) POS(1);

DCL DD EXC_OBJ CHAR(32) DEF(EXCDTA) POS(17);

DCL PTR INV_PTR DEF(EXCPDBUF) POS(97);

DCL DD \ CHAR(87) DCF(EXCPDBUF) POS(113);

DCL SPCPTR EXCPDBUF@ INIT(EXCPDBUF);

/\ Template for RTNEXCP \/

DCL DD RTNTMPLT CHAR(19) BDRY(16);

DCL PTR INV_PTR2 DEF(RTNTMPLT) POS(1);

DCL DD \ CHAR(1) DEF(RTNTMPLT) POS(17) INIT(X'ðð');

DCL DD ACTION CHAR(2) DEF(RTNTMPLT) POS(18);

DCL SPCPTR RTNTMPLT@ INIT(RTNTMPLT);

/\ Start of internal handler \/

RETEXCPD EXCPDBUF@, X'ð1';

CMPBLA(B) EXC_OBJ, OBJID / EQ(SAME);

MODEXCPD DUPERROR, X'2ððð', X'ð1';

CPYBLA ACTION, X'ðððð';

Chapter 7. Machine Interface Programming7-31