// 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 ]