C C ROUTINE TO LOG OFF ONE TERMINAL FROM ANOTHER C C AUTHOR: D.F. HESS - MAY 22, 1981 C D.R.P. - DATA ANALYSIS - DEPT. 5359 C CAMARILLO, CALIF. C C REVISION HISTORY: NOV 20, 1981 -DFH- Added ^Z abort option and prevented C TT0: from being logged off ! C DEC 10, 1984 -DFH- Removed option to run again. C C Oct 5, 1987 -DFH- Added GETMCR C C MACHINE HARDWARE: DIGITAL EQUIPMENT CORP. (D.E.C.) PDP 11/70 C C OPERATING SYSTEM: RSX-11M+ C C SUBROUTINES REQUIRED: SPAWN - EXECUTIVE DIRECTIVE! C WAITFR - WAIT FOR SINGLE EVENT FLAG C C SYMBOL DEFINITIONS: ANS - Single byte answer to Y/N question C CD0 - Address of TDX command line C CD1 - Address of TDX command line C CLI - Address of command line interpreter C CMD - Address of MCR command line C IDS - Address of DSW C IESB - Address of 8 word status buffer C CMDBUF - Buffer for mcr command line C C DEFINE VARIABLES C INTEGER IESB(8),BYTCNT,PRL REAL*8 CMD,CD1 BYTE ANS BYTE CMDBUF(80) BYTE TASK(6) C CHARACTER TSKCHR*6 C EQUIVALENCE (TASK(1),TSKCHR(1:1)) C C DEFINE DATA C DATA CLI /6RMCR.../ DATA CMD /'BYE'/ DATA CD0,CD1 /'CLR','DLG'/ EXTERNAL TIMAST C TSKCHR = 'RMDTxx' C C C------------------------------------------------------------------------------- C See if any commands were passed to this task C------------------------------------------------------------------------------- C CALL GETMCR(CMDBUF,IDS) IF (IDS .GE. 1) GOTO 10 TYPE *,'GETMCR ERROR !!!!!! IDS =',IDS GOTO 470 C 10 IF (IDS .LT. 5) GOTO 100 ! No - go get one IF (CMDBUF(4) .NE. ' ') STOP 'SYNTAX ERROR' C IF (IDS-4 .EQ. 1) THEN IF(CMDBUF(5).LT.'0'.OR.CMDBUF(5).GT.'7') GOTO 420 DECODE(1,140,CMDBUF(5)) ITNUM ELSE IF(CMDBUF(5).LT.'0'.OR.CMDBUF(5).GT.'7') GOTO 420 IF(CMDBUF(6).LT.'0'.OR.CMDBUF(6).GT.'7') GOTO 420 DECODE(2,140,CMDBUF(5)) ITNUM ENDIF C GOTO 200 ! Log this sucker off C C------------------------------------------------------------------------------- C No terminal number was passed so we'll ask the operator for one ! C SPAWN TDX COMMAND 'CLR' TO ISSUING TERMINAL C------------------------------------------------------------------------------- C 100 CALL SPAWN(CLI,,,3,,IESB,,CD0,3,,,IDS) IF (IDS .EQ. 1) GO TO 110 TYPE *,'#1 SPAWN ERROR !!!! IDS =',IDS GOTO 470 C C SPAWN TDX COMMAND 'DLG' TO ISSUING TERMINAL C 110 CALL WAITFR (3) CALL SPAWN(CLI,,,3,,IESB,,CD1,3,,,IDS) IF (IDS .EQ. 1) GO TO 120 TYPE *,'#1 SPAWN ERROR !!!! IDS =',IDS GOTO 470 C 120 CALL WAITFR (3) C C Start the AST stuff C CALL TIMAST C C ASK FOR TERMINAL TO SPAWN THE MCR COMMAND TO C WRITE (5,130) 130 FORMAT (/,$,' Enter the TT # you wish to LGO (^Z to quit): ') C READ (5,140,END=430) ITNUM 140 FORMAT (O2.2) C C------------------------------------------------------------------------------- C DO NOT LOG OFF SYSTEM CONSOLE DFH 20-NOV-81 C------------------------------------------------------------------------------- C 200 IF ( ITNUM .EQ. 0 ) GO TO 440 C C------------------------------------------------------------------------------- C We don't want to spawn BYE if RMD is running on that terminal C------------------------------------------------------------------------------- C ENCODE (2,210,TASK(5)) ITNUM 210 FORMAT (O2) C C Left justify the TT number C IF (TASK(5) .EQ. ' ') THEN TASK(5) = TASK(6) TASK(6) = ' ' ENDIF C C Alter the priority of RMDTxx C CALL ALTPRI(RAD50(TASK),225,IDS) C C Check IDS. If IDS = 1 then RMD is running - bail out C IF (IDS .EQ. 1) GOTO 450 C C SPAWN THE MCR COMMAND LINE C CALL SPAWN(CLI,,,1,,IESB,,CMD,3,ITNUM,'TT',IDS) IF (IDS .EQ. 1) GO TO 290 TYPE *,'SPAWN ERROR!!!!! IDS =',IDS GOTO 470 C 290 CALL WAITFR (1) C C------------------------------------------------------------------------------- C Message to tell what's up C------------------------------------------------------------------------------- C 400 WRITE (5,410)"7,ITNUM 410 FORMAT (/,1x,a1,'BYE has been spawned to TT',O2.2,':') GOTO 500 C 420 STOP ' Use OCTAL #''s only ! ' 430 STOP ' Terminated by user !! ' 440 STOP ' I can''t LGO TT0: !!! ' 450 WRITE (5,460)"7,"7,"7,ITNUM 460 FORMAT (/,1X,3A1,'TT',O2.2,': has RMD running. Can''t LGO !!') 470 STOP ' FATAL ERROR' C 500 continue c END