TESTFTP CSECT TESTFTP AMODE 24 TESTFTP RMODE 24 * R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 BASE REGISTER R13 EQU 13 R14 EQU 14 R15 EQU 15 LENG72 EQU 72 *---------------------------------------------------------------------* * DAVID YOUNG THIS WILL TEST THE FTP2 INTERFACE *---------------------------------------------------------------------* BEGIN STM R14,R12,12(R13) STORE R14 THRU R12 INTO R13 BALR R12,R0 USING *,R12 USE 12 AS THE BASE REGISTER ST R13,SAVEAREA+4 STORE R13 CONTENTS AT SAVEAREA+4 LA R13,SAVEAREA LOAD SAVEAREA ADDRESS INTO REG 13 ST R1,PASSR1 KEEP POINTER TO SYSIN * MAIN L R1,PASSR1 PASS SYSIN THROUGH THIS PROGRAM LINK EP=FTP2 DYNAMICALLY LTR R15,R15 TEST RETURN CODE BZ EXITPRT IF R15 IS 0, GOTO EXIT * ERROR_PROC DS 0H SR R6,R6 CLEAR COUNTER REGISTER LA R5,MSG1 POINT TO ARRAY OF MESSAGES ERROR_LOOP DS 0H MVC WTOMSG+8(70),0(R5) MOVE A MESSAGE TO WTO AREA BAS R10,WTOMSG PERFORM WTOMSG ROUTINE LA R5,70(R5) INCREMENT TO NEXT ARRAY ENTRY A R6,=F'1' ADD 1 TO # MSGS PROCESSED C R6,=F'7' HAVE WE REACHED 7 MSGS? BL ERROR_LOOP NO, CONTINUE LOOP ISSUE_WTOR DS 0H */ ISSUE WTOR TO GET OPERATOR'S FEEDBACK /* XC ECBADDR,ECBADDR WTOR TEXT=(QSTMSG,REPLYAREA,LENG72,ECBADDR), X CONSNAME=DESTCON, X RPLYISUR=IDSAREA WAIT ECB=ECBADDR * SR R4,R4 CLEAR COUNTER REGISTER LA R5,REPLYAREA POINT TO REPLY AREA SCAN_LOOP DS 0H CLC ABEND_CONST(5),0(R5) 'ABEND' FOUND? BE ABEND_EXIT THEN GOTO ABEND_EXIT CLC CONT_CONST(4),0(R5) 'CONT' FOUND? BE CONT_EXIT THEN GOTO CONT_EXIT CLC WAIT_CONST(4),0(R5) 'WAIT' FOUND? BE WAIT_EXIT THEN GOTO WAIT_EXIT LA R5,1(R5) MOVE TO NEXT CHARACTER A R4,=F'1' ADD 1 TO COUNTER C R4,=F'60' IS COUNTER = 60? BL SCAN_LOOP IF NOT, CONTINUE LOOP B CONT_EXIT IF NO VALID CMD FOUND * THEN GOTO CONT_EXIT WTOMSG WTO ' + ',ROUTCDE=11,DESC=7 BR R10 * CONT_EXIT DS 0H SR R15,R15 EXITPRT DS 0H CLEAR R15 L R13,SAVEAREA+4 PUT PREV SAVEAREA IN REGISTER 13 L R14,12(R13) LOAD REG 14 WITH DISP 12 ADDR R13 LM R0,R12,20(R13) RESTORE R0 TO R12 FROM DISP 20 ON SR R15,R15 CLEAR RETURN CODE BSM 0,R14 BRANCH TO RETURN ADDR , IN R14 * ABEND_EXIT DS 0H * WTO 'ABEND EXIT',ROUTCDE=11,DESC=7 L R1,=X'000003E7' ABEND CODE IS U999 SVC 13 ISSUE USER ABEND SVC L R13,SAVEAREA+4 PUT PREV SAVEAREA IN REGISTER 13 L R14,12(R13) LOAD REG 14 WITH DISP 12 ADDR R13 LM R0,R12,20(R13) RESTORE R0 TO R12 FROM DISP 20 ON BSM 0,R14 * WAIT_EXIT DS 0H * WTO 'WAIT EXIT',ROUTCDE=11,DESC=7 STIMER WAIT,DINTVL=WAIT_INTV WAIT, B MAIN THEN TRY AGAIN * (GOTO MAIN LOOP) DS 0F SAVEAREA DS 18F REGISTER SAVE AREA PASSR1 DS F REG 1 SAVE AREA (SYSIN) ECBADDR DS F ECB FOR WTOR WAIT_INTV DC X'F0F0F0F0F1F0F0C0' TIME INTERVAL FOR STIMER WAIT ABEND_CONST DC CL5'ABEND' CONSTANT FOR 'ABEND' CONT_CONST DC CL4'CONT' 'CONT'INUE WAIT_CONST DC CL4'WAIT' 'WAIT' * DESTCON DC CL8'ALTCON ' ALTERNATE CONSOLE IS DESTINATION REPLYAREA DC CL72' ' CONSOLE REPLY AREA QSTMSG DC XL2'0050' LENGTH OF MSG FOR CONSOLE QMSG DC C'TESTFTP - REPLY ' DC XL1'7D' X'7D' = SINGLE QUOTE DC C'ABEND' DC XL1'7D' DC C', ' DC XL1'7D' DC C'CONT' DC XL1'7D' DC C' OR ' DC XL1'7D' DC C'WAIT' DC XL1'7D' DC CL40' ' IDSAREA DS CL12 CONSOLE ID INFO RETURNED HERE *MESSAGE AREA* MSG1 DC CL70'---FTP2 - ERROR OCCURRED. RECEIVING SERVER NOT ACTIVE ' MSG2 DC CL70'---FTP2 - PLEASE NOTIFY IT ONCALL TO ACTIVATE SERVER ' MSG3 DC CL70'---FTP2 - AND SELECT ONE OF THE FOLLOWING OPTIONS: ' MSG4 DC CL70'---FTP2 - WAIT => +RECOMMENDED+ WAIT AND RETRY ' MSG5 DC CL70'---FTP2 - CONT => CONTINUE JOB PROCESSING ' MSG6 DC CL70'---FTP2 - ABEND => JOB WILL ABEND +LAST RESORT+ ' MSG7 DC CL70'---FTP2 ----------------------------------------------' END