FTN4,L
      PROGRAM LGOFF(131,90),92067-16260 REV.1940 790726 
C 
C  ***************************************************************
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS     *
C  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
C  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
C  ***************************************************************
C 
C  SOURCE 92067-18261 
C 
C 
C 
      IMPLICIT INTEGER (A-Z)
      REAL REG,DCMC,DBLK
C 
C 
      DIMENSION IDCB(144),IBUF(128),IGBUF(13),
     C          ICON(2),JBUF(3),NAMB(3),
     C          REG(2),IREG(2),TIME(5),RUFM(5), 
     C          FMGR(3),FMGXX(3)
C 
C 
      DIMENSION OFPRG(6),PGRM(3),DSEC(2),DCPU(2)
C 
C  ERROR AND LOG-OFF MESSAGE BUFFERS
C  NOTE THAT ONLY THOSE MESSAGES (BUFFERS) WHICH ARE ALTERED ARE
C  DECLARED HERE. ALL OTHERS ARE FORMATED IN THE CALL STATEMENT.
C 
C 
C 
      DIMENSION LG01(25),OFMS1(23),OFMS3(27),OFMS4(32), 
     C          OFMS5(27),DMES(19)
C 
C 
C 
      EQUIVALENCE (IDCB(17),IBUF),
     C            (IGBUF(11),JBUF), 
     C            (REG,IA,IREG),(IREG(2),IB),(RUFM(3),FMGLU), 
     C            (RUFM(4),GX), 
     C            (RUFM(5),XB),(OFPRG(3),PGRM),(DMES(5),DBLK) 
C 
C 
C  FOUR WORDS USED IN COMUNICATION WITH SUBROUTINES 
C 
C  CCLAS  (PROGRAMATIC COMMUNICATION CLASS) 
C  IOPN1  (SESSION ID)
C  INTER  (INTERACTIVE FLAG)
C  IOPN2  (SCB ADDRESS) 
C 
C 
C 
C 
C     "LGOF 01 FMP ERROR - XXXXX ON ACCOUNT FILE ACCESS"
C 
      DATA LG01/2HLG,2HOF,2H 0,2H1 ,2HFM,2HP ,2HER,2HRO,2HR ,2H- ,
     C     2HXX,2HXX,2HXX,2H O,2HN ,2HAC,2HCO,2HUN,2HT ,2HFI,2HLE,
     C     2H A,2HCC,2HES,2HS / 
C 
C 
C     " OFF                                      "
C 
      DATA OFMS1/2HOF,2HF ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,
     C      2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,
     C      2H  / 
C 
C     "CONNECT TIME:              WW HRS.,  XX MIN.,  YY SEC."
C 
      DATA OFMS3/2HCO,2HNN,2HEC,2HT ,2HTI,2HME,2H: ,2H  ,2H  ,
     C           2H  ,2H  ,2H  ,2H  ,2HWW,2H H,2HRS,2H.,,2H  ,
     C           2HXX,2H M,2HIN,2H.,,2H  ,2HYY,2H S,2HEC,2H. /
C 
C    "CPU USAGE:                  WW HRS.,  XX MIN.,  YY SEC., ZZZ MS." 
C 
      DATA OFMS4/2HCP,2HU ,2HUS,2HAG,2HE:,2H  ,2H  ,2H  ,2H  ,
     C           2H  ,2H  ,2H  ,2H  ,2HWW,2H H,2HRS,2H.,,2H  ,
     C           2HXX,2H M,2HIN,2H.,,2H  ,2HYY,2H S,2HEC,2H.,,
     C           2HZZ,2HZZ,2HZZ,2H M,2HS./
C 
C   "CUMULATIVE CONNECT TIME:    WW HRS.,  XX MIN.,  YY SEC." 
C 
      DATA OFMS5/2HCU,2HMU,2HLA,2HTI,2HVE,2H C,2HON,2HNE,2HCT,
     C           2H T,2HIM,2HE:,2H  ,2HWW,2H H,2HRS,2H.,,2H  ,
     C           2HXX,2H M,2HIN,2H.,,2H  ,2HYY,2H S,2HEC,2H. /
C 
C 
C   "DISC CRN XXXXX LU YY DISMOUNTED (POOL) 
C 
      DATA DMES/2HDI,2HSC,2H C,2HRN,2H X,2HXX,2HXX, 
     C          2H L,2HU ,2HYY,2H D,2HIS,2HMO,2HUN,2HTE,
     D          2HD ,2H(P,2HOO,2HL)/
C 
      DATA ICON/0,10400B/ 
      DATA FMGR/2HFM,2HGR,2H  / 
      DATA FMGXX/2HFM,2HGX,2HX /
      DATA RUFM/2HRU,2H, ,2HFM,2HGL,2HU / 
      DATA NAMB/2H  ,2H  ,2H  / 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C  RELEASE POSSIBLE STRING AND DEFINE SIZE OF SECOND BUFFER FOR 
