;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 121.55
;;; Reason:
;;;  Metering runs with GC turned off.  Unfortunately, when you resume GC and then want to start
;;;  metering again, the GC does not get turned off again.
;;; Written 13-Apr-87 18:55:57 by pld (Peter L. DeWolf) at site LMI Cambridge
;;; while running on Cthulhu from band 3
;;; with Experimental System 121.54, Experimental Lambda-Diag 15.0, Experimental ZMail 70.2, Experimental KERMIT 32.0, Experimental Unix-Interface 10.0, Experimental Local-File 72.0, Experimental FILE-Server 21.0, Experimental Tape 13.0, Experimental Site Data Editor 5.0, microcode 1742, SDU Boot Tape 3.12, SDU ROM 102, the old ones.



; From modified file DJ: L.IO1; METER.LISP#85 at 13-Apr-87 18:55:58
#8R METER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "METER")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; METER  "

(DEFUN BUFFER-RESET ()
  (SETQ *BUFFER-ARRAY* (MAKE-ARRAY (* PAGE-SIZE 4) :ELEMENT-TYPE '(MOD #.(^ 2 16.))))
  (MULTIPLE-VALUE-SETQ (*DISK-PARTITION-START* *DISK-PARTITION-LENGTH*)
    (SI:FIND-DISK-PARTITION (find-metr-partition-name)))
  (IF (NULL *DISK-PARTITION-START*)
      (FERROR "No partition named ~S to use for metering" (find-metr-partition-name)))
  (SETQ *BUFFER-ADDRESS* (%POINTER-PLUS (LOGIOR (%POINTER *BUFFER-ARRAY*)	;This is in Q's here
						(1- PAGE-SIZE))
					1))
  (SI:%WIRE-PAGE *BUFFER-ADDRESS*)
  ;***bug displaced-index-offset can be negative, bombing if array exactly on page boundary.
  (SETQ *BUFFER* (MAKE-ARRAY (* PAGE-SIZE 2)
			     :ELEMENT-TYPE '(MOD #.(^ 2 16.))
			     :DISPLACED-TO *BUFFER-ARRAY*
			     :DISPLACED-INDEX-OFFSET (* 2 (- *BUFFER-ADDRESS*
							     (%POINTER *BUFFER-ARRAY*) 2))))
  )

))

; From modified file DJ: L.IO1; METER.LISP#85 at 13-Apr-87 18:56:16
#8R METER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "METER")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; METER  "

(DEFUN RESET ()
  "Reset metering and clear metering information."
  (compiler::%set-meter-enables 0)
  (WITHOUT-INTERRUPTS
    (OR (BOUNDP '*BUFFER-ADDRESS*) (BUFFER-RESET))
    (STOP-GC-PROCESS)
    (SETQ %METER-BUFFER-POINTER *BUFFER-ADDRESS*
	  %METER-DISK-COUNT *DISK-PARTITION-LENGTH*
	  %METER-DISK-ADDRESS *DISK-PARTITION-START*))
  (setq *simple-data-analyzed* nil))

))

; From modified file DJ: L.IO1; METER.LISP#85 at 13-Apr-87 18:56:26
#8R METER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "METER")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; METER  "

(DEFUN ENABLE (&REST THINGS)
  "Turn on metering of THINGS.  Each THING must be a stack group or specify one.
Processes and windows are allowed ways of specifying a stack group.
/(METER:ENABLE T) turns on metering in all stack groups."
  (DOLIST (THING THINGS)
    (IF (EQ THING T)
	(SETQ %METER-GLOBAL-ENABLE T)
      (SETQ THING (ENABLE-STACK-GROUP THING 1)))
    (PUSHNEW THING *METERED-OBJECTS*)))

))

; From modified file DJ: L.IO1; METER.LISP#85 at 13-Apr-87 18:58:34
#8R METER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "METER")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; METER  "

(DEFUN STOP-GC-PROCESS ()
  (UNLESS (MEMQ 'METERING (SEND GC::*GC-PROCESS* :ARREST-REASONS))
    (GC:GC-OFF)
    (IF (SEND GC::*GC-PROCESS* :ACTIVE-P)
	(FORMAT T "~&Turning off GC process, because metering requires it disabled.
Use ~S to allow GC to proceed, once you are done with metering."
		'(RESUME-GC-PROCESS))
      (UNLESS *WARNING-GIVEN*
	(FORMAT T "~&Note: Metering automatically turns off GC.
Use ~S to un-arrest GC, once you are done with metering."
		'(RESUME-GC-PROCESS))
	(SETQ *WARNING-GIVEN* T)))
    (SEND GC:*GC-PROCESS* :ARREST-REASON 'METERING)))

))

; From modified file DJ: L.IO1; METER.LISP#85 at 13-Apr-87 18:58:43
#8R METER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "METER")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; METER  "

(DEFUN RESUME-GC-PROCESS ()
  (setq *warning-given* nil)
  (SEND GC::*GC-PROCESS* :REVOKE-ARREST-REASON 'METERING)
  (gc:gc-on))

))