C C VAXNET.FOR C C This program is used to communicate with a remote CPU over C an asynchronous interface line. C C Written by: C Robin Miller at Project Software & Development, Inc. 1981 C INCLUDE 'COM.INC/LIST' INCLUDE 'TTDEF.FOR/NOLIST' EXTERNAL RESET_WORLD LOGICAL DUM_LOG, GULP_READ INTEGER*4 BYTES, EXIT_BLOCK(4), SIZE, STATUS, TIMEOUT DATA TIMEOUT /65535/ C C Character strings for questions, help, etc. C CHARACTER*(*) INFOQ, LOGQ, DIALUP_MESSAGE PARAMETER (INFOQ = 'Do you want Help information displayed (No) ? ') PARAMETER (LOGQ = 1 'Write the output from the remote to a log file (No) ? ') PARAMETER (DIALUP_MESSAGE = SS// 1 '*** If using a dialup modem, call the remote system now. ***' 1 //SS) C C VAXNET program starts here. C CALL ASSIGN_LOCAL() ! Assign the local channels. CALL WRITE_VERSION() ! Now write the version number. C C Set up an exit handler. C EXIT_BLOCK(2) = %LOC(RESET_WORLD) EXIT_BLOCK(3) = 1 EXIT_BLOCK(4) = %LOC(LOCAL_STATUS) EXIT_STATUS = SS$_NORMAL ! Initialize the exit status. STATUS = SYS$DCLEXH(EXIT_BLOCK)! Set up exit handler. CALL CHECK_STATUS ('VAXNET(DCLEXH)',STATUS) C C Initialize various flags and counts. C AUTO_REF = .TRUE. ! Enable automatic logfile reformat. BREAK_CHAR(1) = 2 ! Default break character to CTRL/B. BREAK_IS_ENABLED = .FALSE. ! Don't check for break character. DEBUG_MODE = .FALSE. ! Disable debug output. DUMP_MODE = .FALSE. ! Disable dump mode. DUMP_ECHO = .TRUE. ! Echo records dumped to remote. EXITING = .FALSE. ! We're not exiting yet. EXIT_ON_ERROR = .TRUE. ! Exit on TRNLOG/ASSIGN. HANGUP = .TRUE. ! Hangup the modem on exit. HIBERNATING = .FALSE. ! Show we're not hibernating. LOGFILE = .FALSE. ! Default to no log file. MODEM = .FALSE. ! Presume not using a modem. MODEM_ONLINE = .FALSE. ! Autodial modem is offline. NEED_TO_DEAS = .FALSE. ! Don't have remote port yet. REF_WAIT = .TRUE. ! Wait for reformat to complete. REMOTE = .FALSE. ! Presume using a local terminal. SLAVE_MODE = .FALSE. ! Presume using local terminal. STARTUP = .TRUE. ! Show we're in startup code. WATCH_FILES = .TRUE. ! Enable file name watching. C C Setup various defaults. C DISPLAY_SCREEN = .TRUE. ! Enable the screen display. DISPLAY_RECORD = 25 ! Set the default record display. DUMP_TIMEOUT = 3 ! Set the dump timeout count. RETRY_LIMIT = 10 ! Set the default retry limit. TIMEOUT_COUNT = 10 ! Set the read timeout count TYPEAHEAD_LIMIT = 32 ! and the typeahead limit. TTY_WIDTH = 80 ! Set the default terminal width. BITMASK = SEVENBIT_MASK ! Setup the default bit mask. EIGHT_BIT = .FALSE. ! Disable eight bit data. FILE_TYPE = ASCII ! Default to ASCII file type. C C Ask if Help information wanted. C IF (GET_SYMBOL ('VAXNET_INTRO',SCRATCH,SIZE)) THEN GO TO 30 ENDIF CALL WRITE_USER (SS) ! Single space to look nice. 25 CALL PROMPT_USER (INFOQ,%REF(SCRATCH),LEN(SCRATCH)) 30 IF (WANTS_HELP .OR. SCRATCH(1:1) .EQ. 'Y') THEN CALL GET_HELP ('INTRO') ENDIF C C Ask if user wants output from remote to go to log file. C IF (GET_SYMBOL ('VAXNET_LOG',SCRATCH,SIZE)) THEN GO TO 60 ENDIF 50 CALL PROMPT_USER(LOGQ,%REF(SCRATCH),LEN(SCRATCH)) IF (BACKUP) GO TO 25 IF (WANTS_HELP) THEN CALL GET_HELP ('LOG') ! Get help on logging. GO TO 50 ENDIF C C Go open the log file if one was requested. C 60 IF (SCRATCH(1:1) .NE. 'Y') GO TO 75 IF (.NOT. LOGFILE) THEN CALL ENABLE_LOGFILE() ! Go enable a logfile. IF (BACKUP) GO TO 50 ENDIF C C Request the remote system type. C 75 CALL SETUP_SYSTEM() ! Set up the system type. IF (BACKUP) GO TO 50 C C Request the interrupt character. C 85 CALL SETUP_INTERRUPT() ! Set up the interrupt character. IF (BACKUP) GO TO 75 C C Request the remote port to use. C 100 CALL GET_PORT() ! Get the remote port. IF (BACKUP) GO TO 85 C C Request the remote baud rate. C 125 CALL SETUP_BAUDRATE ! Setup the remote baud rate. IF (BACKUP) GO TO 100 C C If the remote port is setup MODEM, get the modem type. C 200 IF (MODEM) THEN CALL GET_MODEM_TYPE() ! Get autodial modem type. IF (BACKUP) GO TO 125 ENDIF C C If using an autodial modem, get phone number. C IF (AUTODIAL) THEN CALL GET_PHONE_NUMBER() ! Get the phone number to dial. IF (BACKUP) GO TO 200 ENDIF C C If the symbol BREAK_CHAR exists, we'll call the routine to C to setup the break character. C IF ( GET_SYMBOL ('BREAK_CHAR', SCRATCH, SIZE) ) THEN CALL SETUP_BREAK() ! Setup the BREAK character. ENDIF C C If symbols answered all or some of the questions, display C a status report so the user knows what the answers were. C IF (SYMBOL_COUNT .GT. 0) THEN CALL SHOW_STATUS(.FALSE.) ! Display a short status report. ENDIF C C Disable Control/C traps. C IF (.NOT. BATCH_MODE) THEN LOCAL_STATUS = SYS$QIOW(,%VAL(LCHAN_IN), 1 %VAL(IO$_SETMODE + IO$M_CTRLCAST),,,,,,,,,) CALL CHECK_STATUS ('VAXNET(SETMODE)',LOCAL_STATUS) CALL REENABLE() ! Enable CTRL/C's. ENDIF C C If the user has the PSWAPM privilege, we will disable swapping. C Swapping must be disabled if VAXNET is getting hung in hibernate C or an MWAIT state if SDA is to examine its process header. C CALL SYS$SETSWM(%VAL(1)) ! Disable process swapping. C C If using an autodial modem, dial the phone number. C IF (AUTODIAL) THEN CALL DIAL_MODEM() ! Dial the phone number. ENDIF C C Special modem code. C IF (CROSS_FILE) THEN IF (AUTODIAL) THEN IF (MODEM_ONLINE) THEN CALL WAIT_CROSSFILE() ENDIF ELSE CALL WAIT_CROSSFILE() ENDIF ELSEIF (MODEM) THEN IF (.NOT. AUTODIAL) THEN IF (BAUD_RATE .LE. TT$C_BAUD_1200) THEN CALL WRITE_USER(DIALUP_MESSAGE) ENDIF ENDIF ENDIF C C Attempt automatic login. C IF (AUTODIAL .AND. MODEM_ONLINE) THEN IF (.NOT. AUTO_LOGIN()) THEN IF (BATCH_MODE) THEN CALL FINISH() ELSE GO TO 500 ! Skip the VAXNET command symbol. ENDIF ENDIF ENDIF C C Setup the local terminal characteristics. This routine also C resets the DUMP_ECHO and DISPLAY_SCREEN flags if the local C terminal is not a scope. C CALL SETUP_LOCAL(.FALSE.) ! Set local for normal mode. C C Check for a VAXNET command to execute. C IF (GET_SYMBOL ('VAXNET_CMD', SCRATCH, SIZE)) THEN CALL CHECK_CMD (SCRATCH, DUM_LOG, SIZE) ENDIF 500 STARTUP = .FALSE. ! Done with startup code. C C If the symbol TYPEAHEAD_LIMIT is defined, we'll change the C default typeahead limit used during remote reads. This is C the value we allow the typeahead buffer to fill to before C issuing our read function. C IF (GET_SYMBOL ('TYPEAHEAD_LIMIT',SCRATCH,SIZE)) THEN CALL CVT_DTB (SCRATCH(1:SIZE),TYPEAHEAD_LIMIT) ENDIF C C The symbol DISPLAY_RECORD can be defined to override the default C record display used in file transmissions. C IF (GET_SYMBOL ('DISPLAY_RECORD',SCRATCH,SIZE)) THEN CALL CVT_DTB (SCRATCH(1:SIZE),DISPLAY_RECORD) IF (DISPLAY_RECORD .EQ. 0) THEN DISPLAY_SCREEN = .FALSE. ! Disable screen display. ENDIF ENDIF C C If batch mode, we never enter the interactive loop. C IF (BATCH_MODE) THEN IF (AUTODIAL .AND. MODEM_ONLINE) THEN CALL GET_COMMAND() ! Get a VAXNET command. ENDIF IF (.NOT. SLAVE_MODE) THEN CALL FINISH() ! Exit if not slave mode. ENDIF ENDIF IF (CONTROLC_TYPED) THEN CALL GET_COMMAND() ! Go request a command. ENDIF C C Main Loop. C C After the local and remote reads are enabled, all we do is C hibernate. All further processing is done at AST level. C C We get woken up for two reasons. We get woken up when the C user types the interrupt character, and also when a remote C or local read completes. C 1000 INTERRUPT_TYPED = .FALSE. ! Show interrupt not typed. SUSPEND_OUTPUT = .FALSE. ! Show output isn't suspended. CALL SETUP_LOCAL(.TRUE.) ! Setup local for interactive. CALL SETUP_REMOTE(.TRUE.) ! Setup remote for interactive. XMITTER_BUSY = .FALSE. ! Show transmitter isn't busy. RECEIVER_BUSY = .FALSE. ! Show the receiver isn't busy. C C Disable resource wait mode so system services return immediatly C with a status code if a resource is unavailable. This prevents C us from entering an MWAIT state which prevents our process from C being deleted with the "STOP/ID=proc_id" command. To free the C terminal port, the system has to be rebooted. C C Although the rewrite of the TTYREAD and TTYWRITE modules appear C to prevent exceeding the buffered I/O quota (and MWAIT state), C this code will remain for a short time. C C On VMS V3.5, the delete process is supposed to be an "Atomic" C operation. For this reason, the resource wait is left enabled. C C*** CALL SYS$SETRWM(%VAL(1)) ! Disable resource wait mode. 1100 IF (INTERRUPT_TYPED) THEN C*** CALL SYS$SETRWM(%VAL(0)) ! Reenable resource wait mode. CALL SETUP_LOCAL(.FALSE.) ! We're leaving interactive mode. CALL GET_COMMAND() ! Go request a command. GO TO 1000 ! Get the reads started again. ENDIF C C If we're not in slave mode, we startup our normal reads. C IF (.NOT. SLAVE_MODE) THEN IF (.NOT. XMITTER_BUSY) THEN CALL LOCAL_READ() ! Startup another local read. ENDIF IF (.NOT. RECEIVER_BUSY) THEN CALL REMOTE_READ() ! Startup another remote read. ENDIF ENDIF C C If slave mode is enabled, then all we do is read data from the C remote and write it to the log file. This mode allows us to run C in either a sub-process or in batch mode accepting any data the C remote outputs. In this mode, VAXNET should be aborted with a C program using force exit system service so our exit handler gets C a chance to close the log file. If the process is simply stopped, C a portion of the log file will not be written. C 1200 IF (SLAVE_MODE) THEN IF ( GULP_READ (RBUFFER(1), RDESC, TIMEOUT) ) THEN BYTES = RDESC(1) ! Copy the remote byte count. CALL WRITE_LOGFILE (RBUFFER(1), BYTES) CALL FLUSH_LOGFILE() ! Force it to the disk file. ENDIF GO TO 1200 ! Loop forever ... ENDIF C C The local and/or remote read can complete immediatly after the C read is issued. If this happens, then we don't hibernate so the C read can be reactivated. C IF (XMITTER_BUSY .AND. RECEIVER_BUSY) THEN HIBERNATING = .TRUE. ! Show we are hibernating. STATUS = SYS$HIBER() ! Wait till something happens. ENDIF GO TO 1100 ! Go see who woke us up. END SUBROUTINE ASSIGN_LOCAL C C This routine is used to assign the local input and output channels. C INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) SYSCOM, SYSIN, SYSOUT PARAMETER (SYSCOM = 'SYS$COMMAND') PARAMETER (SYSIN = 'SYS$INPUT') PARAMETER (SYSOUT = 'SYS$OUTPUT') LOGICAL GETDVI INTEGER*4 STATUS, SIZE C C Allocate some event flags for QIO's. C CALL GET_EFN (LEFN_IN) ! Local input event flag. CALL GET_EFN (LEFN_OUT) ! Local output event flag. CALL GET_EFN (REFN_IN) ! Remote input event flag. CALL GET_EFN (REFN_OUT) ! Remote output event flag. CALL GETJPI() ! See if we're in batch mode. C C In batch mode, we use FORTRAN I/O since we don't have a terminal C to use the normal QIO's. C IF (BATCH_MODE) THEN CALL OPEN_FILE (SYSIN, IN_UNIT) ! Open SYS$INPUT CALL OPEN_FILE (SYSOUT, OUT_UNIT) ! Open SYS$OUTPUT DISPLAY_SCREEN = .FALSE. ! Disable the screen display. RETURN ENDIF C C If not in batch mode, translate SYS$COMMAND and assign a channel C for QIO's. SYS$COMMAND is used instead of SYS$INPUT since this C logical points to the terminal when running interactive command C files. C LOCAL_SIZE = LEN (SYSOUT) ! Length of SYS$OUTPUT. LOCAL_DEVICE = SYSOUT ! Copy SYS$OUTPUT for translation. CALL TRNLOG (LOCAL_DEVICE, LOCAL_SIZE) ! Translate SYS$OUTPUT. STATUS = SYS$ASSIGN (LOCAL_DEVICE(1:LOCAL_SIZE),LCHAN_OUT,,) IF (.NOT. STATUS) GO TO 9900 C C Now do SYS$COMMAND. C LOCAL_SIZE = LEN (SYSCOM) ! Length of SYS$COMMAND. LOCAL_DEVICE = SYSCOM ! Copy SYS$COMMAND for translation. CALL TRNLOG (LOCAL_DEVICE, LOCAL_SIZE) ! Translate SYS$COMMAND. STATUS = SYS$ASSIGN (LOCAL_DEVICE(1:LOCAL_SIZE),LCHAN_IN,,) IF (.NOT. STATUS) GO TO 9900 C C If SYS$COMMAND is not assigned to a terminal, we open SYS$INPUT so C we can prompt the user, and force batch mode operation to prevent us C from entering the interactive loop in the mainline. That loop calls C routines which uses QIO's to the terminal. C SYSCOM_TERM = GETDVI(LCHAN_IN) ! Set the terminal status. IF (.NOT. SYSCOM_TERM) THEN CALL OPEN_FILE (SYSIN, IN_UNIT) ! Open SYS$INPUT BATCH_MODE = .TRUE. ! Force batch mode operation. ENDIF C C If SYS$OUTPUT is not assigned to a terminal, we open SYS$OUTPUT so C messages can be written somewhere. Otherwise, if SYS$COMMAND is a C terminal, we assign the local output channel to it so we can still C enter the normal interactive loop in the mainline. C SYSOUT_TERM = GETDVI(LCHAN_OUT) ! Set the terminal status. IF (.NOT. SYSOUT_TERM) THEN IF (SYSCOM_TERM) THEN STATUS = SYS$ASSIGN (LOCAL_DEVICE(1:LOCAL_SIZE),LCHAN_OUT,,) ELSE CALL OPEN_FILE (SYSOUT, OUT_UNIT)! Open SYS$OUTPUT ENDIF ENDIF RETURN C C Can't assign SYS$COMMAND or SYS$OUTPUT. C 9900 CALL CHECK_STATUS (MODULE_NAME, STATUS) CALL SYS$EXIT (%VAL(STATUS)) ! Exit if we return ... END SUBROUTINE OPEN_FILE (DEVICE, UNIT) C C Common routine to open a file for FORTRAN I/O. C INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) DEVICE INTEGER*4 UNIT OPEN (UNIT=UNIT, TYPE='UNKNOWN', NAME=DEVICE, 1 FORM='FORMATTED', RECORDTYPE='VARIABLE', 1 RECORDSIZE=OUT_SIZE, CARRIAGECONTROL='NONE', 1 ORGANIZATION='SEQUENTIAL') RETURN END