.PROC,GENMONT.      
.*  COMPILE AND LINK MONTERM PRODUCT    
RETURN,MONTERM,LGO. 
FTN5,I=MONTERS,REW,OPT=0,S=SYSTEXT,S=PSSTEXT,S=IOTEXT.      
LOAD(LGO) 
NOGO(MONTERM)       
.DATA,MONTERS.      
      PROGRAM MONITOR         
          
***   MONITOS/UN=92380        
*         
*  6 FEB 1984    A. KREYMER   
*         
*   USE TRANSPARENT INPUT, WITH 1 BYTE TERMINATION COUNT    
*     TO MONITOR INPUT FROM A TERMINAL, WITH A DISPLAY      
*     OF RECEIVED CODES IN HEX, DECIMAL, AND OCTAL.         
*         
*      THE SYSTEXT AND PSSTEXT ARE REQUIRED FOR ROUTINE PROFF.        
*         
*  3 MARCH 1984    A. KREYMER 
*         
*       SET OC=N  AT STARTUP, SO THAT ^S AND ^Q MAY BE PASSED         
*       TO MONITOR BY THE SYSTEM.       
*         
**************************************************************        
          
          
*         PRINT THESE STRINGS TO DESCRIBE EACH CHARACTER    
*         
      CHARACTER*4 PARITY      
      CHARACTER*5 MARK        
      CHARACTER*7 CONTRL      
          
*         COUNT ESCAPES, TERMINATE FOR 3 IN A ROW 
      DATA NESC / 0 /         
          
*         OPEN THE OUTPUT FILE
      OPEN(6,FILE='OUTPUT',FORM='FORMATTED',STATUS='NEW')   
          
*         INTRODUCTION, INSTRUCTIONS, AND OUTPUT COLUMN HEADERS       
      WRITE(6,*) '  * * * *  TERMINAL MONITOR PROGRAM  * * * * '      
      WRITE(6,*)    
      WRITE(6,*) '       TYPE THREE CONSECUTIVE ESCAPE '    
      WRITE(6,*) '    CHARACTERS (CONTROL-[) TO TERMINATE ' 
      WRITE(6,*)    
      WRITE(6,*) ' CODE VALUES GIVEN IN OCTAL/DECIMAL/HEX ' 
      WRITE(6,*)    
      WRITE(6, '(''CHAR      CODE       PARITY'')' )        
          
*         TURN OFF INPUT PROMPT         
      CALL PROFF    
          
*         TURN ON TRANSPARENT INPUT MODE
      WRITE(6,'(A10)') O"00060000000055555555"    
          
*         SET MULTI MESSAGE MODE AND EP=N WITH TERMDEF      
      WRITE(6,'(3A10)') O"00164070400040714000",  
     +                  O"40724001407340154106",  
     +                  O"40014061400041044000"   
          
*         READ ONE CHARACTER TO CLEAR THE BUFFERS.
      CALL TINP(JOCK)         
          
******************************************************************    
*         MAIN LOOP.  READ AND PROCESS EACH CHARACTER            *    
******************************************************************    
          
      DO 10 ICHAR=1,20000     
          
*         READ ONE CHARACTER  
      CALL TINP(JOCK)         
          
*         STRIP OUT 8 BITS OF ASCII     
      IASCII = AND ( O"377" , SHIFT(JOCK,-36) )   
          
*         STRIP 7 NON PARITY ASCII BITS 
      JASCII = AND ( O"177" , IASCII )  
          
*         COUNT CONSECUTIVE ESCAPE CHARACTERS     
*         
      IF (JASCII.EQ.27) THEN  
         NESC = NESC + 1      
         IF (NESC.GE.3) GO TO 100       
      ELSE
           NESC = 0 
      ENDIF         
          
*         LABEL CONTROL CHARACTERS WITH CARET AND 'CONTROL' 
*         
      IF (JASCII.LT.32) THEN  
          JASCII = JASCII + 64
          CONTRL = 'CONTROL'  
          KASCII = JASCII + O"000741364000"       
      ELSE
          CONTRL = ' '        
          KASCII = JASCII + O"000740404000"       
      ENDIF         
          
*          CALCULATE PARITY   
*         
      ISET = 0      
      DO 20 J=0,7   
   20 ISET = ISET + AND( 1 , SHIFT(IASCII,-J) )   
          
