CONSTINTEGER  NEWCONNECT = 0; ! Set this non-zero to work with the
                              ! new CONNECT mechanism.
ENDOFLIST 
INCLUDE  "ERCC16.SSOWNF"
LIST 
! %RECORDFORMAT SSOWNF(%INTEGER SSMONAD,DIAGMON)
! %EXTRINSICRECORD(SSOWNF) SSOWN
RECORDFORMAT  RF(INTEGER  CONAD, FTYPE, DATASTART, DATAEND)
RECORDFORMAT  FRF(INTEGER  CONAD, FILETYPE, DATASTART, DATEND,  C 
   SIZE, RUP, EEP, APF, USERS, ARCH,  C 
   STRING  (6) TRAN, STRING  (8) DATE, TIME,  C 
   INTEGER  COUNT, SPARE1, SPARE2)
RECORDFORMAT  HDRF(INTEGER  DATAEND,DATASTART,SIZE,TYPE,PASS1,DATETIME, C 
   NEXTCYC,SEMA)
SYSTEMROUTINESPEC  DISCONNECT(STRING (31) FILE, INTEGERNAME  FLAG)
SYSTEMROUTINESPEC  FINFO(STRING (31) FILE, INTEGER  MODE, C 
   RECORD (FRF)NAME  FR, INTEGERNAME  FLAG)
SYSTEMROUTINESPEC  WRLOG(STRING (255) ENTRY)
SYSTEMSTRINGFNSPEC  HTOS(INTEGER  I,PL)
SYSTEMSTRINGFNSPEC  ITOS(INTEGER  I)
SYSTEMROUTINESPEC  CONNECT(STRING  (31) S,  C 
   INTEGER  MODE, HOLE, PROT, RECORD (RF)NAME  R, INTEGERNAME  FLAG)
! %SYSTEMROUTINESPEC CHANGEACCESS(%STRING(31) FILE,%INTEGER MODE, %C
! %INTEGERNAME FLAG)
SYSTEMROUTINESPEC  SETUSE(STRING (31) FILE, INTEGER  MODE,VALUE)
SYSTEMROUTINESPEC  MOVE(INTEGER  LEN,FROM,TO)
EXTERNALINTEGERFNSPEC  DDELAY(INTEGER  SECS)
SYSTEMROUTINESPEC  OUTFILE(STRING (31) S, INTEGER  SIZE,MAXBYTES, C 
PROTECTION, INTEGERNAME  CONAD,FLAG)
SYSTEMSTRINGFNSPEC  FAILUREMESSAGE(INTEGER  FLAG)
EXTERNALSTRINGFNSPEC  UINFS(INTEGER  I)
EXTERNALINTEGERFNSPEC  UINFI(INTEGER  I)
EXTERNALSTRINGFNSPEC  DATE
EXTERNALSTRINGFNSPEC  TIME
CONSTSTRING (4) LASTFN="}{|~"; ! This can be used instead of a file name
!       as a parameter to CONNECT, etc., to mean "the last file I nominated".
CONSTSTRING (7) SSMONFILE="SS#MON"
CONSTINTEGER  DEFMONSIZE=X'10000'; ! 64K
CONSTINTEGER  SSCHARFILETYPE=3
!
!
INTEGERFN  STINT(STRING (15) S, INTEGERNAME  INT)
INTEGER  I,J,K,L,SIGN
LONGINTEGER  RES
CONSTINTEGER  BIGGEST INT=X'7FFFFFFF'
L=LENGTH(S)
->ERR IF  L=0
RES=0
J=CHARNO(S,1)
IF  J='X' THEN  START 
   IF  L>9 THEN  -> ERR
   FOR  I=2,1,L CYCLE 
      J = CHARNO(S,I)-'0'
      IF  J>9 THEN  J=J+'0'-'A'+10
      UNLESS  0<=J<=15 THEN  -> ERR
      RES = (RES<<4)!J
   REPEAT 
FINISH  ELSE  START 
   K=1
   IF  J='-' THEN  SIGN=-1 AND  K=2 ELSE  SIGN=1
   IF  J='+' THEN  K=2
   FOR  I=K,1,L CYCLE 
      UNLESS  '0'<=CHARNO(S,I)<='9' THEN  -> ERR
      RES=RES*10+CHARNO(S,I)-48
      ->ERR IF  RES>BIGGEST INT
   REPEAT 
   RES=RES*SIGN
