jdc@beach.cis.ufl.edu (Jeff Capehart) (03/23/88)
I hope everyone has a FORTRAN compiler, otherwise it may take a bit
of re-writing for this thing to work in another language. I had a
few problems with the terminal name because I use it to build the
process name for the clock subprocess. Not too many comments, it
is fairly short, and the system services are pretty well defined.
----EXTRACT_HERE_AND_SAVE_WITH_YOUR_EDITOR----------------------
PROGRAM CLOCK
*
* CLOCK V1.1
*
* Author: Jeff Capehart
* Username: MICRONAUT@UFOAK (jdc@beach.cis.ufl.edu)
* Date: March 1987
* Revised: March 1988 Fix process name to remove colon.
*
BYTE QLIST(20)/20*0/
INTEGER*4 JPIBUF(13)/13*0/,TCHAN,BUFLEN,OWNER,OL,PNL,TLEN,IMLEN,
1 PAD1,REPTIM,RPTIM2,PAD2,STS,PID,SYS$GETJPIW
INTEGER*2 TIMLEN
CHARACTER TIMBUF*23,TERM*9,ESC*1/'1B'X/,FREEZE*22,BUFFER*80,
1 PRCNAM*15,REVON*4,REVOFF*3
INCLUDE '($IODEF)/NOLIST'
INCLUDE '($JPIDEF)/NOLIST'
INCLUDE '($PQLDEF)/NOLIST'
FREEZE = ESC//'7'//ESC//'[1;73H'//ESC//'[1K'//ESC//'[2;24r'//ESC//'8'
JPIBUF(1)=4+JPI$_OWNER * 65536
JPIBUF(2)=%LOC(OWNER)
JPIBUF(3)=%LOC(OL)
JPIBUF(4)=80+JPI$_IMAGNAME * 65536
JPIBUF(5)=%LOC(BUFFER)
JPIBUF(6)=%LOC(IMLEN)
JPIBUF(7)=9+JPI$_TERMINAL * 65536
JPIBUF(8)=%LOC(TERM)
JPIBUF(9)=%LOC(TLEN)
JPIBUF(10)=15+JPI$_PRCNAM * 65536
JPIBUF(11)=%LOC(PRCNAM)
JPIBUF(12)=%LOC(PNL)
CALL SYS$GETJPIW (,,,%REF(JPIBUF),,,)
IF (INDEX(PRCNAM,'CLOCK') .NE. 0) THEN
CALL SYS$GETJPIW (,%REF(OWNER),,%REF(JPIBUF),,,)
If (term(tlen:tlen) .NE. ':') then
tlen = tlen + 1
term(tlen:tlen) = ':'
Endif
CALL SYS$ASSIGN (TERM,%REF(TCHAN),,)
BUFLEN = 26
CALL SYS$BINTIM('0 ::1',%REF(REPTIM))
CALL SYS$SCHDWK (,,%REF(REPTIM),%REF(REPTIM))
CALL SYS$QIOW (,%VAL(TCHAN),%VAL(IO$_WRITEVBLK+IO$M_CANCTRLO)
1 ,,,,%REF(FREEZE(1:1)),%VAL(22),,,,)
10 CALL SYS$ASCTIM(,TIMBUF,,%VAL(1))
BUFFER = ESC//'7'//ESC//'[1;73H'//ESC//'[7m'//
1 TIMBUF(1:8)//ESC//'[m'//ESC//'8'
CALL SYS$QIOW (,%VAL(TCHAN),%VAL(IO$_WRITEVBLK+
1 IO$M_CANCTRLO)
2 ,,,,%REF(BUFFER(1:1)),%VAL(BUFLEN),,,,)
CALL SYS$HIBER()
GOTO 10
ELSE
JPIBUF(4) = 0
IF (term(tlen:tlen) .EQ. ':') tlen = tlen -1
STS = SYS$GETJPIW (,%REF(PID),TERM(:TLEN)//'_CLOCK',%REF(JPIBUF),,,)
IF (STS .EQ. 1) THEN
CALL SYS$DELPRC(%REF(PID),)
PRINT *,ESC,'7',ESC,'[1;24r',ESC,'8'
ELSE
QLIST(1) = PQL$_BYTLM
QLIST(3) = 4
QLIST(6) = PQL$_CPULM
QLIST(7) = 150
QLIST(11)= PQL$_PGFLQUOTA
QLIST(13)= 1
CALL SYS$CREPRC(,BUFFER(:IMLEN),,,,,%REF(QLIST),
1 TERM(:TLEN)//'_CLOCK',%VAL(4),,,)
CALL LIB$SET_SYMBOL ('FREEZE','write sys$output "'//FREEZE,2)
ENDIF
ENDIF
END
-----END_OF_PROGRAM------------------------
--
Jeff Capehart Internet: jdc@beach.cis.ufl.edu
University of Florida UUCP: ..!ihnp4!codas!uflorida!beach.cis.ufl.edu!jdc