C C Utility routines for VAXNET. C INTEGER FUNCTION CHECK_TYPEAHEAD C C This routine checks for characters in the remote typeahead C buffer. It passes back the typeahead count (if any). C INCLUDE 'COM.INC/NOLIST' INTEGER*4 STATUS, SYS$QIOW STATUS = SYS$QIOW(%VAL(REFN_IN),%VAL(RCHAN_IN), 1 %VAL(IO$_SENSEMODE + IO$M_TYPEAHDCNT), 1 RIOSB,,,TYPEAHEAD_COUNT,,,,,) CALL CHECK_STATUS('CHECK_TYPEAHEAD',STATUS) CHECK_TYPEAHEAD = TYPEAHEAD_COUNT(1) ! Pass back the count. RETURN END SUBROUTINE CLEAR_TYPEAHEAD C C Clears the typeahead buffer on the remote channel. C INCLUDE 'COM.INC/NOLIST' INTEGER*4 STATUS, SYS$QIOW STATUS = SYS$QIOW(%VAL(REFN_IN),%VAL(RCHAN_IN), 1 %VAL(IO$_READLBLK + IO$M_PURGE), 2 RIOSB,,,RBUFFER,%VAL(0),,,,) CALL CHECK_STATUS('CLEAR_TYPEAHEAD',STATUS) RETURN END LOGICAL FUNCTION CVT_DTB(STR,NUM) C C This routine is used to convert an ASCII string of numbers to C an integer. C C Inputs: C STR - string descriptor. C NUM - integer to return number to. C C Outputs: C .TRUE./.FALSE. = success/failure. C IMPLICIT NONE CHARACTER*(*) STR INTEGER*4 NUM, LIB$CVT_DTB CVT_DTB = LIB$CVT_DTB(%VAL(LEN(STR)),%REF(STR),NUM) RETURN END SUBROUTINE CVT_CTRL(BUFF,SIZE) C C This routine searches for and converts "^char" to control C characters. The original buffer is converted (if necessary) C and the new buffer size is passed back in SIZE. C IMPLICIT NONE LOGICAL*1 BUFF(1) INTEGER*4 I, O, SIZE I = 1 ! Input buffer index. O = 1 ! Output buffer index. 100 IF (I .GT. SIZE) THEN ! If finished, BUFF(O) = 0 ! Terminate the buffer. SIZE = O - 1 ! And pass back new size. RETURN ENDIF BUFF(O) = BUFF(I) ! Copy the next character. IF (BUFF(O) .EQ. '^') THEN ! If its an "^", I = I + 1 ! Point to the next BUFF(O) = BUFF(I)-64 ! and convert to ctrl/char. ENDIF I = I + 1 ! Next input index. O = O + 1 ! Next output index. GO TO 100 ! Loop until we're done. END SUBROUTINE ENABLE_OUT_OF_BAND C C This routine enables Out-Of-Band AST's for the local terminal to C be used when in file transmission mode. The ESCape character is C then used to display the single line status report instead of C after each record transferred. C INCLUDE 'COM.INC/NOLIST' EXTERNAL REPORT_RECORD INTEGER*4 OUTBAND_MASK(2) IF (.NOT. BATCH_MODE) THEN CALL LIB$INSV(1,ESCAPE,1,OUTBAND_MASK(2)) STATUS = SYS$QIOW(%VAL(LEFN_IN),%VAL(LCHAN_IN), 1 %VAL(IO$_SETMODE + IO$M_OUTBAND),,,, 1 REPORT_RECORD,OUTBAND_MASK,,,,) CALL CHECK_STATUS('OUT_OF_BAND',STATUS) ENDIF RETURN ENTRY DISABLE_OUT_OF_BAND IF (.NOT. BATCH_MODE) THEN STATUS = SYS$QIOW(%VAL(LEFN_IN),%VAL(LCHAN_IN), 1 %VAL(IO$_SETMODE + IO$M_OUTBAND),,,,,,,,,) ENDIF RETURN END INTEGER FUNCTION FIND_SUBSTRING (SUB,S) C C This routine is used to search for a substring in a string. C C Inputs: C SUB and S are character string descriptors. C C Outputs: C Returns position of substring or 0 if not found. C IMPLICIT NONE CHARACTER*(*) SUB, S INTEGER*4 INDEX FIND_SUBSTRING = INDEX (S, SUB) ! Pass back the position. RETURN END INTEGER FUNCTION GET_EFN(EVENT_FLAG) C C Get an event flag. C IMPLICIT NONE INTEGER*4 EVENT_FLAG, CHECK_STATUS, LIB$GET_EF, STATUS STATUS = LIB$GET_EF(EVENT_FLAG) ! Local input event flag. CALL CHECK_STATUS('LIB$GET_EF',STATUS) RETURN END LOGICAL FUNCTION GETDVI (CHAN) C C This subroutine is used to get device information about the C specified channel and pass back a status stating whether this C device is assigned to a terminal or not. C C Inputs: C CHAN = Channel to get information on. C C Outputs: C .TRUE./.FALSE. = Terminal/Not a terminal. C IMPLICIT INTEGER*4 (A-Z) INCLUDE '($DCDEF)/NOLIST' INCLUDE 'DVIDEF/NOLIST' CHARACTER*(*) MODULE_NAME PARAMETER (MODULE_NAME = '$GETDVI') LOGICAL*1 ITEMS(16) INTEGER*2 CLASS_LEN, CLASS_CODE INTEGER*4 CHAN, STATUS INTEGER*4 CLASS_ADDR, CLASS_RET, CLASS_STATUS, CLASS_SIZE EQUIVALENCE (CLASS_LEN,ITEMS(1)) ! Length of status buffer. EQUIVALENCE (CLASS_CODE,ITEMS(3)) ! Store JPI code here. EQUIVALENCE (CLASS_ADDR,ITEMS(5)) ! Address of status longword. EQUIVALENCE (CLASS_RET,ITEMS(9)) ! Address of return length. EQUIVALENCE (END_ITEMS,ITEMS(13)) ! End of items list. GETDVI = .FALSE. ! Initialize to bad return. CLASS_LEN = 4 ! Length of status longword. CLASS_CODE = DVI$_DEVCLASS ! Return CLASS status flags. CLASS_ADDR = %LOC(CLASS_STATUS) ! Address of status longword. CLASS_RET = %LOC(CLASS_SIZE) ! Address to store return value END_ITEMS = 0 ! Terminate the items list. C SYS$GETDVI ([efn], [chan], [devnam], itmlst, [iosb], [astadr], [astprm],) STATUS = SYS$GETDVI (,%VAL(CHAN),,ITEMS,,,,) IF (STATUS) THEN IF ((CLASS_STATUS .AND. DC$_TERM) .NE. 0) THEN GETDVI = .TRUE. ! Channel assigned to terminal. ENDIF ELSE CALL CHECK_STATUS (MODULE_NAME, STATUS) ENDIF RETURN END SUBROUTINE GETJPI C C This subroutine is used to get our job/process information to C determine if we are running in batch mode. C INCLUDE 'COM.INC/NOLIST' INCLUDE '($JPIDEF)/NOLIST' CHARACTER*(*) MODULE_NAME PARAMETER (MODULE_NAME = '$GETJPI') PARAMETER (PCB$M_BATCH = '4000'X) ! Batch mode = bit 14 (0E). LOGICAL*1 ITEMS(16) INTEGER*2 PROCESS_LEN, PROCESS_CODE INTEGER*4 PROCESS_ADDR, PROCESS_RET, PROCESS_STATUS, PROCESS_SIZE EQUIVALENCE (PROCESS_LEN,ITEMS(1)) ! Length of status buffer. EQUIVALENCE (PROCESS_CODE,ITEMS(3)) ! Store JPI code here. EQUIVALENCE (PROCESS_ADDR,ITEMS(5)) ! Address of status longword. EQUIVALENCE (PROCESS_RET,ITEMS(9)) ! Address of return length. EQUIVALENCE (END_ITEMS,ITEMS(13)) ! End of items list. PROCESS_LEN = 4 ! Length of status longword. PROCESS_CODE = JPI$_STS ! Return process status flags. PROCESS_ADDR = %LOC(PROCESS_STATUS) ! Address of status longword. PROCESS_RET = %LOC(PROCESS_SIZE) ! Address to store user name size. END_ITEMS = 0 ! Terminate the items list. BATCH_MODE = .FALSE. ! Presume not in batch mode. STATUS = SYS$GETJPI(,,,ITEMS,LIOSB,,) IF (STATUS) THEN IF ((PROCESS_STATUS .AND. PCB$M_BATCH) .NE. 0) THEN BATCH_MODE = .TRUE. ENDIF ELSE CALL CHECK_STATUS (MODULE_NAME, STATUS) ENDIF RETURN END SUBROUTINE SET_TERMINATOR(PTR,TBL,TBYTE) C C This routine is used to set the terminator character for reads C in the terminator table. This table which has 256 bits for C this entire character set, must have a bit set for each character C used to terminate a read (i.e., ). Currently, I presume C only one character is used to terminate the read (table is cleared). C C Inputs: C PTR - address of table pointer. C TBL - address of terminator table. C TBYTE - byte to set into table. C IMPLICIT INTEGER*4 (A-Z) INTEGER*4 PTR(2), TBL(8) LOGICAL*1 TBYTE(1) DO 100 I=1,8 TBL(I) = 0 ! Clear the entire table. 100 CONTINUE I = ((TBYTE(1)/32) + 1) ! Offset into table. BIT = (TBYTE(1) - ((I-1)*32)) ! Bit to set in longword. PTR(1) = I*4 ! Terminator table size. PTR(2) = %LOC(TBL) ! Fill in the table address. CALL LIB$INSV(1,BIT,1,TBL(I)) ! Set the terminator bit. RETURN END SUBROUTINE SET_TERMS(PTR,TBL,TBYTE) C C This routine is used to set the terminator character for reads C in the terminator table. This table which has 256 bits for C this entire character set, must have a bit set for each character C used to terminate a read (i.e., ). This entry is called C to ADD a new byte to the table after it has been cleared, in C which case multiple characters may terminate reads. C C Inputs: C PTR - address of table pointer. C TBL - address of terminator table. C TBYTE - byte to set into table. C IMPLICIT INTEGER*4 (A-Z) INTEGER*4 PTR(2), TBL(8) LOGICAL*1 TBYTE(1) I = ((TBYTE(1)/32) + 1) ! Offset into table. BIT = (TBYTE(1) - ((I-1)*32)) ! Bit to set in longword. PTR(1) = I*4 ! Terminator table size. PTR(2) = %LOC(TBL) ! Fill in the table address. CALL LIB$INSV(1,BIT,1,TBL(I)) ! Set the terminator bit. RETURN END SUBROUTINE SHOW_SIGNALS (DO_REMOTE) C C This routine is used to display the modem signals. The sense C mode QIO returns the following in the first longword: C C 31 24|23 16|15 8|7 0 C +-----------------+---------------+--------------+--------------+ C | | Receive modem | | Cont. type | C +-----------------+---------------+--------------+--------------+ C INCLUDE 'COM.INC/NOLIST' INCLUDE '($TTDEF)/NOLIST' INCLUDE '($DCDEF)/NOLIST' LOGICAL DO_REMOTE INTEGER*2 SENSE_BLOCK(4) INTEGER DEVICE_SIZE, STATUS CHARACTER*10 DEVICE_TYPE CHARACTER*(*) MODULE_NAME PARAMETER (MODULE_NAME = 'SHOW_SIGNALS') CHARACTER*(*) CTS_MSG, DSR_MSG, SRCV_MSG, RNG_MSG, CO_MSG PARAMETER (CTS_MSG = 'Clear To Send (CTS)') PARAMETER (DSR_MSG = 'Data Set Ready (DSR)') PARAMETER (SRCV_MSG = 'Secondary receive data') PARAMETER (RNG_MSG = 'The calling indicator (RING)') PARAMETER (CO_MSG = 'The line signal detector (CARRIER)') C C Read the modem signals for the local or remote terminal. C IF (DO_REMOTE) THEN STATUS = SYS$QIOW (%VAL(REFN_IN),%VAL(RCHAN_IN), 1 %VAL(IO$_SENSEMODE + IO$M_RD_MODEM), 1 RIOSB,,,SENSE_BLOCK,,,,,) ELSE STATUS = SYS$QIOW (%VAL(LEFN_IN),%VAL(LCHAN_IN), 1 %VAL(IO$_SENSEMODE + IO$M_RD_MODEM), 1 RIOSB,,,SENSE_BLOCK,,,,,) ENDIF IF (.NOT. CHECK_STATUS (MODULE_NAME, STATUS) ) RETURN STATUS = RIOSB(1) ! Copy the I/O status word. IF (.NOT. CHECK_STATUS (MODULE_NAME, STATUS) ) RETURN C C Determine the type of controller. C IF (SENSE_BLOCK(1) .EQ. DT$_DZ11) THEN DEVICE_TYPE = 'DZ11' DEVICE_SIZE = 4 ELSE IF (SENSE_BLOCK(1) .EQ. DT$_DZ32) THEN DEVICE_TYPE = 'DZ32' DEVICE_SIZE = 4 ELSE IF (SENSE_BLOCK(1) .EQ. DT$_DMF32) THEN DEVICE_TYPE = 'DMF32' DEVICE_SIZE = 5 ELSE DEVICE_TYPE = 'Unknown' DEVICE_SIZE = 7 ENDIF C C Now display the modem signals. C CALL WRITE_USER (SS//'Incoming Modem Signals:'//DS) C C I've modified the following to display signals asserted/not asserted C to clarify which signals we're actually looking at. C IF ((SENSE_BLOCK(2) .AND. TT$M_DS_CTS) .NE. 0) THEN CALL SHOW_ASSERTED (CTS_MSG, .TRUE.) ELSE CALL SHOW_ASSERTED (CTS_MSG, .FALSE.) ENDIF IF ((SENSE_BLOCK(2) .AND. TT$M_DS_DSR) .NE. 0) THEN CALL SHOW_ASSERTED (DSR_MSG, .TRUE.) ELSE CALL SHOW_ASSERTED (DSR_MSG, .FALSE.) ENDIF IF ((SENSE_BLOCK(2) .AND. TT$M_DS_SECREC) .NE. 0) THEN CALL SHOW_ASSERTED (SRCV_MSG, .TRUE.) ELSE CALL SHOW_ASSERTED (SRCV_MSG, .FALSE.) ENDIF IF ((SENSE_BLOCK(2) .AND. TT$M_DS_RINGR) .NE. 0) THEN CALL SHOW_ASSERTED (RNG_MSG, .TRUE.) ELSE CALL SHOW_ASSERTED (RNG_MSG, .FALSE.) ENDIF IF ((SENSE_BLOCK(2) .AND. TT$M_DS_CARRIER) .NE. 0) THEN CALL SHOW_ASSERTED (CO_MSG, .TRUE.) ELSE CALL SHOW_ASSERTED (CO_MSG, .FALSE.) ENDIF C IF (SENSE_BLOCK(2) .EQ. 0) THEN C CALL WRITE_USER ('There are no modem signals asserted.'//SS) C ENDIF C C Display the local/remote terminal port and the controller type. C IF (DO_REMOTE) THEN CALL WRITE_USER ('The remote port ('//REMOTE_DEVICE(1:REMOTE_SIZE)) ELSE CALL WRITE_USER ('The local port ('//LOCAL_DEVICE(1:LOCAL_SIZE)) ENDIF CALL WRITE_USER (') is attached to a '//DEVICE_TYPE(1:DEVICE_SIZE)// 1 ' controller.'//SS) CALL WRITE_USER (SS) RETURN END SUBROUTINE SHOW_ASSERTED (SIGNAL_NAME, SIGNAL_ASSERTED) C C Common subroutine to display whether a modem signal is asserted C or not asserted. C IMPLICIT NONE LOGICAL SIGNAL_ASSERTED CHARACTER*(*) SIGNAL_NAME CHARACTER*(*) IS_ASSERTED, IS_NOT_ASSERTED, SS PARAMETER (SS = CHAR(13)//CHAR(10)) PARAMETER (IS_ASSERTED = ' is asserted.'//SS) PARAMETER (IS_NOT_ASSERTED = ' is NOT asserted.'//SS) IF (SIGNAL_ASSERTED) THEN CALL WRITE_USER (SIGNAL_NAME//IS_ASSERTED) ELSE CALL WRITE_USER (SIGNAL_NAME//IS_NOT_ASSERTED) ENDIF RETURN END SUBROUTINE TRNLOG (DEVICE, SIZE) C C This routine is used to translates a logical name to a physical C name. C C Inputs: C DEVICE = Logical name to translate. C SIZE = Size of logical name. C C Outputs: C DEVICE = The translated logical name. C SIZE = Size of the physical name. C IMPLICIT INTEGER*4 (A-Z) INCLUDE '($SSDEF)/NOLIST' CHARACTER*(*) DEVICE INTEGER SIZE, STATUS 100 STATUS = SYS$TRNLOG (DEVICE(1:SIZE),SIZE,DEVICE,,,) IF (STATUS .NE. SS$_NOTRAN) GO TO 100 C C Note that $TRNLOG puts a 4-byte header on the translations of C SYS$COMMAND, SYS$INPUT, and SYS$OUTPUT. This header only exists C if the first byte starts with an escape character. C IF (DEVICE(1:1) .EQ. CHAR(27)) THEN DEVICE(1:) = DEVICE(5:SIZE) SIZE = (SIZE - 4) ! Adjust the device size. ENDIF RETURN END SUBROUTINE WAITABIT(SECONDS) C C This subroutine just waits a little then returns. C INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) SECONDS INTEGER*4 DELTA(2) STATUS = SYS$BINTIM('0 00:00:'//SECONDS,DELTA) IF (.NOT. CHECK_STATUS('WAITABIT(BINTIM)',STATUS)) RETURN STATUS = SYS$SETIMR(%VAL(TIMER_EFN),DELTA,,) IF (.NOT. CHECK_STATUS('WAITABIT(SETIMR)',STATUS)) RETURN STATUS = SYS$WAITFR(%VAL(TIMER_EFN)) CALL CHECK_STATUS('WAITABIT(WAITFR)',STATUS) C STATUS = SYS$SCHDWK(,,DELTA,,) ! Schedule wakeup. C IF (.NOT. CHECK_STATUS('WAITABIT(SCHDWK)',STATUS)) RETURN C STATUS = SYS$HIBER() ! Go into hibernation. RETURN END