FINISH 
INT<-RES
RESULT =0
ERR:
RESULT =-1
END ;  ! OF STINT
!
!
EXTERNAL {SYSTEM}ROUTINE STARTMON(STRING (255) S)
RECORD (FRF) FR
RECORD (HDRF)NAME  H
RECORD (RF) RR
INTEGER  FLAG,CONAD,SSMONSIZE
STRING (255) ENTRY
! See whether we know anything already
IF  SSOWN_SSMONAD=0 THEN  START 
   ! Not actively monitoring but the monitoring file may already exist.
   ! If it doesn't then set it up, otherwise connect in required mode
   ! Check SS#MON status.
   FINFO(SSMONFILE,0,FR,FLAG);  ! Don't connect it even if it exists.
   IF  0#FLAG#218 THEN  ->ERR
   IF  FLAG#0 THEN  START 
      ! SS#MON doesnt exist - create it
      ! Has a size been requested?
      FLAG=STINT(S,SSMONSIZE)
      IF  FLAG#0 THEN  FLAG=140 {Invalid integer} AND  ->ERR
      IF  SSMONSIZE<DEFMONSIZE THEN  SSMONSIZE=DEFMONSIZE
      OUTFILE(SSMONFILE,SSMONSIZE,SSMONSIZE,0,CONAD,FLAG)
      IF  FLAG#0 THEN  ->ERR
      H==RECORD(CONAD)
      H_DATAEND=SSMONSIZE
      H_TYPE=SSCHARFILETYPE
      H_PASS1=1
      H_NEXTCYC=H_DATASTART
      H_SEMA=-1
      PRINTSTRING(SSMONFILE." created OK
")
   FINISH 
   CONNECT(SSMONFILE,11,0,8,RR,FLAG);   ! Write shared/Perm connect/
   ->ERR IF  FLAG#0
   SSOWN_SSMONAD=RR_CONAD
FINISH  ELSE  PRINTSTRING("Already monitoring
") AND  RETURN 
SSOWN_DIAGMON=0
ENTRY="DT: ".DATE." ".TIME." ".UINFS(1)." Procno=".ITOS(UINFI(11)). C 
" Invoc=".ITOS(UINFI(13)).": MONITOR ON
"
WRLOG(ENTRY)
RETURN 
ERR:
PRINTSTRING("STARTMON fails -".FAILUREMESSAGE(FLAG))
RETURN 
END ;  ! OF STARTMON
!
!
EXTERNALROUTINE  ENDMON(STRING (255) S)
STRING (255) ENTRY
IF  SSOWN_SSMONAD=0 THEN  PRINTSTRING("Not currently monitoring
") AND  RETURN 
SSOWN_DIAGMON=0
ENTRY="DT: ".DATE." ".TIME." ".UINFS(1)." Procno=".ITOS(UINFI(11)). C 
" Invoc=".ITOS(UINFI(13)).": MONITOR OFF
"
WRLOG(ENTRY)
SSOWN_SSMONAD=0
RETURN 
END ;  ! OF ENDMON
!
EXTERNALROUTINE  MONLEVEL(STRING (255) S)
INTEGER  FLAG,I
IF  SSOWN_SSMONAD=0 THEN  PRINTSTRING("Not currently monitoring
") AND  RETURN 
IF  S="?" THEN  PRINTSTRING("Current level: X".HTOS(SSOWN_DIAGMON,8)."
") AND  RETURN 
FLAG=STINT(S,I)
PRINTSTRING("Invalid integer
") AND  RETURN  IF  FLAG#0
SSOWN_DIAGMON=I
RETURN 
END ;  ! OF MONLEVEL
!
!
EXTERNAL {SYSTEM}ROUTINE SSLOG(STRING  (255) S)
RECORD (RF) RR
RECORD (HDRF)NAME  H,H1
INTEGER  FLAG,ASEMA,SIZE,CONAD,L,MAXTRIES
IF  SSOWN_SSMONAD=0 THEN  START 
   CONNECT(SSMONFILE,11,0,0,RR,FLAG)
   ->ERR IF  FLAG#0
   IF  NEWCONNECT#0 THEN  SETUSE(LASTFN,-1,0)
FINISH  ELSE  RR_CONAD=SSOWN_SSMONAD
H==RECORD(RR_CONAD)
! Calculate size of T#MON. Depends whether it has wrapped round.
IF  H_PASS1=0 THEN  SIZE=H_DATAEND ELSE  SIZE=H_NEXTCYC
OUTFILE("T#MON",SIZE,0,0,CONAD,FLAG)
->ERR IF  FLAG#0
H1==RECORD(CONAD)
H1_DATAEND=SIZE
H1_TYPE=SSCHARFILETYPE
MAXTRIES=3
! Try to claim the semaphore
! Construct a descriptor to it
ASEMA=RR_CONAD+28;  ! Address of the semaphore.
AGAIN:
*LDTB_X'28000001';  ! Load descriptor type and bound 
*LDA_ASEMA;         ! Load descriptor address
*INCT_(DR );        ! Increment and test descriptor
*JCC_7,<WAIT>;      ! Jump to label WAIT on condition code 7 i.e. H_SEMA>0
! Got the semaphore if here.
IF  H_PASS1#0 THEN  MOVE(SIZE-32,RR_CONAD+32,CONAD+32) ELSE  START 
   L=SIZE-H_NEXTCYC
   MOVE(L,RR_CONAD+H_NEXTCYC,CONAD+32)
   MOVE(H_NEXTCYC-32,RR_CONAD+32,CONAD+32+L)
FINISH 
! Now release the semaphore
*LDTB_X'28000001'
*LDA_ASEMA
*LSS_-1;      ! Load ACC with -1
*ST_(DR );    ! Store it in H_SEMA
DISCONNECT("T#MON",FLAG)
PRINTSTRING("T#MON written
")
RETURN 
WAIT:
PRINTSTRING("**Can't claim semaphore
") AND  RETURN  IF  MAXTRIES=0
FLAG=DDELAY(1)
MAXTRIES=MAXTRIES-1
->AGAIN
ERR:
PRINTSTRING("SSLOG fails - ".FAILUREMESSAGE(FLAG))
RETURN 
END ;  ! OF SSLOG
ENDOFFILE