SUBROUTINE DIAL_VA3480 C C This routine dials the phone number for the VADIC 3480 modem. C INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) AUTO_NFG, CONNECTION_OK, CONNECTION_NFG LOGICAL ASSIGN_DIALER_PORT INTEGER*4 AUTO_RETRY, SIZE, STATUS INTEGER*4 DIAL_TMO, RESET_TMO DATA DIAL_TMO, RESET_TMO /60, 3/ PARAMETER (AUTO_NFG = SS// 1 '*** The autodialer is not responding, aborting... ***' 1 //BELL//SS) PARAMETER (CONNECTION_OK = SS// 1 '*** Connection established, you may continue. ***'//BELL//SS) PARAMETER (CONNECTION_NFG = SS// 1 '*** The connection was not established. ***'//BELL//SS) AUTO_RETRY = 0 ! Initialize the retry count. C C If the dialer port is not assigned, try to assign it. C IF (.NOT. DIALER_ASSIGNED) THEN IF ( ASSIGN_DIALER_PORT() ) THEN CALL SETUP_DIALER_PORT() ! Setup the dialer char./speed. ELSE RETURN ! Dialer port not assigned. ENDIF ENDIF CALL CLEAR_DIALER_PORT() ! Clear the typeahead buffer. C C Send a CTRL/A (SOH) to reset the autodialer. C 100 XBUFFER(1) = SOH ! Prepare to send CTRL/A (SOH). CALL WRITE_DIALER (XBUFFER, 1) ! Send it to the autodialer. C C The autodialer should respond with "B" if successfully reset. C IF (READ_DIALER (RBUFFER, 1, RESET_TMO)) THEN IF (RBUFFER(1) .EQ. 'B') THEN ! ASCII 'B' = reset. GOTO 200 ! Go dial the number. ENDIF ENDIF AUTO_RETRY = AUTO_RETRY + 1 ! Bump the retry count. IF (AUTO_RETRY .EQ. AUTODIAL_LIMIT) THEN CALL WRITE_USER (AUTO_NFG) RETURN ! All finished ... ELSE GO TO 100 ! Try to reset dialer again ... ENDIF C C Prepare to send the phone number with following format: C C Sequence Description C -------- ----------- C 1 Start of text (STX = CTRL/B). C 2 Dialer address/modem type (4 = dialer 0, type = 103/212). C 3 The modem address (slot number of modem to dial). C 4 Telephone digits (0 - 9, <, =, or * and # for tone dial). C 5 Buffer empty (SI = CTRL/O). C 6 End of text (ETX = CTRL/C). C C Note: The VA811 autodialer manual states that the characters C "*" and "#" are valid for tone dialing. The VA831A/B C adapter manual doesn't show these as valid characters. C 200 AUTO_RETRY = 0 ! Reset the retry count. XBUFFER(1) = STX ! Start of text (STX = CTRL/B). XBUFFER(2) = 4 ! Dialer = 0, modem = 103/212. XBUFFER(3) = MODEM_SLOT * 2 ! Copy the modem address (slot). SIZE = 4 ! Starting position for number. C C Loop through the number discarding invalid characters. This C allows us to use additional characters to format the phone C number (i.e. 9 - (area_code) - 1 - phone_number). C DO 300 I = 1,PHONE_SIZE XBUFFER(SIZE) = ICHAR(PHONE_NUMBER(I:I)) IF ( ((XBUFFER(SIZE) .GE. '0') .AND. 1 (XBUFFER(SIZE) .LE. '9')) .OR. 1 (XBUFFER(SIZE) .EQ. '<') .OR. 1 (XBUFFER(SIZE) .EQ. '=') .OR. 1 (XBUFFER(SIZE) .EQ. '*') .OR. 1 (XBUFFER(SIZE) .EQ. '#') ) THEN SIZE = SIZE + 1 ! Point to the next position. ENDIF 300 CONTINUE XBUFFER(SIZE) = SI ! Empty buffer (SI = CTRL/O). XBUFFER(SIZE+1) = ETX ! End of text (ETX = CTRL/C). SIZE = SIZE + 1 ! Set the total buffer size. C C Send the formatted phone number to the autodialer. C 400 CALL WRITE_DIALER (XBUFFER, SIZE) C C The response from the dialer will be one of the following: C C A - Data Set Status (DSS). C Indicates successful call completion. Also called C Call Originate Status (COS). C C B - Abandon Call/Retry (ACR). C Indicates received abort character from the DTE or C Abandon Call/Retry (ACR) received from dialer. This C status is sent from the dialer after 42 seconds by C default if carrier is not detected. Our dialer was C increased to 56 seconds for overseas phone calls. C C D - Format Error. C Indicates data framing error in character string C received by adapter. C C E - Parity Error. C Indicates parity error in character string received C by adapter. C C F - RAM Overflow. C Indicates character buffer (RAM) capacity has been C exceeded. The maximum capacity is 60 or 32 characters, C depending on option switch setting. All characters C in the message string except STX and ETX are stored C in the buffer during a Write mode. C C G - Data Line Occupied (DLO). C Indicates the modem or dialer is busy (off-hook). C IF (READ_DIALER (RBUFFER, 1, DIAL_TMO)) THEN IF (CONTROLC_TYPED) THEN ! CTRL/C typed to abort. CALL WRITE_USER (CONNECTION_NFG) RETURN ENDIF IF (RBUFFER(1) .EQ. 'A') THEN ! ASCII 'A' = success. CALL WRITE_USER (CONNECTION_OK) REMOTE = .TRUE. ! Show modem is connected. MODEM_ONLINE = .TRUE. ! Show the modem is online. CALL RELEASE_DIALER_PORT() ! Release the dialer port. RETURN ! All done ... ELSEIF (RBUFFER(1) .EQ. 'B') THEN ! ASCII 'B' = failure. CALL WRITE_USER ('*** Abandon Call/Retry') ELSEIF (RBUFFER(1) .EQ. 'D') THEN ! ASCII 'D' = failure. CALL WRITE_USER ('*** Format Error') ELSEIF (RBUFFER(1) .EQ. 'E') THEN ! ASCII 'E' = failure. CALL WRITE_USER ('*** Parity Error') ELSEIF (RBUFFER(1) .EQ. 'F') THEN ! ASCII 'F' = failure. CALL WRITE_USER ('*** RAM Overflow') ELSEIF (RBUFFER(1) .EQ. 'G') THEN ! ASCII 'G' = failure. CALL WRITE_USER ('*** Data Line Occupied') ELSE CALL WRITE_USER ('*** Unexpected or no response') ENDIF CALL WRITE_USER (' received, retrying ... ***'//SS) ENDIF AUTO_RETRY = AUTO_RETRY + 1 ! Bump the retry count. IF (AUTO_RETRY .EQ. AUTODIAL_LIMIT) THEN CALL WRITE_USER (CONNECTION_NFG) ELSE GO TO 400 ! Send the number again ... ENDIF CALL RELEASE_DIALER_PORT() ! Release the dialer port. RETURN END SUBROUTINE GET_DIALER_PORT (DPORT) C C This routine is used to request the auto dialer port. C INCLUDE 'COM.INC/NOLIST' LOGICAL ASSIGN_DIALER_PORT CHARACTER*(*) MODULE_NAME, PORTQ, PORT_DEFAULT, DPORT PARAMETER (MODULE_NAME = 'GET_DIALER_PORT') PARAMETER (PORTQ = 'Enter the port being used for the autodialer (') PARAMETER (PORT_DEFAULT = 'DAILER$PORT') IF (STARTUP) THEN STATUS = GET_SYMBOL ('DIALER_PORT', DIALER_PORT, DIALER_SIZE) ENDIF IF (DIALER_SIZE .EQ. 0) THEN DIALER_PORT = PORT_DEFAULT ! Set up the default port. DIALER_SIZE = LEN(PORT_DEFAULT) ! And the dialer port size. ENDIF IF (DEFN_IN .EQ. 0) THEN CALL GET_EFN (DEFN_IN) ! Dialer input event flag. CALL GET_EFN (DEFN_OUT) ! Dialer output event flag. ENDIF IF (STARTUP .AND. STATUS) GO TO 200 ! Go assign the dialer port. IF (LEN(DPORT) .GT. 0) THEN DIALER_PORT = DPORT ! Set up the dialer port. DIALER_SIZE = LEN(DPORT) ! And the dialer port size. GO TO 200 ! Try to assign dialer port. ENDIF C C Ask for the VA3480 autodialer port. C 100 CALL PROMPT_USER (PORTQ//DIALER_PORT(1:DIALER_SIZE)//'): ', 1 %REF(SCRATCH), LEN(DIALER_PORT)) IF (BACKUP) RETURN IF (WANTS_HELP) THEN CALL GET_HELP ('DIALER_PORT') GO TO 100 ENDIF C C If we already have a dialer port assigned, deassign it first. C The deassign must be done before clobbering the DIALER_PORT. C IF (DIALER_ASSIGNED) THEN CALL RELEASE_DIALER_PORT() ENDIF IF (LBYTE_COUNT .GT. 0) THEN DIALER_PORT = SCRATCH(1:LBYTE_COUNT) DIALER_SIZE = LBYTE_COUNT ENDIF 200 IF ( .NOT. ASSIGN_DIALER_PORT() ) THEN GO TO 100 ! Dialer port not assigned. ENDIF CALL SETUP_DIALER_SPEED() ! Now request the speed. IF (BACKUP) GO TO 100 ! Request the port again. RETURN END LOGICAL FUNCTION ASSIGN_DIALER_PORT C C This routine is used to allocate and assign channels to the C autodialer port. C INCLUDE 'COM.INC/NOLIST' INTEGER*4 I, STATUS, WAIT_RETRYS, MAX_RETRYS, WAIT_SIZE, WAIT_TIME DATA MAX_RETRYS /18/ CHARACTER*10 DIALER_WAIT CHARACTER*(*) MODULE_NAME, BAD_PORT, IN_USE, NO_DIALER, WAIT_DEFAULT PARAMETER (MODULE_NAME = 'ASSIGN_DIALER_PORT') PARAMETER (WAIT_DEFAULT = '10') PARAMETER (BAD_PORT = 1 '*** The DIALER and LOCAL terminal ports must be different. ***' 1 //BELL//SS) PARAMETER (IN_USE = 1 '*** The dialer is INUSE by another user, please be patient. ***' 1 //SS) PARAMETER (NO_DIALER = 1 '*** The dialer is NOT available, please try again later. ***' 1 //BELL//SS) ASSIGN_DIALER_PORT = .FALSE. ! Dialer not assigned. WAIT_RETRYS = 0 ! Initialize retry count. C C The symbol DIALER_WAIT can be defined to override the default C wait delay used when the dialer is inuse by another user. C STATUS = GET_SYMBOL ('DIALER_WAIT', DIALER_WAIT, WAIT_SIZE) IF (STATUS) THEN STATUS = CVT_DTB (DIALER_WAIT(1:WAIT_SIZE), WAIT_TIME) ENDIF IF (.NOT. STATUS) THEN DIALER_WAIT = WAIT_DEFAULT ! Setup the default wait WAIT_SIZE = LEN(WAIT_DEFAULT) ! and the wait size. ENDIF C C Try to allocate the dialer port first. C 100 STATUS = SYS$ALLOC (DIALER_PORT(1:DIALER_SIZE), 1 DIALER_SIZE, DIALER_PORT,) C C Bypass extra characters at start of the device name. C I = INDEX (DIALER_PORT(1:DIALER_SIZE), '$') ! Bypass the dollar sign. IF (I .EQ. 0) I = 1 ! Initialize the index. DO WHILE (DIALER_PORT(I:I) .EQ. '_') I = I + 1 ! Adjust the index. ENDDO C C Make sure dialer port is not the same as local port. C IF (INDEX (LOCAL_DEVICE(1:LOCAL_SIZE), 1 DIALER_PORT(I:DIALER_SIZE)) .GT. 0) THEN CALL WRITE_USER(BAD_PORT) ! Tell user the bad news. RETURN ENDIF C C If the device is inuse by another user, wait and then try again. C IF (STATUS .EQ. SS$_DEVALLOC) THEN IF (CONTROLC_TYPED) RETURN ! Give up if CTRL/C typed. WAIT_RETRYS = WAIT_RETRYS + 1 ! Bump the retry count. IF (WAIT_RETRYS .LE. MAX_RETRYS) THEN CALL WRITE_USER (IN_USE) ! Tell user dialer inuse. CALL WAITABIT (DIALER_WAIT(1:WAIT_SIZE)) GO TO 100 ! And retry the allocate. ELSE CALL WRITE_USER (NO_DIALER) ! Tell user we're giving up. RETURN ENDIF ENDIF IF (STATUS .NE. SS$_DEVALRALLOC) THEN IF (.NOT. CHECK_STATUS (MODULE_NAME, STATUS)) THEN RETURN ! Return failure ... ENDIF ENDIF STATUS = SYS$ASSIGN (DIALER_PORT(1:DIALER_SIZE), DCHAN_IN,,) STATUS = SYS$ASSIGN (DIALER_PORT(1:DIALER_SIZE), DCHAN_OUT,,) IF (STATUS) THEN DIALER_ASSIGNED = .TRUE. ! We have a port assigned. ELSE CALL CHECK_STATUS (MODULE_NAME, STATUS) RETURN ENDIF ASSIGN_DIALER_PORT = .TRUE. ! Show dialer is assigned. RETURN END SUBROUTINE CLEAR_DIALER_PORT C C Clears the typeahead buffer on the autodial port. C INCLUDE 'COM.INC/NOLIST' INTEGER*4 STATUS, SYS$QIOW CHARACTER*(*) MODULE_NAME PARAMETER (MODULE_NAME = 'CLEAR_DIALER_PORT') STATUS = SYS$QIOW(%VAL(DEFN_IN),%VAL(DCHAN_IN), 1 %VAL(IO$_READLBLK + IO$M_PURGE), 2 DIALER_IOSB,,,RBUFFER,%VAL(0),,,,) IF ( CHECK_STATUS (MODULE_NAME, STATUS) ) THEN STATUS = DIALER_IOSB(1) CALL CHECK_STATUS (MODULE_NAME, STATUS) ENDIF RETURN END SUBROUTINE RELEASE_DIALER_PORT C C This routine is used to deassign and deallocate the autodialer C port so someone else can use it if desired. C INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) MODULE_NAME PARAMETER (MODULE_NAME = 'RELEASE_DIALER_PORT') STATUS = SYS$DASSGN (%VAL(DCHAN_IN)) STATUS = SYS$DASSGN (%VAL(DCHAN_OUT)) CALL CHECK_STATUS (MODULE_NAME, STATUS) STATUS = SYS$DALLOC (DIALER_PORT(1:DIALER_SIZE),) IF (STATUS .NE. SS$_NOPRIV) 1 CALL CHECK_STATUS (MODULE_NAME, STATUS) DIALER_ASSIGNED = .FALSE. ! No dialer port assigned. RETURN END INTEGER FUNCTION READ_DIALER (BUFFER, BYTES, TIMEOUT) C C This function is called to read characters from the dialer. C C Inputs: C BUFFER The input buffer to read into. C BYTES The number of characters to read. C TIMEOUT The timeout for the read in seconds. C C Outputs: C Returns system service or I/O status code. C INCLUDE 'COM.INC/NOLIST' LOGICAL*1 BUFFER(1) INTEGER BYTES, NBYTES, TIMEOUT CHARACTER*(*) MODULE_NAME PARAMETER (MODULE_NAME = 'READ_DIALER') BUFFER(1) = 0 ! Initialize the first byte. READ_DIALER = SYS$QIOW (%VAL(DEFN_IN),%VAL(DCHAN_IN), 1 %VAL(IO$_READLBLK + IO$M_NOECHO + IO$M_TIMED), 1 DIALER_IOSB,,,BUFFER,%VAL(BYTES), 1 %VAL(TIMEOUT),NOTERM,,) IF (CONTROLC_TYPED) RETURN ! Return if aborted. NBYTES = DIALER_IOSB(2) ! Copy the byte count. IF (CHECK_STATUS (MODULE_NAME, READ_DIALER)) THEN READ_DIALER = DIALER_IOSB(1) ! Pass back I/O status. CALL CHECK_STATUS (MODULE_NAME, READ_DIALER) CALL WRITE_DEBUG (MODULE_NAME, BUFFER, NBYTES) ENDIF RETURN END SUBROUTINE SETUP_DIALER_PORT C C This routine is used to setup the autodialer port for the Vadic C model VA3480. C C Terminal: _TXG5: Device_Type: VT100 Owner: Robin Miller C C Terminal Characteristics: C Passall No Echo Type_ahead No Escape C No Hostsync No TTsync Lowercase Tab C No Wrap Scope No Remote No Holdscreen C No Eightbit No Broadcast No Readsync Form C Fulldup No Modem No Local_echo No Autobaud C No Hangup No Brdcstmbx No DMA Altypeahd C Set_speed ANSI_CRT No Regis No Block_mode C Advanced_video No Edit_mode DEC_CRT C C Inputs: C DIALER_RATE The autodialer baud rate. C INCLUDE 'COM.INC/NOLIST' INCLUDE 'TTDEF.FOR/NOLIST' INCLUDE 'TT2DEF.FOR/NOLIST' CHARACTER*(*) MODULE_NAME PARAMETER (MODULE_NAME = 'SETUP_DIALER_PORT') IF (.NOT. DIALER_ASSIGNED) RETURN ! No dialer port yet. C C Get the dialer terminal characteristics. C STATUS = SYS$QIOW (%VAL(DEFN_IN),%VAL(DCHAN_IN), 1 %VAL(IO$_SENSEMODE),DIALER_IOSB,,, 1 DIALER_CHAR,%VAL(12),,,,) IF (CHECK_STATUS (MODULE_NAME, STATUS)) THEN STATUS = DIALER_IOSB(1) CALL CHECK_STATUS (MODULE_NAME, STATUS) ENDIF IF (.NOT. STATUS) RETURN C C Set up new characteristers. C SET_CHAR = TT$M_LOWER + TT$M_MECHFORM + TT$M_MECHTAB + 1 TT$M_NOBRDCST + TT$M_NOECHO + TT$M_PASSALL + 1 TT$M_SCOPE C C Insert the new terminal characteristics. C CALL LIB$INSV (TT$_VT100, 8, 8, DIALER_CHAR(1)) CALL LIB$INSV (511, 16, 16, DIALER_CHAR(1)) CALL LIB$INSV (SET_CHAR, 0, (TT$V_HALFDUP+1), DIALER_CHAR(2)) C C Clear the XOFF (CTRL/S) state to prevent read problems. C DIALER_CHAR(3) = DIALER_CHAR(3) .OR. TT2$M_XON C C Setup the dialer terminal characteristics. C STATUS = SYS$QIOW (%VAL(DEFN_IN),%VAL(DCHAN_IN), 1 %VAL(IO$_SETMODE),DIALER_IOSB,,, 1 DIALER_CHAR,%VAL(12),%VAL(DIALER_RATE),,,) IF (CHECK_STATUS (MODULE_NAME, STATUS)) THEN STATUS = DIALER_IOSB(1) CALL CHECK_STATUS (MODULE_NAME, STATUS) ENDIF RETURN END SUBROUTINE SETUP_DIALER_SPEED C C Get and set the baud rate for the Vadic autodialer port. C INCLUDE 'COM.INC/NOLIST' INCLUDE 'TTDEF.FOR/NOLIST' CHARACTER*(*) BAUDQ, SPEED_DEFAULT PARAMETER (BAUDQ = 'Enter the baud rate for the dialer port (') PARAMETER (SPEED_DEFAULT = '1200') IF (STARTUP) THEN STATUS = GET_SYMBOL ('DIALER_SPEED',DIALER_SPEED,DSPEED_SIZE) ENDIF IF (DSPEED_SIZE .EQ. 0) THEN DIALER_SPEED = SPEED_DEFAULT ! Default remote baud rate DSPEED_SIZE = LEN(SPEED_DEFAULT) ! and the baud rate size. ENDIF IF (STARTUP .AND. STATUS) GO TO 230 ! Go parse the baud rate. 200 CALL PROMPT_USER(BAUDQ//DIALER_SPEED(1:DSPEED_SIZE)//'): ' 1 ,%REF(SCRATCH),LEN(DIALER_SPEED)) IF (BACKUP) RETURN IF (WANTS_HELP) THEN 225 CALL GET_HELP('DIALER_SPEED') GOTO 200 ENDIF C C See if the baud rate is acceptable. C IF (LBYTE_COUNT .GT. 0) THEN DIALER_SPEED = SCRATCH(1:LBYTE_COUNT) DSPEED_SIZE = LBYTE_COUNT ENDIF C C Check for the valid autodialer speeds. C 230 IF (DIALER_SPEED(1:DSPEED_SIZE) .EQ. '110') THEN DIALER_RATE = TT$C_BAUD_110 ELSEIF (DIALER_SPEED(1:DSPEED_SIZE) .EQ. '134') THEN DIALER_RATE = TT$C_BAUD_134 ELSEIF (DIALER_SPEED(1:DSPEED_SIZE) .EQ. '150') THEN DIALER_RATE = TT$C_BAUD_150 ELSEIF (DIALER_SPEED(1:DSPEED_SIZE) .EQ. '300') THEN DIALER_RATE = TT$C_BAUD_300 ELSEIF (DIALER_SPEED(1:DSPEED_SIZE) .EQ. '1200') THEN DIALER_RATE = TT$C_BAUD_1200 ELSEIF (DIALER_SPEED(1:DSPEED_SIZE) .EQ. '2400') THEN DIALER_RATE = TT$C_BAUD_2400 ELSE GO TO 225 ENDIF CALL SETUP_DIALER_PORT() ! Setup dialer characteristics. IF (BACKUP) GO TO 200 ! Request dialer speed again. RETURN END SUBROUTINE WRITE_DIALER (BUFFER, BYTES) C C This subroutine is used to write a buffer to the autodialer. C INCLUDE 'COM.INC/NOLIST' LOGICAL*1 BUFFER(1) INTEGER BYTES, STATUS CHARACTER*(*) MODULE_NAME PARAMETER (MODULE_NAME = 'WRITE_DIALER') CALL WRITE_DEBUG (MODULE_NAME, BUFFER, BYTES) STATUS = SYS$QIOW (%VAL(DEFN_OUT),%VAL(DCHAN_OUT), 1 %VAL(IO$_WRITELBLK + IO$M_NOFORMAT), 1 DIALER_IOSB,,,BUFFER,%VAL(BYTES),,,,) IF (CHECK_STATUS (MODULE_NAME, STATUS)) THEN STATUS = DIALER_IOSB(1) CALL CHECK_STATUS (MODULE_NAME, STATUS) ENDIF RETURN END