R0 EQU 0 R1 EQU 1 WORK REGISTER R2 EQU 2 CPPL POINTER R3 EQU 3 WORK REGISTER R4 EQU 4 PPL POINTER R5 EQU 5 * UNUSED R6 EQU 6 PARSE ROUTINE WORK REGISTER R7 EQU 7 WORK REGISTER R8 EQU 8 LINKAGE TO PARSE ROUTINE R9 EQU 9 PARSE ROUTINE WORK REGISTER R10 EQU 10 * UNUSED R11 EQU 11 * UNUSED R12 EQU 12 BASE FOR PROGRAM R13 EQU 13 SAVEAREA POINTER + BASE FOR WS R14 EQU 14 IMPLICIT USE R15 EQU 15 WORK REGISTER (RC) SPACE 2 ASMPS CSECT ASMPS RMODE 24 ASMPS AMODE 31 SAVE (14,12),T,* SAVE CALLER'S REGS LR R12,R15 SET R12 AS BASE USING ASMPS,R12 PROGRAM ADDRESSABILITY LA R0,WORKSIZE SET WORKAREA SIZE GETMAIN R,LV=(0) AND GET IT ST R13,4(R1) * ST R1,8(R13) * CHAIN SAVEAREAS LR R13,R1 * USING WORKAREA,R13 WORKAREA ADDRESSABILITY OPEN (OUTPUT,(OUTPUT)) OPEN FILE TM OUTPUT+DCBOFLGS-IHADCB,DCBOFOPN DID IT WORK? BNO NOTOPEN SLR R15,R15 ST R15,BUFLEN INITIALIZE RDW AREAS ST R15,PATHLEN ST R15,TTYLEN ST R15,CMDBLEN LA R15,PGPS#LENGTH GET LENGTH FOR RETURNED AREA ST R15,PGPSL STORE FOR GETPSENT LA R15,7(,R15) ADD RDW + EYE STH R15,BUFLEN STORE AS RDW LA R15,PGPSWORK GETMAIN AREA MAPPED BY BPXYPGPS ST R15,PGPSA HOLD POINTER TO THIS AREA XC PROCTOK,PROCTOK FIRST RELATIVE PROCESS (ZERO) USING PGPS,R15 LA R2,TTYBUF CONTROLLING TTY ->BUFFER ST R2,PGPSCONTTYPTR STORE INTO PGPS MVC PGPSCONTTYBLEN,=A(L'PGPSCONTTYBUF) LENGTH LA R2,PATHBUF PATHNAME ->BUFFER ST R2,PGPSPATHPTR STORE INTO PGPS MVC PGPSPATHBLEN,=A(L'PGPSPATHBUF) LENGTH LA R2,CMDBUF COMMAND ->BUFFER ST R2,PGPSCMDPTR STORE INTO PGPS MVC PGPSCMDBLEN,=A(L'PGPSCMDBUF) LENGTH MVC BUFID,=CL3'BUF' INITIALIZE EYE CATCHER MVC TTYID,=CL3'TTY' INITIALIZE EYE CATCHER MVC CMDID,=CL3'CMD' INITIALIZE EYE CATCHER MVC PATHID,=CL3'PTH' INITIALIZE EYE CATCHER DROP R15 SPACE , REDO CALL BPX1GPS, GET PROCESS DATA + (PROCTOK, INPUT: RELATIVE PROCESS TOKEN + PGPSL, INPUT: LENGTH OF BUFFER NEEDED + PGPSA, I/O: ->BUFFER, MAPPED BY BPXYPGPS + RETVAL, RETURN VALUE: -1, 0, NEXT PROCTOK + RETCODE, RETURN CODE + RSNCODE), REASON CODE + VL,MF=(E,PLIST) ---------------------------------- SPACE , ICM R15,B'1111',RETVAL TEST RETURN VALUE: 0 OR -1 ST R15,PROCTOK THE NEXT RELATIVE PROCESS TOKEN BZ ENDIT RETVAL = 0, END OF FILE BM ENDIT RETVAL < 0, ERROR LA R4,BUFLEN POINT TO BUFFER PUT OUTPUT,(R4) OUTPUT AREA LA R2,TTYBUF GET POINTER L R4,0(R2) GET LENGTH LA R4,11(,R4) ADD RDW + EYE STH R4,TTYLEN STORE IN RDW LA R4,TTYLEN POINT TO BUFFER PUT OUTPUT,(R4) OUTPUT AREA LA R2,PATHBUF GET POINTER L R4,0(R2) GET LENGTH LA R4,11(,R4) ADD RDW + EYE STH R4,PATHLEN STORE IN RDW LA R4,PATHLEN POINT TO BUFFER PUT OUTPUT,(R4) OUTPUT AREA LA R2,CMDBUF GET POINTER L R4,0(R2) GET LENGTH LA R4,11(,R4) ADD RDW + EYE STH R4,CMDBLEN STORE IN RDW LA R4,CMDBLEN POINT TO BUFFER PUT OUTPUT,(R4) OUTPUT AREA B REDO RETVAL > 0, NEXT LOGICAL PROCESS ENDIT TM OUTPUT+DCBOFLGS-IHADCB,DCBOFOPN IS FILE OPEN? BNO NOTOPEN CLOSE (OUTPUT) CLOSE FILE NOTOPEN LR R1,R13 LA R0,WORKSIZE SET WORKAREA SIZE L R13,SAVEAREA+4 RESTORE CALLER'S R13 FREEMAIN R,A=(1),LV=(0) FREE MY DYNAMIC AREA LR R15,R7 SET RETURN CODE RETURN (14,12),T,RC=(15) AND EXIT THIS COMMAND PROCESSOR LTORG OUTPUT DCB DDNAME=OUTPUT,DSORG=PS,MACRF=PM,RECFM=VB,LRECL=4096 WORKAREA DSECT SAVEAREA DS 18F PGPSA DS F POINTER TO RETURNED INFO PROCTOK DS F POINTER TO TOKEN PGPSL DS F LENGTH OF AREA RETVAL DS F RETURNED VALUE RETCODE DS F RETURN CODE RSNCODE DS F REASON CODE PLIST DS 6F PARAMETER LIST FOR CALL BUFLEN DS F RDW STUFF BUFID DS CL3 PGPSWORK DS CL(PGPS#LENGTH) TTYLEN DS F RDW STUFF TTYID DS CL3 TTYBUF DS CL(L'PGPSCONTTYBUF) PATHLEN DS F RDW STUFF PATHID DS CL3 PATHBUF DS CL(L'PGPSPATHBUF) CMDBLEN DS F RDW STUFF CMDID DS CL3 CMDBUF DS CL(L'PGPSCMDBUF) PGPSLEN EQU *-PGPSWORK WORKSIZE EQU *-WORKAREA BPXYPGPS DCBD DSORG=PS END ASMPS