C----------------------------------------------------------------------------- C Program: INIBAT C C Purpose: Assign terminal I/O LUNs corresponding to the batch C status of TI:. C C Author: Han Lasance C Digital Equipment B.V., Utrecht, Holland C for Neurophysiology Group, Organon Intern.B.V., Oss, Holland C C Date: Nov-81 C C Language: Fortran-77 C C Modified by: Name Date Ident. Version C Jan H. Belgraver 16-Oct-89 JB02 V1.2 C Report problem when serious error deleting .CTL files, i.e. C on status=0 when e.g. delete protected, but not C on status=2 when there are no such files. C C Jan H. Belgraver 24-Mar-89 JB01 V1.1 C Completed DOC-header, F77 style, and annotated. C C Calls to: ASSIGN, CLOSE, CNCT, DATE, GETADR, OPEN, SPAWN, STOPFR, C TIME, WTQIO C C Event flags: Number Description C 1 Used by WTQIO C 2 Used by SPAWN C C LUNs: Number Description C 2 .SAV answer_files save file C 4 BA: C 5 Terminal input C 6 Terminal output C C Description: INIBAT is used in conjuction with a private driver BADRV C and the Indirect Commandfile Processor. C For each terminal on this system (8 ports) BADRV stores C one of three possible conditions: C C 0 = No batch (default) C -1 = Batch, fill answerfile C 1 = Batch, read answerfile C C in the following integer table: C C word 1 word 2 C +----------+-----------+ C | status 1 | LUN 1 | C +----------+-----------+ C | status 2 | LUN 2 | C +----------+-----------+ C | . | . | C | . | . | C +----------+-----------+ C | status 8 | LUN 8 | C +----------+-----------+ C C De LUN values are in octal. C C Following a Read Logical Block QIO BADRV returns the terminal C number in word two of IBUF and the status in word one. C If the task is not started from within a command procedure, C the status is always zero. C C The batch driver uses two maintenance tasks - INIBAT and EXB - C to set and clear the status flags. This can only be done from C from within a command procedure. INIBAT asks the user for the C required mode and sets the corresponding flag, whereas EXB C clears the flag as soon as IND completes a Create or Use C mode session on that particular terminal. EXB is started C by INIBAT. C C----------------------------------------------------------------------------- c c PROGRAM INIBAT c c INTEGER*2 IBUF(2), ! BADRV buffer 1 IPARM(6), ! QIO parameter block 2 IESB(8) ! SPAWN status block LOGICAL*1 IOST(4), ! QIO status block 1 FNAME(22), ! SAV-file name 2 REC(80), ! SAV-file record buffer 3 CMD(26), ! SPAWN command buffer 4 TIM(8), ! System time 5 DAT(9), ! System date 6 YN ! TI: Y or N answerbuffer REAL*4 MCR, ! R50 taskname string 1 ATDOT(9) ! AT.Tx variants DATA MCR /6RMCR.../ ! MCR command dispatcher DATA DOTAT /6R...AT./ ! Possible IND task names DATA ATDOT /6RAT.T0 , 6RAT.T1 , 6RAT.T2 , 6RAT.T3 , 1 6RAT.T4 , 6RAT.T5 , 6RAT.T6 , 6RAT.T7 , 2 6RAT.T10/ DATA IORLB /" 1000/ ! QIO function code 1 IOSFC /"15400/ ! QIO Set Flag Create function code 2 IOSFU /"15401/ ! QIO Set Flag Use function code DATA FNAME /'S','Y','0',':','B','A','T','C','H', 1 'T','T','0',0,'.','S','A','V',0,0,0,0,0/ DATA CMD /'P','I','P',' ',14*0,'C','T','L',';','*', 1 '/','D','E'/ IXSTAT = 1 ! Preset exit status to success CALL ASSIGN (4, 'BA:') ! Batch driver CALL GETADR (IPARM(1),IBUF) ! Move driver buffer address c ! into QIO parameter block. IPARM(2)= 4 ! Four bytes to transfer CALL WTQIO (IORLB, 4, 1,, IOST, IPARM, IDS) ! Get status IF (IOST(1) .LE. 0 .OR. ! Any error is fatal 1 IDS .NE. 1) GOTO 900 c c Find out how Indirect was activated for this terminal. c CALL CNCT (ATDOT(IBUF(2)+1),,,,, IDS1) ! AT.Tx active? IF (IDS1 .LE. 0) THEN ! No, CALL CNCT (DOTAT,,,,, IDS2) ! Was it ...AT.? END IF IF (IDS2 .LT. 0) GOTO 700 ! No, exit with severe error 5 WRITE (6, 10) 10 FORMAT (/'$[C]reate, [U]se or [N]o Batch file?', T45,': ') READ (5, 20, END=999) YN ! Get mode 20 FORMAT (A1) IF ( YN .EQ. 'N' .OR. YN .EQ. 'n') GOTO 1000 ! Exit IF ((YN .NE. 'C' .AND. YN .NE. 'c') .AND. 1 (YN .NE. 'U' .AND. YN .NE. 'u')) GOTO 5 ! Invalid answer IF (IBUF(1) .NE. 0) GOTO 800 ! Status flag not cleared c ! exit with severe error. FNAME(13)= IBUF(2)+48 ! Insert converted terminal c ! number into answer save file IF (IBUF(2) .GE. 8) THEN ! It is TT10: FNAME(12) = '1' FNAME(13) = '0' END IF DO 30 I=1,14 ! Insert filename into 30 CMD(I+4) = FNAME(I) ! DELETE command string. CALL SPAWN (MCR,,,,, IESB,, 'EXB', 3,,, IDS) ! Start c ! EXit Batch task IF (YN .EQ. 'C' .OR. YN .EQ. 'c') THEN c c Create Mode c OPEN (UNIT = 2, ! Create answer save file 1 NAME = FNAME, 2 TYPE = 'NEW', 3 CARRIAGECONTROL = 'LIST', 4 ERR = 999) CALL DATE (DAT) ! Get system date and CALL TIME (TIM) ! time for time-stamp. WRITE (2, 310) IBUF(2), DAT, TIM ! Store ident. string 310 FORMAT ('<<<<< Batch Answer File Created From TT', 1 O<1+IBUF(2)/8>, ': -- ', 9A1, 1X, 8A1,' >>>>>') CLOSE (UNIT = 2) ! Done WRITE (6, 320) (CMD(I),I=9,23) ! .CTL files names 320 FORMAT (/'$', 15A1, ' Will Be Deleted - OK? [Y/N]', T45, ': ') READ (5, 20, END=999) YN IF (YN .NE. 'Y' .AND. YN .NE. 'y') GOTO 400 ! Skip delete 325 CALL SPAWN (MCR,,, 2,, IESB,, CMD, 26,,, IDS) ! Delete them IF (IDS .LT. 1) THEN ! PIP discovered problem IF (IESB(1) .LT. 1 .or. IESB(1) .GT. 2) THEN ! JB02 327 WRITE (6, 330) IDS, IESB(1) ! Write message 330 FORMAT (/' INIBAT -W- Unable to Delete .CTL Files', 1 /' DSW= ', I4, ', PIP Exit Status= ', I2, 2 /'$', 11X, 'Try Again? [Y/N]', T45, ': ') READ (5, 20, END=999) YN IF (YN .EQ. 'Y' .OR. YN .EQ. 'y') GOTO 325 ! Do it GOTO 400 ! Don't wait END IF ! JB02 END IF 340 CALL STOPFR (2) ! Wait for MCR IF (IESB(1) .NE. 1) GOTO 327 ! Write message, try again 400 CALL WTQIO (IOSFC, 4, 1,, IOST, IDS)! Set Create flag IF (IOST(1) .EQ. -3) GOTO 800 ! Device not Ready, exit IF (IOST(1) .LE. 0) GOTO 900 ! Any other fatal error GOTO 1000 ! Success exit ELSE c c Use Mode c OPEN (UNIT = 2, ! Open saved answers file 1 NAME = FNAME, 2 TYPE = 'OLD', 3 ERR = 999) READ (2, 250, END=999) NCH, (REC(I),I=1,NCH) ! Get ident. rec'd 250 FORMAT (Q, 80A1) CLOSE (UNIT=2) WRITE (6, 260) (REC(I),I=1,NCH) ! Show on terminal 260 FORMAT (/' File Id: ', A1, 1 //'$-- Continue? [Y/N]', T45, ': ') READ (5, 20, END=999) YN ! Is the expected one? IF (YN .NE. 'Y' .AND. YN .NE. 'y') GOTO 999! No, fatal error CALL WTQIO (IOSFU, 4, 1,, IOST, IDS) ! Set Use flag IF (IOST(1) .EQ. -3) GOTO 800 ! Device not Ready, exit IF (IOST(1) .LE. 0) GOTO 900 ! Any other fatal error GOTO 1000 ! Success exit END IF c c Error Messages c 700 WRITE (6, 710) IDS1, IDS2 710 FORMAT (/' INIBAT -F- INIBAT Not Activated By ...AT.', 1 /' DSW1, DSW2 = ', 2O7/) GOTO 999 ! Severe error exit 800 WRITE (6, 810) 810 FORMAT (/' INIBAT -F- Batch Driver Already Busy For This Terminal'/) GOTO 999 ! Severe error exit 900 WRITE (6, 910) IDS, IOST(1) 910 FORMAT (/' INIBAT -F- Batch Driver Error', 1 /' IDS = ', I4, ', I/O Status = ', O3/) 999 IXSTAT = 4 1000 CALL EXST (IXSTAT) ! Return status to INDirect END