SUBROUTINE FXCMNS C C C AUTHER: P. GANDHI C C DATE: AUG 1978 C C**** C**** C**** ENTRY POINTS C**** C**** 1. LNCNCT TO SET UP LINE ATTRIBUTES FOR COMMUNICATIONS C**** C**** 2. LNREST TO SET LINE BACK IN NON-ORIGINATE MODE C**** C**** 3. LNREAD TO READ FROM COMMUNICATIONS LINE C**** C**** 4. LNXMIT TO TRANSMIT VIA COMMUNICATIONS LINE C**** C**** 5. LNHANG TO DISCONNECT COMMUNCATIONS C**** C**** 6. LNRTRY TO EMPTY BUFFER AND SEND RETRY. C**** IMPLICIT INTEGER (A-Z) INCLUDE '[360,100]FXCBUF.FTN' C**** INCLUDE '[360,100]FXCOMM.FTN' PARAMETER LUN=4 ! LOGICAL UNIT NUMBER FOR COMM. LINE INTEGER IDS ! STATUS RETURNED AFTER ASNLUN CALL INTEGER ISTAT(2)! STATUS RETURNED AFTER WTQIO CALL INTEGER IPC2(2) ! INTEGER IPC3(2) ! INTEGER IPRM(5) ! BYTE EFR ! FLAG FOR RETURN IN XMITLN BYTE FREE1 ! FOR FUTURE USE LOGICAL*1 IBST ! FIRST BYTE OF ISTAT EQUIVALENCE (ISTAT(1),IBST) C**** DATA IPC2 / "7,1 / ! TC.RAT READAHEAD DEFERRED DATA IPC3 /"37,0 / ! TC.PAR PARITY C.... ENTRY LNCNCT(IERR) C.... C.... ASSIGN LOGICAL UNIT # C.... CALL ASNLUN(LUN,'TT',ILIN,IDS) C.... C.... SET UNIT FULL DUPLEX C.... USING "3020 = IO.FDX - SET FULL DUPLEX MODE C.... CALL WTQIO("3020,LUN,1,,ISTAT,,) C.... IF(PGSTAT.EQ.'S')GO TO 20 IF(IBST.EQ.1)GO TO 20 CALL ERRMCM(109,ILIN,IBST) IERR=1 RETURN C.... C.... DO A NORMAL READ TO INITIALIZE THE LINE C.... USING "1200 = IO.RDB ; READ BINARY MODE - READ PASS ALL C.... 20 LINEON=1 ! SET LINE POSSESSION INDICATOR IPRM(1)=RSVBAD ! RECEIVE BUFFER ADDRESS IPRM(2)=1 IPRM(3)=0 IPRM(4)=0 IPRM(5)=0 30 CALL WTQIO("1200,LUN,1,,ISTAT,IPRM,) IF(IBST.NE.2)GO TO 30 C.... C.... WE HAVE GOT THE LINE NOW SET THE CHARACTERISTICS C.... C.... FUCTION CODES ARE AS FOLLOWS C.... C.... SF.DEF=010 SET DEFAULT CHARACTERS C.... SF.SSC=2420 SET SINGLE CHARACTERS C.... CALL WTQIO("2430,LUN,1,,ISTAT,IPC2,) IF(IBST.NE.1) GO TO 60 C.... C.... DO A READ (PASS ALL, WITH TIME OUT) ON THE LINE. IPRM(3)=1 CALL WTQIO("1230,LUN,1,,ISTAT,IPRM,) IERR=0 RETURN C.... C.... ERROR EXITS 60 IERR=2 RETURN C....................................................... ENTRY LNREST C.... C.... SWITCH LINE BACK TO NON-ORIGINATE MODE C.... CALL WTQIO("3030,LUN,1,,ISTAT,,) RETURN C....................................................... ENTRY LNREAD(RCNT,IRET) C---- C---- RETURN CODES. C---- C 1 NON ESFX DATA C 2 TIME OUT C 3 SLAVE ESFLX READY C 4 FILE HEADER RECEIVED C 5 DATA BLOCK RECEIVED C 6 END OF FILE C 7 ACKNOWLEDGE C 8 RETRY C 9 SIGN OFF C 10 UNKNOWN RET CODE. C 11 FILE OPEN ERROR C 12 SOME NOISE OR UNWANTED MESSAGE RECEIVED. C---- C---- ESFX CODES C---- C FH FILE HEADER C RT RETRY C OK SLAVE READY C EF END OF FILE C DB DATA BLOCK C SO SIGN OFF C AK ACKNOWLDGE C OX FILE OPEN ERROR C---- C.... C.... DO A 1 CHARACTER READ ON COMMUN. LINE UNTIL VALID C.... CHARACTER OR TIMEOUT. C.... 400 RCNT=0 IPRM(1)=RSVBAD ! 1ST BYTE ADDRESS OF RSVBUF IPRM(2)=1 ! 1 CHAR IPRM(3)=TMXLN ! TIME OUT IPRM(4)=0 410 CALL WTQIO("1230,LUN,1,,ISTAT,IPRM,) IF(IBST.NE.2)GO TO 420 IRET=2 ! TIME OUT RETURN CODE. RETURN 420 IF(IBST.NE.1)GO TO 490 ! ERROR ON READ IF(RSVBUF(1).LT."40)GO TO 410 C.... C.... DO A 9 CHARACTER READ (ESFX CONSTANT PORTION - 1) C.... ON COMMUN. LINE WITH 4 SEC TIME OUT. C.... IPRM(1)=RSVBAD+1 ! 2ND BYE ADDRESS OF RSVBUF IPRM(2)=9 ! 9 CHARS IPRM(3)=2 ! 4 SEC TIMEOUT CALL WTQIO("1230,LUN,1,,ISTAT,IPRM,) IF(IBST.LT.0)GO TO 490 ! ERROR ON READ RCNT=ISTAT(2)+1 ! TOTAL CHAR. READ IF(RCNT.GE.4)GO TO 450 440 IRET=1 ! NON ESFX DATA RETURN C.... C.... IF ITS NOT ESFX RECORD, RECOVER THE REST. C.... 450 IF(RBUFID.EQ.'ESFX') GO TO 510 IF (RSVBUF(2).NE.'E') GO TO 460 IF((RSVBUF(3).NE.'S').OR. - (RSVBUF(4).NE.'F').OR. - (RSVBUF(5).NE.'X')) GO TO 460 DO 455, I=1,RCNT-1 RSVBUF(I)=RSVBUF(I+1) 455 CONTINUE RCNT=RCNT-1 GO TO 500 C.... C.... 460 IF(RCNT.LT.10)GO TO 440 IPRM(1)=RSVBAD+10 ! FROM 11THRD BYTE ON IPRM(2)=680 ! MAKE SURE THERE IS ENOUGH SPACE IPRM(3)=2 ! 2 SEC TIME OUT CALL WTQIO("1230,LUN,1,,ISTAT,IPRM,) IF(IBST.LT.1)GO TO 490 ! IN CASE OF ERROR RCNT=10+ISTAT(2) ! TOTAL READ GO TO 440 C.... C.... 490 CALL ERRMCM(110,IBST) CALL FXEXIT C.... C.... ESFX RECORD PROCESSING C.... 500 IPRM(1)=RSVBAD+9 IPRM(2)=1 IPRM(3)=1 CALL WTQIO("1230,LUN,1,,ISTAT,IPRM,) RCNT = 10 510 IF(RCODE .NE. 'OK')GO TO 520 IRET = 3 GOTO 590 C.... 520 IF(RCODE .NE. 'AK')GO TO 530 IRET =7 GOTO 590 C.... 530 IF(RCODE .NE. 'EF')GO TO 540 IRET = 6 GOTO 590 C.... 540 IF(RCODE .NE. 'RT')GO TO 550 IRET = 8 GO TO 590 C.... 550 IF(RCODE .NE. 'SO')GO TO 560 IRET = 9 GO TO 590 C.... 560 IPRM(1)=RSVBAD+10 IPRM(3)=10 IF(RCODE .NE. 'DB')GO TO 570 IPRM(2)=DBSIZ-10 ! SIZE OF REST OF THE BLOCK IRET = 5 CALL WTQIO("1230,LUN,1,,ISTAT,IPRM) IF(IBST .NE. 1)GO TO 600 RCNT=RCNT+ISTAT(2) CALL WTQIO("1230,LUN,1,,ISTAT,IPCLR,) IF(IBST .NE. 2) GO TO 600 WCODE='AK' CALL SETXMT(10) GO TO 590 C.... 570 IF(RCODE .NE. 'FH')GO TO 595 IPRM(2)=FHSIZ-10 ! SIZE OF REST OF THE HEADER BLOCK IRET=4 CALL WTQIO("1230,LUN,1,,ISTAT,IPRM,) IF(IBST .NE. 1)GO TO 600 RCNT = RCNT+ISTAT(2) CALL WTQIO("1230,LUN,1,,ISTAT,IPRM,) IF (IBST.NE.2)GO TO 600 GO TO 590 C.... 580 IF(RCODE.NE.'OX')GO TO 595 IRET=11 C.... 590 CALL CHKRSV(RCNT,NRET) C IF(NRET .EQ. 0)RETURN RETURN C.... 595 IRET=10 IF(RCODE .EQ. 'OX') IRET = 11 RETURN 600 IRET = 12 ! POSSIBLY JUNK ON THE LINE RETURN ENTRY LNXMIT(XCNT) C**** C**** WRITE OUT THE MESSAGE IN XMTBUF BUFFER. C**** 700 IPRM(1)=XMTBAD ! XMTBUF ADDRESS IPRM(2)=XCNT ! DATA COUNT IPRM(3)=0 IPRM(4)=0 IPRM(5)=0 CALL WTQIO("410,LUN,5,,ISTAT,IPRM,) IF(IBST.NE.1)GO TO 800 ! ERROR JUMP C.... TMXLN=5 ! INCREASE WAITING TIME ON COMM LINE RETURN C.... 800 CALL ERRMCM(113) CALL FXEXIT ! ERROR EXIT FROM PROGRAM C...................................................... ENTRY LNRTRY C---- C---- EMPTY READ AHEAD BUFFER. C---- 850 IPCLR(2)=25 ! 25 CHARACTERS AT A TIME CALL WTQIO("1230,LUN,1,,ISTAT,IPCLR,) IF (IBST.NE.2) GO TO 850 C---- C---- ISSUE RETRY ON THE LINE C---- IPCLR(2)=1 ! SET IT BACK TO NORMAL WCODE='RT' ! RETRY COMMAND CALL SETXMT(10) ! SEND RETRY RETURN ENTRY LNHANG(IERR) C.... C.... IF LINE WAS ALREADY BUSY AT ENTRY TO CONECT, DON'T RESET IT. IF (LINEON.EQ.0) RETURN C.... C.... PERFORM LINE HANGUP ASSIGNED TO LUN C.... EMPTY READAHEAD BUFFER IPRM(1)=RSVBAD IPRM(2)=1 IPRM(3)=1 IPRM(4)=0 IPRM(5)=0 900 CALL WTQIO("1230,LUN,1,,ISTAT,IPRM,) C.... IF(IBST.EQ.2)GO TO 910 IF(IBST.LT.0)GO TO 920 GO TO 900 C.... C.... IO.HNG "3000 TO HANGUP THE MODEM C.... SKIP THIS IF IN SLAVE MODE. C.... 910 IF(PGSTAT.EQ.'S')GO TO 915 CALL WTQIO("3000,LUN,1,,ISTAT,,) IF(IBST.NE.1)GO TO 920 C.... C.... RESET CHARACTERISTICS 915 IPC2(2)=0 CALL WTQIO("2430,LUN,1,,ISTAT,IPC2,) IF(IBST.NE.1) GO TO 920 C.... C.... SET PARITY C.... IPC3(2)=1 CALL WTQIO("2430,LUN,1,,ISTAT,IPC3,) IF(IBST.NE.1) GO TO 920 C.... C.... DO READ WITH TIME OUT TO INVOKE THE SET CHARACTERISTICS C.... CALL WTQIO("1230,LUN,1,,ISTAT,IPRM,) IERR=0 ! SUCCESS RETURN C.... C.... ERROR EXIT C.... 920 IERR=3 IF(IDBG.EQ.'N')RETURN C.... IF(IBST) 930,940,950 930 IDCD=IOR("177400,ISTAT(1)) GO TO 960 C.... 940 IDCD=2 GO TO 960 C.... 950 IDCD=IBST 960 CALL ERRMCM(114,ILIN,IDCD) RETURN END