!File: LABIOSTAT.FOR ! Version 'V04-000' ! !**************************************************************************** !* * !* COPYRIGHT (c) 1978, 1980, 1982, 1984 BY * !* DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. * !* ALL RIGHTS RESERVED. * !* * !* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * !* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE * !* INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * !* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * !* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * !* TRANSFERRED. * !* * !* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * !* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * !* CORPORATION. * !* * !* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS * !* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. * !* * !* * !**************************************************************************** ! Program LABIO_STATUS ! This is a utility routine for the LABIO system. It displays ! the status of all 16 channels of the A/D. It assumes that ! the terminal is a VT52 or an equivalent, e.g VT100 in VT52 mode. ! The display is update once every 1-9 seconds. Default is ! one second. There are 5 commands associated with the program ! ! C - display status of 16 channels ! P - display status by process PID ! H - display help frame (timeouts after 1 min.) ! E - Exit to VMS DCL ! Digit(1-9) Change cycle time. ! ! The key pad can also be used to enter commands. The special function ! Keys on the VT52 or VT100 correspond to the first 4 commands (3 on VT52). ! ! Typing ANY key will cause a display refresh. Include 'LABCHNDEF.FOR' Character*10 STATUS(4) Character*8 XTIME Character*9 XDATE Parameter COMMAND_MAX = 4 Character*1 COMMAND,COMMAND_TABLE(COMMAND_MAX,2),ESCAPE,TERMINATOR Character*63 COMMAND_DEV External SS$_NOTRAN,SS$_NORMAL,SS$_PARTESCAPE External IO$M_CVTLOW,IO$M_NOECHO,IO$M_TIMED,IO$_READVBLK,IO$M_PURGE Logical SUCCESS,SYS$QIOW,SYS$ASSIGN Integer CHANNEL,DISPLAY_FLAG,OLD_DISPLAY,COMMAND_CHAN Integer DEF_TIME_OUT,TIME_OUT Byte ERASE_SCREEN(2),HOME(2),ERASE_LINE(2),VT52_MODE(7) Integer*2 IO_STATUS(4),CHAR_COUNT Equivalence (ESCAPE,HOME),(CHAR_COUNT,IO_STATUS(2)) ! ! VT52 control ESCAPE Sequences ! Data HOME,ERASE_SCREEN,ERASE_LINE 1 /'33'O,'H','33'O,'J','33'O,'K'/ ! ! VT100 control ESCAPE sequences ! This ESC seq places a VT100 in VT52 mode ! Data VT52_MODE/'33'O,'[','?','2','l','33'O,']'/ Data STATUS/'Unknown ','Inactive',' Active ',' '/ Data COMMAND_TABLE/'C','P','E','H','P','Q','S','R'/ Data DISPLAY_FLAG,ERASE_FLAG /1,.TRUE./ Data DEF_TIME_OUT /1/ ! ! Map to the GLOBAL DATA section created by the I/O program ! Call LABIO_INIT(0) ! ! Place VT100's in VT52 mode ! Type 500, VT52_MODE ! ! Initialize Command input channel ! We will read the command via a QIOW with a 1 sec timeout ! Commands are single character, to simplify matters we will ! read with no echo and convert lower to upper case. ! Call SYS$ASSIGN( 'TT',COMMAND_CHAN,,,) QIO_READ = %Loc(IO$M_NOECHO) + %Loc(IO$M_CVTLOW) + %Loc(IO$M_TIMED) 1 + %Loc(IO$_READVBLK) TT_PURGE = %Loc(IO$M_PURGE) Go To 25 ! Display Something ! ! Get a command from the user, but only wait a short time (TIME_OUT) ! so we can update the screen. The input buffer is purged if a command ! was decode on the last read. (Prevents unnecessary erase loops) ! 20 DISPLAY_FLAG = OLD_DISPLAY !Default is last display TIME_OUT = DEF_TIME_OUT !Default time out 21 TABLE_INDEX = 1 !Assume no escape sequence 22 Call SYS$QIOW(,%Val(COMMAND_CHAN),%Val(QIO_READ+PURGE), 1 IO_STATUS,,,%Ref(COMMAND),%Val(1),%Val(TIME_OUT),,,,) PURGE = 0 ! If escape seq., set command table pointer to second table and ! get character following escape. TERMINATOR = Char( IO_STATUS(3) ) If( TERMINATOR .ne. ESCAPE ) Go To 23 TABLE_INDEX = 2 Go To 22 !Get char following escape 23 If( CHAR_COUNT .ne. 0) Then ! Char count not 0 ! Check for char 1-9 If( COMMAND .ge. '0' .and. COMMAND .le. '9' ) Then DEF_TIME_OUT = Ichar ( COMMAND ) - Ichar( '0' ) ! Not 1-9 try a command. Else ERASE_FLAG = .true. ! Screen erase Do 24 I = 1,COMMAND_MAX If( COMMAND .eq. COMMAND_TABLE(I,TABLE_INDEX)) DISPLAY_FLAG = I 24 Continue End If PURGE = TT_PURGE !Purge the input buffer next time End If ! ! Get date and time, then dispatch to display routine ! 25 Call DATE (XDATE) Call TIME (XTIME) Go to (50,60,99,40) DISPLAY_FLAG ! ! Refresh the screen (Erase and Redisplay) ! 30 DISPLAY_FLAG = OLD_DISPLAY !Redisplay last display ERASE_FLAG = .true. Go To 25 ! ! Display the HELP frame, set the temporary time-out to 1 minute ! 40 Type 600, HOME,ERASE_SCREEN !Display the help frame TIME_OUT = 60 !Give the user 1 minute to read it DISPLAY_FLAG = OLD_DISPLAY !When it times out, default old ERASE_FLAG = .true. Go To 21 ! ! Generate the Status Line for each A/D channel ! 50 If ( ERASE_FLAG ) Type 300, HOME,ERASE_SCREEN Type 100, HOME,XTIME,XDATE CHANNEL_COUNT = 0 Do 51 CHANNEL = 1,MAX_AD_CHANNEL If( AD_BLOCK(2,CHANNEL) .ne. 0 ) Then !If allocated, display info Type 200,CHANNEL, STATUS(AD_BLOCK(1,CHANNEL)+1), 1 (AD_BLOCK(J,CHANNEL), J = 2,6 ) CHANNEL_COUNT = CHANNEL_COUNT + 1 Else !If not allocated, say so Type 900, CHANNEL,'',ERASE_LINE End If 51 Continue PID_COUNT = 0 Do 52 PID_INDEX = 1, MAX_PID PID = CONNECT_BLOCK(PID_INDEX,1) If ( PID .ne. 0 ) PID_COUNT = PID_COUNT + 1 52 Continue Type 400,ERASE_LINE, PID_COUNT,CHANNEL_COUNT OLD_DISPLAY = DISPLAY_FLAG ERASE_FLAG = .false. Go to 20 ! ! Status display via process (PID) ! 60 If ( ERASE_FLAG ) Type 300, HOME,ERASE_SCREEN Type 100, HOME,XTIME,XDATE PID_COUNT = 0 ! Number of connected processess CHANNEL_COUNT = 0 ! Number of allocated channels Do 61 PID_INDEX = 1, MAX_PID PID = CONNECT_BLOCK(PID_INDEX,1) If ( PID .ne. 0 ) Then PID_COUNT = PID_COUNT + 1 OLD_COUNT = CHANNEL_COUNT Do 62 CHANNEL = 1, MAX_AD_CHANNEL If( AD_BLOCK( 2,CHANNEL) .eq. PID ) Then !If right PID, display info Type 200, CHANNEL, STATUS(AD_BLOCK(1,CHANNEL)+1), 1 (AD_BLOCK(J,CHANNEL), J = 2,6 ) CHANNEL_COUNT = CHANNEL_COUNT + 1 End IF 62 Continue If (OLD_COUNT .eq. CHANNEL_COUNT ) Type 800, '',PID,ERASE_LINE End IF 61 Continue Type 400,ERASE_LINE,PID_COUNT,CHANNEL_COUNT,ERASE_SCREEN OLD_DISPLAY = DISPLAY_FLAG ERASE_FLAG = .false. Go to 20 ! ! Exit ! 99 Call Exit ! ! Format Statments ! 100 Format(1X,2A1,' Lab IO Status as of ',A,' ',A// 1' Channel Status PID Tics/Sample Buffer Size 1 Buffers '/) 200 Format(I5,5x,A8,Z10,4I12) 300 Format(' ',4A1) 400 Format(' '2A1/' Totals: ',I2,' Processes connected ',I2,' Channels 1 allocated'/' '2A1$) 500 Format(' '7A1) 600 Format(' '4A1/ 1' The following commands are available:'// 1' VT100 VT52 any'/ 1' ------ ---- ---'/ 1' PF1 red C Channel Display'/ 1' PF2 blue P Process Display'/ 1' PF3 grey H Help Display'/ 1' PF4 n/a E Exit'// 1' To change display time, type a digit 0-9 for the desired time'//) 700 Format(A) 800 Format(' ',A6,11X,Z10,2A1) 900 Format(I5,5x,A8,2A1) End ![End of File]