Google
 

Trailing-Edge - PDP-10 Archives - BB-FP64A-SB_1986 - 10,7/dpypak/dpysub.mac
There are 5 other files named dpysub.mac in the archive. Click here to see a list.
TITLE DPYSUB --  MISC. ROUTINES FOR FORTRAN DPY'ERS

	SEARCH MACTEN,UUOSYM
	P=17

;THIS FILE CONTAINS ALL THE J-RANDOM SUBROUTINES USED BY VARIOUS FORTRAN
;	PROGRAMS THAT USE DPYPAK.  THE ARE PUT TOGETHER HERE SO THAT I DON'T
;	HAVE TO LOOK ALL OVER THE PLACE IN CASE I CHANGE ONE OF THE PROGRAMS.
;	NEW ONES ARE ADDED AS NEW HACKS FOR DPY'ING ARE INVENTED.
;
;NO GUARANTEES (IMPLICIT OR OTHERWISE), YOU'RE ON YOUR OWN..

;NECHO CLEARS TERMINAL ECHOING AND SET FUNNY EDITOR MODE. USEFUL WHEN YOU
;	DON'T WANT TYPING TO SCREW UP THE SCREEN, OF COURSE YOU'LL HAVE TO
;	ECHO IT YOURSELF (OR NOT, I DON'T CARE).  ALSO SETS UP ^C INTERRUPT TO
;	RETURN TO NORMAL MODE,SET TTY CRLF, AND EXIT. CALL ECHO WHEN ALL DONE.
;SEE: PONG,FORM,SWAP

NECHO::	OPEN	0,TTBLK
	  HALT	.
CCTRAP::MOVEI	0,INTBLK
	MOVEM	0,.JBINT##
	PJOB	0,
	TRMNO.	0,
	  HALT .
	MOVEM	0,IOIDX1
	MOVEM	0,IOIDX2
	POPJ	P,
ECHO::	PUSHJ	P,DPYXIT##		;CLEAN UP FROM DPYPAK
	SKIPE	GRAPHIC
	  OUTSTR[BYTE(7)33,"G"]
	EXIT	1,
	JRST	.-1

INTBLK:	XWD	4,ECHO
	XWD	0,ER.ICC
	Z
	Z
TTBLK:	IO.TEC!IO.SUP!IO.LEM
	SIXBIT	/TTY/
	Z
ADR2:	.TOSET+.TONFC
IOIDX2:	0
	0
;
;ENGRAP SETS VT52 GRAPHIC MODE, CLEARED ON EXIT (SEE CPU)

ENGRAP::AOS	GRAPHIC
	OUTSTR	[BYTE(7)33,"F"]
	POPJ	P,
GRAPHIC:0
;FOLLOWING THREE ROUTINES ARE FOR PONG.
;	NIN	CLEARS TYPEAHEAD
;	SYNCH	WAITS FOR TYPEOUT TO COMPLETE
;	WAITMS	IS A MILLISECOND HIBER

NIN::	CLRBFI
CPOPJ:	POPJ	P,
SYNCH::	MOVE	0,[2,,ADR1]
	TRMOP.	0,
	  POPJ	P,
	JRST	SYNCH
ADR1:	.TOSOP
IOIDX1:	0
WAITMS:: HRRZ	0,@0(16)	;GET TIME TO SLEEP
	TLO	0,(HB.RTC)	;AND WAKE ON CHAR
	HIBER	0,
	  JFCL
	POPJ	P,


;FOLLOWING ROUTINE IS TO STUFF A SINGLE ASCII CHARACTER INTO A PACKED 7 BIT
;	ARRAY.  SEE CPU
;	CALL PUTC(CHAR,COLUMN,LINE,BASE,WIDTH)

PUTC::	MOVE	0,@2(16)
	SOS	0
	IMUL	0,@4(16)
	ADD	0,@1(16)
	SOS	0
	IDIVI	0,5
	ADDI	0,@3(16)
	HLL	0,PUTC.A(1)
	MOVE	1,@0(16)
	DPB	1,0
	POPJ	P,
PUTC.A:	350700,,0
	260700,,0
	170700,,0
	100700,,0
	010700,,0

;OUTPUT SOME HELP TEXT FOR "CPU"

CPUHLP:: SETZ	1,
	EXCH	1,GRAPHIC	;GET GRAPHIC SETTING, CLEAR IT
	SKIPE	1		;IN VT52 GRAPHIC MODE
	  OUTSTR[BYTE(7)33,"G"] ;YES, NOT ANY MORE
	OUTSTR	HLPTXT
	SKIPE	1		;WAS IT BEFORE
	JRST	ENGRAP		;YES, PUT IT BACK
	POPJ	P,		;NO, RETURN
	XLIST
HLPTXT:	ASCIZ/
    Character	Action

	F	Decrease wait time ( 1 Sec min. ) "Faster Chipmunks"
	S	Increase wait time (60 Sec max. )
	R	Refresh the screen
	H	You're lookin' at it
	E	Exit (Yes James, ^Z will do it too)
	W	Write current screen to file SCREEN.nnn (Incremental numbers)
	T	Track all data points to file TRKOUT.CPU

	+ or -	Change graphs being displayed
		Follow with ID for graph affected

		U	UUOs per second
		O	Overhead
		C	Context switches per second
		I	Idle time
		S	Swapping Pages per second
		J	Cache Sweeps per second ("Jim's graph")
		H	Cache Hit Ratio
		F	Free Core Used
		D	Inter-processor Door Bell Rings per second
		Z	Cache Lost Time (why "Z", I dunno)
		L	Swap Lost Time

To add a graph, there must be room. Only 2 graphs on the screen at a time.
Use "-x" to remove one then "+y" to get the desired one on./
	LIST
;THE FOLLOWING CHARACTER DIDDLERS ARE USED FOR PROGRAMS THAT DO THEIR OWN
;	THING IN FORTRAN.  SEE: PONG,FORM
;
;	CHAR1	FUNCTION RETURNS 0 IF NO CHARACTER TYPED, ELSE
;		CHARACTER IN A1 FORMAT
;	CHAR2	FUNCTION RETURNS CHARACTER TYPED IN A1 FORMAT, WAITS FOR IT
;		(UNLIKE CHAR1). ALSO TAKES 1 ARGUMENT AND FILLS IT IN WITH:
;			0 = CHAR WAS A CONTROL CHARACTER
;			1 = CHAR WAS A LETTER (EITHER CASE)
;			2 = CHAR WAS A NUMBER
;			3 = DON'T KNOW WHAT IT WAS
;	CHAR3	FUNCTION THAT COMBINES THE BEST(WORST) OF CHAR1 & CHAR2

CHAR1::	SETZ	0,
	INCHRS	0
	  POPJ	P,
	JRST	CHAR12
CHAR3::	SETZ	0,
	INCHRS	0
	  POPJ	P,
	SKIPA
CHAR2::	INCHRW	0
	MOVEI	1,3
	CAIGE	0,40
	  MOVEI	1,0
	CAIG	0,"9"
	 CAIGE	0,"0"
	  SKIPA
	   MOVEI 1,2
	CAIG	0,"Z"
	 CAIGE	0,"A"
	  SKIPA
	   MOVEI 1,1
	CAIG	0,"z"
	 CAIGE	0,"a"
	  SKIPA
	   MOVEI 1,1
	MOVEM	1,@0(16)
CHAR12:	CAIL	0,"a"
	 CAILE	0,"z"
	  CAIA
	   SUBI	0,"a"-"A"
	LSH	0,^D29
	OR	[BYTE(7)0," "," "," "," "]
	POPJ	P,
;ERROR IS USED BY FORM TO MOVE AN ERROR MESSAGE (BELOW) INTO THE ARRAY,
;	SPREADING IT INTO A1 FORMAT AS WE GO.

ERROR::	MOVE	1,@0(16)
	MOVE	1,ERTBL-1(1)
	MOVEM	1,TPTR
	MOVEI	0,@1(16)
	HRLI	0,(POINT 36,0)
ERR1:	ILDB	1,TPTR
	JUMPE	1,CPOPJ
	LSH	1,^D29
	OR	1,[BYTE(7)0," "," "," "," "]
	IDPB	1,0
	JRST	ERR1
TPTR:	0
ERTBL:
%.1:	POINT	7,[ASCIZ/Field Must be Full/]
%.2:	POINT	7,[ASCIZ/Field is Required/]
%.3:	POINT	7,[ASCIZ/Letters not Allowed/]
%.4:	POINT	7,[ASCIZ/Numbers not allowed/]
%.5:	POINT	7,[ASCIZ/Invalid Character/]
%.6:	POINT	7,[ASCIZ/Enter One of:/]
%.7:	POINT	7,[ASCIZ/Can't Back Up Any More/]

;COMPAR IS CALLED BY FORM TO COMPARE 2 CHARACTERS FOR EQUALITY.
;	RETURNS 0 IF NOT EQUAL, 1 IF THEY ARE.  2 BLANKS ARE NEVER EQUAL.
;	CASE IS IGNORED FOR LETTERS.

COMPAR:: MOVE	0,@0(16)
	MOVE	1,@1(16)
	LSH	0,-^D29
	LSH	1,-^D29
	CAIE	0," "
	 CAIN	1," "
	  JRST	COMP.0
	CAMN	0,1
	  JRST	COMP.1
	CAIG	0,"z"
	 CAIGE	0,"a"
	  SKIPA
	   SUBI	0," "
	CAIG	1,"z"
	 CAIGE	1,"a"
	  SKIPA
	   SUBI	1," "
	CAME	0,1
COMP.0:	 TDZA	0,0
COMP.1:	  MOVEI	0,1
	POPJ	P,
;CALL SWPDAT(INDEX,UNINAM,UNIHID,UNIICT,UNIOCT,UNIFKS,UNIK4S)
;INDEX=0 MEANS START AT THE BEGINNING
;	RETURNS VALUES AND INDEX UPDATED FOR THE NEXT CALL
;	RETURNS INDEX = 0 WHEN ALL DONE
;SEE SWAP

	UNINAM==0	;UNIT NAME
	UNIHID==2	;HOME BLOCK ID
	UNIICT==24	;READ COUNT
	UNIOCT==25	;WRITE COUNT
	UNIFKS==31	;AMT USED
	UNIK4S==7	;AMOUNT OF SPACE AVAILABLE
	UNISWP==7	;LINK TO NEXT SWAPPING DEVICE
	UNIPCI==45	;PAGING READS (IPCF TOO)
	UNIPCO==46	;PAGING WRITES (IPCF TOO)

SWPDAT::SKIPN	HAVMAP		;HAVE THE MONITOR MAPPED YET
	  PUSHJ	P,GETMAP	;NO, DO IT NOW
	MOVE	1,@0(16)	;GET INDEX TO USE
	JUMPE	1,[MOVE 0,[%LDSWP] ;FIRST CALL, GET IT FROM GETTABS
		   PUSHJ P,GTTAB   ;GET IT
		     SETZ 0,	   ;FAILED, GIVE UP
		   JRST SW.1]
	MOVEI	0,UNISWP(1)	;POINT TO LINK WORD
	PUSHJ	P,FETCH		;GET THE MONITOR DATA
SW.1:	HLRZ	1,0		;WANT IT IN RH OF AC1
	MOVEM	1,@0(16)	;STORE FOR USER FOR NEXT TIME
	JUMPE	1,CPOPJ		;RETURN IF THIS WAS THE LAST UNIT
	MOVEI	0,@1(16)	;POINT TO USERS NAME
	TLO	0,440700	;MAKE A BP
	PUSH	P,0		;SAVE IN A SAFE PLACE
	MOVEI	0,UNINAM(1)	;POINT TO UNIT NAME
	PUSHJ	P,FETCH		;GET IT
SW.2:	JUMPE	0,SW.3		;DONE AT END OF NAME
	SETZ	1,		;CLEAR SCRATCH
	ROTC	0,6		;BRING IN A CHARACTER
	ADDI	1,40		;CONVERT TO ASCII
	IDPB	1,(P)		;STORE IT FOR USER
	JRST	SW.2		;GET ANOTHER
SW.3:	MOVEI	0,@2(16)	;POINT TO USERS VARIABLE
	TLO	0,440700	;MAKE ANOTHER BP
	MOVEM	0,0(P)		;BACK ON THE STACK
	MOVE	1,@0(16)	;RESTORE ADDRESS
	MOVEI	0,UNIHID(1)	;POINT TO UNIT ID
	PUSHJ	P,FETCH		;GET IT
SW.4:	JUMPE	0,SW.5		;DONE AT END OF NAME
	SETZ	1,		;CLEAR SCRATCH
	ROTC	0,6		;BRING IN A CHARACTER
	ADDI	1,40		;CONVERT TO ASCII
	IDPB	1,(P)		;STORE IT FOR USER
	JRST	SW.4		;GET ANOTHER
SW.5:	POP	P,(P)		;CLEAN STACK
	MOVE	1,@0(16)	;RESTORE ADDRESS
	MOVEI	0,UNIICT(1)	;GET ITS READ COUNT
	PUSHJ	P,FETCH		;GET IT
	MOVEM	0,@3(16)	;STORE FOR USER
	MOVEI	0,UNIPCI(1)	;GET PAGING READS
	PUSHJ	P,FETCH		;GET IT
	ADDM	0,@3(16)	;ACCUMULATE FOR USER
	MOVEI	0,UNIOCT(1)	;AND WRITE COUNT
	PUSHJ	P,FETCH		;GET IT
	MOVEM	0,@4(16)	;..
	MOVEI	0,UNIPCO(1)	;GET PAGING WRITES
	PUSHJ	P,FETCH		;GET IT
	ADDM	0,@4(16)	;ACCUMULATE
	MOVEI	0,UNIFKS(1)	;GET AMOUNT USED ON UNIT
	PUSHJ	P,FETCH		;GET IT
	MOVEM	0,@5(16)	;..
	MOVEI	0,UNIK4S(1)	;GET AMOUNT AVAIL ON UNIT
	PUSHJ	P,FETCH		;GET IT
	ANDI	0,17777		;WANT BOTTOM 13 BITS
	LSH	0,1		;CONVERT K TO P
	MOVEM	0,@6(16)	;..
	SUBB	0,@5(16)	;COMPUTE USED = AMOUNT AVAIL - AMOUNT FREE
	POPJ	P,
;  FLAG = CPUDAT(CPUNUM,UPTIME,LSTTIM,NULTIM,OVRHED,DOORBL,UUOS,CTXS,SWEEPS,CSHHIT,CSHLST)

;RETURNS CPU INFORMATION IN ARGUMENTS AND RETURNS 0=DATA OK, NON-0=NO SUCH CPU
;SEE CPU

FREUSD::MOVE	0,[%CNFRE]	;GET FREE CORE BYTE POINTER
	PUSHJ	P,GTTAB		;GET IT
	  HALT	.
	HLRE	1,0		;GET NUMBER OF WORDS IN BITMAP
	MOVMS	1		;MAKE POSITIVE
	IMULI	1,44		;TO NUMBER OF BITS AVAILABLE
	MOVE	0,[%CNFRU]	;GET NUMBER OF FREE BLOCK USED (BITS)
	PUSHJ	P,GTTAB		;...
	  HALT	.
	IMULI	0,^D10000	;SCALE FOR XXX.XX%
	IDIV	0,1		;COMPUTE PERCENT USED
	MOVEM	0,@0(16)	;STORE
	POPJ	P,

MTRINI::MOVE	1,@0(16)	;GET CPU NUMBER
	SETZM	0,MTRTAB(1)	;SET NOT INITIALIZED
	JUMPN	1,CPOPJ		;DONE IF NOT CPU0
	PUSH	P,2
	PUSH	P,3
	MOVX	0,<.GTCNF,,.GTSLF> ;GET ADDRESS OF CONFIG TABLE
	PUSHJ	P,GTTAB		;...
	  JRST	MTRI.1		;OH WELL
	HRRZ	1,0		;GET ADDRESS
	ADDI	1,(%CNST2&777777000000) ;ADDRESS OF STATES WORD 2 IN THE MONITOR
	MOVE	0,1		;ADDRESS OF IT
	PUSHJ	P,FETCH		;GET CURRENT STATES FLAGS
	MOVE	3,0		;COPY OF THE STATES WORD
	TXZ	3,ST%XPI	;ALLOW RUNNING DURING PIS
	CAMN	3,0		;DO WE NEED TO CHANGE THIS?
	JRST	MTRI.1		;NO, SKIP THIS
	MOVE	2,0		;COPY PREVIOUS VALUE
	MOVE	0,[3,,1]	;POINT TO ARGUMENTS
	POKE.	0,		;PATCH
	  JFCL			;OH WELL, JUST SHOWS LESS INTERESTING NUMBERS
MTRI.1:	JRST	P3POPJ
CPUDAT::SKIPN	HAVMAP		;HAVE THE MONITOR MAPPED
	  PUSHJ	P,GETMAP	;NO, DO IT NOW
	MOVE	1,@0(16)	;GET CPU REQUESTED
	LSH	1,1		;*2 FOR GETTABS
	MOVE	0,[%CVUPT]	;CPU UP TIME
	ADD	0,1		;CORRECT FOR CPU NUMBER
	PUSHJ	P,GTTAB		;GET THE DATA
	  JRST	CPUD.1		;FAILED, MUST BE NO SUCH CPU
	MOVEM	0,@1(16)	;STORE FOR CALLER
	MOVE	0,[%CVLST]	;CPU LOST TIME
	ADD	0,1		;CORRECT FOR CPU NUMBER
	PUSHJ	P,GTTAB		;GET THE DATA
	  JRST	CPUD.1		;FAILED, MUST BE NO SUCH CPU
	MOVEM	0,@2(16)	;STORE FOR CALLER
	MOVE	0,[%CVNUL]	;CPU NUL TIME
	ADD	0,1		;CORRECT FOR CPU NUMBER
	PUSHJ	P,GTTAB		;GET THE DATA
	  JRST	CPUD.1		;FAILED, MUST BE NO SUCH CPU
	MOVEM	0,@3(16)	;STORE FOR CALLER
	MOVE	0,[%CVOHT]	;CPU OVERHEAD TIME
	ADD	0,1		;CORRECT FOR CPU NUMBER
	PUSHJ	P,GTTAB		;GET THE DATA
	  JRST	CPUD.1		;FAILED, MUST BE NO SUCH CPU
	MOVEM	0,@4(16)	;STORE FOR CALLER
	MOVE	0,[%CVNDB]	;CPU DOOR BELL RINGS
	ADD	0,1		;CORRECT FOR CPU NUMBER
	PUSHJ	P,GTTAB		;GET THE DATA
	  JRST	CPUD.1		;FAILED, MUST BE NO SUCH CPU
	MOVEM	0,@5(16)	;STORE FOR CALLER
	MOVE	0,[%CVTUC]	;CPU UUO COUNT
	ADD	0,1		;CORRECT FOR CPU NUMBER
	PUSHJ	P,GTTAB		;GET THE DATA
	  JRST	CPUD.1		;FAILED, MUST BE NO SUCH CPU
	MOVEM	0,@6(16)	;STORE FOR CALLER
	MOVE	0,[%CVTJC]	;CPU CONTEXT SWITCHES
	ADD	0,1		;CORRECT FOR CPU NUMBER
	PUSHJ	P,GTTAB		;GET THE DATA
	  JRST	CPUD.1		;FAILED, MUST BE NO SUCH CPU
	MOVEM	0,@7(16)	;STORE FOR CALLER
	MOVE	0,[%CVCSN]	;CPU CACHE SWEEPS
	ADD	0,1		;CORRECT FOR CPU NUMBER
	PUSHJ	P,GTTAB		;GET THE DATA
	  JRST	CPUD.1		;FAILED, MUST BE NO SUCH CPU
	MOVEM	0,@10(16)	;STORE FOR CALLER
	MOVE	0,[%CVCLT]	;CPU CACHE LOST COUNT
	ADD	0,1		;CORRECT FOR CPU NUMBER
	PUSHJ	P,GTTAB		;GET THE DATA
	  JRST	CPUD.1		;FAILED, MUST BE NO SUCH CPU
	MOVEM	0,@12(16)	;STORE FOR CALLER
	MOVEI	1,^D100000	;GET 100% MISSES
	MOVEM	1,@11(16)	;IN CASE CAN'T GET METER
	MOVE	1,@0(16)	;GET CPU NUMBER
	SKIPGE	MTRTAB(1)	;-1 = PERF. TO INIT THE METER FAILED
	JRST	CPUD.0		;SO DON'T TRY AGAIN
	SKIPE	MTRTAB(1)	;METER RUNNING
	  PUSHJ	P,MTRRED	;YES, READ AND FILL IN DATA
	SETZM	MTRZAP		;CLEAR OUT OLD DATA
	MOVE	1,[MTRZAP,,MTRZAP+1]
	BLT	1,MTRZND	;ZAP IT ALL
	MOVEI	1,11		;NUMBER OF ARGS
	MOVEM	1,VAL1		;...
	MOVEM	1,VAL2		;...
	MOVE	1,@0(16)	;GET CPU NUMBER AGAIN
	HRLM	1,FNCLEN+2	;STORE IN PERF. ARG BLOCKS
	MOVEM	1,VAL1+1	;...
	MOVE	0,[3,,MTRSTR]	;START THE METER
	MOVEM	0,MTRTAB(1)	;SET FLAG NON-ZERO
	PERF.	0,		;DO IT
	  SETOM	MTRTAB(1)	;FAILED, DON'T EVER TRY AGAIN
	IMULI	1,11		;COMPUTE OFFSET FOR THIS CPU
	HRRI	0,ORGVAL(1)	;TO MOVE ORIGINAL VALUES
	HRLI	0,VAL1		;FROM INITIAL BLOCK CAUSE THIS CODE WAS ORIGINALLY
	BLT	0,ORGVAL+10(1)	;WRITTEN FOR ONLY 1 CPU AND THIS IS QUICK AND DIRTY
CPUD.0:	TDZA	0,0		;WORKED, GIVE 0 AS ANSWER
CPUD.1:	  MOVEI	0,1		;FAILED, TELL CALLER TO STOP
	POPJ	P,		;RETURN
; 1 = CPU NUMBER

MTRRED:	PUSH	P,2
	PUSH	P,3
	PUSH	P,4
	PUSH	P,5
	PUSH	P,6
	MOVEM	1,VAL2+1	;STORE CPU NUMBER
	MOVEM	1,MTRREL+1	;...
	IMULI	1,11
	HRLI	1,ORGVAL(1)	;SEE COMMENTS ABOVE
	HRRI	1,VAL1
	BLT	1,VAL1+10	;SO COMPUTATIONS WORK
	MOVE	1,[XWD 2,MTRFIN]
	PERF.	1,
	  JRST	P6POPJ
	DMOVE	3,VL2ACM	;READ RESULTS
	SETZB	1,2		;CLEAR
	DSUB	3,VL1ACM	;DIFFERENCE
	MOVEI	6,10000
	SETZ	5,
	DDIV	1,5		;RIGHT ADJUST
	PUSH	P,1
	PUSH	P,2		;SAVE RESULT (ELAPSED TIME IN USEC)
	DMOVE	3,VL2PMD	;PERFORMANCE DATA
	SETZB	1,2		;ZERO HIGH ORDER BITS
	MOVEI	6,10000		;
	SETZ	5,
	DDIV	1,5		;RIGHT ADJUST DATA
	MOVE	6,[^D100000]
	SETZ	5,
	DMUL	1,5		;RESULT TO 1,2,3,4
	POP	P,6		;PREVIOUS RESULTS
	POP	P,5		;...
	DDIV	1,5		;(T1,T2)=(1,2,3,4)/(5,6)
	MOVEM	2,@11(16)	;STORE RESULT FOR CPU
P6POPJ:	POP	P,6
P5POPJ:	POP	P,5
P4POPJ:	POP	P,4
P3POPJ:	POP	P,3
P2POPJ:	POP	P,2
	POPJ	P,

MTRTAB:	BLOCK	6		;ONE FOR EACH CPU
ORGVAL:	BLOCK	<6*11>		;SAVED ORIGINAL VALUES
MTRSTR:	1,,FNCLEN
	2,,VAL1
	3,,VAL1

FNCLEN:	^D9
	1B3
	1B19
	1B1!1B4
	EXP	0,0,0,0,0,0

MTRFIN:	4,,VAL2
	5,,MTRREL

MTRREL:	1
	0

MTRZAP:
VAL1:	EXP	0
	EXP	0
VL1TIM:	BLOCK	2
VL1PMD:	BLOCK	2
VL1ACM:	BLOCK	2

VAL2:	EXP	0
	EXP	0
VL2TIM:	BLOCK	2
VL2PMD:	BLOCK	2
VL2ACM:	BLOCK	2

MTRZND==.-1
; PERFRE = FRECOR(ARRAY,MAXSIZE)
;RETURNS FREQUENCY TABLE FOR FREE CORE HOLES ON SIZE INDEXED INTO ARRAY
;SEE BITMAP

FRECOR::SKIPN	HAVMAP
	  PUSHJ	P,GETMAP
	PUSH	P,2
	PUSH	P,3
	PUSH	P,4
	PUSH	P,5
	PUSH	P,6
	MOVE	0,[%CNFRE]
	PUSHJ	P,GTTAB
	  HALT	.
	MOVE	1,0
	HLRE	0,1
	MOVMS	0
	IMULI	0,44
	MOVEM	0,FREC.A
	SETZM	FREC.B
	MOVEI	2,@0(16)
	SOS	2
	TLO	2,3
	SETZ	3,
FREC.1:	HRRZ	0,1
	PUSHJ	P,FETCH
	CAMN	0,[-1]
	JRST	[SKIPE 3
		   PUSHJ P,FREC.6
		 SETZ 3,
		 JRST FREC.5]
	MOVSI	4,(POINT 1,0)
	MOVEI	5,44
FREC.2:	ILDB	6,4
	JUMPE	6,FREC.3
	JUMPE	3,FREC.4
	PUSHJ	P,FREC.6
	TDZA	3,3
FREC.3:	AOS	3
FREC.4:	SOJG	5,FREC.2
FREC.5:	AOBJN	1,FREC.1
	SKIPE	3
	  PUSHJ	P,FREC.6
	MOVE	0,FREC.B
	IMULI	0,^D10000	;LEAVE RESULT IN 0 FOR FORTRAN
	IDIV	0,FREC.A
	JRST	P6POPJ

FREC.6:	ADDM	3,FREC.B
	CAMLE	3,@1(16)
	  MOVE	3,@1(16)
	AOS	@2
	POPJ	P,

FREC.A:	0
FREC.B:	0
;SUBROUTINE TO GRAB THE MONITORS ADDRESSING SPACE

GETMAP:	MOVE	0,.JBFF##	;GET FIRST FREE LOC
	ADDI	0,3777		;MORE ROUNDING
	TRZ	0,777		;CLEAR BITS
	MOVEM	0,BASEAD	;SAVE BASE OF MONITOR CORE
	LSH	0,-^D9		;TO A PAGE NUMBER
	HRRZM	0,PUUARG+1	;STORE ARGUMENT
	MOVE	0,[%CNSIZ]	;SIZE OF THE MONITOR
	GETTAB	0,		;GET IT
	  MOVEI	0,340000	;ASSUME UP TO THE PER PROCESS MAP
	ADDI	0,777		;DO ROUNDING
	LSH	0,-^D9		;CONVERT TO P
	MOVEM	0,HAVMAP	;STORE AND SET FLAG
GETM.1:	MOVE	1,[11,,PUUARG]	;POINT TO ARGUMENT
	PAGE.	1,		;MAP MONITOR TO ME
	  JRST	[SETZM BASEAD	;FAILED, CLEAR OFFSET
		 POPJ P,]	;AND RETURN
	MOVE	1,[1,,1]	;TWO ONES
	ADDM	1,PUUARG+1	;BUMP PAGES INVOLVED
	SOJG	0,GETM.1	;GET ALL PAGES
	MOVE	0,[.GTSLF,,.GTSLF] ;GETTAB TABLE BASE
	PUSHJ	P,GTTAB		;GET THE BASE ADDRESS
	  POPJ	P,		;CAN'T DO GETTAB SELF ?
	ADD	0,BASEAD	;OFFSET FOR QUICK REFERENCE
	HRLI	0,1		;LIGHT AC1 FOR INDIRECT ADDRESSING
	MOVEM	0,GTSLF		;FOR FUTURE GETTABS
	POPJ	P,		;RETURN

HAVMAP:	0			;NON-ZERO = MAPPED MONITOR (OR TRIED TO)
BASEAD:	0			;WHERE WE MAPPED IT TO (0 = TRIED BUT COULDN'T)
PUUARG:	EXP	1,0		;ARGUMENT BLOCK FOR PAGE UUO
GTSLF:	0			;ADDRESS OF MONITOR GETTAB BASE
;SUBROUTINE TO SIMULATE GETTABS USING THE MAPPED MONITOR
;	0 = GETTAB ARGUMENT
;	RETURNS AS GETTAB DOES

GTTAB:	SKIPL	0		;LET MONITOR DO NEGATIVE GETTABS
	SKIPN	GTSLF		;GETTAB TABLE BASE KNOWN
	  JRST	[GETTAB 0,	;NO, DO GETTAB INSTEAD
		   POPJ P,	;FAILED, NON-SKIP RETURN
		 AOS (P)	;GIVE GOOD RETURN
		 POPJ P,]	;RETURN
	PUSH	P,2		;SAVE AC2
	PUSH	P,1		;SAVE AC1
	HRRZ	1,0		;GET TABLE WANTED
	MOVE	2,@GTSLF	;GET TABLE ADDRESS
	HLRZS	0		;GET ITEM WANTED
	LDB	1,[POINT 9,2,8]	;GET TABLE MAXIMUM INDEX
	JUMPE	1,GTTAB1	;IF ZERO, NO REAL TABLE
	CAILE	0,(1)		;RANGE CHECK INDEX
	JRST	GTTAB1		;GIVE FAIL RETURN
	ADDI	0,(2)		;INCLUDE TABLE BASE
	PUSHJ	P,FETCH		;GET THE DATA
	AOS	-2(P)		;GIVE GOOD RETURN
GTTAB1:	POP	P,1		;RESTORE CALLERS
	JRST	P2POPJ		;RESTORE CALLERS AC2 AND RETURN

;SUBROUTINE TO GET DATA FROM THE MONITOR
;	0 = MONITOR ADDRESS (NOT RELOCATED BY BASEAD)
;	RETURNS 0 = CONTENTS (OR 0)

FETCH:	CAIGE	340000		;IN HIGH SEG?
	 SKIPN	BASEAD		;MONITOR THERE
	  JRST	[PEEK 0,	;NO, GET IT THE HARD WAY
		 POPJ P,]	;RETURN
	ADD	0,BASEAD	;OFFSET TO OUR ADDRESSING SPACE
	MOVE	0,@0		;FETCH THE DATA
	POPJ	P,		;RETURN
	SUBTTL	SUPPORT FOR CSHDPY

;CALL SIXASC(SIXBIT,ASCII) CONVERT SIXBIT INPUT TO A6 ASCII OUTPUT

SIXASC::MOVE	0,@(16)		;FETCH SIXBIT
	MOVEI	2,@1(16)	;GET ASCII DESTINATION
	HRLI	2,(POINT 7,)	;MAKE BYTE POINTER
SIX.2:	JUMPE	0,SIX.3		;DONE AT END OF NAME
	SETZ	1,		;CLEAR SCRATCH
	ROTC	0,6		;BRING IN A CHARACTER
	ADDI	1,40		;CONVERT TO ASCII
	IDPB	1,2		;STORE IT FOR USER
	JRST	SIX.2		;GET ANOTHER
SIX.3:	POPJ	P,		;AND RETURN


IRH::	HRRZ	0,@(16)
	POPJ	P,

ILH::	HLRZ	0,@(16)
	POPJ	P,

CSHSIZ::MOVE	0,@(16)
	HRLI	0,44
	SETUUO	0,
	 JFCL
	POPJ	P,

CSHHLP::OUTSTR	CSHMSG
	POPJ	P,

	XLIST
CSHMSG:	ASCIZ!
    Character	Action

	nnnB	Set cache size to n blocks
	E	Exit (Yes James, ^Z will do it too)
	H	You're lookin' at it
	I	Toggle incremental display
	M	Toggle hits/misses display
	P	Toggle performance blocks/second
	R	Refresh the screen
	nnS	Set sleep time to n seconds
	W	Write data into CSHDPY.DAT

!
	SUBTTL	END

	END