// Stats.bcpl. Lisp statistics buffer 
// Last change April 5, 1981  3:56 PM by Beau Sheil
// Tone change March 17, 1981  1:15 PM by Beau Sheil
// Bar change February 5, 1981  6:54 PM by Beau Sheil
// Phrase change November 23, 1980  5:50 PM by Beau Sheil
// Chord change November 20, 1980  1:01 PM by Beau Sheil
// Previous change August 4, 1980  9:38 PM by Beau Sheil

	get "LispBcpl.decl"
	get "Stats.decl"
	get "Streams.d"

external [	// procedures defined here
	StatsOverflow		// Punt Subr: WRITESTATS()
	WRITESTATS		// Subr: WRITESTATS(type, lvX)
	GATHERSTATS		// Subr: \GATHERSTATS(lvFID)
	OpenStats		// (fid, windowing)
	CloseStats		// ()
	WriteStatsX		// (x, y, z)
	DumpBlockToStats	// (eventN, addr, numBlocks, blockSize)
		// static defined here
	@MiscSTATSbase
		// procedures used
	Bytes2; ReadClock; CallSwat; Smallp; SmallUnbox; VP2; Zero
	EqNIL; RAIDCode; MoveBlock; Closes; Puts; WriteBlock
        Version; Serial; IGetBase; OutputStream; MovePage
		// statics used
	@lvNIL; @lvKT; NPages; EmuDiskVp; EmuDiskBuffer
	 ]

static  [
	Stats = 0		// Stats disk stream
	MiscSTATSbase = 0
	]

let StatsOverflow() = valof
   [ 
   unless Stats resultis lvNIL		// forget it if no stats file
   let t = vec 3			// space for two times
   ReadClock(t)				// time of overflow
   WriteBlock(Stats, StatsBase, @StatsPtr-StatsBase)
   ReadClock(t+2)			// time disk write finished
   @StatsPtr=StatsBase			// Reset stats pointer
   WriteStatsX(evDmpBuff, 4, t)		// log the dump event
   resultis lvNIL
  ]

and WRITESTATS(lvType, lvX) = valof
   [
   let typ = SmallUnbox(lvType)<<LoByte
   let v = vec 10
   let lvArg = lvX
   for i=0 to 9 do				// only got room for 10
     [ unless Smallp(lvArg) break		// args are all smallp
       v!i = SmallUnbox(lvArg); lvArg = lvArg+2 ]	// sequential on stack
   test typ ls 200b
    ifso  WriteStatsX(typ, (v!0)<<LoByte, v!1)
    ifnot WriteStatsX(typ, (lvArg-lvX) rshift 1, v)
   resultis lvNIL
   ]

and GATHERSTATS(lvFID) =
   EqNIL(lvFID) ?
     valof [ CloseStats(); resultis lvNIL ] ,
     valof
       [
       if Stats then resultis RAIDCode("Multiple stats logs", lvNIL)
       Stats = OutputStream(lvFID)		// create log stream
       @StatsPtr = StatsBase
       let v = vec 5
       v!0, v!1, v!2, v!3, v!4, v!5 =
          Version(), Serial(), IGetBase(IFPRVersion), BcplVersion,
          IGetBase(IFPLVersion), NPages
       WriteStatsX(evVersions, 6, v)		// write version event
       DumpMiscStats()				// dump MiscStats at start
       resultis lvKT
       ]

and CloseStats() be
    [ if Stats then [ DumpMiscStats(); StatsOverflow()
                      Closes(Stats); Stats = 0 ]
      @StatsPtr = 0
    ]

and DumpMiscStats() be
    [ MovePage(EmuDiskVp, VP2(STATSspace, MISCSTATSbase))
      WriteStatsX(evMStatsCnts, lenMiscStats,
                  EmuDiskBuffer+(MISCSTATSbase<<LoByte))
    ]

and WriteStatsX(x,y,z) be
  [ unless @StatsPtr return		// forget it if no stats action
    switchon x rshift 6 into		// EventType: #xyz -> #x
      [ case 0: @StatsPtr!0 = Bytes2(x, y)	// evnt, arg
                @StatsPtr = @StatsPtr+1
                endcase
        case 1: @StatsPtr!0 = Bytes2(x, y)	// evnt, arghi, arglo
		@StatsPtr!1 = z
                @StatsPtr = @StatsPtr+2
                endcase
        case 2: @StatsPtr!0 = Bytes2(x, y-1)	// evnt, N, lv Nwords
                MoveBlock(@StatsPtr+1, z, y)
                @StatsPtr = @StatsPtr+y+1
                endcase
        default: CallSwat("Invalid event number")
                 endcase
      ]
    if @StatsPtr gr StatsEdge then StatsOverflow()
  ]

// DumpBlockToStats dumps large blocks.  Dumps numBlocks of size blockSize
// word 0: {eventN,,blockSize}; word 1: {0, num in sequence}
// words 2 thru blockSize+1 {data}

and DumpBlockToStats(eventN, addr, numBlocks, blockSize) be
  [
   unless Stats return
   WriteBlock(Stats, StatsBase, @StatsPtr-StatsBase)	// empty stats buffer
   for i = 1 to numBlocks do
     [ Puts(Stats, Bytes2(eventN, blockSize)); Puts(Stats, i)
       WriteBlock(Stats, addr, blockSize)
       addr = addr + blockSize
     ]
   @StatsPtr=StatsBase			// Reset stats pointer
  ]