// DirTimer.bcpl
// Copyright Xerox Corporation 1979
// Last modified August 28, 1979  9:19 PM by Taft

// Bldr DirTimer DirTimerA GP

get "Streams.d"
get "Disks.d"

external
[
// incoming procedures
OpenFile; DeleteFile; CreateDisplayStream; ShowDisplayStream
SetupReadParam
Wss; Wns; Gets; Puts; Closes; Endofs
InterceptDoDiskCommand; InterceptGetCb
Mul32x16; Div32x16; DoubleSubtract
@timerItem; @RealDoDiskCommand; @RealGetCb

// incoming statics
sysDisk; keys; lvSysZone
]

static [ logDsp; logFile ]

structure TI:  // Timer Item
[
next word
timeH word
timeL word
page word
da word
action word
snH word
snL word
type word
]
manifest lenTI = size TI/16
manifest numTI = 1000

//----------------------------------------------------------------------------
let DirTimer() be
//----------------------------------------------------------------------------
[
let repeatFlag = false
let switchVec = vec 10
SetupReadParam(0, switchVec)
for i = 1 to switchVec!0 do
   switchon switchVec!i & #137 into
      [
      case $R:
         repeatFlag = true; endcase
      ]

let tiBuf = vec lenTI*numTI
timerItem = tiBuf
let ti = tiBuf
for i = 1 to numTI-1 do
   [
   ti>>TI.next = ti+lenTI
   ti = ti+lenTI
   ]
ti>>TI.next = ti

let mainStatics = lvSysZone-221B
RealDoDiskCommand = mainStatics!146B
mainStatics!146B = InterceptDoDiskCommand
RealGetCb = mainStatics!150B
mainStatics!150B = InterceptGetCb
if sysDisk>>DSK.DoDiskCommand eq RealDoDiskCommand then
   [ // This BFS has these procedures in the DSK object
   sysDisk>>DSK.DoDiskCommand = InterceptDoDiskCommand
   sysDisk>>DSK.GetDiskCb = InterceptGetCb
   ]

   [
   let s = OpenFile("foozot")
   Closes(s)
   DeleteFile("foozot")
   ] repeatwhile repeatFlag & Endofs(keys)

mainStatics!146B = RealDoDiskCommand
mainStatics!150B = RealGetCb
if sysDisk>>DSK.DoDiskCommand eq InterceptDoDiskCommand then
   [ // This BFS has these procedures in the DSK object
   sysDisk>>DSK.DoDiskCommand = RealDoDiskCommand
   sysDisk>>DSK.GetDiskCb = RealGetCb
   ]

let bitmap = vec 20000
logDsp = CreateDisplayStream(50, bitmap, 20000)
ShowDisplayStream(logDsp)
logFile = OpenFile("DirTimer.log", ksTypeWriteOnly, charItem)
let log = lv LogPuts - offset ST.puts/16
let line = 0
ti = tiBuf
let baseTicks = vec 1
baseTicks!0 = ti>>TI.timeH rshift 6
baseTicks!1 = ti>>TI.timeH lshift 10 + ti>>TI.timeL rshift 6
let lastMS = vec 1; lastMS!0 = 0; lastMS!1 = 0
until ti eq timerItem do
   [
   let thisMS = vec 1
   TicksToMS(lv ti>>TI.timeH, thisMS, baseTicks)
   Wss(log, "*n")
   Wns(log, thisMS!0, 6, 10)
   Wss(log, ".")
   Wns(log, (thisMS!1)/100)
   let delta = vec 1
   delta!0 = thisMS!0 - lastMS!0
   delta!1 = thisMS!1 - lastMS!1
   if delta!1 ls 0 then
      [ delta!1 = delta!1+1000; delta!0 = delta!0 -1 ]
   Wns(log, delta!0, 4)
   Wss(log, ".")
   Wns(log, (delta!1)/100)
   lastMS!0 = thisMS!0; lastMS!1 = thisMS!1
   switchon ti>>TI.type into
      [
      case 0:
         Wss(log, "  DoDiskCommand ")
         Wss(log, selecton ti>>TI.action into
            [
            case DCreadHLD:   "DCreadHLD   "
            case DCreadLD:    "DCreadLD    "
            case DCreadD:     "DCreadD     "
            case DCwriteHLD:  "DCwriteHLD  "
            case DCwriteLD:   "DCwriteLD   "
            case DCwriteD:    "DCwriteD    "
            case DCseekOnly:  "DCseekOnly  "
            case DCdoNothing: "DCdoNothing "
            default:          "Bad Action  "
            ])
         Wss(log, " page ")
         Wns(log, ti>>TI.page, 4)
         Wss(log, " DA ")
         Wns(log, ti>>TI.da, 5)
         Wss(log, ", SN ")
         Wns(log, ti>>TI.snH, 6, 8)
         Wns(log, ti>>TI.snL, 7, 8)
         endcase
      case 1:
         Wss(log, "  GetCb")
         endcase
      ]
   ti = ti>>TI.next
   line = line+1
   if line rem 50 eq 0 then [ Wss(logDsp, "       More?"); Gets(keys) ]
   ]

Wss(logDsp, "       End..."); Gets(keys)
Closes(logDsp); Closes(logFile)
]

//----------------------------------------------------------------------------
and LogPuts(s, char) be [ Puts(logDsp, char); Puts(logFile, char) ]
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and TicksToMS(lvTime, lvMS, baseTicks) be
//----------------------------------------------------------------------------
// Converts RCLK time to milliseconds in lvMS!0 and leftover microseconds
// in lvMS!1
[
let ticks = vec 1
ticks!0 = lvTime!0 rshift 6
ticks!1 = lvTime!0 lshift 10 + lvTime!1 rshift 6
DoubleSubtract(ticks, baseTicks)
Mul32x16(ticks, 38)
lvMS!1 = Div32x16(ticks, 1000)
lvMS!0 = ticks!1
]