Code: |
DCL UIBPTR PTR; /* POINTER TO UIB */ DCL 1 DLIUIB UNALIGNED BASED(UIBPTR), /* EXTENDED CALL USER INTFC BLK*/ 2 UIBPCBAL PTR, /* PCB ADDRESS LIST */ 2 UIBRCODE, /* DL/I RETURN CODES */ 3 UIBFCTR BIT(8) ALIGNED, /* RETURN CODES */ 3 UIBDLTR BIT(8) ALIGNED; /* ADDITIONAL INFORMATION */ |
Code: |
/* -----------------------------------------*/ /* Deklarations */ /* -----------------------------------------*/ DCL UIBPTR PTR; /* POINTER TO UIB */ DCL 1 DLIUIB UNALIGNED BASED(UIBPTR), /* EXTENDED CALL USER INTFC BLK*/ 2 UIBPCBAL PTR, /* PCB ADDRESS LIST */ 2 UIBRCODE, /* DL/I RETURN CODES */ 3 UIBFCTR BIT(8) ALIGNED, /* RETURN CODES @EAPARE @01A*/ 3 UIBDLTR BIT(8) ALIGNED; /* ADDITIONAL INFORMATION * @EAPARE @01A*/ DCL CNTR BIN FIXED(31) ; DCL FUNC CHAR (04) ; DCL PLITDLI ENTRY ; DCL PSB_NAME CHAR(8) ; DCL PCB_ADDRESS_LIST(256) BASED(DLIUIB.UIBPCBAL) POINTER ; DCL I BIN FIXED(31) ; /* -----------------------------------------*/ /* Get PSB */ /* -----------------------------------------*/ PSB_NAME = GetPSBName(); CNTR = 3 ; FUNC = 'PCB '; CALL PLITDLI(CNTR,FUNC,PSB_NAME,UIBPTR); IF UIBFCTR ^= '00000000'B THEN DO; PUT SKIP EDIT('ERROR')(A); SIGNAL ERROR ; END; ELSE DO; END; /* -----------------------------------------*/ /* Check available PCB's */ /* -----------------------------------------*/ DO I = 1 TO 256 ; /* How many entries are valid ?????*/ CALL Check(PCB_ADDRESS_LIST(I)); END; /* -----------------------------------------*/ /* Terminate PSB */ /* -----------------------------------------*/ CNTR = 1 ; FUNC = 'TERM'; CALL PLITDLI(CNTR,FUNC); |
Code: |
Check: PROC(pPCB) ; DCL 1 pPCB PTR ; DCL 1 PCB UNAL BASED(pPCB) ,2 DBNAME CHAR (08) ,2 SLEVEL CHAR (02) ,2 S_CODE CHAR (02) ,2 OPTION CHAR (04) ,2 JCBADD BIN FIXED(31) ,2 FBNAME CHAR (08) ,2 KEYLEN BIN FIXED(31) ,2 SENSEG BIN FIXED(31) ; PUT SKIP EDIT(PCB.DBName)(A); END; |
Code: |
DFHAC2236 07/14/2014 09:12:07 CICSTSTM Transaction XXXX abend ASRA in program EQANCXOU term E000. Updates to local recoverable resources will be backed out. |
bauer wrote: | ||
|
Code: |
CALL PLITDLI(num-parms,dli-function, pcb-mask, io-area, ssa, ...) |
Code: |
GU Get Unique GHU Get Hold Unique GN Get Next GHN Get Hold Next GHNP Get Hold Next within Parent DLET Delete REPL Replace ISRT Insert FLD Field POS Position |
Code: |
01 AIB-CNTL-BLOCK. 05 AIBRID PIC x(8). 05 AIBRLEN PIC 9(9) USAGE BINARY. 05 AIBRSFUNC PIC x(8). 05 AIBRSNM1 PIC x(8). 05 AIBRSNM2 PIC x(8). 05 AIBRESV1 PIC x(8). 05 AIBOALEN PIC 9(9) USAGE BINARY. 05 AIBOAUSE PIC 9(9) USAGE BINARY. 05 AIBRESV2 PIC x(12). 05 AIBRETRN PIC 9(9) USAGE BINARY. 05 AIBREASN PIC 9(9) USAGE BINARY. 05 AIBERRXT PIC 9(9) USAGE BINARY. 05 AIBRESA1 USAGE POINTER. 05 AIBRESA2 USAGE POINTER. 05 AIBRESA3 USAGE POINTER. 05 AIBRESV4 PIC x(40). 05 AIBRSAVE OCCURS 18 TIMES USAGE POINTER. 05 AIBRTOKN OCCURS 6 TIMES USAGE POINTER. 05 AIBRTOKC PIC x(16). 05 AIBRTOKV PIC x(16). 05 AIBRTOKA OCCURS 2 TIMES PIC 9(9) USAGE BINARY. 01 IMS-FUNC-CALLS. 05 FUNC-GU PIC X(04) VALUE 'GU '. 05 FUNC-GN PIC X(04) VALUE 'GN '. 05 FUNC-CHNG PIC X(04) VALUE 'CHNG'. 05 FUNC-ISRT PIC X(04) VALUE 'ISRT'. 05 FUNC-PURG PIC X(04) VALUE 'PURG'. 05 FUNC-INQY PIC X(4) VALUE 'INQY'. 01 IMS-IO-AREA PIC X(100). |
Code: |
AIBRSNM1 = GetPSBName(); AIBLEN = 264; CNTR = 4; FUNC = 'GN '; CALL PLITDLI(CNTR,FUNC,AIB-CNTL-BLOCK,IMS-IO-AREA); IF AIBRETRN ^= '00000000'B THEN DO; PUT SKIP EDIT('ERROR')(A); SIGNAL ERROR ; END; ELSE DO; print the contents of IMS-IO-AREA; END; |
Code: |
/* -----------------------------------------*/ /* Check available PCB's */ /* -----------------------------------------*/ /* HIGH END BIT is set in address of last PCB in the PCB_ADDRESS_LIST, so exit loop if HIGH END BIT is set and this entry is processed */ DCL LAST_PCB BIN FIXED(31) BASED; DO I = 1 TO 256 UNTIL(ADDR(PCB_ADDRESS_LIST(I)) -> LAST_PCB < 0); CALL Check(PCB_ADDRESS_LIST(I)); END; |
output generated using printer-friendly topic mod. All times are GMT - 5 Hours