PROGRAM ESFLX C C C C AUTHOR: P. GANDHI C C C DATED: AUG. 1978 C C C C FUNCTION: TRANSMIT FILES BETWEEN TWO C PDP-11/45 SYSTEMS. C IMPLICIT INTEGER (A-Z) EXTERNAL FDB C---- C---- DEFINITION OF COMMON AREA BETWEEN ESFLX AND FLXLAT ROUTINE. C---- COMMON /FBADCM/TTBAD, - BNBAD, - CDBAD, - DTCNT, - RTNCD INTEGER*2 TTBAD ! TT BUFFER ADDRESS INTEGER*2 BNBAD ! BINARY DATA BUFFER ADDRESS INTEGER*2 CDBAD ! CODE PORTION BUFFER ADDRESS INTEGER*2 DTCNT ! DATA (ORIGINAL) COUNT INTEGER*2 RTNCD ! RETURN CODE C---- INCLUDE '[360,100]FXCBUF.FTN' INCLUDE '[360,100]FXCOMM.FTN' EXTERNAL FXTRAP ! CONTROL C TRAP ROUTINE C---- INTEGER*2 AVALNO(4) ! VALID LINE #S IN ASCII INTEGER BVALNO(4) ! VALID LINE #S IN BINARY INTEGER*4 DESC(9) ! FOR THE STRTCM ROUTINE C---- C---- DATA IPCLR(2)/1/, IPCLR(3)/1/, IPCLR(4)/0/ DATA AVALNO / '15','16','17','20'/ DATA BVALNO / "15,"16,"17,"20/ DATA PGNAME/ 'E','S','F','L','X',' '/ DATA DESC / 'ENG.',' SYS','TEMS',' FIL', - 'ES T','RANS','MIT ','UTIL','ITY '/ C---- C---- C---- FILL IN ADDRESSES IN COMMON C---- RSVBAD = IGETAD(RSVBUF) XMTBAD = IGETAD(XMTBUF) TTBBAD = IGETAD(TTBUF) C---- TTBAD = TTBBAD BNBAD = IGETAD(FILBUF) CDBAD = IGETAD(WBXDAT) C---- IPCLR(1)=TTBAD ! MOVE IN TTBUFFER ADDRESS IDBG = 'N' ! NO DEBUG DEFAULT XBLKNO=1 RBLKNO=1 C---- C---- C---- CALL GETLUN(5,TTBUF) IF((TTBUF(3).GE."15).AND.(TTBUF(3).LE."20)) GO TO 1000 PGSTAT='M' ! MASTER IF NON MODEM LINE CALL FXRDTT(1,ICNT) ! GIVE ...INS TIME TO GET LOST. CALL STRTCM(PGNAME,DESC,FXTRAP) WRITE(5,5) 5 FORMAT( '$ENTER DEBUG MODE Y OR N > ') CALL FXRDTT(254,ICNT) IDBG = TTBUF(1) C---- C---- 20 WRITE(5,25) 25 FORMAT( '$ENTER AVAILABLE LINE # OR EX > ') CALL FXRDTT(254,ICNT) DO 30, IN=1,4 IF(TTB2BY.EQ.AVALNO(IN))GO TO 40 30 CONTINUE GO TO 20 C---- 40 ILIN = BVALNO(IN) C---- 50 CALL LNCNCT(IERR) IF(IERR.EQ.0)GO TO 60 WRITE(5,55) 55 FORMAT( '0LINE WAS FOUND BUSY.'/ - ' -IF YOU WISH TO RESET THE LINE',/ - ' HANGUP THE PHONE AND ENTER "YES"',/ - '$-ELSE ENTER "NO" > ') CALL FXRDTT(254,ICNT) IF(TTB2BY.NE.'YE')GO TO 20 LINEON=1 ! TO ACTIVATE LNHANG CALL LNHANG(IERR) GO TO 50 C---- C---- 60 WRITE(5,65) ILIN 65 FORMAT( '0ESTABLISH CONNECTION WITH PDP-11 VIA LINE ',O2,/ - ' -IF SUCCESSFUL ENTER "GO"',/ - '$-ELSE ENTER "EX" TO EXIT THE PROGRAM > ') 70 CALL FXRDTT(254,ICNT) IF(TTB2BY.EQ.'GO') GOTO 78 WRITE(5,75) 75 FORMAT( '$GO OR EX > ') GO TO 70 78 CALL LNREST C---- 80 TMXLN = 3 ! 3 SECOND TIME OUT CALL DISCKP ! DISABLE CHECKPOINTING 85 CALL LNREAD(RCNT,IRET) GO TO (100,110,135),IRET C---- 100 CALL FXWRTT(RCNT) C---- 110 WRITE(5,115) 115 FORMAT('$ESFX>') CALL FXRDTT(10,ICNT) IF (ICNT.EQ.0)GO TO 85 IF(ICNT.NE.2)GO TO 120 IF(TTB2BY.NE.'CC')GO TO 117 XMTBUF(1)="3 ! ^C XMTBUF(2)="3 ! ^C XCNT=2 GO TO 130 117 IF(TTB2BY.NE.'CZ') GO TO 120 XMTBUF(1)="32 ! ^Z XMTBUF(2)=0 XCNT=2 GO TO 130 120 XCNT=ICNT+1 DO 125,I=1,ICNT 125 XMTBUF(I)=TTBUF(I) XMTBUF(XCNT)="15 ! ADD CR 130 CALL LNXMIT(XCNT) GO TO 85 C---- C---- AT THIS POINT SLAVE ESFLX IS READY AND WAITING FOR C---- COMMAND. C---- 135 WRITE(5,136) 136 FORMAT('$CHECKPOINTING YES OR NO> ') CALL FXRDTT(250,ICNT) CKP=TTBUF(1) IF (CKP.NE.'N')CALL ENACKP 140 WRITE(5,145) 145 FORMAT('$XMT OR RSV> ') CALL FXRDTT(250,I) IF (TTB2BY.NE.'SO') GO TO 148 WCODE='SO' ! TELL SLAVE TO SIGN OFF CALL SETXMT(10) GO TO 80 ! GET BACK TO INTERACTIVE MODE 148 IF ((TTB2BY.NE.'RS').AND.(TTB2BY.NE.'XM'))GO TO 140 FXROUT=TTB2BY 150 WRITE(5,155) 155 FORMAT('$FILES> ') CALL FXRDTT(250,ICNT) DTCNT=ICNT CALL FXVFY ! CHECK FOR SYNTAX ERROR IF (RTNCD.EQ.0) GO TO 159 IF(RTNCD.EQ.1)GO TO 157 WRITE(5,156) 156 FORMAT(' *** SYNTAX ERROR') GO TO 150 157 IF(TTB4BY.EQ.'ROUT')GO TO 140 WRITE(5,158) 158 FORMAT(' *** REQUIRED INPUT FILE MESSING') GO TO 150 C---- 159 IFILBF(11)=DTCNT ! BYTE 17 AND 18 IFILBF(12)=FXROUT ! BYTE 19 AND 20 FILBUF(25)=CKP DO 160,I=1,DTCNT 160 FILBUF(25+I)=TTBUF(I) ! COMMAND STRING IF (FXROUT.EQ.'RS') GO TO 170 CALL FXOPNI ! OPEN INPUT FILE IF FILE TO BE XMITTED IF(RTNCD.EQ.0)GO TO 170 162 WRITE(5,165) 165 FORMAT(' *** INPUT FILE OPEN ERROR') GO TO 150 C---- C---- TRANSMIT FILE HEADER TO SLAVE ESFLX. C---- 170 DTCNT=90 ! FOR XLATION RTN. WCODE='FH' CALL SETXMT(FHSIZ) ! SET UP AND XMIT FHSIZ BYTES OF INFO DTCNT=512 175 TMXLN=250 ! 4 MAX. TIMOUT CALL LNREAD(RCNT,IRET) IRET=IRET-3 GO TO (270,180,180,280,200,900,180,220,240),IRET C---- C---- INVALID RETUN CODE. C---- 180 IRET=IRET+3 IF(IRET.EQ.1) GO TO 240 182 WRITE(5,185)IRET 185 FORMAT(' *** INVALID RETURN CODE ',I2) CALL FXEXIT C---- C---- RETRANSMIT REQUEST C---- 200 CALL LNXMIT(FHSIZ) ! RETRANSMIT GO TO 175 C---- C---- FILE OPEN ERROR C---- 220 IF(FXROUT.EQ.'RS')GO TO 162 CALL FXCLOS WRITE(5,225) 225 FORMAT(' *** OUTPUT FILE OPEN ERROR') GO TO 150 C--- CALL RETRY ENTRY POINT C--- 240 CALL LNRTRY GO TO 175 C---- FILE HEADER RECEIVED. C---- 270 CALL FXOPNO ! OPEN OUTPUT FILE IF(RTNCD.EQ.0)GO TO 310 WRITE(5,225) CALL FXEXIT C---- C---- FILE OPEN ACK FORM SLAVE C---- 280 CALL FXREAD ! READ A SECTOR OF DATA IF(RTNCD.EQ.0)GO TO 300 IF(RTNCD.EQ.1)GO TO 290 WRITE(5,285) 285 FORMAT('0***ERROR*** ON FILE READ') CALL FXEXIT C---- C---- END OF FILE C---- 290 WCODE='EF' ! END-OF-FILE CALL SETXMT(10) 294 CALL FXCLOS WRITE(5,295) 295 FORMAT(' *** CURRENT FILE SUCCESFULLY PROCESSED') GO TO 140 300 WCODE='DB' ! DATA BLOCK TRANSMIT CALL SETXMT(DBSIZ) GO TO 320 C---- C---- SEND "AK" FOR ACKNOWLEDGE. C---- 310 WCODE='AK' CALL SETXMT(10) C---- C---- ISSUE A READ ON COMMUNICATIONS LINE C---- 320 TMXLN=250 ! 4 MINUTES TIMEOUT CALL LNREAD(RCNT,IRET) IF (INTRSW.EQ.1)CALL CHECK IRET=IRET-4 GO TO (340,294,280,360,900,400,400,400),IRET IRET=IRET+4 IF(IRET.EQ.1) GO TO 400 GO TO 182 C---- C---- DATA BLOCK RECEIVED. C---- 340 CALL FXWRIT ! WRITE ON OUTPUT FILE IF(RTNCD.EQ.0)GO TO 320 ! ACK AND ISSUE READ WRITE(5,345) 345 FORMAT('0***ERROR*** ON WRITE') CALL FXEXIT C---- C---- RETRY REQUEST BY SLAVE. C---- 360 CALL LNXMIT(DBSIZ) GO TO 320 C---- C---- SOME JUNK RECEIVED DO A RETRY C---- 400 CALL LNRTRY GO TO 320 C---- C---- SLAVE SIGNED OFF REASON UNKNOWN. C---- 900 WRITE(5,910) 910 FORMAT(' *** SLAVE ESFLX SIGNED OFF') CALL FXEXIT C---- SLAVE ESFLX CONTROL CODE C---- 1000 PGSTAT = 'S' ! SLAVE STATUS XBLKNO = 1 ! INITIALIZE XMT BLK SEQ # ILIN = TTBUF(3) CALL LNCNCT(IERR) C---- C---- WAIT 11 SECONDS BEFORE REPLYING C---- TMXLN=8 ! TO GET A FRESH START CALL LNREAD(RCNT,IRET) WCODE = 'OK' ! INDICATE SLAVE READY CALL SETXMT(10) C---- C---- ISSUE A READ WITH 5 MIN-TIMOUT. C---- 1010 TMXLN=250 ! 4 MIN. MAX TIMOUT C---- CALL QSAVE(2,1,FDB,512,'S1FDB.SAV',9,R) DTCNT=90 ! FOR FIRST FILE HEADER CALL LNREAD(RCNT,IRET) IF(IRET.EQ.9)CALL FXEXIT IF(IRET.EQ.4)GO TO 1020 IF(IRET.EQ.2)CALL FXEXIT 1015 WCODE='RT' CALL SETXMT(10) GO TO 1010 C---- C---- 1020 DTCNT=IFILBF(11) ! COMMAND STRING LENGTH FXROUT=IFILBF(12) ! ASCII ROUT CODE CKP=FILBUF(25) IF(CKP.EQ.'N')CALL DISCKP DO 1030 I=1,DTCNT 1030 TTBUF(I)=FILBUF(25+I) CALL FXVFY DTCNT=512 IF(FXROUT.EQ.'RS')GO TO 1050 IF(FXROUT.NE.'XM')GO TO 1015 CALL FXOPNO ! OPEN OUTPUT FILE IF(RTNCD.EQ.0)GO TO 1060 1040 WCODE='OX' ! OPEN ERROR CALL SETXMT(10) GO TO 1010 1050 CALL FXOPNI ! OPEN INPUT FILE IF(RTNCD.NE.0)GO TO 1040 WCODE='FH' DTCNT=90 CALL SETXMT(FHSIZ) DTCNT=512 GO TO 1070 C---- C---- 1060 WCODE='AK' CALL SETXMT(10) C---- 1070 TMXLN=250 C---- CALL QSAVE(2,1,FDB,512,'SFDB.SAV',8,R) CALL LNREAD(RCNT,IRET) IRET=IRET-4 GOTO(1140,1180,1200,1250,1300,1260),IRET 1100 CALL FXEXIT C---- 1140 CALL FXWRIT IF(RTNCD.EQ.0)GO TO 1070 CALL FXEXIT C---- 1180 CALL FXCLOS GO TO 1010 C---- 1200 CALL FXREAD IF(RTNCD.EQ.0)GO TO 1240 IF(RTNCD.EQ.1)GO TO 1230 CALL FXEXIT C---- 1230 CALL FXCLOS ! CLOSE OPEN FILE WCODE='EF' ! END-OF-FILE CALL SETXMT(10) GO TO 1010 C---- 1240 WCODE='DB' DTCNT=512 CALL SETXMT(DBSIZ) GO TO 1070 C---- RETRY REQUEST FROM MASTER. C---- 1250 CALL LNXMIT(DBSIZ) GO TO 1070 C---- C---- ISSUE A RETRY C---- 1260 WCODE='RT' CALL SETXMT(10) GO TO 1070 C---- C---- SIGN OFF RECEIVED C---- 1300 CALL FXEXIT END