Trailing-Edge
-
PDP-10 Archives
-
tops10_tools_bb-fp64b-sb
-
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