!***********************************************************************
!*
!*                 PAGETURN monitoring analysis program
!*
!*       Copyright (C) R.D. Eager   University of Kent   MCMLXXXI
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!*          Constants
!*
!***********************************************************************
!
%CONSTINTEGER MAXEPAGE = 120*64-1;   ! Maximum number of epages in VM
%CONSTBYTEINTEGERARRAY HEX(0:15) = %C
'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
!
!
!***********************************************************************
!*
!*          Subsystem references
!*
!***********************************************************************
!
%SYSTEMSTRINGFNSPEC FAILUREMESSAGE(%INTEGER MESS)
%SYSTEMROUTINESPEC FILL(%INTEGER LENGTH,FROM,FILLER)
%SYSTEMINTEGERFNSPEC IOCP(%INTEGER EP,PARM)
%SYSTEMROUTINESPEC SETPAR(%STRING(255) S)
%EXTERNALROUTINESPEC SET RETURN CODE(%INTEGER I)
%SYSTEMSTRINGFNSPEC SPAR(%INTEGER N)
!
%EXTERNALROUTINESPEC CLEAR(%STRING(255) S)
%EXTERNALROUTINESPEC DEFINE(%STRING(255) S)
!
!
!***********************************************************************
!*
!*          Service routines
!*
!***********************************************************************
!
%ROUTINE FAIL(%INTEGER FLAG)
SELECTOUTPUT(0)
NEWLINE
PRINTSTRING("KAN fails - ".FAILUREMESSAGE(FLAG))
SET RETURN CODE(FLAG)
%STOP
%END;   ! of FAIL
!
!
%ROUTINE OUTHEX(%INTEGER N)
%INTEGER I
!
%CYCLE I = 28,-4,0
   PRINTSYMBOL(HEX((N >> I) & X'F'))
%REPEAT
%END;   ! of OUTHEX
!
!
!***********************************************************************
!*
!*          K A N
!*
!***********************************************************************
!
%EXTERNALROUTINE KAN(%STRING(255) PARMS)
%INTEGER I,J,SEG,AD,EPAGE,LASTSEG,BAD,MAX,K,C
%REAL SCALE
%STRING(31) INPUT,OUTPUT
%STRINGNAME S
%INTEGERARRAY EPAGE REFS(0:MAXEPAGE)
!
%ON %EVENT 9 %START;   ! Trap 'Input Ended'
   -> EOF
%FINISH
!
SET RETURN CODE(1000);   ! In case of catastrophic failure
!
SETPAR(PARMS)
INPUT = SPAR(1)
OUTPUT = SPAR(2)
%IF INPUT = "" %THEN FAIL(263);   ! Wrong number of parameters
%IF OUTPUT = "" %THEN OUTPUT = ".OUT"
DEFINE("1,".INPUT)
DEFINE("2,".OUTPUT)
SELECTINPUT(1)
SELECTOUTPUT(2)
!
FILL((MAXEPAGE+1)*4,ADDR(EPAGE REFS(0)),0);   ! Clear counts
BAD = 0
MAX = 0
!
%CYCLE
   S == STRING(IOCP(6,0));   ! Use fast line reading routine
   %CONTINUE %IF LENGTH(S) < 100
   %CONTINUE %UNLESS FROMSTRING(S,1,19) = "PAGETURN: 00040001 "
   AD = 0
   %CYCLE I = 38,1,45
      C = CHARNO(S,I)
      %IF '0' <= C <= '9' %THEN C = C - '0' %ELSE C = C - 'A' + 10
      AD = (AD << 4)!C
   %REPEAT
   EPAGE = AD >> 12
   %UNLESS 0 <= EPAGE <= MAXEPAGE %THEN %START
      BAD = BAD + 1
      %CONTINUE
   %FINISH
   J = EPAGE REFS(EPAGE) + 1
   %IF J > MAX %THEN MAX = J
   EPAGE REFS(EPAGE) = J
%REPEAT
!
EOF:
SCALE = MAX/90
NEWLINE
PRINTSTRING("Scale ="); PRINT(SCALE,1,1); PRINTSTRING(":1"); NEWLINES(2)
!
PRINTSTRING("Bad records:"); WRITE(BAD,1); NEWLINES(2)
PRINTSTRING("Segment   Epage  Count  Address")
NEWLINES(2)
LASTSEG = -1
!
%CYCLE I = 0,1,MAXEPAGE
   %CONTINUE %IF EPAGE REFS(I) = 0
   SEG = I >> 6
   %IF SEG = LASTSEG %THEN SPACES(5) %ELSE %START
      LASTSEG = SEG
      WRITE(SEG,4)
   %FINISH
   WRITE(I - (SEG << 6),7); WRITE(EPAGE REFS(I),7); SPACES(2)
   OUTHEX((SEG << 18)!(I << 12))
   PRINTSTRING("   |   ")
   K = INT PT(EPAGE REFS(I)/SCALE)
   %IF K = 0 %THEN K = 1
   J = IOCP(17,'*'!(K << 8));   ! Print K asterisks
   NEWLINE
%REPEAT
SELECTINPUT(0)
SELECTOUTPUT(0)
CLOSESTREAM(1)
CLOSESTREAM(2)
CLEAR("1,2")
SET RETURN CODE(0)
%END;   ! of KAN
%ENDOFFILE