C  PASSWORD RESPONSE. 
C 
C 
      CALL DTACH(ITMP1) 
      CALL EXEC(14,1,I,0) 
      SBUF=-3 
C 
C  DEFINE ADDRESSES OF COMMUNICATION PARAMETERS 
C 
      CALL SETAA(CCLAS,IOP1,INTER,IOP2) 
C 
C 
C 
C 
C  MAKE INITIALIZATION CALL  ( INIT2 CHECKS THE ENVIRONMENT AND 
C  RETURNS THE LOG-OFF CLASS NUMBER AND CONTENTS OF $DSCS+1.
C 
C  ITMP1 IS SET UP = $DSCS+1  IF= -2 ACCTS IS BUSY WORKING ON THE ACCT
C  FILE SO LGOFF TERMINATES, WAITING FOR ACCTS TO RESTART IT WHEN 
C  THE ACCOUNT FILE HAS BEEN UPDATED. 
C 
C 
1     LGFC=INIT2(ITMP1) 
      IF(ITMP1.EQ.-2) GOTO 376
C 
C  MAKE A GET SO WE HAVE SOMEONE TO TALK TO IF PROBLEMS COME UP.
C 
      CALL EXEC(100025B,LGFC+40000B,IGBUF,-26,IOP1,IOP2,ITMP1)
       GOTO 380 
C 
C  MAKE SURE IT WAS A READ OR WRITE/READ
C 
2     IF(ITMP1.NE.1) GOTO 350 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C OK, BEFORE CHECKING THE ACCOUNT FILE, DETERMINE WHO WE ARE TALKING C
C TO. THIS IS DONE TO PERMIT LGOFF TO REPORT AN ERROR TO THE CALLER  C
C AND THEN RE-ENABLE THE REQUESTING TERMINAL. THIS CODE IS EXECUTED  C
C ONLY ON THE FIRST ENTRY TO LGOFF. AFTER THE ACCOUNT FILE IS FOUND  C
C AND OPENED, LGOFF NEVER TERMINATES BUT HANGS ON A CLASS GET REQ.   C
C THIS CODE SHOULD BE IN A SUBROUTINE SO ALL REQUESTS TO LGOFF (NOT  C
C JUST THE FIRST ONE) COULD USE IT.                                  C 
C                                                                    C
C  NOTE: THE REQUEST BUFFER WAS NOT RELEASED. THIS IS SETUP WORK     C
C        ONLY. THE NORMAL PROCESSING WILL MAKE ANOTHER GET AND       C
C        THEN DO THE REAL WORK ON THIS REQUEST.                      C
C                                                                    C
C                                                                    C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C 
      INTER=0 
      CCLAS=IGBUF 
      IF(IOP2) 50,350,60
C 
C 
C  THE REQUEST CODE IS NEGATIVE. WE HAVE A SHUT-DOWN (-1) OR
C  A RESPONSE TO A KILL PROGRAMS PROMPT (=SBUF) OR AN INVALID 
C  REQUEST. 
C 
C 
50    IF(IOP2.EQ.-1) GOTO 350 
      IF(IOP2.NE.SBUF) GOTO 350 
C 
C  THIS IS A RESPONSE TO A KILL PROMPT. MODIFY THE CONTROL
C  PARAMETERS FROM THE SECOND BUFFER RETURNED ON THE CLASS GET. 
C 
C 
      IOP1=JBUF 
      IOP2=JBUF(2)
      CCLAS=JBUF(3) 
C 
C 
C  SEE IF THE REQUEST IS INTERACTIVE
C 
C 
60    IOP1=IAND(IOP1,777B)
      IF(IOP1.GT.99) GOTO 200 
      INTER=XFTTY(IOP1) 
C 
C 
C 
C 
C 
C  SESSION ENVIRONMENT HAS BEEN INITIALIZED--OR THE CLASS GET ON
C  $LGOF (CLASS #) WOULD HAVE BEEN REJECTED.
C 
C 
C  OPEN ACCOUNT FILE AND DEFINE RECORD NUMBERS OF ACTIVE SESSION
C  TABLE AND NUMBER OF RECORDS IN THAT TABLE.  ALSO, FETCH THE
C  RESOURCE NUMBER FOR ACCOUNT FILE CONTROL(IRN) AND SAVE IT FOR EVER 
C  AND EVER (OR UNTIL THIS PROGRAM TERMINATES). 
C 
C 
200   CALL OPEN(IDCB,IERR,6H+@CCT!,1,-31178)
      IF(IERR.EQ.1) GOTO 400
C 
C 
C  PROBLEM WITH ACCOUNT FILE -- ISSUE ERROR AND TERMINATE.
C 
C  IF IERR POSITIVE, BUT NOT = 1 GIVE FILE NOT FOUND ERROR. 
C 
C  FILE TYPE MUST BE 1
C 
C 
250   IF(IERR.GE.0) IERR=-6 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                    C
C    FMP ERROR AND SHUT DOWN WORK    C
C                                    C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
300   CALL CNUMD(-IERR,LG01(11))
      CALL MESSP(100103B,LG01,-50)
C 
C  RELEASE POSSIBLE CLASS BUFFER
C 
350   CALL EXEC(21+100000B,LGFC,IGBUF,0)
      GOTO 375
C 
C  FAKE OUT THE COMPLIER
C 
98765 CONTINUE
375   CALL CLOSE(IDCB)
C 
C  IF NOT SHUTDOWN REQUEST, GO WAIT FOR BETTER NEWS.
C 
      IF(IOP2.NE.-1) GOTO 1 
376   CALL EXEC(6)
C 
C 
C 
C 
C 
C  SESSION ENVIRONMENT NOT SETUP. ISSUE ERROR AND TERMINATE.
C 
380   CALL MESSP(100003B, 
     C          44HLGOF 00 SESSION ENVIRONMENT NOT INITIALIZED ,44) 
C 
C  FORCE A TERMINATION
C 
      IOP2=-1 
      GOTO 350
C 
C 
C 
C 
C 
C 
C  ACCOUNT FILE OPEN - REQUEST LOCAL LOCK ON RN TO VERIFY VALIDITY
C 
C 
C  READ HEADER
C 
400   CALL READF(IDCB,IERR,IBUF,128,ITMP1,1)
      IF(IERR.LT.0) GOTO 300
      IRN=IBUF(25)
C 
C  IF REJECT ON LOCK OF RN, GIVE BAD ENVIRONMENT ERROR. 
C 
      CALL RNRQ(40001B,IRN,ITMP1) 
      GOTO 380
C 
C 
C  NORMAL RETURN-- ACCOUNT FOUND AND SET-UP.
C 
C 
C  DEFINE ACCOUNT FILE POINTERS TO BEGINING AND LENGTH OF ACTIVE
C  SESSION TABLE AND REC # OF START OF DIRECTORY. 
C 
C 
410   ACTIV=IBUF
      EACTV=IBUF(2)-1 
      DIRC=IBUF(5)
C 
C  GO GET FIRST REQUEST 
C 
      GOTO 500
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C                                                                 C 
C  NORMAL FLOW OF CONTROL RETURNS HERE TO MAKE NEXT "GET" REQUEST.C 
C  WE ALWAYS RELEASE THE RN BEFORE THE "GET" SO SOMEONE ELSE CAN  C 
C  GAIN ACCESS TO THE ACCOUNT FILE.                               C 
C                                                                 C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
C 
C 
C  SIGNAL COMPLETION TO CALLER
C 
C 
450   CALL MESSP(0,I,0) 
C 
C     RELEASE POSSIBLE CLASS BUFFER 
C 
475   CALL EXEC(21,LGFC,IGBUF,0)
C 
C 
C  RELEASE POSSIBLE RN LOCK 
C 
C 
500   CALL RNRQ(40004B,IRN,ITMP1) 
C 
C  IGNORE NOT SET ABORT RETURN
C 
      GOTO 525
C 
C  FAKE OUT THE COMPLIER
C 
87654 CONTINUE
C 
C 
C 
C  MAKE A "GET" REQUEST BUT DON'T RELEASE THE BUFFER. 
C 
C 
525   IGBUF=0 
      REG=EXEC(21,LGFC+40000B,IGBUF,-26,IOP1,IOP2,ITMP1)
C 
C 
C 
C  ONLY ACCEPT READ OR WRITE/READ REQUESTS WITH IOP2 .NE. 0 
C 
C 
      IF(ITMP1.NE.1.OR.IOP2.EQ.0) GOTO 475
C 
C 
C 
C  CHECK TYPE OF REQUEST  (IOP2 .LT. 0 = RESPONSE TO KILL PROMPT) 
C 
      IF(IOP2.LT.0) GOTO 6000 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C  VERIFY THAT THIS IS REALLY A LOG-OFF CALL                         C
C                                                                    C
C    IOP1 MUST CONTAIN THE SESSION ID IN THE LOW 9 BITS.             C
C         BITS 15-13 ARE LOG-OFF OPTN FLAGS                          C
C                                                                    C
C         15=DISMOUNT PRIVATE                                        C
C         14=DISMOUNT GROUP                                          C
C         13=KILL ACTIVE PROGRAMS                                    C
C                                                                    C
C                                                                    C
C    IOP2 MUST = THE SCB POINTER OF THE SESSION LOGGING OFF          C
C                                                                    C
C                                                                    C
C 
C  ISOLATE OPTIONS AND SESSION ID - SAVE OPTIONIAL CLASS # (PASSED   C
C  IN THE CLASS BUFFER) - AND SET UP THE INTERACTIVE FLAG            C
C                                                                    C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
      OPTNS=IAND(IOP1,160000B)
      INTER=0 
      CCLAS=IGBUF 
C 
C 
      IOP1=IAND(IOP1,777B)
C 
C  IF SESSION ID > 99  MUST NOT BE INTERACTIVE
C 
      IF(IOP1.GT.99) GOTO 535 
C 
      INTER=XFTTY(IOP1) 
C 
C 
C  VERIFY PASSED PARAMETERS AND FETCH INFORMATION FROM SCB
C 
C 
535   IF(VALID(DCPU,PID,GID,DENT).NE.0) GOTO 600
C 
C 
C  PARAMETERS ARE NOT VALID - SEND POSSIBLE TIE-OFF TO CALLING PROGRAM
C  AND CONTINUE WITH NEXT REQUEST. NOTE SPECIAL RETURN STATUS = 76B 
C 
550   CALL MESSP(117601B,I,0) 
      GOTO 475
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C  THE PARAMETERS MATCHED AN EXISTING SCB 
C  PREPARE FOR SCAN OF ID SEGMENTS
C 
C 
C 
C  SET KILL FLAGS 
C 
C 
C 
C   NOTE: MAY WANT TO DISABLE TERMINAL (SET BIT MAP FLAG) HERE. 
C 
C 
600   OK=IAND(OPTNS,20000B) 
626   FND=0 
      OOPS=0
      IDNO=0
650   ITMP1=0 
C 
C 
C 
C  SCAN FOR ACTIVE PROGRAM RUNNING FOR THIS SESSION 
C 
C 
700   IF(IDSCH(IDNO,OFPRG).EQ.0) GOTO 1000
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C  ACTIVE PROGRAM FOUND                                              C
C                                                                    C
C  SPECIAL WORK MUST BE DONE HERE. THE PROGRAMS SMP AND D.RTR        C
C  MUST BE ALLOWED TO CLEAN THEMSELVES UP. THEREFORE WE NEVER        C
C  ABORT THEM. D.RTR IS CLEANED UP VIA A SESSION CLEAN-UP SCHEDULE   C
C  REQUEST. THIS REQUEST IS CURRENTLY TREATED AS A NOP (BY D.RTR).   C
C  IT'S FUNCTION IS TO PREVENT THE DESTRUCTION OF A SESSION CONTROL  C
C  BLOCK WHILE D.RTR IS STILL LINKED TO IT. SMP IS CLEARED VIA IT'S  C
C  SESSION CLEAN-UP REQUEST. THIS REQUEST WILL CAUSE ALL PENDING     C
C  SPOOL LU'S (FILES) ASSOIATED WITH THIS SESSION TO BE OUTSPOOLED   C
C  AND CLEANED UP.                                                   C
C                                                                    C
C                                                                    C
C   OOPS=1 IF D.RTR \  2 IF SMP                                      C
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
      IF(PGRM.EQ.2HD..AND.PGRM(2).EQ.2HRT.AND.PGRM(3).EQ.2HR ) ITMP1=1
C 
      IF(PGRM.EQ.2HSM.AND.PGRM(2).EQ.2HP ) ITMP1=2
C 
      IF(ITMP1.EQ.0) GOTO 750 
      OOPS=ITMP1
      GOTO 650
C 
C 
C 
C 
C 
C 
C 
C  ACTIVE PROGRAM FOUND AND IT'S NOT SMP OR D.RTR. CHECK KILL FLAG
C  TO SEE IF WE MUST PROMPT FOR PERMISSION OF IF WE CAN JUST KILL 
C  THE PROGRAM. 
C 
C 
C 
750   IF(OK.EQ.0) GOTO 900
C 
C 
C  WE CAN KILL IT, SO MAKE THE MESSS CALL.
C  SET FOUND FLAG =-1 TO INDICATE THAT A PROGRAM HAS BEEN TERMINATED. 
C 
C 
      CALL MESSS(OFPRG,12)
      FND=-1
      GOTO 700
C 
C 
C 
C  WE CAN'T KILL THE PROGRAM WITHOUT PERMISSION. PRINT THIS ONE'S 
C  NAME AND SET FOUND FLAG=1 TO INDICATE THAT AN ACTIVE PROGRAM EXISTS. 
C 
C  NOTE RETURN STATUS =75B
C 
C 
900   CALL MESSP(17501B,PGRM,-6)
      FND=1 
      GOTO 700
C 
C 
C 
C 
C 
C 
C 
C 
C 
C  WE HAVE REACHED THE END OF THE ID SEGMENTS ( OR THE FIRST SHORT SEG).
C 
C  IF ANY PROGRAMS HAVE BEEN ABORTED, GO BACK AND MAKE ANOTHER PASS 
C  TO VERIFY THAT NO ONE CAME IN BEHIND US. 
C 
C  IF ANY ACTIVE PROGRAMS STILL EXIST GET PERMISSION TO KILL. 
C 
C 
1000  IF(FND) 626,2000,1100 
C 
C 
C 
C 
C 
C  PROGRAMS TO BE ABORTED, MUST GET PERMISSION
C 
C 
1100  CALL MESSP(17501B,29HABOVE SESSION PROGRAMS ACTIVE,-29) 
      CALL MESSP(17501B,24HOK TO ABORT ?  (Y OR N)_,-24)
C 
C 
C  CHECK FOR NON-INTERACTIVE CALL AS SPECIAL WORK MUST BE DONE IN 
C  THAT CASE. 
C 
C 
      IF(INTER.NE.0) GOTO 1200
C 
C 
C  THIS IS A NON-INTERACTIVE CALL, A CLASS # MUST HAVE BEEN PROVIDED
C  OR WE CAN GO NO FURTHER. 
C 
C 
      IF(CCLAS.EQ.0) GOTO 475 
C 
C 
C  SETUP FOR CLASS WRITE/READ 
C 
      ICON(1)=0 
      ICLAS=CCLAS 
      IREQ=100025B
      ITMP1=0 
      GOTO 1400 
C 
C 
C 
C 
C  SETUP FOR AN INTERACTIVE RESPONSE
C 
C 
1200  ICON(1)=IOP1
      ICLAS=LGFC
      IREQ=100021B
      ITMP1=-20 
C 
C 
C 
C  DEFINE SECOND BUFFER 
C 
C 
C 
1400  JBUF=IOP1+OPTNS 
      JBUF(2)=IOP2
      JBUF(3)=CCLAS 
C 
C 
C 
C 
C  MAKE THE REQUEST. IF ERROR, ASSUME BAD CLASS PASSED IN NON-INTERACTIVE 
C  CALL.
C 
C 
      CALL XLUEX(IREQ,ICON,IGBUF,ITMP1,JBUF,SBUF,ICLAS) 
C 
C  MAKE ERROR EXIT
C 
      GOTO 550
C 
C 
C  MAKE NORMAL CONTINUATION - GO RELEASE CURRENT CLASS BUFFER AND 
C  MAKE NEXT GET REQUEST. 
C 
C 
C 
C 
1410  GOTO 475
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C  AT THIS POINT, ALL PROGRAMS RUNNING FOR THIS SESSION HAVE BEEN    C
C  ABORTED. IF D.RTR IS STILL POINTING AT THIS SESSION CONTROL       C
C  BLOCK WE WILL ISSUE THE SESSION CLEAN-UP REQUEST TO IT.           C
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C 
C 
2000  IF(OOPS.NE.1) GOTO 3000 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C  CLEAR D.RTR WITH IT'S SESSION CLEAN-UP CALL. THIS CALL CURRENTLY  C
C  DOES NOTHING MORE THAN ALLOW LGOFF TO WAIT UNTIL THE PROBLEM      C
C  WITH D.RTR IS CLEARED.                                            C
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
      CALL IGET(1717B,ITMP1)
      CALL EXEC(23,6HD.RTR ,ITMP1,30) 
C 
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C NO ACTIVE PROGRAMS FOR THIS SESSION EXIST. RELEASE THE ID SEGMENTS C
C  (LONGS ONLY) ALLOCATED TO THIS SESSION.                           C
C                                                                    C
C                                                                    C
C  CLEAC COMPARES THE OWNER FLAG (IN WD 31) OF ALL LONG ID'S         C
C  WITH THE SESSION ID OF THIS SESSION. IF THEY MATCH, AND THE       C
C  PROGRAM USING THE ID IS DORMANT, AN OF,PROG,8 IS ISSUED. IF       C
C  AN ID WAS BUILT FOR THIS SESSION AND SOMEONE ELSE IS USING        C
C  THE PROGRAM ( REMEMBER, ALL PROGRAMS RELATED TO THIS SESSION      C
C  MUST BE DORMANT OR WE WOULDN'T BE HERE ) , GIVE THE ID TO THE     C
C  SESSION CURRENTLY RUNNING THE PROGRAM.                            C
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C 
3000  CALL CLEAC
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C  THIS SECTION PERFORMS THE DISC CARTRIDGE MANAGEMENT. 
C 
C  FIRST, SEE IF ANYTHING IS TO BE DISMOUNTED.
C 
C 
      IF(IAND(OPTNS,140000B).EQ.0) GOTO 4000
C 
C 
C  A DISMOUNT HAS BEEN REQUESTED. GET A COPY OF DISCS MOUNTED 
C  TO THIS SESSION. 
C 
C  GET SST LENGTH AND DISC LIMIT
C 
      CALL ISMVE(IOP2,-1,IBUF,2)
C 
C  IF DISC LIMIT=0 DONE 
C 
      IF(IBUF.EQ.0) GOTO 4000 
C 
C  GET DISC MOUNTED LIST
C 
      CALL ISMVE(IOP2,2-IBUF(2),IBUF(2),IBUF) 
C 
C 
C 
C  SCAN FOR MATCHING PRIVATE OR GROUP ID (AS DIRECTED BY OPTNS) 
C 
C 
C 
      DO 3700 J=1,2 
C 
      IF(J.EQ.2) GOTO 3100
C 
C  CHECK FOR PRIVATE DISMOUNT  (IF NOT PRIVATE, GO DO GROUP)
C 
      IF(IAND(100000B,OPTNS).EQ.0) GOTO 3300
C 
C 
C  SCAN FOR THE PRIVATE ID
C   IF GLOBAL DISC (ID=7777B) DON'T DISMOUNT IT.
C 
C 
C 
      ID=0
      IF(PID.EQ.7777B) GOTO 3300
C 
C 
C  DISC MOUNTED LIST STARTS AT IBUF(2)
C 
C 
3100    DO 3200 I=2,IBUF+1
C 
C  CKECK FOR BLANK ENTRY
C 
      IF(IBUF(I).EQ.0) GOTO 3200
C 
C  CKECK FOR GROUP FLAG (BIT 14)
C 
        IF(IAND(IBUF(I),40000B).NE.ID) GOTO 3200
C 
C 
C  MATCH FOUND. ATTEMPT TO DISMOUNT IT. 
C 
C 
        REG=DCMC(TEMP1,2,-(IAND(IBUF(I),377B)),2HRR,0,0,0,0,IOP2) 
      IF(TEMP1.NE.0) GOTO 3200
C 
C  DCMC RETURNS THE FOLLOWING:
C 
C (A) REG=+CRN OF DISC DISMOUNTED 
C (B) REG=DISC LU AND BIT 15=1 IF RETURNED TO POOL
C                         14=1 IF DISMOUNTED BUT NOT POOL 
C 
C 
C  SEE IF IT WAS REALLY DISMOUNTED (AND IF IT WENT BACK TO
C  THE POOL). 
C 
      DMLEN=-38 
        IF(IB) 3150,3125
C 
C  DISC WAS NOT RETURNED TO POOL
C  SEE IF IT WAS DISMOUNTED FROM SYSTEM 
C 
3125  IF(IAND(IB,40000B).EQ.0) GOTO 3200
C 
C  IT WAS DISMOUNTED. ADJUST MESSAGE LENGTH 
C 
      DMLEN=-32 
C 
C 
C  IT WAS DISMOUNTED AND RETURNED TO THE POOL 
C  CONVERT CRN AND LU AND TELL THEM ABOUT IT
C 
3150  DBLK=4H 
      DMES(7)=IA
C 
C     MOVE CRN IN FRONT OF ASCII BLANKS FOR NAM.. TEST
C 
      NAMB=IA 
      IF(NAMT(NAMB).NE.0)  CALL CNUMD(IA,DMES(5)) 
      DMES(10)=KCVT(IAND(IBUF(I),77B))
C 
      CALL MESSP(10001B,DMES,DMLEN) 
C 
C 
3200    CONTINUE
C 
C 
C 
C  CHECK FOR GROUP DISMOUNTS
C 
C 
3300  IF(IAND(OPTNS,40000B).EQ.0) GOTO 4000 
      ID=40000B 
C 
3700  CONTINUE
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C  THIS SECTION CALLS THE SPOOL MONITOR PROGRAM (SMP) TO CLEAN-UP    C
C  ALL SPOOL FILES ASSOCIATED WITH THIS SESSION.                     C
C                                                                    C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
4000  CALL ISMVE(IOP2,0,ITMP1,1)
      CALL EXEC(100027B,6HSMP   ,19,DENT,IOP2,ITMP1)
      GOTO 4050 
4001  CONTINUE
C 
C 
C  RELEASE THE SCB
C 
4050  CALL RLSCB(IOP1,ITMP1)
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C  ACCOUNT FILE UPDATE SECTION
C 
C  LOCK THE ACCOUNT FILE RN 
C 
C  FIND THE ENTRY IN THE ACTIVE SESSION TABLE FOR THIS SESSION
C 
C 
      CALL RNRQ(1,IRN,ITMP1)
C 
C 
C 
      DO 4200 I=ACTIV,EACTV 
      CALL READF(IDCB,IERR,IBUF,128,ITMP1,I)
      IF(IERR.NE.0) GOTO 300
C 
        DO 4100 J=1,124,4 
        IF(IBUF(J).EQ.IOP1) GOTO 4300 
C 
4100    CONTINUE
4200  CONTINUE
C 
C 
C 
C  TO GET HERE MEANS THAT THE ACCOUNT FILE IS CORRUPT.
C 
C 
      CALL MESSP(100103B,28HLGOF 01 ACCOUNT FILE CORRUPT,-28) 
      GOTO 350
C 
C 
C 
C 
C 
4300  LOT1=IBUF(J+1)
      LOT2=IBUF(J+2)
      DREC=IBUF(J+3)/8+DIRC 
      DOFF=MOD(IBUF(J+3),8)*16
C 
C  CLEAR THE ACTIVE SESSION TABLE ENTRY 
C 
      IBUF(J)=0 
      CALL WRITF(IDCB,IERR,IBUF,128,I)
C 
C 
C  UPDATE ACTIVE SESSION COUNTER IN HEADER
C 
      CALL READF(IDCB,IERR,IBUF,128,ITMP1,1)
      IBUF(29)=IBUF(29)-1 
      CALL WRITF(IDCB,IERR,IBUF,128,1)
C 
C 
C 
C 
C 
C  GET LOG-OFF TIME 
C 
      CALL EXEC(11,TIME,YEAR) 
      CALL FTIME(OFMS1(3))
C 
C 
C  FORMAT LOG-OFF TIME FOR ACCT FILE
C 
      OFF1=TIME(2)+(TIME(3)*64)+((YEAR-1978)*4096)
      OFF2=TIME(4)+(TIME(5)*32) 
C 
C 
C 
C 
C 
C  CALCULATE CONNECT TIME 
C 
C 
C  LOT1 AND LOT2 REPRESENT THE LOG-ON TIME (PACKED LIKE OFF1&2) 
C 
C  THE TIME ARRAY CONTAINS THE FOLLOWING: 
C 
C  TIME(2)=SEC
C  TIME(3)=MIN
C  TIME(4)=HOUR 
C  TIME(5)=DAY
C 
C 
C  ISOLATE LOG-ON TIME
C 
      ONSEC=IAND(LOT1,77B)
      ONMIN=IAND(LOT1,7700B)/64 
      ONHR=IAND(LOT2,37B) 
      ONDAY=IAND(LOT2,37740B)/32
C 
C 
C  DO CONNECT TIME NOW
C 
C 
C  CONNECT SECONDS
C 
C 
C 
      SEC=TIME(2)-ONSEC 
      IF(SEC.GE.0) GOTO 5000
      SEC=60+TIME(2)-ONSEC
      TIME(3)=TIME(3)-1 
C 
C 
C 
C  CONNECT MIN
C 
C 
5000  MIN=TIME(3)-ONMIN 
      IF(MIN.GE.0) GOTO 5010
      MIN=60+TIME(3)-ONMIN
      TIME(4)=TIME(4)-1 
C 
C 
C  CONNECT HRS
C 
C 
5010  HRS=TIME(4)-ONHR
      IF(HRS.GE.0) GOTO 5020
      HRS=24+TIME(4)-ONHR 
      TIME(5)=TIME(5)-1 
C 
C 
C  CONNECT DAYS 
C 
C 
5020  DYS=TIME(5)-ONDAY 
      IF(DYS.GE.0) GOTO 5100
C 
      DYS=366+TIME(5)-ONDAY 
C 
      IF(MOD((YEAR-1),4).NE.0) DYS=DYS-1
C 
C 
C 
C 
C  CALCULATE TOTAL NUMBER OF CONNECT SECONDS
C  FOR ACCT FILE UPDATE. NOTE: DSEC IS A DOUBLE WORD INTEGER. 
C 
C 
5100  DSEC=0
      DSEC(2)=SEC+(MIN*60)
      CALL DCNCT(DSEC,HRS,DYS)
C 
C 
C 
C 
C 
C 
C  GET DIRECTORY ENTRY INTO MEMORY
C 
C 
      CALL READF(IDCB,IERR,IBUF,128,ITMP1,DREC) 
      IF(IERR.LT.0) GOTO 300
C 
C 
C  SPACE A LINE, THEN ISSUE "OFF" MESSAGES TO SESSION CONSOLE 
C 
      CALL MESSP(10001B,2H  ,-2)
      CALL MESSP(1,OFMS1,-34) 
C 
C  MOVE USER AND GROUP NAMES INTO MESSAGE BUFFER
C  AND ISSUE SHORT VERSION TO SYSTEM CONSOLE. 
C 
      NAML=MBT(IBUF(DOFF+1),OFMS1(13))
      CALL MESSP(2,OFMS1,-24+NAML)
C 
C 
C  DEFINE USER AND GROUP RECORD NUMBERS 
C 
C 
      GREC=IAND(IBUF(DOFF+14),77777B) 
      UREC=IAND(IBUF(DOFF+15),77777B) 
C 
C  DEFINE OFFSETS (MAY START AT WORD 65 OF SECTOR)
C 
      GOFF=0
      IF(IBUF(DOFF+14).LT.0) GOFF=64
C 
      UOFF=0
      IF(IBUF(DOFF+15).LT.0) UOFF=64
C 
C 
C  UPDATE THE USER ENTRY
C 
      CALL READF(IDCB,IERR,IBUF,128,ITMP1,UREC) 
C 
C  POST LAST LOG-OFF TIME TO USER ENTRY 
C 
      IBUF(UOFF+23)=OFF1
      IBUF(UOFF+24)=OFF2
C 
      CALL DADD(IBUF(25+UOFF),DSEC) 
      CALL DADD(IBUF(27+UOFF),DCPU) 
C 
C  FORMAT CUMULATIVE CONNECT TIME (DOUBLE WORD SECONDS) WHILE 
C  DATA IS IN MEMORY. 
C 
C 
C 
      CALL FCNCT(IBUF(25+UOFF),TIME)
      CALL CNV2(OFMS5(13),TIME) 
      OFMS5(19)=IOR(KCVT(TIME(2)),30060B) 
      OFMS5(24)=IOR(KCVT(TIME(3)),30060B) 
C 
C 
C 
      CALL WRITF(IDCB,IERR,IBUF,128,UREC) 
C 
C 
C 
C 
CC  CHECK FOR PENDING MAIL
C 
      MAIL=IBUF(UOFF+21)
C 
C 
C 
C  UPDATE GROUP ENTRY 
C 
C 
      CALL READF(IDCB,IERR,IBUF,128,ITMP1,GREC) 
C 
      CALL DADD(IBUF(2+GOFF),DSEC)
      CALL DADD(IBUF(4+GOFF),DCPU)
C 
      CALL WRITF(IDCB,IERR,IBUF,128,GREC) 
C 
C 
C  ACCOUNT FILE IS UPDATED. CLEAR THE LOCK
C 
      CALL RNRQ(4,IRN,ITMP1)
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C  CONNECT TIME CONVERSION (THIS SESSION) 
C 
C 
      HRS=DYS*24+HRS
C 
      CALL CNV2(OFMS3(13),HRS)
      OFMS3(19)=IOR(KCVT(MIN),30060B) 
      OFMS3(24)=IOR(KCVT(SEC),30060B) 
C 
      CALL MESSP(10001B,OFMS3,-54)
C 
C 
C  FORMAT CPU USAGE 
C 
      CALL FCPU(DCPU,TIME)
      OFMS4(14)=IOR(KCVT(TIME),30060B)
      OFMS4(19)=IOR(KCVT(TIME(2)),30060B) 
      OFMS4(24)=IOR(KCVT(TIME(3)),30060B) 
      CALL CNUMD(TIME(4)*10,OFMS4(28))
      OFMS4(30)=IOR(OFMS4(30),30060B) 
C 
C 
      CALL MESSP(10001B,OFMS4,-64)
C 
C 
C 
C 
C  ISSUE CUMULATIVE CONNECT TIME
C 
C 
      CALL MESSP(10001B,OFMS5,-54)
C 
C 
C  IF MAIL PENDING, SPACE A LINE AND LET THEM KNOW ABOUT IT.
CC
      IF(IAND(MAIL,100000B).EQ.0) GOTO 5500 
      CALL MESSP(10001B,2H  ,-2)
      CALL MESSP(10001B,16HMESSAGES WAITING,-16)
C 
C 
C 
5500  CALL MESSP(10001B,14HEND OF SESSION,-14)
C 
      GOTO 450
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C  RESPONSE TO KILL PROMPT
C 
6000  IF(IOP2.EQ.-1) GOTO 350 
      IF(IOP2.NE.SBUF) GOTO 550 
C 
C 
      IOP1=IAND(JBUF,777B)
      OPTNS=IAND(JBUF,177000B)
      IOP2=JBUF(2)
      CCLAS=JBUF(3) 
C 
C 
C  IF SESSION ID > 255 MUST NOT BE INTERACTIVE
C 
      INTER=0 
      IF(IAND(IOP1,400B).NE.0) GOTO 6025
      INTER=XFTTY(IOP1) 
C 
C 
C  VERIFY CALL PARAMETERS 
C 
6025  IF(VALID(DCPU,PID,GID,DENT).EQ.0) GOTO 550
C 
C  CHECK RESPONSE TO KILL PROMPT. ANYTHING OTHER THAN "Y" OR
C  A ZERO LENGTH TRANSFER IS TREATED AS "NO". 
C 
      IF(IB.EQ.0) GOTO 6050 
C 
      IF(SQUZ(IGBUF,IB).NE.131B) GOTO 7000
C 
C WE HAVE PERMISSION TO KILL, SET KILL FLAG AND CONTINUE
C 
6050  OK=1
      GOTO 626
C 
C 
C 
C  PERMISSION TO KILL NOT GIVEN.
C   IF INTERACTIVE, RESTART THE FMGR
C 
C 
C 
7000  IF(INTER.EQ.0) GOTO 550 
C 
C 
      ITMP1=IOR(KCVT(IOP1),30000B)
C 
      GX=43400B+(ITMP1/256) 
      XB=IAND(ITMP1,377B)*256+40B 
C 
      DO 7050 I=1,5 
      IBUF(I)=RUFM(I) 
7050  CONTINUE
C 
      IBUF(6)=2H,1
C 
      CALL MESSS(IBUF,12,1,IOP2)
C 
C 
      GOTO 550
C 
      END 
      END$