; -*-MIDAS-*-
	TITLE METER - ITS SYSTEM METERING - DAM OCT. 19, 1974

.INSRT SYSENG;CALRET >

TTYIF==1		;CHAR TYPED INTERRUPT
BSCLK==10000		;SLOW-CLOCK INTERRUPT (1/2 SEC)
OPTINT==4000		;NEW STYLE INTERRUPTS

;;; DEFINE MACROS SO THAT SYSTEM VARIABLES ACCESSED
;;; THROUGH ABS PAGES CAN BE REFERENCED IN A NATURAL WAY

DEFINE CONC A,B
A!B!TERMIN

DEFINE ABSREF SYMS
DEFINE ABSTAB
IRPW SYM,,[SYMS]
IFSE [SYM]----, IMMEDS:	;FROM HERE DOWN ARE NOT ADDRESSES
.ELSE [  SQUOZE 0,SYM
  CONC ABSRF",\.IRPCNT,ABS
  CONC [EXPUNGE ABSRF"]\.IRPCNT,ABS
]
TERMIN
TERMIN
IRPW SYM,,[SYMS]
IFSN [SYM]----, ABSRF. SYM,\.IRPCNT
TERMIN
TERMIN

DEFINE ABSRF. SYM,CT
ABSRF"!CT!ABS==0
IF1,[DEFINE SYM ?MOD
(MOD)[.,,ABSRF"!CT!ABS]TERMIN
]
IF2,[DEFINE SYM ?MOD
(MOD)<ZZZ==ABSRF"!CT!ABS ? ABSRF"!CT!ABS==[.,,ZZZ] ? ZZZ>TERMIN
]
TERMIN

.BEGIN ABSRF		;PLACE TO KEEP NNNABS SYMBOLS
.END

DEFINE INFORM A,B,C,D,E
PRINTX/A B C D E
/
TERMIN

;;; FORMAT OF DISPLAY

FORMAT:	ASCIZ\###% User Time,###% Idle,###% Overhead,###% Lost
### Processes,###% active last 15 seconds
###% Processes running,###% Exec run,###% Blocked,###% Stopped
ATB disk i/o ##.###: read ##.###, write ##.###, PgIn ##.###, PgOut ##.###
TTY #### ch/s in, #### ch/s out (estimated)
ATB Sched ##.###, ATB PCLSR ##.###, ATB swap out ##.###
ATB page faults ##.###:###% in,###% coming,###% out,###% going
\

ABSREF [TIME		;TIME COUNTER, 30'THS OF A SECOND
	NULTM1		;USECS USED BY NULL JOB
	NULTM3		;SECONDS PART OF THAT
	USRTM1		;USECS USED BY USERS OVER 4
	USRTIM		;SECONDS PART OF THAT
	LOSTM1		;4USECS LOST
	LOSTIM		;SECONDS OF LOST TIME (ALL OTHERWISE RUNNABLE JOBS WAITING FOR PAGES)
	NWXFR		;NUMBER OF NON-SWAP DISK WRITES
	NRXFR		;NUMBER OF NON-SWAP DISK READS
	NSWXFR		;NUMBER OF SWAP DISK WRITES
	NSRXFR		;NUMBER OF SWAP DISK READS
	NSKED		;NUMBER OF TIMES INTO SCHEDULER
	NPCLSR		;NUMBER OF ATTEMPTS TO PCLSR
	NSOUSR		;NUMBER OF ATTEMPTS TO SWAP OUT A USER
	NSOPGS		;NUMBER OF SEARCHES FOR A PAGE TO SW OUT
	NPGFLT		;NUMBER OF PAGE FAULTS
	NRPI		;.. PAGE ALREADY IN
	NRPCI		;.. PAGE COMING IN
	NRPO		;.. PAGE OUT
	NRPGO		;.. PAGE GOING OUT
	TIIP		;TYI BUF IN PTR
	TOOP		;TYO BUF OUT PTR
	TOIP
	USRHI		;HIGHEST LOC OF USER VARS
	UPC		;010000,, IS USER MODE BIT
	USTP		;USER STOP WORD
	FLSINS		;USER BLOCK WORD
	UNAME		;0 MEANS IDLE SET OF VARS
	LUBTM		;TIME USER LAST UNBLOCKED
----
	TIBS		;TYI BYTES/BUFFER
	TOBS		;TYO BYTES/BUFFER
	LUBLK		;(CONST) LENGTH OF USER BLOCK
]

%TOOVR==1000		;TTY OVERSTRIKE CAPABILITY
%TOERS==40000		;TTY SELECTIVE ERASE CAPABILITY
%TOMVU==400		;TTY RANDOM MOTION CAPABILITY
;;; DATA AREAS

OTIME:	0		;TIME PREVIOUSLY WOKE UP
OUSRTM:	0		;OLD VALUE OF USRTM1  (WELL,...
ONULTM:	0		;OLD VALUE OF NULTM1   SEE THE CODE
OLOSTM:	0		;OLD VALUE OF LOSTM1   ...)
ONWXFR:	0		;.. NWXFR
ONRXFR:	0		;.. NRXFR
ONSWXF:	0		;.. NSWXFR
ONSRXF:	0		;.. NSRXFR
OXFR:	0		;.. NXFR (WELL, NOT REALLY)
OTOOP:	BLOCK 100	;OLD TOOP VALUES FOR TTYS
TOCT:	0		;COUNT OF CHARS OUTPUT ON TTYS
OTOCT:	0		;OLD VALUE OF TOCT
OTIIP:	BLOCK 100	;OLD TIIP VALUE FOR TTYS
TICT:	0		;COUNT OF CHARS INPUT ON TTYS
OTICT:	0		;OLD VALUE OF ..
ONSKED:	0		;OLD VALUE OF NSKED
ONPCLSR:0		;.. NPCLSR
ONSOUSR:0		;.. NSOUSR
ONPGFLT:0		;.. NPGFLT
ONRPI:	0		;.. NRPI
ONRPCI:	0		;.. NRPCI
ONRPO:	0		;.. NRPO
ONRPGO:	0		;.. NRPGO


TTYOPT:	0		;TTYOPT WORD GETS PUT HERE

MEMHOL:	ASCIZ\WARNING: THERE IS A HOLE IN LOW MEMORY
\

NO340:	ASCIZ\CAN'T GET 340
\

BLETCH:	ASCIZ\
WRONG SYSTEM VERSION - REPURIFY
\

TYIC==2			;TTY INPUT CHANNEL
TYOC==1			;TTY OUTPUT CHANNEL
TYO=<.IOT TYOC,>	;INSTRUCTION TO OUTPUT A CHAR
;;; ROUTINE TO OUTPUT A NUMBER IN FORMAT (CALL IN SAME ORDER
;;;  AS THEY APPEAR IN STRING ABOVE)

PUTNUM:  PROCEDURE N

	REGISTER W,W1,TTOPT,CH,NOSUP
	REGISTER NDIGS		;NUMBER OF DIGITS
	REGISTER NZDIGS		;.. NON ZERO SUPPRESSED

	MOVE TTOPT, TTYOPT

; SCAN DOWN TO NEXT FIELD

	MOVEI W, 7		;LEFT MARGIN CONST MINUS 1
NXTFLD:	ILDB CH, FORMPT
	JUMPE CH, [.VALUE]	;TOO MANY NUMBERS FOR FORMAT
	CAIN CH, "#
	 JRST GOTFLD		;NUMBER SIGN BEGINS FIELD
	TLNN TTOPT, %TOERS
	 TYO CH
	CAIN CH, 15
	 MOVEM W, HPOS		;CARRIAGE RETURN
	CAIN CH, 12
	 AOSA VPOS		;LINE FEED
	AOS HPOS		;PRINTING CH - INCR HPOS
	JRST NXTFLD

; GOT BEGINNING OF FIELD, NOW ANALYZE IT --> NDIGS, NZDIGS

GOTFLD:	IF [TLNN TTOPT,%TOERS][
		TYO [^P]		;SET POSITION
		TYO ["V]
		TYO VPOS
		TYO [^P]
		TYO ["H]
		TYO HPOS
	 ]
	SETZB NDIGS, NZDIGS
GOTFL0:	CAIN CH, ".		;PERIOD STOPS ZERO SUPPRESS
	 SOJA NDIGS, GOTFL1
	CAIE CH, "#		;NUMBER INDICATES A DIGIT
	 JRST GOTFLX
	SKIPE NZDIGS		;IF THIS NOT ZERO SUPPRESSED
GOTFL1:	 ADDI NZDIGS, 1		; THEN COUNT NZSUP DIGS
	AOS HPOS
	MOVE W1, FORMPT
	ILDB CH, FORMPT		;CHECK NEXT CHAR
	AOJA NDIGS, GOTFL0

GOTFLX:	MOVEM W1, FORMPT	;DON'T COUNT TERMINATING CHAR
	SKIPN NZDIGS		;ENSURE AT LEAST 1 DIGIT
	 MOVEI NZDIGS, 1
	SETZM NOSUP		;flag turned on after first nonzero digit

; NOW DO NUMBER CONVERSION (UNLESS SAME AS BEFORE)

	MOVE W, N
	AOS NUMPT
	IF [TLNE TTOPT,%TOERS	;SUPPRESS IF NUMBER SAME & DISPLAY
	    CAME W, @NUMPT][
	 	 RETURN	;SAME AS BEFORE
	   ]
	MOVEM W, @NUMPT

NUMLP:	IDIV W, TENPOW(NDIGS)	;GET A DIGIT IN W, REM IN W1
	JUMPN NOSUP, .+5
	 JUMPN W, .+3		;SEE IF SHOULD BLANK OUT
	  CAMLE NDIGS, NZDIGS	;..
	   SKIPA W, [-20]	;YES
	SETOM NOSUP		;have digit don't blank zeroes any more
	ADDI W, "0		;MAKE ASCII CHAR
	IF [ TLNE TTOPT, %TOERS
	     TLNN TTOPT, %TOOVR ][;IF NECESSARY, ERASE PREV CHAR
		TYO [^P]
		TYO ["K]
	   ]
	TYO W
	IF [CAIE NDIGS,1	;IF NECESSARY, SKIP OVER PERIOD
	    CAME NDIGS, NZDIGS][
		IF [ TLNE TTOPT, %TOERS
		     TLNN TTOPT, %TOOVR ][
			TYO [^P]
			TYO ["F] ]
		ELSE [ TYO [".] ]
	   ]
	MOVE W, W1		;PICK UP REMAINDER
	SOJG NDIGS, NUMLP	;DO ANOTHER DIGIT

PTNMXX:	RETURN

HPOS:	0		;HORIZONTAL POSITION
VPOS:	0		;VERTICAL POSITION
FORMPT:	0		;B.P. TO FORMAT STRING
NUMPT:	0		;PTR TO NUMBUF
NUMBUF:	REPEAT 30., -1	;USED TO AVOID REDISPLAYING IF UNCHANGED

TENPOW:	-1 ? 1 ? 10. ? 100. ? 1000. ? 10000. ? 100000.
	1000000. ? 10000000. ? 100000000.


;;; ENTRY PUTNUM"RESET GETS SET FOR ANOTHER SET OF FIGURES

RESET:  ENTRY

	MOVE TT, [440700,,FORMAT] ;INIT VARS
	MOVEM TT, FORMPT
	MOVEI TT, 10		;TOP OF PAGE LOGICALLY
	MOVEM TT, HPOS
	MOVEM TT, VPOS
	IF [SKIPE TT, TTYOPT][
		TYO [^L]]		;340
	ELSE [	TYO [^P]		;AND PHYSICALLY
		IF [TLNN TT, %TOERS][
			TYO ["T]]	;OVER WRITE
		ELSE [ TYO ["C] ]	;NEW THING ENTIRELY
	      ]
	MOVEI TT, NUMBUF-1	;INIT NUMPT
	MOVEM TT, NUMPT
	RETURN

;;; PUTNUM"FINISH FINISHES IT OFF

FINISH:  ENTRY

	MOVE TT, TTYOPT
	TLNE TT, %TOERS		;PRINTING TTY'S ONLY
	 RETURN
FINIS0:	ILDB CH, FORMPT
	JUMPE CH, .RETN.
	TYO CH
	JRST FINIS0

.END
;;; Routine to meter TTYs, called frequently

CHKTTY:  PROCEDURE

	REGISTER I		;TTY NUMBER
	REGISTER A,B,FROB,C		;TEMPS

	MOVEI I, TOOP		;COMPUTE # TTYS
	SUBI I, TOIP		;..
NEXTTY:	SOJLE I, LASTTY		;JUMP IF NO MORE TTYS

	; COUNT CHARACTERS OUTPUT

	MOVE A, TOOP(I)
	LDB B, [360600,,A]	;POS FIELD
	SUBI B, 44
	LDB C, [300600,,A]	;SIZE FIELD
	IDIV B, C		;B := - NUM OF CHARS (BITS)
	MOVE C, CHPRWD(C)	; CONVERT CHAR SIZE TO CHARS PER WORD
	IMULI C, (A)		;C := NUM OF CHARS (WORDS)
	SUB C, B		;C := NUM OF CHARS
	MOVE A, C
	EXCH C, OTOOP(I)	;COMPARE AGAINST OLD READING
	SUB A, C		;TAKE DIFFERENCE
	SKIPGE A		;SKIP IF NO BUFFER WRAP AROUND
	 ADDI A, TOBS		;WRAP AROUND ADD BUFFER SIZE
	ADDM A, TOCT		;ACCUM TOTAL CHARS OUTPUT

	;COUNT CHARACTERS INPUT

	MOVE A, TIIP(I)
	LDB B, [360600,,A]	;POS FIELD
	SUBI B, 44
	LDB C, [300600,,A]	;SIZE FIELD
	IDIV B, C		;B := - NUM OF CHARS (BITS)
	MOVE C, CHPRWD(C)	; CONVERT CHAR SIZE TO CHARS PER WORD
	IMULI C, (A)		;C := NUM OF CHARS (WORDS)
	SUB C, B		;C := NUM OF CHARS
	MOVE A, C
	EXCH C, OTIIP(I)	;COMPARE AGAINST OLD READING
	SUB A, C		;TAKE DIFFERENCE
	SKIPGE A		;SKIP IF NO BUFFER WRAP AROUND
	 ADDI A, TIBS		;WRAP AROUND ADD BUFFER SIZE
	ADDM A, TICT		;ACCUM TOTAL CHARS OUTPUT

	JRST NEXTTY		;GO DO ANOTHER TTY

LASTTY:	RETURN

CHPRWD:	36.			;CHARS PER WORD, INDEXED BY CHAR SIZE
	REPEAT 35., 36./<1+.RPCNT>

	.END
;;; MAIN PROGRAM

PROGRAM METER

	REGISTER A,B,C,MS

	.SUSET [.RJNAME,,A]	;SEE IF SHOULD USE 340
	SETZM DIXONSLOSS
	IF [ CAME A,['SMETER] ][ SETOM DIXONSLOSS ]
	IF [ CAME A,['METERD] ][	;YES, SET UP
		.OPEN TYOC, [.UAO,,'DIS]
		JRST [	CALL TYPE,NO340
			JRST KILL
		     ]
		SETZM TTYOPT	;ABSOLUTELY NO FEATURES
		.VALUE [ASCIZ/:PROCED /]
		]
	ELSE [			;NORMALLY USE TTY
		.OPEN TYIC, [.UAI,,'TTY]	;JUST SO CAN GET INTERRUPTS
		 .VALUE
		.OPEN TYOC, [20+.UAO,,'TTY]
		 .VALUE
		.CALL CNSGET,[#TYOC][A,A,A,A,TTYOPT]
		 .VALUE
	  ]

	CALL RITUAL		;ASSURANCE OF PURITY

	MOVE A, [-11.,,INTLST]	;set up interrupts
	MOVEM A, 42
	.SUSET [.ROPTION,,A]
	TLO A, OPTINT
	.SUSET [.SOPTION,,A]
	.SUSET [.SMASK,,[TTYIF+BSCLK]]

	IF [SKIPE TTYOPT][TYO [^L]]
	ELSE [	TYO [^P]		;DISPLAY FIXED STUFF
		TYO ["C]
	     ]
	MOVE TT, TTYOPT
	IF [ TLNN TT, %TOERS ][ CALL TYPE,FORMAT ]

; MACRO TO PICK UP A VAR, UPDATE OLD COPY, PUT DIFFERENCE IN T

DEFINE DERIV REG,VAR
	MOVE REG, VAR
	MOVE TT, REG
	EXCH TT, O!VAR
	SUB REG, TT
TERMIN

; MACRO TO CONVERT NUMBER IN REG TO % OF VAR, LEAVE IN REG

DEFINE PERCENT REG,VAR
	IMULI REG, 100.
	IDIV REG, VAR
TERMIN


;;; MAIN DISPLAY LOOP

	LOCAL ELAPSED		;ELAPSED TIME SINCE LAST CYCLE
				; IN MILLISECONDS


LOOP:	CALL PUTNUM"RESET	;GET SET FOR DISPLAY CYCLE

	DERIV T,TIME		;COMPUTE TIME SINCE LAST CYCLE
	IMULI T, 33.		;CONVERT 30THS TO MILLISECONDS
	MOVEM T, ELAPSED	;..

;	DERIV T,USRTM1		;PUT % USER TIME IN A
	MOVE T, USRTIM		;ALLOWING FOR VARIOUS FROBS
	IMULI T, 1000.		;CONVERT TO MILLISECONDS
	MOVE T0, USRTM1		;AND GET CURRENT STUFF
	IDIVI T0, 250.		;ALSO IN MILLISECONDS
	ADD T, T0
	MOVE TT, T
	EXCH TT, OUSRTM1
	SUB T, TT		;END FAKE DERIV EXPANSION
	PERCENT T, ELAPSED
	MOVE A, T
;	DERIV T,NULTM1		;PUT % NULL TIME IN B
	MOVE T0, NULTM1		;AGAIN ALLOWING FOR FROBS
	IDIVI T0, 250.		;AND CONVERTING TO MILLISEC
	MOVE T, NULTM3
	IMULI T, 1000.
	ADD T, T0
	MOVE TT, T
	EXCH TT, ONULTM
	SUB T, TT		;END FAKE EXPANSION
	PERCENT T, ELAPSED
	MOVE B, T
;	DERIV T,LOSTM1		;PUT % LOST TIME IN B
	MOVE T0, LOSTM1		;AGAIN ALLOWING FOR FROBS
	IDIVI T0, 250.		;AND CONVERTING TO MILLISEC
	MOVE T, LOSTIM
	IMULI T, 1000.
	ADD T, T0
	MOVE TT, T
	EXCH TT, OLOSTM
	SUB T, TT		;END FAKE EXPANSION
	PERCENT T, ELAPSED
	MOVE C, T
	CALL PUTNUM,A
	CALL PUTNUM,B
	MOVNS B			;COMPUTE OVERHEAD
	ADDI B, 100.
	SUB B, A
	CALL PUTNUM,B
	CALL PUTNUM,C

; AT LAST, THAT CRUFT IS OVER WITH!
; SCAN USERS

	REGISTER U		;USER INDEX
	IRP Z,,[TOTU,ACTU,RUNU,ERUNU,BLOCKU,STOPU]
	  LOCAL Z		;BUCKETS
	  SETZM Z
	TERMIN

	SETZM U
;CAN'T USE UNTIL MACRO WITH ABSREF MACROS.....WAAAH - ???

ULOOP:	;LOOP THROUGH ALL USERS
	 SKIPN UNAME(U)
	 JRST ULOOP0
	    AOS TOTU
	    MOVE T, LUBTM(U)	;SEE IF RECENTLY ACTIVE
	    ADDI T, 15.*30.
	    CAML T, TIME
	     AOS ACTU		;YES

		SKIPN USTP(U)
		JRST .+3
		 AOS STOPU	;STOPPED
		 JRST ULOOP0

		SKIPN FLSINS(U)
		JRST .+3
		 AOS BLOCKU	;BLOCKED
		 JRST ULOOP0

		MOVE T, UPC(U)
		TLNE T, 010000
		JRST .+3
		 AOS ERUNU	;RUNNING IN EXEC MODE
		 JRST ULOOP0

		 AOS RUNU

ULOOP0:	ADDI U, LUBLK
	CAMGE U, USRHI
	JRST ULOOP

	CALL PUTNUM,TOTU
	IRP Z,,[ACTU, RUNU, ERUNU, BLOCKU, STOPU]
	 MOVE A, Z
	 PERCENT A, TOTU
	 CALL PUTNUM,A
	TERMIN

; DISK STATISTICS

	MOVE MS, ELAPSED	;SET UP FOR IDIVM'S

	MOVE A,NRXFR
	ADD A,NWXFR
	ADD A,NSRXFR
	ADD A,NSWXFR
	MOVE TT, A
	EXCH TT, OXFR
	SUB A, TT
	IDIVM MS, A
	CALL PUTNUM,A

	DERIV A,NRXFR
	IDIVM MS, A
	CALL PUTNUM,A
	DERIV A,NWXFR
	IDIVM MS, A
	CALL PUTNUM,A
	DERIV A,NSRXFR
	IDIVM MS, A
	CALL PUTNUM,A
	DERIV A,NSWXFR
	IDIVM MS, A
	CALL PUTNUM,A

; TTY STATISTICS

	DERIV A,TICT		;TTY CHARS/SECOND
	IMULI A, 1000.
	IDIV A, ELAPSED
	CALL PUTNUM,A
	DERIV A,TOCT
	IMULI A, 1000.
	IDIV A, ELAPSED
	CALL PUTNUM,A

; RANDOM SCHED ATB'S - MILLISECONDS

	DERIV A,NSKED
	IDIVM MS, A
	CALL PUTNUM,A
	DERIV A,NPCLSR
	IDIVM MS, A
	CALL PUTNUM,A
	DERIV A,NSOUSR
	IDIVM MS, A
	CALL PUTNUM,A

; PAGE FAULT DATA

	DERIV A,NPGFLT		;ATB P F
	MOVE C, A		;TOTAL PF SAVED FOR BELOW
	IDIVM MS, A
	CALL PUTNUM,A
	IRP PF,,[NRPI,NRPCI,NRPO,NRPGO]
	  DERIV A,PF
	  IMULI A, 100.		;PERCENT OF THIS TYPE
	  IDIV A, C		;RELATIVE TO TOTAL
	  CALL PUTNUM,A
	TERMIN

	CALL PUTNUM"FINISH

	IF [ SKIPE TT, TTYOPT	;IF DISPLAY BUT NOT 340
	     TLNN TT, %TOERS ][
		TYO [^P]
		TYO ["Z]
		TYO [^P]	;leave line for :KILL message
		TYO ["U]
		TYO [^P]	;leave line for :KILL message
		TYO ["U]
		TYO [^P]	;leave line for **MORE** OR RATHER TO AVOID IT.
		TYO ["U]
	    ]
	SKIPE TTYOPT		;DON'T LISTEN IF 340
	.LISTEN A,
	IF [ SKIPN DIXONSLOSS ][ MOVEI A,60.*60. ]	;WHOLE MINUTE
	ELSE [ MOVEI A, 150. ]	;SLEEP 5 SEC
	.SLEEP A,
	SKIPE A,TTYOPT		;DON'T LISTEN IF 340
	.LISTEN A,
	JUMPE A, LOOP

KILL:	.BREAK 16, 040000

DIXONSLOSS:  0		;FLAG FOR SLOW REPEAT (FOR GARY DIXON)

;;; Interrupt Handlers

INTLST:	P
	TTYIF ? 0		;CHARACTER TYPED
	TTYIF ? 0 ? KILL	; STOP JOB

	BSCLK ? 0		;1/2 SEC INT CHECK TTYS
	BSCLK ? 0 ? .+1

	PUSH P, T
	PUSH P, TT
	PUSH P, T0
	PUSH P, T1
	PUSH P, .PF.
	CALL CHKTTY
	POP P, .PF.
	POP P, T1
	POP P, T0
	POP P, TT
	POP P, T
	.CALL DISMIS,[P]


.END
;;; ROUTINE TO TYPE A CONSTANT STRING

TYPE:  PROCEDURE STRING

	REGISTER PT,CH

	MOVEI PT, STRING	;SET UP B.P. TO STRING
	TLOA PT, 440700		;..
LOOP:	TYO CH
	ILDB CH, PT		;GET NEXT CHAR
	JUMPN CH, LOOP		;AND IF NOT DONE, TYPE IT
	RETURN
.END
;;; PURIFICATION RITUAL

OITSVRS:0			;ITS VERSION PURIFIED FOR
OUSRSTG:0			;EXTRA Check

RITUAL:  PROCEDURE

	.RSYSID TT,
	MOVE T, [SQUOZE 0,USRSTG]	;SEE IF SYSTEM CHANGED
	.EVAL T,
	 JFCL
	CAMN TT, OITSVRS
	CAME T, OUSRSTG
	JRST NOGOOD
	RETURN	

NOGOOD:	CALL PURIFY			;WRONG SYS VERSION OR NOT PURE
	RETURN				;YET SO REPURIFY

.END

ABSTB1:	ABSTAB
ABSTB2:

PURIFY:  PROCEDURE 

	REGISTER I,L,V,LIM

	.VALUE [ASCIZ\:New system version; must repurify.
Take paws off keys and wait.

p\]
	MOVEI LIM, IMMEDS-ABSTB1	;LIMIT ON REMAPPABLENESS
	MOVSI I, <ABSTB1-ABSTB2>/2	;SCAN ABSTAB
EVLOOP:	MOVE V, ABSTB1(I)		;GET SYMBOL
	.EVAL V,			;EVALUATE IT
	 .VALUE				;NOT THERE???
	CAIG LIM, (I)			;SKIP FOLLOWING CODE
	 JRST EVLP00			; IF IMMEDIATE SYMBOL
	CAIGE V, REMAPT			;REMAP LOW CORE
	 SUBI V, REMAPT			;INTO HIGH CORE
EVLP00:	ADDI I, 1
	MOVE TT, ABSTB1(I)		;FOLLOW PATCH LIST
PLOOP:	JUMPE TT,EVLPNX			;JUMP IF END OF LIST
	MOVE L,TT
	HLRZ TT,(L)			;LOC TO PATCH
	HRRM V,(TT)			;PATCH IT
	HRRZ TT,(L)			;LINK TO NEXT
	JRST PLOOP			;AND TRY AGAIN

EVLPNX:AOBJN I, EVLOOP			;NEXT SYMBOL

; HAVING PATCHED, SET UP PAGE TABLE
; FOR NOW, WE DON'T ACTUALLY PURIFY ANY PAGES...

	.RSYSID V,			;REMEMBER ITS VERSION
	MOVEM V, OITSVRS
	MOVE V, [SQUOZE 0,USRSTG]	;AND A KLUDGEY MACHINE CHECK
	.EVAL V,
	 .VALUE
	MOVEM V, OUSRSTG

	SETZM V
	MOVEI TT, REMAPT_-10.		;GET ABS PAGES
	HRLI TT, <REMAPT-400000>_-10.	;FROM 0 TO 400000
	MOVE T, TT
GETMOR:	.CALL CORBLK,[#210000,#-1,TT,#400000,T]
	 JRST .+2		;ERROR RETURN
	 JRST GOTIT
	.SUSET [.RBCHN,,V]	;FIND OUT WHAT LOST
	.CALL STATUS,V,V	;GET ERROR CODE
	 .VALUE
	LDB V, [270600,,V]	;..
	CAIE V, 32		;CAN'T GET THAT ACCESS
	 .VALUE			;NO - UNCLEAR
	ADD TT, [40,,40]	;YES - BITING MD10'S HAVE A 32K HOLE!
	MOVE T, TT
	JUMPL TT, GETMOR

GOTIT:	JUMPE V,GOTIT1
	 CALL TYPE,MEMHOL
GOTIT1:	MOVEI TT, <1000000-REMAPT>_-10.	;DO REMAPPAGE
	HRLI TT, -<REMAPT_-10.>
	SETZ T,
	.CALL CORBLK,[#210000,#-1,TT,#400000,T]
	 .VALUE
	.VALUE [ASCIZ\:PDUMP SYS1;TS METER
P\]
	RETURN
.END PURIFY

CONSTANTS

REMAPT=<.+1777>&776000	;FIRST NON USED PAGE

END METER
