C C AUTHOR: C R. STODOLA C THE INSTITUTE FOR CANCER RESEARCH C 7701 BURHOLME AVE. C PHILADELPHIA, PA. 19111 C C ******************************************************* C * * C * THIS SOFTWARE WAS DEVELOPED WITH SUPPORT * C * FROM THE NATIONAL INSTITUTES OF HEALTH: * C * NIH CA06927 * C * NIH CA22780 * C * * C * DIRECT INQUIRIES TO: * C * COMPUTER CENTER * C * THE INSTITUTE FOR CANCER RESEARCH * C * 7701 BURHOLME AVENUE * C * PHILADELPHIA, PENNSYLVANIA 19111 * C * * C * NO WARRANTY OR REPRESENTATION, EXPRESS OR * C * IMPLIED, IS MADE WITH RESPECT TO THE * C * CORRECTNESS, COMPLETENESS, OR USEFULNESS * C * OF THIS SOFTWARE, NOR THAT USE OF THIS * C * SOFTWARE MIGHT NOT INFRINGE PRIVATELY * C * OWNED RIGHTS. * C * * C * NO LIABILITY IS ASSUMED WITH RESPECT TO * C * THE USE OF, OR FOR DAMAGES RESULTING FROM * C * THE USE OF THIS SOFTWARE * C * * C ******************************************************* C * * C * THIS SOFTWARE WAS DESIGNED FOR USE ON A * C * PDP-11/70 OPERATING UNDER IAS V2.0 USING * C * THE FORTRAN-IV PLUS COMPILER. * C * * C ******************************************************* C C NOTE THAT THE SIZE OF THIS PROGRAM MAKES LINKING IT AS A C PRIVILEGED TASK IMPRACTACLE. C C THE USER MUST ADJUST THESE PARAMETERS FOR EACH SYSTEM. C CITHD = .CITHD C CTU = C.TU C CITSIZ= CONTENTS OF REGISTER .CITSZ C IDN = I.DN C ITT = I.TT C IUNM = U.NM C PDSIT = THE NUMBER OF THE CIT ENTRY FOR PDS IN THE CIT TABLE (FIRST C IS ONE). C PARAMETER CITHD="40242,CTU=2,CITSIZ="12 PARAMETER IDN="24,ITT="26,IUNM="46 PARAMETER PDSIT=2 BYTE LINE(80),IDMES(32) INTEGER LOOSE(63),LUN(6),ISTAT(2),ULOCKS INTEGER MES(18),MLINE(42),ALL(6) EQUIVALENCE (IDMES,MES(3)),(LU,MLINE),(NCH,MLINE(2)) EQUIVALENCE (LINE,MLINE(3)) BYTE BNM(2) EQUIVALENCE (BNM,NM) INTEGER LUSER(6) COMMON/TTLOCK/LOCKS(0:63),ULOCKS(6,0:63) DATA IFFLAG,IEOFLG/0,0/ DATA ALL/2HAL,2HL ,4*2H / C C GET THIS PROGRAMS TT# C CALL GETLUN(5,LUN) IF(LUN(1).NE.2HTT)GO TO 50 IUN=LUN(2).AND."77 C C TURN OFF THIS TERMS LOCK. C NTSUSR=0 IF(IUN.EQ.0)NTSUSR=-1 LOCKS(IUN)=NTSUSR GO TO 15 C C GET THE COMMAND LINE. C 10 IFFLAG=-1 IF(IUN.EQ.0)LOCKS(0)=-1 15 IF(IEOFLG)50,17,50 17 CALL GUNAM(LOCK,LIST,LUSER,IER) IF(IER)20,40,40 20 TYPE 30 30 FORMAT(/' COMMAND ERROR') GO TO 10 40 IL=LOCK+LIST+IER IF(IL)50,50,60 C C EOF OR NULL LINE, SO TERMINATE. C 50 CALL EXIT C C INITIATE LOCK CHECK. C 60 DO 70 I=1,63 70 LOOSE(I)=0 C C SCAN PDS UTN LIST FOR ACTIVE TERMINALS. NOTE THAT IF THIS COULD C BE A PRIVILEGED TASK, IT WOULD SCAN CIT LIST FOR PDS. INSTEAD C WE WILL ASSUME THAT PDS IS THE "PDSIT"TH CIT ENTRY. C CALL GLAD(CITHD,IPDS) IPDS=IPDS+((PDSIT-1)*CITSIZ+CTU) NPDS=IPDS 80 CALL GLAD(NPDS,NPDS) IF(NPDS.EQ.IPDS)GO TO 100 CALL GLAD(NPDS+IDN,IDV) IF(IDV.NE.2HTT)GO TO 80 CALL GLAD(NPDS+ITT,NDEV) NDEV=NDEV.AND."77 IF(NDEV.EQ.0)GO TO 80 NUN=NPDS+IUNM CALL GLAD(NUN,IFILL) IF(IFILL.NE.0)IFILL="40 DO 90 I=1,6 CALL GLAD(NUN,NM) IF(BNM(1).EQ.0)BNM(1)=IFILL IF(BNM(2).EQ.0)BNM(2)=IFILL IF(ULOCKS(I,NDEV).EQ.NM)GO TO 90 ULOCKS(I,NDEV)=NM LOCKS(NDEV)=0 90 NUN=NUN+2 LOOSE(NDEV)=-1 IF(ULOCKS(1,NDEV).EQ.0)LOCKS(NDEV)=0 GO TO 80 C C UNLOCK ANY TERMINAL NOT FOUND. C 100 DO 110 I=1,63 IF(LOOSE(I).NE.0)GO TO 110 LOCKS(I)=0 DO 105 J=1,4 105 ULOCKS(J,I)=0 110 CONTINUE NLINES=0 C C NOW INTERPRET COMMAND. C IF(LOCK)120,130,120 C C LOCK USER C 120 LOCKS(IUN)=-2 130 IF(LIST)140,180,140 C C LIST ALL USERS ON SYSTEM C 140 DO 170 I=1,63 IF(ULOCKS(1,I))150,170,150 150 IH=I/8+48 IL=MOD(I,8)+48 IF(LOCKS(I))165,155,165 155 TYPE 160,IH,IL,(ULOCKS(J,I),J=1,6) 160 FORMAT(' TT'2A1': '6A2) GO TO 170 165 TYPE 167,IH,IL,(ULOCKS(J,I),J=1,6) 167 FORMAT(' TT'2A1': '6A2' (BUSY)') 170 CONTINUE 180 IF(IER)190,10,190 C C NOW TALK TO USER. C 190 IF(IUN.NE.0)GO TO 197 DO 193 I=1,6 IF(LUSER(I).NE.ALL(I))GO TO 197 193 CONTINUE LU=-1 GO TO 230 197 DO 210 I=0,63 DO 200 J=1,6 IF(LUSER(J).NE.ULOCKS(J,I))GO TO 210 200 CONTINUE LU=I GO TO 230 210 CONTINUE TYPE 220,LUSER 220 FORMAT(1X,6A2' NOT ON SYSTEM.') GO TO 10 230 IF(IUN.EQ.0)GO TO 290 IF(LU.EQ.0.AND.LOCKS(0).EQ.IUN)GO TO 300 IF(LOCKS(LU))240,300,240 240 TYPE 250,LUSER 250 FORMAT(1X,6A2' IS BUSY.') GO TO 10 290 LOCKS(0)=LU 300 CALL GTLIN(LINE,NCH) IF(IFFLAG.NE.0.OR.NLINES.NE.0.OR.IEOFLG.NE.0)GO TO 305 IF(NCH.NE.0)GO TO 305 IEOFLG=-1 GO TO 300 305 IF(NCH)10,10,310 310 IF(NLINES.NE.0)GO TO 318 ENCODE(32,312,IDMES)(ULOCKS(J,IUN),J=1,6) 312 FORMAT('***** MESSAGES FROM '6A2) MES(1)=LU MES(2)=32 IF(IUN.EQ.0)GO TO 315 IF(LU.EQ.0.AND.LOCKS(0).EQ.IUN)GO TO 315 IF(LOCKS(LU).NE.0)GO TO 240 315 CALL SENDR(MES,18) 318 NLINES=NLINES+1 NW=(NCH+5)/2 IF(IUN.EQ.0)GO TO 320 IF(LU.EQ.0.AND.LOCKS(0).EQ.IUN)GO TO 320 IF(LOCKS(LU).NE.0)GO TO 240 320 CALL SENDR(MLINE,NW) GO TO 230 END SUBROUTINE SENDR(MES,NW) INTEGER MES(NW),SDATR(2) INTEGER ULOCKS COMMON/TTLOCK/LOCKS(0:63),ULOCKS(6,0:63) PARAMETER IEUNS=-4 DATA SDATR/3R.SD,3RAT./ LU=MES(1) IF(LU)10,20,20 10 IL=1 IH=63 GO TO 30 20 IL=LU IH=LU 30 DO 50 I=IL,IH MES(1)=I 35 IF(ULOCKS(1,I).EQ.0)GO TO 50 CALL VSNDRR(SDATR,,MES,,NW,,,IDSW) IF(IDSW.GE.0)GO TO 50 TYPE 555,IDSW 555 FORMAT(I7) IF(IDSW.NE.IEUNS)GO TO 50 C C POOL EXHAUSTED, SO WAIT FOR 100 MILLISECONDS C 40 CALL MARK(6,6,1) CALL WAITFR(6) GO TO 35 50 CONTINUE MES(1)=LU RETURN END