*         LABEL PARITY WITH MARK AND EVEN VARIABLES         
*         
      IF (SHIFT(IASCII,-7).EQ.1) THEN   
        MARK = 'MARK'         
      ELSE
        MARK = 'SPACE'        
      ENDIF         
      IF (MOD(ISET,2).EQ.0) THEN        
        PARITY = 'EVEN'       
      ELSE
        PARITY = 'ODD'        
      ENDIF         
          
*                DESCRIBE THE CHARACTER 
*         
      WRITE(6,'(R6,''  '',O5.0,I4,Z3.0,A7,A6,A8)')
     +      KASCII,IASCII,IASCII,IASCII,PARITY,MARK,CONTRL  
          
   10 CONTINUE      
          
************************************************  
*       TERMINATING,   RESET THE TERMINAL      *  
************************************************  
          
  100 WRITE(6,'(A10,A8)') O"00164106400040614001",
     +                    O"40644000410440015555" 
*         TURN ON THE PROMPT  
      CALL PRON     
      WRITE (6,*) ' MONITOR TERMINATED ^*'        
      ENDFILE 6     
      CALL TINPC    
      ENDFILE 5     
*         SUPRESS 'CP SECONDS' MESSAGE  
      CALL ENDRUN   
          
      STOP
      END 
          IDENT  PROFF        
          
***       PROFF     
*         
*         TURN OFF THE TERMINAL INPUT PROMPT      
*         
*         ENTRY  NONE         
*         
*         EXIT   NONE         
*         
*         USES   NONE         
*         
          
          SST       
TRACE.    VFD    42/5HPROFF,18/PROFF    
          ENTRY PROFF         
PROFF     EQ     *+4S15       
          
          PROMPT OFF
          EQ PROFF  
          
          END       
          IDENT  PRON         
***       PRON      
*         
*         TURN ON THE TERMINAL INPUT PROMPT       
*         
*         ENTRY  NONE         
*         
*         EXIT   NONE         
*         
*         USES   NONE         
*         
          
          SST       
TRACE.    VFD    42/4HPRON,18/PRON      
          ENTRY PRON
PRON      EQ     *+4S15       
          
          PROMPT OFF
          EQ PRON   
          
          END       
          IDENT  TINP         
          
***       TINP FORTRAN FUNCTION         
*         
*         TRANSPARENT INPUT OF ONE CHARACTER.     
*         
*         ENTRY  NONE         
*         
*         EXIT   X6 = CHARACTER         
*         
*         USES   A  0 1    5 6
*                B    1       
*                X    1 2    6
*         
          
          ENTRY  TINP,TINPC   
          SYSCOM B1 
          
ZZZZZZZ   FILE   RT=S,CNF=YES,ASCII=2,MRL=10      
          
TINP      PS        
          SX6    A0 
          SA6    SAVEA0       
          SB1    1  
          SA5    OPEND        
          NZ     X5,TINP1        IF ALREADY OPEN  
          
          SX6    A1 
          SA6    OPEND        
          OPENM  ZZZZZZZ,INPUT,N        
          SA1    OPEND        
          SA1    X1 
          
TINP1     GET    ZZZZZZZ,X1,X2       READ THE DATA
          SA1    SAVEA0              RESTORE A0   
          SA0    X1 
          EQ     TINP         
          
OPEND     BSSZ   1  
          
TINPC     PS        
          SX6    A0 
          SA6    SAVEA0       
          SB1    1  
          CLOSEM ZZZZZZZ,RET,FILE       
          RETURN ZZZZZZZ,R    
          MX6    0  
          SA6    OPEND        
          SA1    SAVEA0       
          SA0    X1 
          EQ     TINPC        
SAVEA0    BSS    1  
          
          END       
          IDENT  ENDRUN       
          
***       ENDRUN    
*         
*         END THE RUN GRACEFULLY, WITHOUT CPU OR STOP MSG.  
*         
*         ENTRY  NONE         
*         
*         EXIT   NONE         
*         
*         USES   NONE         
*         
*     A. KREYMER   FNAL    01 MARCH 1984
*       ( PER DAVE SACHS SUGGESTION )   
*         
*         
          
          ENTRY  ENDRUN       
          
 ENDRUN   EQ     *+4S15       
          
          MESSAGE  =0,1,R     
          ENDRUN             END THE RUN
          
          END