SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00011 TIMER/RESOLUTION ROUTINES 1 05-28-9314:09ALL SWAG SUPPORT TEAM Millisecond Timer Unit IMPORT 13 «uUe { millisecond timer Unit }ππUnit msecs;ππInterfaceππVarπ timer:Word; { msec timer }π idle:Procedure; { you can change this to do something useful when Delaying}ππProcedure Delay_ticks(t:Word); { resume Until t clock ticks have elapsed }πProcedure start_clock; { starts the 1 msec timer }πProcedure stop_clock; { stops the 1 msec timer }ππImplementationππUses Dos;ππProcedure Delay_ticks(t:Word);πbeginπ inc(t,timer);π Repeat idle Until Integer(timer - t) >= 0;πend;ππConst clock_active:Boolean = False;π one_msec = 1193;πVar save_clock:Pointer;π clocks:Word;ππProcedure tick_int; Far; Assembler;πAsmπ push axπ push dsπ mov ax,seg @dataπ mov ds,axπ mov al,$20π out $20,alπ inc [timer]π add [clocks],one_msecπ jnc @1π pushfπ call [save_clock]π@1:π pop dsπ pop axπ iretπend;πππProcedure start_clock;πbeginπ if clock_active then Exit;π inc(clock_active);π timer := 0;π clocks := 0;π getintvec($08,save_clock);π setintvec($08,@tick_int);π port[$43] := $36;π port[$40] := lo(one_msec);π port[$40] := hi(one_msec);πend;ππProcedure stop_clock;πbeginπ if not clock_active then Exit;π dec(clock_active);π port[$43] := $36;π port[$40] := 0;π port[$40] := 0;π setintvec($08,save_clock);πend;ππProcedure nothing; Far;πbeginπend;ππVar saveexit:Pointer;ππProcedure uninstall; Far;πbeginπ Exitproc := saveexit;π if clock_active then stop_clock;πend;ππbeginπ timer := 0;π idle := nothing;π saveexit := Exitproc;π Exitproc := @uninstall;πend.ππππ 2 05-28-9314:09ALL SWAG SUPPORT TEAM TCTIMER.PAS IMPORT 4 «u⌠┴ Unit tctimer;ππInterfaceπUses tptimer;ππ Varπ start : LongInt;ππProcedure StartTimer;ππProcedure WriteElapsedTime;ππππImplementationππProcedure StartTimer;π beginπ start := ReadTimer;π end;ππProcedure WriteElapsedTime;π Var stop : LongInt;π beginπ stop := ReadTimer;π Writeln('Elapsed time = ',(ElapsedTime(start,stop) / 1000):10:6,' seconds');π end;πππend.π 3 05-28-9314:09ALL D.J. MURDOCH Time Code Segments IMPORT 26 «uf▌ {$G+,S-,R-,Q-}π program timer;ππ { Program to time short segments of code; inspired by Michael Abrash'sπ Zen timer. Donated to the public domain by D.J. Murdoch }ππ usesπ opdos; { Object Professional unit, needed only for TimeMS,π a millisecond timer. }ππ constπ onetick = 1/33E6; { This is the time in seconds for one cpu cycle.π I've got it set for a 33 Mhz machine. }ππ { Instructions: put your code fragment into a short routine called Segment.π It should leave the stack unchanged, or it'll blow up when we clone it.π It *must* have a far return at the end. Play around with declaring itπ as an assembler procedure or not to see the cost of the TP entry andπ exit code. }ππ { This example is Sean Palmer's "var2 := var1 div 2" replacement fragment. }ππ varπ var1,var2 : integer;ππ procedure Segment; far; assembler;π asmπ mov ax,var1π sar ax,1π jns @Sπ adc ax,0π @S:π mov var2,axπ end;ππ { This is the comparison TP code. Note that it includes entry/exit code;π play around with variations on the assembler version to make it a fairπ comparison }π (*π procedure Segment; far;π beginπ var2 := var1 div 2;π end;π *)ππ { This procedure is essential!!! Do not move it. It must followπ Segment directly. }π procedure Stop;π beginπ end;ππ { This routine will only be called once at the beginning of the program;π set up any variables that Segment needs }ππ procedure Setup;π beginπ var1 := 5;π writeln('This run, var1=',var1);π end;ππ constπ maxsize=65520;π RETF = $CB;π varπ p : pointer;π src,dest : ^byte;π size : word;π repeats : word;π i : word;π start,finish : longint;π count : longint;π main,overhead,millisecs : real;π beginππ setup;ππ { Get a segment of memory, and fill it up with as many copiesπ of the segment as possible }ππ size := ofs(stop) - ofs(Segment) -1;π repeats := maxsize div size;π getmem(p, size*repeats + 1);π src := @Segment;π dest := p;π for i:=1 to repeats doπ beginπ move(src^,dest^,size);π inc(dest,size);π end;π { Add a final RETF at the end. }π dest^ := RETF;ππ { Now do the timing. Keep repeating one second loops indefinitely. }ππ writeln(' Bytes Clocks ns MIPS');π repeatπ { First loop: one second worth of calls to the segment }π start := timems;π count := 0;π repeatπ asmπ call dword ptr pπ end;π finish := timems;π inc(count);π until finish > 1000+start;π main := (finish - start)/repeats/count;ππ { Second loop: 1/2 second worth of calls to the RETF }π start := timems;π count := 0;π repeatπ asmπ call dword ptr destπ end;π finish := timems;π inc(count);π until finish > 500+start;π overhead := (finish-start)/count;π millisecs := (main-overhead/repeats);π writeln(size:6,millisecs/1000/onetick:11:1,π 1.e6*millisecs:11:0,π 1/millisecs/1000:11:3);π until false;π end.πππ--- Msg V3.2π * Origin: Murdoch's Point, Kingston, Ont, Canada - - (1:249/99.5)π 4 05-28-9314:09ALL SWAG SUPPORT TEAM TIMELOOP.PAS IMPORT 5 «u»L {$A+,B-,D-,E-,F-,I-,N-,O-,R-,S-,V-}ππProgram TimeNullRoutine;ππUsesπ TpTimer;ππVarπ Count : Byte;ππProcedure DoNothing;πbeginπend;ππVarπ Loop : Word;π Start,π Stop : LongInt;ππbeginπ Start := ReadTimer;π For Loop := 1 to 1000 doπ DoNothing;π Stop := ReadTimer;π WriteLn('Time = ', ElapsedTimeString(Start, Stop), ' ms')πend.ππ{π ...Well running the Program listed above, 1000 nul loops timeπ in at 3.007 miliseconds on my 386SX-25.π} 5 05-28-9314:09ALL SWAG SUPPORT TEAM Calculate Program Time IMPORT 29 «u? { SB> Has anyone by any chance written a Procedure For calculating the amountπ SB> of time a Program runs. I understand how to use getTime, etc, but I amπ SB> trying to figure out a way around all the possibilities...i.e. someoneπ SB> starts a Program at 23:59:03.44, and it's finished at 00:02:05.33.π SB>π SB> Anyway, if someone already has this figured out, I'd sure appreciate itπ SB> or even some ideas...ππScott,π try:ππ Varπ Timer : LongInt Absolute $0040:$006c;ππ That's the Tic counter, stored at Segment 0040h, offset 006Ch. Itπstores the number of ticks since you turned the Computer on and so willπonly wrap after MorE THAN 3 YEARS, if you never close the machine ;-)ππ it is incremented 18.2 times/sec, so divide it by 18.2 to get theπnumber of seconds. You can figure out the rest ;-)ππ Store its content to another LongInt at the start of the Program,πagain at the end. Substract the first value from the second and you haveπthe number of ticks elapsed during the Program's execution.ππOh what the heck, here is a Complete Unit, all you have to do is includeπit in your Uses clause nothing more unless you want to save the time inπa log File or something.π}ππ{$A+,B-,D+,E-,F+,G+,I-,L+,N-,O+,P+,Q-,R-,S-,T-,V-,X+,Y+}π{$M 8192,0,0}πUnit TimePrg;π(**) Interface (**)π(**) Implementation (**)πUsesπ Dos;πTypeπ CmdLine = String[127];πVarπ TimerTicks : LongInt Absolute $0040:$006C;π OldCommandLine, NewCommandline : CmdLine;π CommandLine : ^CmdLine;π TimeIn, TimeOut, Spent : LongInt;π Years, Days, Hours, Minutes, Seconds, ms : Byte;π ExitBeForeTimePrg : Pointer;π D : DirStr;π N : NameStr;π E : ExtStr;π Index : Integer;ππFunction Strfunc(Value:Byte):String;πVarπ temp : String;πbeginπ Str(Value:0, Temp);π StrFunc := #32+temp;πend;ππProcedure TimePrgExit; Far;πbeginπ TimeOut := TimerTicks;π ExitProc := ExitBeForeTimePrg;π Spent := TimeOut - TimeIn;π ms := (Spent - trunc(Spent / 18.2))*55;π Spent := Trunc(Spent / 18.2);π Years := Spent div (3600*24*365);π Spent := Spent mod (3600*24*365);π Days := Spent div (3600*24);π Spent := Spent mod (3600*24);π Hours := Spent div 3600;π Spent := Spent mod 3600;π Minutes := Spent div 60;π Spent := Spent mod 60;π Seconds := Spent;π CommandLine := Ptr(PrefixSeg, $80);π OldCommandLine := CommandLine^;π NewCommandLine := '';π if Years>0 thenπ NewCommandLine := NewCommandLine + Strfunc(Years) + ' Years';π if Days>0 thenπ NewCommandLine := NewCommandLine + Strfunc(Days) + ' Days';π if Hours>0 thenπ NewCommandLine := NewCommandLine + Strfunc(Hours) + ' Hours';π if Minutes>0 thenπ NewCommandLine := NewCommandLine + Strfunc(Minutes) + ' Minutes';π if Seconds>0 thenπ NewCommandLine := NewCommandLine + Strfunc(Seconds) + ' Seconds';π if ms>0 thenπ NewCommandLine := NewCommandLine + Strfunc(ms) + ' milli-seconds';π CommandLine^ := NewCommandLine;π Write('Thanks For spending ');π Case Paramcount ofπ 0: Write('so little time');π 2: Write(ParamStr(1),#32, Paramstr(2));π elseπ For Index := 1 to ParamCount - 3 do beginπ Write(Paramstr(Index));π if odd(Index) thenπ Write(' ')π elseπ Write(', ');π end;π Write(Paramstr(Index+1), ' and ',π Paramstr(Index+2), ' ', Paramstr(Index+3));π end;π CommandLine^ := OldCommandLine;π Fsplit(Paramstr(0), D, N, E);π Writeln(' In ', N);πend;ππbeginπ TimeIn := TimerTicks;π ExitBeForeTimePrg := ExitProc;π ExitProc := @TimePrgExit;πend.π 6 05-28-9314:09ALL SWAG SUPPORT TEAM Timing Using TP Clock IMPORT 8 «uh {π> Does anyone know of a proFiler For TP 6, or is there a specialπ> command using TPC to activate a proFiler to tell how much time theπ> Program takes doing a task. Thanks, LukeππTry this Unit. Put a ClockOn and it will start timing then when the ClockOffπis reached it will tell you how long it took. It's very nice For optimizingπpieces of code.π}ππUnit Timer;ππInterfaceππProcedure ClockOn;πProcedure ClockOff;ππImplementationπUses Dos;ππVarπ H, M, S, S100 : Word;π Startclock, Stopclock : Real;ππProcedure ClockOn;π beginπ GetTime(H, M, S, S100);π StartClock := (H * 3600) + (M * 60) + S + (S100 / 100);πend;ππProcedure ClockOff;π beginπ GetTime(H, M, S, S100);π StopClock := (H * 3600) + (M * 60) + S + (S100 / 100);π WriteLn('Elapsed time = ', (StopClock - StartClock):0:2);π end;ππend.ππ 7 05-28-9314:09ALL SWAG SUPPORT TEAM High Resolution Timer IMPORT 46 «udw {$S-,R-,I-,V-,B-}ππ{*********************************************************}π{* TPTIMER.PAS 2.00 *}π{* by TurboPower Software *}π{*********************************************************}ππUnit TpTimer;π {-Allows events to be timed With 1 microsecond resolution}ππππInterfaceπConstπ TimerResolution = 1193181.667;πProcedure InitializeTimer;π {-ReProgram the timer chip to allow 1 microsecond resolution}ππProcedure RestoreTimer;π {-Restore the timer chip to its normal state}ππFunction ReadTimer : LongInt;π {-Read the timer With 1 microsecond resolution}ππFunction ElapsedTime(Start, Stop : LongInt) : Real;π {-Calculate time elapsed (in milliseconds) between Start and Stop}ππFunction ElapsedTimeString(Start, Stop : LongInt) : String;π {-Return time elapsed (in milliseconds) between Start and Stop as a String}ππ {==========================================================================}ππImplementationππVarπ SaveExitProc : Pointer;π Delta : LongInt;ππ Function Cardinal(L : LongInt) : Real;π {-Return the unsigned equivalent of L as a Real}π begin {Cardinal}π if L < 0 thenπ Cardinal := 4294967296.0+Lπ elseπ Cardinal := L;π end; {Cardinal}ππ Function ElapsedTime(Start, Stop : LongInt) : Real;π {-Calculate time elapsed (in milliseconds) between Start and Stop}π begin {ElapsedTime}π ElapsedTime := 1000.0*Cardinal(Stop-(Start+Delta))/TimerResolution;π end; {ElapsedTime}ππ Function ElapsedTimeString(Start, Stop : LongInt) : String;π {-Return time elapsed (in milliseconds) between Start and Stop as a String}π Varπ R : Real;π S : String;π begin {ElapsedTimeString}π R := ElapsedTime(Start, Stop);π Str(R:0:3, S);π ElapsedTimeString := S;π end; {ElapsedTimeString}ππ Procedure InitializeTimer;π {-ReProgram the timer chip to allow 1 microsecond resolution}π begin {InitializeTimer}π {select timer mode 2, read/Write channel 0}π Port[$43] := $34; {00110100b}π Inline($EB/$00); {jmp short $+2 ;Delay}π Port[$40] := $00; {LSB = 0}π Inline($EB/$00); {jmp short $+2 ;Delay}π Port[$40] := $00; {MSB = 0}π end; {InitializeTimer}ππ Procedure RestoreTimer;π {-Restore the timer chip to its normal state}π begin {RestoreTimer}π {select timer mode 3, read/Write channel 0}π Port[$43] := $36; {00110110b}π Inline($EB/$00); {jmp short $+2 ;Delay}π Port[$40] := $00; {LSB = 0}π Inline($EB/$00); {jmp short $+2 ;Delay}π Port[$40] := $00; {MSB = 0}π end; {RestoreTimer}ππ Function ReadTimer : LongInt;π {-Read the timer With 1 microsecond resolution}π begin {ReadTimer}π Inline(π $FA/ {cli ;Disable interrupts}π $BA/$20/$00/ {mov dx,$20 ;Address PIC ocw3}π $B0/$0A/ {mov al,$0A ;Ask to read irr}π $EE/ {out dx,al}π $B0/$00/ {mov al,$00 ;Latch timer 0}π $E6/$43/ {out $43,al}π $EC/ {in al,dx ;Read irr}π $89/$C7/ {mov di,ax ;Save it in DI}π $E4/$40/ {in al,$40 ;Counter --> bx}π $88/$C3/ {mov bl,al ;LSB in BL}π $E4/$40/ {in al,$40}π $88/$C7/ {mov bh,al ;MSB in BH}π $F7/$D3/ {not bx ;Need ascending counter}π $E4/$21/ {in al,$21 ;Read PIC imr}π $89/$C6/ {mov si,ax ;Save it in SI}π $B0/$FF/ {mov al,$0FF ;Mask all interrupts}π $E6/$21/ {out $21,al}π $B8/$40/$00/ {mov ax,$40 ;read low Word of time}π $8E/$C0/ {mov es,ax ;from BIOS data area}π $26/$8B/$16/$6C/$00/ {mov dx,es:[$6C]}π $89/$F0/ {mov ax,si ;Restore imr from SI}π $E6/$21/ {out $21,al}π $FB/ {sti ;Enable interrupts}π $89/$F8/ {mov ax,di ;Retrieve old irr}π $A8/$01/ {test al,$01 ;Counter hit 0?}π $74/$07/ {jz done ;Jump if not}π $81/$FB/$FF/$00/ {cmp bx,$FF ;Counter > $FF?}π $77/$01/ {ja done ;Done if so}π $42/ {inc dx ;else count int req.}π {done:}π $89/$5E/$FC/ {mov [bp-4],bx ;set Function result}π $89/$56/$FE); {mov [bp-2],dx}π end; {ReadTimer}ππ Procedure Calibrate;π {-Calibrate the timer}π Constπ Reps = 1000;π Varπ I : Word;π L1, L2, Diff : LongInt;π begin {Calibrate}π Delta := MaxInt;π For I := 1 to Reps do beginπ L1 := ReadTimer;π L2 := ReadTimer;π {use the minimum difference}π Diff := L2-L1;π if Diff < Delta thenπ Delta := Diff;π end;π end; {Calibrate}ππ {$F+}π Procedure OurExitProc;π {-Restore timer chip to its original state}π begin {OurExitProc}π ExitProc := SaveExitProc;π RestoreTimer;π end; {OurExitProc}π {$F-}ππbeginπ {set up our Exit handler}π SaveExitProc := ExitProc;π ExitProc := @OurExitProc;ππ {reProgram the timer chip}π InitializeTimer;ππ {adjust For speed of machine}π Calibrate;πend.π 8 05-28-9314:09ALL SWAG SUPPORT TEAM Release Time Slices IMPORT 17 «u╚b {πSome months ago we discussed the problem With Dos Programsπthat eats CPU time in multitask environments (as OS/2),πwhen they're idle. I have successfully used an Inlineπstatement in my Pascal Programs that calls intr $28, whichπis the Keyboard Busy Flag, For this purpose. I found thatπInline statement in a TurboPower Program, which they useπto signalize to TSRs that it's OK to interrupt processing.ππHere's the Inline statement I use in keyboard loops:ππ Inline($CD/$28);ππBut... This statement doesn't work in the Idle method ofπTurbo Vision Programs... In our previous discussion onπthis subject, somebody here looked up another intr inπRalph Brown's excellent Compilation list of interrupts.πThis intr, $2F, works in another way by releasing theπreminder of unused time-slice to the operating system.πCalled in a tight Program loop, this means that theπProgram will free up it's idle time to the OS.ππHere's a Function I made that I now use in TV's Idle method:π}ππUsesπ Dos;ππFunction ReleaseTimeSlice: Boolean;πVarπ Regs: Registers;ππbeginπ With Regs doπ beginπ AX := $1680;π Intr($2F, Regs);π ReleaseTimeSlice := (AL = $00); { AL=$80 if not supported by OS }π end;πend;ππ{π ...and here's how the Idle loop Uses it in a TV Program:π}ππProcedure TMyProgram.Idle;πbeginπ TApplication.Idle;ππ { more idle calls go here ... }π { : }ππ { Inline($CD/$28); } { this has no effect on PULSE.EXE by itself }π ReleaseTimeSlice; { remember to use $X+ when Compiling the Program }πend;ππ{π...This works fine, judging by PULSE.EXE in OS/2.πRalph Brown also says this works in Windows, tho Windowsπnative Programs may not use it.πMaybe someone can comment on if it's necesarry to alsoπput in the Inline statement above For servicing TSRs.πI can't see any reason For not doing it, but I might'veπoverlooked something here... :-)ππBorland doesn't do this in their Idle method For TP/BP.πIt should be quite easy to patch this in the RTL code,πFor those of you that have it, and reCompile BP.π}ππ 9 08-27-9322:03ALL MARCO MILTENBURG Giving Timeslices IMPORT 7 «u {πMARCO MILTENBURGππ>> if you find SOURCE to detect/give up time slices For Windows/OS/2/Desqview,π>> could you post it? I have stuff For Desqview, I believe.ππ> Procedure GiveTimeSlice; Inline( $cd/$28 );ππThis is nice, but you have to be sure that you have enough stack space left,πbecause Dos or TSR's that hook this interrupt will use SS:SP For their ownπstack. I use the following in my multitasker detect Unit :π}ππProcedure TimeSlice;πVarπ Regs : Registers;πbeginπ Case OS_Type Ofπ _Dos :π beginπ end;ππ _DV,π _DVX :π beginπ Regs.AX := $1000;π Intr($15, Regs);π end;ππ _OS2,π _WINS,π _WIN3:π beginπ Regs.AX := $1680;π Intr($2F, Regs);π end;π end;πend;π 10 08-27-9322:04ALL DAVID DAHL Controling DOS Timer IMPORT 15 «u {πDAVID DAHLππI never posted it as a Unit. I just posted a couple routines to set theπtimer. They're actually a part of another, larger project I've been workingπon to play digitized Sound out of several different output devices. When Iπwas asked if it were possible to speed up the tick and still have Dos's timerπFunction behave normally, I threw them into a Unit and wrote the Program youπquoted from to illustrate how it would be done. Here are the timer routinesπas a Unit:ππThe routines perform no error checking on input values, so be carefulπwith them. The Procedure Set8253Channel should never have aπchannel value of more than 2 since the 8253 only has 3 channelsπ(0 - 2).π}ππUnit C8253;ππ(* PUBLIC DOMAIN *)ππInterfaceππProcedure SetPlaySpeed(Speed : LongInt);πProcedure SetDefaultTimerSpeed;πProcedure Set8253Channel(ChannelNumber : Byte; ProgramValue : Word);ππImplementationππConstπ C8253ModeControl = $43;π C8253OperatingFreq = 1193180;π C8253Channel : Array [0..2] of Byte = ($40, $41, $42);ππ{=[ 8253 Timer Programming Routines ]=====================================}πProcedure Set8253Channel(ChannelNumber : Byte; ProgramValue : Word);πbeginπ Port[C8253ModeControl] := 54 or (ChannelNumber SHL 6); { XX110110 }π Port[C8253Channel[ChannelNumber]] := Lo(ProgramValue);π Port[C8253Channel[ChannelNumber]] := Hi(ProgramValue);πend;π{-[ Set Clock Channel 0 (INT 8, IRQ 0) To Input Speed ]-------------------}πProcedure SetPlaySpeed (Speed : LongInt);πVarπ ProgramValue : Word;πbeginπ ProgramValue := C8253OperatingFreq div Speed;π Set8253Channel(0, ProgramValue);πend;π{-[ Set Clock Channel 0 Back To 18.2 Default Value ]----------------------}πProcedure SetDefaultTimerSpeed;πbeginπ Set8253Channel (0, 0);πend;ππend.πππ 11 08-27-9322:05ALL DANNY MELTON Free time for DV IMPORT 8 «u {π> Does anyone know how to give up your free time under dv or dv/x? Or makeπ> these programs desqview aware?ππDONATED TO THE PUBLIC DOMAIN by Danny Meltonπ}ππprogram YourProgramHere;ππusesπ DOS, CRT;ππconstπ MultiTasking : boolean = false;ππfunction UnderDV : boolean;πvarπ R : registers;πbeginπ if MultiTasking thenπ exit;π R.AX := $1022;π R.BX := $0000;π intr($15, R);π MultiTasking := boolean(R.BX <> 0);π UnderDV := MultiTasking;πend;ππprocedure GiveUpTimeSlice;πvarπ R : registers;πbeginπ if not MultiTasking thenπ exit;π R.AX := $1000;π intr($15, R);πend;ππbeginπ if UnderDV thenπ writeln('Running under a multi-tasker.');π writeln('Press a key when ready');π while not keypressed doπ GiveUpTimeSlice;π writeln('You pressed a key.');πend.ππ