1;;; -*- Mode:Common-Lisp; Package:SYSTEM-INTERNALS; Fonts:(CPTFONT CPTFONTB); Base:10. -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.

;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151

;;; Copyright (C) 1986-1989 Texas Instruments Incorporated. All rights reserved.*

;;; Edit history:
;;;------------------------------------------------------------------------------
;;;  7-20-87  ab   Sys 50   o Rewrote READ-METER/WRITE-METER for efficiency [SPR 4854].
;;;                         o Wrote RESET-METERS to clear all the counters on the new
;;;                           RESETTABLE-METERS list [SPR 4291].  RESETTABLE-METERS
;;;                           is defined in LROY-QCOM next to A-MEMORY-COUNTER-BLOCK-NAMES.
;;;  8-26-87  RJF           o Proclaim resettable-meters to be special to avoid build 
;;;                           warning.

(proclaim '(special resettable-meters))   

(DEFUN READ-METER (NAME)
1"Read the value of the A Memory metering location specified by NAME."*
   (LET ((num (SYMBOL-VALUE name))
	 a-off)
     (UNLESS (AND (NUMBERP num) (<= num 1023.))
       (FERROR NIL "~S is not a valid counter name." NAME))
     (SETQ A-OFF (%pointer-plus A-MEMORY-VIRTUAL-ADDRESS (+ %COUNTER-BLOCK-A-MEM-ADDRESS num)))
     (WITHOUT-INTERRUPTS	;Try not to get inconsistent numbers
       (DPB (%P-LDB %%q-high-half a-off)
	    %%q-high-half 
	    (%P-LDB %%q-low-half a-off)))))


(DEFUN WRITE-METER (NAME VAL)
  1"Set the value of the A Memory metering location specified by the NAME to VAL."*
  (LET ((num (SYMBOL-VALUE name))
	a-off)
    (UNLESS (AND (NUMBERP num) (<= num 1023.))
      (FERROR NIL "~S is not a valid counter name." NAME))
    (SETQ A-OFF (%pointer-plus A-MEMORY-VIRTUAL-ADDRESS (+ %COUNTER-BLOCK-A-MEM-ADDRESS num)))
    (WITHOUT-INTERRUPTS				;Try not to get inconsistent numbers
      (%p-dpb (LDB %%q-high-half val) %%q-high-half a-off)
      (%p-dpb (LDB %%q-low-half val) %%q-low-half a-off)))
  )

(DEFUN reset-meters ()
  "Resets to 0 the A-Memory meters (counters) that can safely be reset."
  (WHEN (VARIABLE-BOUNDP resettable-meters)
    (LOOP for sym in resettable-meters do
	  ;; Check for variable bound & number.  This will run on COLD
	  ;; init list, before EH initialized, & we don't want to crash
	  ;; for something silly like one of these names changed.
	  (WHEN (AND (BOUNDP sym) (NUMBERP (SYMBOL-VALUE sym)))
	    (WRITE-METER sym 0))))
  )

(ADD-INITIALIZATION "Clear meters." '(reset-meters) :cold)