COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "SEEJOB"
C00005 00003	! program specific defines, etc
C00010 00004	! Job info fetching routines
C00014 00005	! Hash table routines
C00016 00006	! User interface routines
C00017 00007	! Display_the_Output routines
C00019 00008	! The main program starts here
C00021 ENDMK
C⊗;
BEGIN "SEEJOB"

COMMENT Peek into another job's tables and display them.  Maybe eventaully extend
  to tell how much time is spent in certain loops, etc.;

REQUIRE "DDHDR.SAI[GRA,HPM]" SOURCE_FILE;
REQUIRE "LOITER.REL[HAK,ROB]" LOAD_MODULE;
REQUIRE "{}<>" DELIMITERS;

DEFINE !={COMMENT};

LET ⊂ = BEGIN, ⊃ = END, S⊂ = START_CODE, Q⊂ = QUICK_CODE;

DEFINE
  SP={" "}, CR={('15&"")}, LF={('12&"")}, ↓={(CR&LF)}, TAB={('11&"")},
  FF={('14&"")}, ALT={('175&"")},comma={", "};
DEFINE
  THRU={STEP 1 UNTIL};
DEFINE
  D$PRINT(str) = {IFC D$BUG THENC PRINT(str) ENDC},
  D$ONLY(s) = {IFC D$BUG THENC ⊂ s ⊃ ENDC},
  D$BUG ← {-1};

DEFINE PI = { 3.1415926536 };
DEFINE pos_int_infinity = { '377777777777 }; ! = 34359738367;
DEFINE neg_int_infinity = { '400000000000 }; ! = -34359738368;
DEFINE pos_real_infinity = {  1.70141182@38 }; ! just weird numbers that work;
DEFINE neg_real_infinity = { -1.69808878@38 };

DEFINE clear_screen = { CALL ((-1 LSH 18) + LOCATION ('004000000516), "TTYSET") };
DEFINE Quit = { BEGIN CALL(1,"EXIT"); END };
DEFINE ErrQuit(s) = { BEGIN PRINT(S); CALL(1,"EXIT"); END };

DEFINE LeftMask=(-1 LSH 18); ! Left half-word mask;
DEFINE RightMask=(-1 LSH -18); ! Right half-word mask;
DEFINE LeftHalf(Word)={((Word) LSH -18)}; ! Left half-word;
DEFINE RightHalf(Word)={((Word) LAND RightMask)}; ! Right half-word;
DEFINE XWD(Left,Right)={( ((Left) LSH 18) LOR ((Right) LAND RightMask) )};

! program specific defines, etc;

DEFINE
  HashLen = 4663, HashMul = 761;

DEFINE MakSym(SYM,Val,Incr) =
 {DEFINE SYM = {Val};
  REDEFINE $Loc = {$Loc + Incr}};

DEFINE $Loc = 0;
DEFINE JDLen = '140;		! Length of JOB DATA AREA;
MakSym(JOBAC, '000,'20);	! PLACE WHERE USER ACS ARE STORED ON UUO CALLS;
MakSym(JOBDAC,'020,'20);	! PLACE WHERE HARDWARE ACS(0-16) ARE STORED;
MakSym(JOBUUO,'040,'01);	! USER UUO TRAP LOC.(UUO STORED HERE);
MakSym(JOB41, '041,'01);	! USER UUO JSR LOCATION;
MakSym(JOBERR,'042,'01);	! IN WHICH RPG SYSTEM PASSES ERRORS TO THE LOADER;
MakSym(JOBENB,'043,'01);	! LH=PC CHNG,AR OVF ENABLE/DISABLE APR BITS;
MakSym(JOBREL,'044,'01);	! LH=0,RH=HIGHEST REL. ADR. IN USER AREA;
MakSym(JOBTM1,'045,'05);	! SOME TEMP CELLS TOO;
MakSym(JOBPDL,'052,'16);	! PUSHDOWN LIST FOR GETPDL AND GIVPDL TO USE;
MakSym(JOBINT,'071,'01);	! TO SEPARATE OLD AND NEW INTERRUPT SYSTEMS;
MakSym(JOBHCU,'072,'01);	! HIGHEST USER IO CHANNEL IN USE;
MakSym(JOBPC, '073,'01);	! JOB PC WHEN JOB INACTIVE;
MakSym(JOBSAV,'073,'01);	! FIRST LOC.-1 WRITTEN BY SAVE COMMAND;
MakSym(JOBDDT,'074,'01);	! LH UNUSED,RH=STARTING ADDRESS OF USER DDT;
MakSym(JOBJDA,'075,'20);	! JOB DEVICE ASSIGNMENT TABLE;
MakSym(JOBPFI,'114,'01);	! HIGHEST LOC. IN JOB DATA AREA PROTECTED FROM IO;
MakSym(JOBHRL,'115,'01);	! HIGHEST ADDRESS OF UPPER SEGMENT;
MakSym(JOBSYM,'116,'01);	! POINTER TO LOADER AND DDT SYMBOL TABLE POINTER;
MakSym(JOBUSY,'117,'01);	! POINTER TO UNDEFINED SYMBOL TABLE;
MakSym(JOBSA, '120,'01);	! LH=FIRST LOC NOT LOADED BY RELOCATING LOADER;
MakSym(JOBFF, '121,'01);	! FIRST FREE LOCATION IN USER AREA;
MakSym(JOBS41,'122,'01);	! C(JOB41) SAVED HERE ON SAVE COMMAND;
MakSym(JOBEXM,'123,'01);	! LAST LOC EXAMINED OR DEPOSITED USING ;
MakSym(JOBREN,'124,'01);	! REENTER ADDRESS FOR REENTER COMMAND;
MakSym(JOBAPR,'125,'01);	! PLACE TO TRAP TO IN USER AREA ON APR TRAP;
MakSym(JOBCNI,'126,'01);	! APR IS CONIED INTO C(JOBCNI) ON APR TRAP;
MakSym(JOBTPC,'127,'01);	! PC IS STORED HERE ON USER APR TRAP;
MakSym(JOBOPC,'130,'01);	! OLD PC IS STORED HERE ON START,DDT,REENTER,;
MakSym(JOBCHN,'131,'01);	! LH=FIRST LOC AFTER FIRST FORTRAN 4 LOADED PROGRAM;
MakSym(JOBFDV,'132,'01);	! DEV. DATA BLOCK ADR. FOR FINISH COMMAND;
MakSym(JOBCOR,'133,'01);	! SIZE OF CORE FOR JOB ON RUN,SAVE,GET COM.;
MakSym(HINAME,'134,'01);	! NAME OF UPPER SEGMENT OVER SAVE-GET;
MakSym(HILOC, '135,'01);	! LOC OF UPPER SEGMENT IN DUMP FILE OVER SAVE-GET;
MakSym(JOBVER,'137,'01);	! JOB VERSION;
MakSym(JOBDA ,'140,'00);	! FIRST LOC NOT USED BY JOB DATA AREA;

! Job info fetching routines;

INTEGER PROCEDURE GetJDA(INTEGER JobNo; INTEGER ARRAY InfBlk);
    ! The JOBRD UUO does a Block Transfer (BLT) of some job's (partial) core
      image
      into your own.  This routine uses this UUO to fetch the Job Data
      Area" (locations '0-JDLen) of JobNo into the specified array (InfBlk).
      The routine will return False (=0) if there was no error, and a (small)
      negative integer (see UUO manual page 149) to indicate an error;
    S⊂
      LABEL JobBlk,GetJD1;
      DEFINE JOBRD = {'400050}, NWC = {-JDLen};
	MOVEI	3,JobBlk	;
	MOVE	2,JobNo		;
	MOVEM	2,0(3)		;
	MOVSI	2,NWC		;
	MOVEM	2,1(3)		; ! -word count,,0
	MOVE	2,InfBlk	;
	MOVEM	2,2(3)		;
	SETZM	1		; ! error ← FALSE;
	CALLI	3,JOBRD		;
	MOVN	1,1(3)		; ! if error, then return -cause in register 1;
	JRST	GetJD1		;
JobBlk:	0			; ! Job number for JOBRD;
	0			; ! -Word Count,,Starting Address;
	0			; ! address of where data gets stored;
GetJD1:	
    ⊃;

INTEGER PROCEDURE GetJPC(INTEGER JobNo);
    ! The routine will return 0 if there was no error, and a (small)
      negative integer (see UUO manual page 149) to indicate an error;
    S⊂
      LABEL JobBlk,GetJP1;
      DEFINE JOBRD = {'400050};
	MOVEI	3,JobBlk	;
	MOVE	2,JobNo		; ! Set the Job Number for JOBRD;
	MOVEM	2,0(3)		;
	HRROI	2,JobPC		; ! WCMA = -1,,JobPC (fetch 1 word starting at JobPC);
	MOVEM	2,1(3)		;
	MOVEI	2,1		; ! Set the destination for JOBRD ( = register 1);
	MOVEM	2,2(3)		;
!	SETZM	1		; ! error ← FALSE (commented out because 1 is always set);
	CALLI	3,JOBRD		;
	MOVN	1,1(3)		; ! if error, then return cause in register 1;
	JRST	GetJP1		;
JobBlk:	0			; ! Job number for JOBRD;
	0			; ! -Word Count,,Starting Address;
	0			; ! address of where data gets stored;
GetJP1:	
    ⊃;

INTEGER PROCEDURE GetTTI(INTEGER JobNo);
  ! This routine will return the total run time (in tics) of
    the specified job.  The SETMAP routine *must* be called
    once before this routine can be executed;
  DEFINE TTIME = {'400214};
  S⊂
	MOVE	2,TTIME		; ! Fetch the address of the TTIME job table;
	ADD	2,JobNo		; ! Index using Job Number;
	MOVE	1,'400000(2)	; ! Fetch the TTIME;
  ⊃;

PROCEDURE SetMap;
  ! This routine maps the system table as an upper segment to this
    job.  It must be called before attempting to read the system
    tables;
  DEFINE SETPR2 = {'400052};
  S⊂
	MOVSI 1,'377777	;
	CALLI 1,SETPR2	;
	JRST 4,		; ! error return - help! ;
  ⊃;

! Hash table routines;
! these routines use the (globally defined) symbols Hashlen and HashMul.
  The algorithm used is MHASH(val) = (val * HashMul) MOD HashLen;

INTEGER PROCEDURE Mhash(INTEGER val);
  ! This routine returns a hashed value between 0 and HashLen-1;
  Q⊂
	MOVE 1,val		;
	IMULI 1,HashMul		; ! Some number relatively prime to HashLen;
	IDIVI 1,HashLen		;
	MOVE  1,2		; ! Return val MOD HashLen;
  ⊃;

INTEGER PROCEDURE EnHash(INTEGER val; INTEGER ARRAY HashTab);
  ! Returns index into HashTab, inserting HASH(val) as needed;
  ! This routine would do well to be START_CODED (ROB 31-Jul-79);
  ⊂
    DEFINE the_cows_come_home = {FALSE};
    INTEGER indx, first;

    indx ← first ← Mhash(val);
    DO 
      ⊂
	IF HashTab[indx] = val THEN RETURN(indx);
	IF HashTab[indx] = 0 THEN ⊂ HashTab[indx] ← val; RETURN(indx) ⊃;
	IF (indx ← indx + 1 MOD HashLen) = first THEN ErrQuit("Hash table full!");
      ⊃
      UNTIL the_cows_come_home;
  ⊃;

! User interface routines;

PROCEDURE SetLimits(
  INTEGER char;
  REFERENCE INTEGER Lo_X, Lo_Y, Hi_X, Hi_Y);
  ! This routine will set the X and Y scale according to what
    characters have been typed;

  ⊂ "SetLimits"
!   CASE MakeUpper(char) OF BEGIN
      ["("]
      [")"]
      ["["]
      ["]"]
      ["/"]
      ["\"]
      ["∂"]
      ["∞"]
      ["B"]
      ["T"]
      END;
  ⊃ "SetLimits";

! Display_the_Output routines;

  PROCEDURE DumpArray(INTEGER ARRAY PCs, Hits; INTEGER count);
    ! Used as a quick and dirty way to see the results;
    ⊂ "DumpArray"
      INTEGER I;
      PRINT(↓,"Loc",tab,"hits",tab,"percent of total",↓);
      FOR I ← 0 THRU HashLen - 1 DO
        IF Hits[I] ≠ 0 THEN 
  	  PRINT(CVOS(PCs[I]),tab,Hits[I],tab,(Hits[I]*100)/count,"%",↓);
    ⊃ "DumpArray";

PROCEDURE DPYArray(
  INTEGER ARRAY PCs, Hits;
  INTEGER count, xlo, ylo, xhi, yhi, DDChan);
  ⊂ "DPYArray" INTEGER I;
    LITEN;
    SCREEN(xlo, ylo, xhi, yhi);
    ERASE(DDChan);
    LINE(xlo,ylo,xlo,yhi);
    FOR I ← 0 THRU HashLen - 1 DO
      IF Hits[I] ≠ 0 THEN LINE(xlo, PCs[I], Hits[I]/count, PCs[I]);
      DPYUP(DDChan);
  ⊃; "DPYArray";

! The main program starts here;

  DEFINE xlo = 0, xhi = 100, ylo = 0, yhi = 100;

  DEFINE cvhwos(v) = {CVOS(RightHalf(v))};
  INTEGER ARRAY HashTab[0:HashLen-1];
  INTEGER ARRAY HitFreq[0:HashLen-1];
  INTEGER JobNum, err, count, I, pc_of_interest, NSamps, LastTic, CurrTic, DDChan;
  INTEGER xl,yl,xh,yh;

  xl ← 0; yl ← 0; xh ← .2; yh ← 40000;
  SetMap;
  PRINT("Job Number :");JobNum ← CVD(INCHWL);
  arrclr(HashTab);
  arrclr(HitFreq);
  LastTic ← 0;
  count ← 0;
  DDChan ← GDDCHN(-1);        ! Fetch us a channel;
  DDINIT;                     ! initialize the DD buffer;
  SHOW(DDChan);
  WHILE TRUE DO IF (pc_of_interest ← GetJPC(JobNum)) < 0
    THEN
      PRINT("error code = ",err,↓)
    ELSE ⊂
      count ← count + 1;
      pc_of_interest ← RightHalf(pc_of_interest);
      I ← EnHash(pc_of_interest, HashTab);
      HitFreq[I] ← HitFreq[I] + 1;
      WHILE (CurrTic ← GetTTI(JobNum)) = LastTic DO CALL(0,"SLEEP");
      LastTic ← CurrTic;
      IF NOT(count MOD 10) THEN DPYArray(HashTab,HitFreq,count,xl,yl,xh,yh,DDChan);
    ⊃;

END "SEEJOB";