SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00022 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 TURBOPOWER SOFTWARE 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 «up{ {π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 O {π> 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.ππ 12 09-26-9309:30ALL MARTIN RICHARDSON Hi-Res Timer IMPORT 7 «u"π {*****************************************************************************π * Function ...... Timerπ * Purpose ....... Returns the number of seconds since midnightπ * Parameters .... Noneπ * Returns ....... Number of seconds since midnight to the 100th decimial placeπ * Notes ......... Noneπ * Author ........ Martin Richardsonπ * Date .......... May 13, 1992π *****************************************************************************}πFUNCTION Timer : REAL;πVAR hour,π minute,π second,π sec100 : WORD;πBEGINπ GETTIME(hour, minute, second, sec100);π Timer := ((hour*60*60) + (minute*60) + (second) + (sec100 * 0.01))πEND;ππ 13 11-02-9306:29ALL CEES BINKHORST Setting Timing at 21Khz IMPORT 23 «u5 {πCEES BINKHORSTππ> Has anyone ever succeeded in setting the timer rate at a higher frequencyπ> than 21KHz in protected mode? I've tried every possible thing, and itπCould you give details on that 21KHz? Sounds rather a high rate.ππ> don't know whether I have enough IOPL as to make CLI and STI to work, butπTry the following:π}ππ{dr. dobb's 80286/386 #185}πFunction SensitiveOK : Boolean; Assembler; {sensitive instructions are: }π {IN read a port }π {OUT Write to a port }π {INS read a String from a port}π {OUTS Write a String to a port}π {CLI disable interrupts }π {STI enable interrupts }πAsmπ push axπ push bxπ pushf {put flags 'I/O privilege level' (IOPL)}π pop ax { into ax }π and ax, 3000h {00110000 00000000 - mask all but iopl}π {ax = 00??0000 00000000 now}π shr ax, 12 {ax -> 00000000 000000??}π {compile With 286 instructions enabled!!}π mov iopl, alπ mov bx, cs {current privilege level (cpl) is in cs}π and bx, 3 {00000000 00000011 - mask all but cpl}π mov cpl, blπ cmp bx, ax {compare cpl and iopl}π ja @not_sensitive {jump if cpl > iopl}π clcπ mov @result, True {sensitive instructions ok}π jmp @exitπ @not_sensitive:π stcπ mov @result, False {sensitive instructions not ok}π @exit:π pop bxπ pop axπend;ππFunction PrivilegeOK: Boolean; Assembler; {privileged instructions are:}π {HLT halt the processor }π {LGDT load the GDT register }π {LIDT load the interrupt-descriptor-}π { table register }π {LLDT load the LDT register }π {CLTS clear the task-switched flag}π {LMSW load the MSW }π {LTR load the task register}πAsmπ push axπ mov ax, cs {cpl resides in cs}π and ax, 3 {00000000 00000011 - mask all but cpl}π {ax = 00000000 000000?? now}π jnz @lbl1π mov @result, True {privileged}π jmp @exitπ @lbl1:π mov @result, False {not privileged}π @exit:π pop axπend;π 14 01-27-9412:23ALL CHRIS BOYD Timing Unit IMPORT 40 «u<╧ {π> Now what I want to do is calculate the total run-time of the overallπ> event, from start to finish, i.e., parse the log file taking the last andπ> first time entries and calculate the time. I'm sure there is an easier wayπ> to do this but I'm new to Pascal, and, open to suggestions. Below is whatπ> appears in the event.log :π}ππUnit Timer;ππ{ SIMPLE TIMER 1.0π =================ππ This is a Timer unit, it calculates time by system clock. A few limitationsπ are:ππ 1) Must not modify clock.π 2) Must not time more than a dayπ 3) Must StopTimer before displaying Timeππ Usage:ππ StartTimer; Starts Timerπ StopTimer; Stops Timerπ CalcTimer; Calculates timeπ DispTime: Displays time between StartTimer and StopTimer,π you don't need to call CalcTimer if you call DispTime.ππ This unit may be used in freeware and shareware programs as long as:ππ 1) The program is a DECENT program, no "Adult" or "XXX" type programsπ shall lawfully contain any code found within this file (modified orπ in original form) or this file after it's been compiled.ππ 2) This copyrighting is not added to, or removed from the program byπ any other person other than I, the author.ππ This is copyrighted but may be used or modified in programs as long as theπ above conditions are followed.ππ I may be reached at:ππ 1:130/709 - Fidonetπ Chris.Boyd@f709.n130.z1.fidonet.org - Internetπ Alpha Zeta, Ft. Worth (817) 246-3058 - Bulletin Boardππ If you have any comments or suggestions (not complaints). I assume noπ responsibility for anything resulting from the usage of this code.ππ -Chris Boydππ}ππInterfaceππUsesπ Dos;ππTypeπ TimeStruct = recordπ Hour,π Minute,π Second,π S100 : Word;π End;ππVarπ StartT,π StopT,π TimeT : TimeStruct;π Stopped : Boolean;ππprocedure StartTimer;πprocedure StopTimer;πprocedure DispTime;πprocedure CalcTimer;ππImplementationππprocedure TimerError(Err : Byte);πBeginπ Case Err ofπ 1 :π Beginπ Writeln(' Error: Must Use StartTimer before StopTimer');π Halt(1);π End;ππ 2 :π Beginπ Writeln(' Error: Timer can not handle change of day');π Halt(2);π End;ππ 3 :π Beginπ Writeln(' Error: Internal - Must StopTimer before DispTime');π Halt(3);π End;π End;πEnd;ππprocedure CalcTimer;πBeginπ If (Stopped = True) Thenπ Beginπ If (StopT.Hour < StartT.Hour) Thenπ TimerError(2);π TimeT.Hour := StopT.Hour - StartT.Hour;ππ If (StopT.Minute < StartT.Minute) Thenπ Beginπ TimeT.Hour := TimeT.Hour - 1;π StopT.Minute := StopT.Minute + 60;π End;π TimeT.Minute := StopT.Minute - StartT.Minute;ππ If (StopT.Second < StartT.Second) Thenπ Beginπ TimeT.Minute := TimeT.Minute - 1;π StopT.Second := StopT.Second + 60;π End;π TimeT.Second := StopT.Second - StartT.Second;ππ If (StopT.S100 < StartT.S100) Thenπ Beginπ TimeT.Second := TimeT.Second - 1;π StopT.S100 := StopT.S100 + 100;π End;π TimeT.S100 := StopT.S100 - StartT.S100;π Endπ Elseπ TimerError(3);πEnd;ππprocedure DispTime;πBeginπ CalcTimer;π Write(' Time : ');π Write(TimeT.Hour);π Write(':');ππ If (TimeT.Minute < 10) Thenπ Write('0');π Write(TimeT.Minute);π Write(':');ππ If (TimeT.Second < 10) Thenπ Write('0');π Write(TimeT.Second);π Write('.');ππ If (TimeT.S100 < 10) Thenπ Write('0');π Writeln(TimeT.S100);πEnd;ππprocedure StartTimer;πBeginπ GetTime(StartT.Hour, StartT.Minute, StartT.Second, StartT.S100);π Stopped := False;πEnd;ππprocedure StopTimer;πBeginπ If (Stopped = False) Thenπ Beginπ GetTime(StopT.Hour, StopT.Minute, StopT.Second, StopT.S100);π Stopped := TRUE;π Endπ Elseπ TimerError(1);πEnd;ππEnd.ππ{πThis is a unit that I wrote. It will not change day without calling an errorπin itself. This can be modified though, I just haven't went about doing it.πFor example, if you started the timer at 11:29 pm and stopped it at 1:00 am, itπwouldn't work, but if you started the timer at 12:00 am and stopped it at 11:59πpm in that same day it would work. The TimeStruct type doesn't store day, justπtime and the only thing you have to do to use it is:ππIn your main program:π}πProgram MyProg;ππUsesπ Timer;ππBeginπ{ Program stuff.... }πStartTimer;π{ More Program Stuff... }πStopTimer;π{ If you don't want to display the time to the screen, then you need toπ call CalcTimer, so that it modifies TimeT}πDispTime; {Whenever you want to display the time.. The calculated time isπstored in the record variable Timer.TimeT, if you wanted to access it. Allπthe fields of the record a word in type. To access the hours for example,πyou'd go like:ππ Timer.TimeT.Hour or TimeT.Hourππ You probably will have to try both.}πEnd.ππ 15 02-03-9407:08ALL JAKE CHAPPLE Events on IRQ/TIMERS IMPORT 101 «u═W {πFrom: JAKE CHAPPLEπSubj: Events on IRQ/TIMERSπ---------------------------------------------------------------------------π}ππ{----------------------- Beginning of TIMER.PAS -----------------------}πUnit Timer;ππ{========================================================================}π{ INTERFACE SECTION }π{========================================================================}π{ }π{ This unit implements a set of general purpose, low resolution timers }π{ for use in any application that requires them. The design of the }π{ timer system is adapted from the following magazine article: }π{ }π{ Jones S., A High-Performance Lightweight Timer Package, Tech }π{ Specialist, Vol. 2, No. 1, Jan 1991, pp 17-27. }π{ }π{ Most of Jones' design has been copied, although this implementation is }π{ in Turbo Pascal rather than MASM. By default, this unit provides 10 }π{ timers, although this can be increased by increasing the value of }π{ MAX_TIMER and re-compiling. }π{ }π{ Timers are referenced by "handles" i.e. small integers. These are }π{ actually indexes into the timer array. To obtain a handle one must }π{ ALLOCATE a timer. The Allocate function also requires the address of }π{ a routine to execute when the timer expires as well as a user context }π{ variable. The timer function must be compiled as a FAR routine. The }π{ user context variable is a 16 bit word of data that can be used for any}π{ application specific purpose. It is passed to the timer routine when }π{ the timer expires. This is useful if a common timer routine is used }π{ for multiple timers. It allows the common timer routine to determine }π{ which timer expired and take appropriate action. }π{ }π{ Once a timer is allocated, it must be STARTED. The StartTimer }π{ procedure requires the timer handle and a timer running time. The }π{ timer running timer is passed as a RELATIVE number of MILLISECONDS i.e.}π{ the number of milliseconds from now when the timer should expire. }π{ }π{ A timer can be stopped before it expires with StopTimer which just }π{ requires the timer handle. There is the possibility that the StopTimer}π{ routine could be interrupted by a clock tick and the expiration routine}π{ could run before the StopTimer procedure actually stops the timer. }π{ It's up to you to guard against this. }π{ }π{ Finally, an allocated timer can be deallocated with DeallocateTimer }π{========================================================================}ππINTERFACEππusesπ Dos;ππtypeπ UserProc = procedure(context : word);πππfunction AllocateTimer(UserContext : word; UserRtn : UserProc) : integer;πprocedure StartTimer(handle : integer; rel_timeout : longint);πprocedure StopTimer(handle : integer);πprocedure DeallocateTimer(handle : integer);ππ{========================================================================}π{ IMPLEMENTATION SECTION }π{========================================================================}ππIMPLEMENTATIONππconstπ MAX_TIMER = 10; {Total number of timers}π MILLISECS_PER_TICK = 55; {clock tick interval}π TIMER_ALLOCATED = 1; {bits in the timer flags word}π TIMER_RUNNING = 2;ππtypeπ timer_rec = record {Timer descriptor record}π timeout : longint; {Timeout. Absolute number of millisecs}π {From beginning of program execution}π routine : UserProc; {User procedure to run on expiration}π flags : word; {Timer status flags}π context : word; {User parameter to pass to User Proc}π end;πvarπ timers : array[1..MAX_TIMER] of timer_rec; {timer database}π Int1CSave : pointer; {dword to hold original Int $1C vector}π TimeCounter : longint; {incremented by 55 millisecs on every entry to ISR}π ExitSave : pointer; {Save the address of next unit exit proc in chain}π i : integer; {loop counter}ππ{$F+}π{------------------------------------------------------------------------}πprocedure Clock_ISR; interrupt;π{------------------------------------------------------------------------}π{ Description: }π{ This is an interrupt service routine which is hooked into the PC's }π{ $1C vector. An Int $1C is generated at each clock tick. Int $1C is }π{ executed by the hardware interrupt service routine after it has up- }π{ dated the system time-of-day clock. }π{ Parameters: }π{ None. }π{------------------------------------------------------------------------}πvarπ i : integer; {local loop counter}πbeginππ {Update the current time, relative to the start of the program}ππ inline($FA); {cli}π TimeCounter := TimeCounter + MILLISECS_PER_TICK; {update millisecond counter}ππ {Scan the array of timers looking for ones which have expired}ππ for i := 1 to MAX_TIMER doπ with timers[i] doπ if (flags and TIMER_ALLOCATED) > 0 then {Is this timer allocated? if no}π if (flags and TIMER_RUNNING) > 0 then {Is this timer running? if not}π if timeout <= TimeCounter then begin {Has this timer expired yet?}π flags := flags and (not TIMER_RUNNING); {turn off running flag}π inline($FB); {sti}π routine(context); {call user expiration routine}π inline($FA); {cli}π end;π inline($FB); {sti}πend;π{$F-}ππ{------------------------------------------------------------------------}πfunction AllocateTimer(UserContext : word; UserRtn : UserProc) : integer;π{------------------------------------------------------------------------}π{ Description: }π{ Allocate the next available timer in the timer database for use by }π{ application. }π{ Parameters: }π{ UserContext - application specific word of data to be passed to the }π{ expiration routine when it is called. }π{ UserProc - address of a procedure to be called when the timer expires}π{ Returns: }π{ Handle - integer from 1 to MAX_TIMER }π{ OR -1 if no timers available. }π{------------------------------------------------------------------------}πvarπ i : integer;πbeginπ inline($FA); {cli}π for i := 1 to MAX_TIMER do begin {scan timer database looking for 1st free}π with timers[i] do beginπ if flags = 0 then beginπ flags := TIMER_ALLOCATED; {Mark timer as allocated}π context := UserContext; {Save users context variable}π routine := UserRtn; {Store user routine}π AllocateTimer := i; {Return handle to timer}π inline($FB); {Enable interrupts}π exit;π end;π end;π end;π { No timers available, return error}π AllocateTimer := -1;π inline($FB);πend;ππ{------------------------------------------------------------------------}πprocedure DeallocateTimer(handle : integer);π{------------------------------------------------------------------------}π{ Description: }π{ Return a previously allocated timer to the pool of available timers }π{------------------------------------------------------------------------}πbeginπ timers[handle].flags := 0;πend;πππ{------------------------------------------------------------------------}πprocedure StartTimer(handle : integer; rel_timeout : longint);π{------------------------------------------------------------------------}π{ Description: }π{ Start an allocated timer ticking. }π{ Parameters: }π{ Handle - the handle of a previously allocated timer. }π{ rel_timeout - number of milliseconds before the timer is to expire. }π{------------------------------------------------------------------------}πbeginπ inline($FA); {cli}π with timers[handle] do beginπ flags := flags or TIMER_RUNNING; {set timmer running flag}π timeout := TimeCounter + rel_timeout; {Convert relative timeout to absolute}π end;π inline($FB); {sti}πend;ππ{------------------------------------------------------------------------}πprocedure StopTimer(handle : integer);π{------------------------------------------------------------------------}π{ Description: }π{ Stop a ticking timer from running. This routine does not deallocate }π{ the timer, just stops it. Remember, it is possible for the clock }π{ interrupt to interrupt this routine before it actually stops the }π{ timer. Therefore, it is possible for the expiration routine to run }π{ before the timer is stopped i.e. unexpectedly. }π{ Parameters: }π{ Handle - handle of timer to stop. }π{------------------------------------------------------------------------}πbeginπ with timers[handle] doπ flags := flags and (not TIMER_RUNNING);πend;ππ{$F+}π{------------------------------------------------------------------------}πProcedure myExitProc;π{------------------------------------------------------------------------}π{ Description: }π{ This is the unit exit procedure which is called as part of a chain of }π{ exit procedures at program termination. }π{------------------------------------------------------------------------}πbeginπ ExitProc := ExitSave; {Restore the chain so other units get a turn}π SetIntVec($1C, Int1CSave); {restore the original Int $1C vector}πend;π{$F-}ππ{=========================================================================}π{ INITIALIZATION SECTION }π{=========================================================================}ππBegin {unit initialization code}ππ (* Establish the unit exit procedure *)ππ ExitSave := ExitProc;π ExitProc := @myExitProc;ππ {Initialize the timers database and install the custom Clock ISR}ππ for i := 1 to MAX_TIMER do {clear flag word for all timers}π timers[i].flags := 0;π TimeCounter := 0; {clear current time counter}π GetIntVec($1C, Int1CSave); {Save original Int $1C vector}π SetIntVec($1C, @Clock_ISR); {install the the clock ISR}πend.ππ{------------------------- End of TIMER.PAS -----------------------------}ππ{---------------------- Beginning of TIMERTST.PAS -----------------------}πprogram timer_test;ππusesπ Crt, timer;πvarπ t1, t2 : integer; {timer handles}π done : boolean;ππ{---- Procedure to be run when timer 1 expires ----}πprocedure t1_proc(context1 : word); far;πbeginπ writeln('Timer ',context1);π StartTimer(t1, 1000); {Keep timer 1 running}πend;ππ{---- Procedure to be run when timer 2 expires ----}πprocedure t2_proc(context2 : word); far;πbeginπ done := true;π writeln('Timer ',context2,' expired');πend;ππbeginπ ClrScr;π done := false;π t1 := AllocateTimer(1, t1_proc); {Create timer 1}π t2 := AllocateTimer(2, t2_proc); {Create timer 2}π StartTimer(t2, 5000); {Start timer 2 for 5 second delay}π StartTimer(t1, 1000); {Start timer 1 for 1 second delay}π while not done do begin {Do nothing until timer 2 expires}π end;π StopTimer(t1);πend.π 16 05-25-9408:24ALL TONI PERRETTA Timing Functions SWAG9405 27 «u╚ {π ▌Is there an easy way to time functions and/or procedures?? I'm tryingπ ▌to compare a couple functions that do the samething and I would like toπ ▌time them. I've tried using the GetTime procedure but the hundredths ofπ ▌seconds isn't fast enough. Can any one help?ππ I think this unit may help you:ππ***************************************************************************π}πunit tptimer;ππinterfaceππprocedure cardinal(l:longint; var result:double);ππprocedure elapsedtime(start:longint; stop:longint; var result:double);π(*Calculate time elapsed (in milliseconds) between Start and Stop*)ππ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*)ππimplementationπuses dos;ππconstπTimerResolution=1193181.667;ππprocedure cardinal(l:longint; var result:double);π Beginπ if l < 0 then result:= l + 4294967296.0π elseπ result := l;π End;ππprocedure elapsedtime(start, stop:longint; var result:double);π var r:double;π Beginπ cardinal(stop - start, r);π result := (1000 * r) / TimerResolution;π End;ππprocedure initializetimer;πlabel NullJump1,NullJump2;πBeginπ port[$043]:=$034;π asm jmp NullJump1;π NullJump1:π end;π port[$040]:=$000;π asm jmp NullJump2π NullJump2:π end;π port[$040]:=$000;πEnd;ππprocedure restoretimer;πlabel NullJump1,NullJump2;πBeginπ port[$043]:=$036;π asm jmp NullJump1;π NullJump1:π end;π port[$040]:=$000;π asm jmp NullJump2π NullJump2:π end;π port[$040]:=$000;πEnd;ππfunction readtimer:longint; assembler;πlabel done;πAsmπ cli (* Disable interrupts *)π mov dx,020h (* Address PIC ocw3 *)π mov al,00Ah (* Ask to read irr *)π out dx,alπ mov al,00h (* Latch timer 0 *)π out 043h,alπ in al,dx (* Read irr *)π mov di,ax (* Save it in DI *)π in al,040h (* Counter --> bx*)π mov bl,al (* LSB in BL *)π in al,040hπ mov bh,al (* MSB in BH *)π not bx (* Need ascending counter *)π in al,021h (* Read PIC imr *)π mov si,ax (* Save it in SI *)π mov al,00FFh (* Mask all interrupts *)π out 021h,alπ mov ax,040h (* read low word of time *)π mov es,ax (* from BIOS data area *)π mov dx,es:[06Ch]π mov ax,si (* Restore imr from SI *)π out 021h,alπ sti (* Enable interrupts *)π mov ax,di (* Retrieve old irr *)π test al,001h (* Counter hit 0? *)π jz done (* Jump if not *)π cmp bx,0FFh (* Counter > 0x0FF? *)π ja done (* Done if so *)π inc dx (* Else count int req. *)πdone:π mov ax,bx (* set function result *)πEnd;ππEnd.ππ***********************************************************************ππand here is a program to test the unit:ππProgram TestTime;πuses crt, dos, tptimer;π var start_time, stop_time: longint;π time:double;πBeginπ Clrscr;π initializetimer;π delay(100);π start_time:=readtimer;π delay(2);π stop_time:=readtimer;π elapsedtime(start_time, stop_time, time);π writeln('elapsed time = ', time:0:10);π readln;π restoretimer;πEnd.ππ 17 05-26-9406:18ALL MARTIN ROMMEL Stop Watch Function IMPORT 19 «u:ó {ππI am sure it is not the most elegant implementation. Except for the nightπof February 29th to March 1st, it should work fine. You might want toπthrough out the escape and beep procedures. }ππππunit Time; {JMR'91} { Unit zur Bestimmung von Programmlaufzeiten }ππinterfaceππ uses DOS,Crt;ππ procedure Start;π procedure Elapsed(var Hour,Minute,Second,HundSec:Word); π function ElapsedStr:String; { 'HH:MM:SS,HH' }π { Elapsed und ElapsedStr ermitteln die Zeit, die seit dem Aufruf von }π { Start vergangen ist. Schaltjahre werden nicht berücksichtigt. }π procedure beep; { gibt kurzen Ton }π function escape:Boolean; { true, wenn <Esc> gedrückt wurde (ReadKey) }π{***************************************************************************}ππimplementationππvar Y,Month,Day,DoW,Month0,Day0,Hour0,Minute0,Second0,HundSec0:Word;ππprocedure Start;π beginπ GetTime(Hour0,Minute0,Second0,HundSec0);π GetDate(Y,Month0,Day0,DoW);π end;ππprocedure Elapsed;π beginπ GetTime(Hour,Minute,Second,HundSec);π GetDate(Y,Month,Day,DoW);π HundSec:=HundSec-HundSec0;π if HundSec>99 then begin HundSec:=HundSec+100; dec(Second) end;π Second:=Second-Second0;π if Second>59 then begin Second:=Second+60; dec(Minute) end;π Minute:=Minute-Minute0;π if Minute>59 then begin Minute:=Minute+60; dec(Hour) end;π Hour:=Hour-Hour0;π Day:=Day-Day0;π if Day>30 then if Month in [1,3,5,7,8,10,12] then Day:=Day+31π else if Month<>2 then Day:=Day+30π else Day:=Day+28;π if Hour>23 then Hour:=Hour+24*Day;π end;ππfunction ElapsedStr;π var Hour,Minute,Second,HundSec:Word;π function LeadingZero(w:Word):String;π var s:String;π beginπ Str(w:0,s);π if Length(s)=1 then s:='0'+s;π LeadingZero:=s;π end;π beginπ Elapsed(Hour,Minute,Second,HundSec);π ElapsedStr:=LeadingZero(Hour)+':'+LeadingZero(Minute)+':'π +LeadingZero(Second){+','+LeadingZero(HundSec)};π end;ππprocedure beep;π beginπ sound(440);π delay(10);π nosound;π end;ππfunction Escape;π var Taste:Char;π beginπ if Keypressed thenπ if Ord(ReadKey)=27 then Escape:=trueπ else Escape:=falseπ else Escape:=false;π end;ππend. { Unit Time }π 18 05-26-9407:30ALL SOUTHERN SOFTWARE Wait Correction IMPORT 50 «u·┴ π{$A+,B-,E-,F-,I-,N-,O-,R-,S-,V-}ππ(*πFastWait Copyright (c) 1991 Southern SoftwareππVersion 1.00 - 4/8/91ππAllows PC's faster than 20 mhz (386/486) to properly use a delayπfunction based upon a null looping procedure such as is used in theπTurbo Pascal "Delay" procedure. Wait is accurate for PC's as fast asπ1,100 mhz equivalent!ππUSAGE: Simply place "FastWait" in the Uses section of your programπ and replace each occurrence of "delay" in your program withπ "wait".ππExample-π=======ππ Existing program:π ----------------π Uses CRT;ππ beginπ writeln('This program delays for 5 seconds.);π delay(5000);π end.ππ New program:π -----------π Uses FastWait, CRT; {Now also uses "FastWait"}ππ beginπ writeln('This program delays for 5 seconds.);π wait(5000); {changed "delay" to "wait"}π end.π*)ππunit FastWait;ππ (* Version 1.00 - 4/8/91 *)ππ {$ifdef DEBUG}π {$D+,L+}π {$else}π {$D-,L-}π {$endif}ππ(****************************************************************************)π interfaceπ(****************************************************************************)ππvarπ (* Number of loops to do for 1 ms wait. *)π WaitOneMS : word;ππ (* Number of loops per timer tick. *)π LoopsPerTick : longint;ππ (* System timer, 18.2/second. *)π BIOSTick : longint absolute $40:$6C;ππ (* Pauses execution for "ms" milliseconds. *)πprocedure Wait(ms : word);ππ{$ifdef VER60}ππ (* This procedure is for very short timing loops ( < 1ms)π that cannot be handled by the delay routine.ππ The variable "LoopsPerTick" has the number of loopsπ to do for one BIOS tick (18.2 of these/sec). If youπ want to delay for "X" µs, the number of loops requiredπ would be "(LoopsPerTick * X) div 54945". This will notπ compile if you are using TP 4.0, 5.0 or 5.5 due to theπ conditional defines. This is because it makes use ofπ the "asm" statement which is not available in TPπ versions prior to 6.0. *)ππ procedure ShortDelay(NumLoops : word);π π{$endif}πππ(****************************************************************************)π implementationπ(****************************************************************************)ππ {$L WAIT.OBJ}ππ procedure Wait(ms : word); external;ππ procedure WaitInit; external;ππ{$ifdef VER60}ππ procedure ShortDelay(NumLoops : word); assembler;π asmπ mov cx,NumLoopsπ jcxz @@2π xor di,di (* ES:DI points to dummy address *)π mov es,di (* which won't change *)π mov al,es:[di] (* AL has the value there *)π @@1:π cmp al,es:[di]π jne @@2π loop @@1π @@2:π end;ππ{$endif}ππBEGIN (* Code to execute at start-up to calibrate the loop *)π (* delay. *)π WaitInitπEND.ππ{ XX3402 Code to WAIT.OBJπ{ Cut and save as WAIT.XX. Execute : XX3402 D WAIT.XX to create WAIT.OBJ }π{ ------------------ CUT HERE -------------------------- }πππ*XX3402-000319-080491--72--85-45848--------WAIT.OBJ--1-OF--1πU+c+03R-GJEiEJBB8cUU++++J5JmMawUELBnNKpWP4Jm60-KNL7nOKxi616iA145W-++ECbgπgsUK03R-GJEiEJBBhcU1+21dH7M0++-cW+A+E84IZUM+-2F-J234a+Q+8++++U2-BNM4++F1πHoF3FNU5+0VR++A-+RSA4U+7Jo37J2xCFIpH++lAHoxEIp-3IZF7Eog+vt+D+++003R-GJF7πHYZI8+++ld+9+++0-3R-GJE6+++WW+E+E86-YO-V++6++0Mu-LI0sjb1WxkqWpQ20x7o2nDzπXgQaWUK95U++Wwjcrjx8RTX8+U0sE+0Ck9xg+9bzznDG7cc37Xc3RDgaWUIaCUJp-S9tEijqπi1Q+YTTEck++WFM0+DTlck++kzWQ3E124kM-+QFF-U20l3I4+E92KUM-+E88+U++R+++π***** END OF BLOCK 1 *****ππ{ -------------------------- CUT HERE ------------------------ }π{ TEST PROGRAM }ππprogram TestWait;πusesπ crt,π FastWait;ππvarπ Counter : word;π jj : longint;ππBEGINπ clrscr;π HighVideo;π writeln(' Southern Software (c) 1991'#10);π LowVideo;π writeln('This test compares the standard "delay" routine with our new "Wait"');π writeln('procedure. Below is the calculated number of small loops the PC goes');π writeln('through for one millisecond delay. If this number is above 1,191 then');π writeln('the "delay" routine in the Turbo CRT unit as well as those in the');π writeln('TurboPower Software Object Professional and Turbo Professional series');π writeln('will yield delays that are too short. Our "wait" procedure is the same');π writeln('as the "delay" procedure except that it will adjust for faster machines.');π writeln;π writeln('The looping below is for 10 seconds in each case. The seconds are shown');π writeln('and at the end, the number of BIOS ticks is shown. A properly calibrated');π writeln('delay routine should be almost exactly 10 seconds long, which is 182 ticks.');π writeln;π writeln('To abort at any time, press any key.');π writeln(#10);π write('The delay factor for this machine is actually ');π HighVideo;π writeln(WaitOneMS);π LowVideo;π writeln(#10);π writeln('10 second delays using');π write(' CRT unit "delay" : ');π HighVideo;π (* Delay 10 seconds using the CRT unit "delay" routine. *)π jj := BIOSTick;π repeatπ until (jj <> BIOSTick);π jj := BIOSTick;π for Counter := 1 to 10 do π beginπ delay(1000);π write(Counter)π end;π jj := (BIOSTick - jj);π LowVideo;π write(' BIOS Ticks : ');π HighVideo;π writeln(jj);π LowVideo;π write('FastWait unit "wait" : ');π HighVideo;π (* Delay 10 seconds using FastWait unit "wait" routine. *)π jj := BIOSTick;π repeatπ until (jj <> BIOSTick);π jj := BIOSTick;π for Counter := 1 to 10 do π beginπ wait(1000);π write(Counter)π end;π jj := (BIOSTick - jj);π LowVideo;π write(' BIOS Ticks : ');π HighVideo;π writeln(jj, #10);π LowVideo;π write('Press any key to end ');π repeatπ until keypressed;π while keypressed doπ Counter := ord(ReadKey);π clrscrπEND.πππ 19 08-24-9413:21ALL KAI ROHRBACHER Dpmi HiRes Timer SWAG9408 ü⌐òk 40 «u πUNIT asytimer;π{Purpose : High resolution timer which runs asynchronous to the }π{ rest of the program }π{Author : Kai Rohrbacher, kai.rohrbacher@logo.ka.sub.org }π{Language : BorlandPascal 7.0 }π{Date : 26.06.1994 }π{Remarks : - Runs both in real- and protected mode. }π{ - Only available on AT-style machines or better (uses }π{ real time clock services) }π{ - Will "fall through" on PC's transparently: behaves as }π{ if time ran off immediately}ππINTERFACEππVAR TimeFlag:^BYTE;ππFUNCTION ATClockAvailable:BOOLEAN;πPROCEDURE SetCycleTime(microseconds:LONGINT);πFUNCTION TimeOver:BOOLEAN;π INLINE($C4/$1E/TimeFlag/ {LES BX,TimeFlag}π $26/$8A/$07/ {MOV AL,ES:[BX] }π $B1/$07/ {MOV CL,7 }π $D2/$E8); {SHR AL,CL}πPROCEDURE Trigger;ππIMPLEMENTATIONππUSES CRT;ππ{$IFDEF DPMI}πTYPE Treg=RECORD {stuff for that dumb DPMI-server}π CASE BYTE OFπ 0:(LoLo,LoHi,HiLo,HiHi:BYTE);π 1:(Lo16,Hi16:WORD);π END;π Tregisters32=π RECORDπ EDI,ESI,EBP,junk32,EBX,EDX,ECX,EAX:Treg;π Flags32,ES,DS,FS,GS,IP,CS,SP,SS:WORDπ END;πVAR regs32:Tregisters32;ππ FUNCTION EmulateInt(IntNr:BYTE; VAR regs32:Tregisters32):BOOLEAN;π ASSEMBLER; {emulate real mode interrupt IntNr with registers regs32}π ASMπ MOV AX,300h {emulate INT}π XOR BH,BH {no A20 gate reset, please}π MOV BL,IntNr {INT to emulate}π XOR CX,CX {no parameter passing via PM stack}π LES DI,regs32 {pointer to register set}π INT 31h {go for it}π CMC {carry flag set if error, reflect this}π MOV AX,0 {as a BOOLEAN value: return TRUE if C=0}π ADC AX,AX {and FALES otherwise}π END;π{$ENDIF}ππVAR CycleTimeLo16,CycleTimeHi16:WORD;π IsAT:BYTE;ππ{$IFDEF DPMI}πFUNCTION ATClockAvailable:BOOLEAN; {protected mode function}πBEGINπ TimeFlag^:=0; {reset flag}π FillChar(regs32,SizeOf(regs32),0);π regs32.ECX.Lo16:=0;π regs32.EDX.Lo16:=1; {trigger flag after 1us}π regs32.ES :=$40; {_segment_ address of Timeflag}π regs32.EBX.Lo16:=Ofs(TimeFlag^); {offset part = $F0}π regs32.EAX.Lo16:=$8300;ππ IF NOT EmulateInt($15,regs32)π THEN WRITELN('Something went wrong in the INT-emulation!?');ππ Delay(1); {INT-emulation went ok, look for timer event:}π {wait 1000us, so event must have happened:}π {Flag now should have been set to $80:}π ATClockAvailable:=TimeFlag^=$80;πEND;ππ{$ELSE}ππFUNCTION ATClockAvailable:BOOLEAN; {real mode function}πBEGINπ TimeFlag^:=0; {reset flag}π IF Test8086<>0 {is it at least an AT?}π THEN ASM {yes, have a closer look:}π STIπ XOR CX,CX {trigger after 1us}π MOV DX,1π LES BX,TimeFlag {set Flag to $80 after this time}π MOV AX,8300h {run asynchron to rest of program}π INT 15h {go!}π END;π Delay(1); {wait a 1000us}π ATClockAvailable:=TimeFlag^=$80 {Flag=$80, if it worked}πEND;π{$ENDIF}ππPROCEDURE SetCycleTime(microseconds:LONGINT);πBEGINπ TimeFlag^:=$80;π CycleTimeHi16:=microseconds SHR 16;π CycleTimeLo16:=microseconds AND $FFFF;π IF (microseconds<>0) AND ATClockAvailableπ THEN IsAT:=0 {ja, Zeitüberwachung soll benutzt werden }π ELSE IsAT:=$80 {nein, keine möglich oder nicht gewünscht }πEND;ππPROCEDURE Trigger;π{starts timer, which must have previously been set by SetCycleTime()}πBEGINπ IF IsAT<>0 THEN EXIT; {jmp out, if timer services unavailable}π TimeFlag^:=0;π{$IFDEF DPMI}π regs32.ECX.Lo16:=CycleTimeHi16;π regs32.EDX.Lo16:=CycleTimeLo16; {trigger flag after t us}π regs32.ES :=$40; {_segment_ address of Timeflag}π regs32.EBX.Lo16:=Ofs(TimeFlag^); {offset part = $F0}π regs32.EAX.Lo16:=$8300;ππ IF NOT EmulateInt($15,regs32)π THEN WRITELN('Something went wrong in the INT-emulation!?');π{$ELSE}πASMπ MOV CX,CycleTimeHi16π MOV DX,CycleTimeLo16π LES BX,TimeFlag {set Flag to $80 after this time}π MOV AX,8300h {run asynchron to rest of program}π INT 15h {go!}πEND;π{$ENDIF}πEND;ππBEGINπ TimeFlag:=Ptr(Seg0040,$F0); {available byte in 1st MB}π SetCycleTime(0)πEND.ππ____ππPROGRAM TestUnit_asytimer;π{Kai Rohrbacher, kai.rohrbacher@logo.ka.sub.org}πUSES asytimer;πCONST wait:LONGINT=5000000; {trigger time in us -> 5sec}ππ PROCEDURE SomeThing;π CONST s:ARRAY[0..3] OF CHAR='\|/-';π help:BYTE=0;π BEGIN WRITE(s[help]+^H); help:=(help+1) AND 3 END;ππBEGINπ IF ATClockAvailableπ THEN WRITELN('INT15h-timer-routine available!')π ELSE WRITELN('INT15h-timer-routine doesn''t work!');ππ SetCycleTime(wait);π WRITELN('Between the following 2 bells, there should be a delay of ',π wait,' microseconds');π Trigger; {wait 5s = 5000ms}π WRITE(#7);π WHILE NOT TimeOver DO SomeThing;π WRITELN(#7'Done!');πEND.π 20 08-24-9413:44ALL PETE ROCCA multitasking program SWAG9408 /äMü 16 «u {πYC> Does anyone got any unit/code on giving up time slice under DV or OS/2?πHere they are for DOS, Windows, OS/2, DV and DoubleDos. You will needπto detect the enviroment first (although none should make the systemπhang if it's the wrong enviroment, just be ignored) The key to goodπidle release is finding the right spots to put them. I have gotten myπdoor making unit that I created to about 97% idle during pauses and 93%πidle while waiting for keyboard input (with no delay in response - muchπbetter than the typical 12% idle pauses and 8% idle keyboard waits)πHere is how... }ππProcedure Sleep(Seconds: Word);πVarπ H,M,S,T,Last: Word;πBeginπ If Seconds = 0 Then Exit;π If Seconds > 999 Then Seconds := Seconds DIV 1000;π {incase of caller is thinking milliseconds}ππ GetTime(H,M,Last,T);π Repeatπ Repeatπ GetTime(H,M,S,T);π TimerSlice;π TimerSlice;π Until S <> Last;π Last := S;π Dec(Seconds);π Until Seconds = 0;πEnd;ππFunction GetChar: Char;πVarπ Counter, Span: Byte;π Done: Boolean;πBeginπ Span := 0;π Done := False;π Repeatπ Inc(Counter);π If Counter > Span Thenπ Beginπ Counter := 0;π If IsChar Then Done := Trueπ Else If Span < 50 Then Inc(Span);π Endπ Else TimerSlice;π Until Done;π If KeyPressedExtended Then GetChar := Readkeyπ Else GetChar := RxChar;πEnd;ππProcedure TimerSlice;πBeginπ Case SystemEnviroment Ofπ DOS4:;π DOS5,π WINDOWS,π OS2: Asmπ MOV AX,$1680π INT $2Fπ End;π DV: Asmπ MOV AX,$1000π INT $15π End;π DOUBLEDOS: Asmπ MOV AX,$EE01π INT $21π End;π End;πEnd;ππThis is released as public domain, however if you are using it, I'dπappreciate a PRIVATE NETMAIL message to me at 1:2401/123 letting meπknow.ππThanksππPete RoccaπMultiboard Communications Centre @ 1:2401/123π 21 08-24-9417:52ALL GAYLE DAVIS A good Timer unit SWAG9408 ß'╦R 19 «u πUNIT Timer;πINTERFACEππTYPEπ tTimerObject = objectπ TimerTicks : LONGINT;π MaxSeconds : LONGINT;π PROCEDURE Start(Amount : LONGINT);π FUNCTION ElapsedSeconds : LONGINT;π FUNCTION Remaining : LONGINT;π FUNCTION Expired : BOOLEAN;π FUNCTION PrintableTimer(Tics : LONGINT) : STRING;π END;ππIMPLEMENTATIONπVARπ TicksSinceMidnight : LONGINT ABSOLUTE $0040 : $006c;ππ PROCEDURE tTimerObject.Start(Amount : LONGINT);π BEGINπ TimerTicks := TicksSinceMidnight;π MaxSeconds := Amount;π END;ππ FUNCTION tTimerObject.ElapsedSeconds : LONGINT; { elapsed time in seconds }π CONSTπ TicksPerDay = 1573040;π TicksPerSecond = 18.20648;π VARπ ElapsedTicks : LONGINT;ππ BEGINπ ElapsedTicks := TicksSinceMidnight;π IF (ElapsedTicks >= TimerTicks) THENπ ElapsedTicks := ElapsedTicks - TimerTicksπ ELSE { Midnight rollover occurred }π ElapsedTicks := TicksPerDay - TimerTicks + ElapsedTicks;π ElapsedSeconds := ROUND (ElapsedTicks / TicksPerSecond);π END;ππ FUNCTION tTimerObject.Expired : BOOLEAN; { Has this timer expired ?? }π BEGINπ Expired := (ElapsedSeconds > MaxSeconds);π END;ππ FUNCTION tTimerObject.Remaining : LONGINT; { How many seconds remain? }π BEGINπ IF Expired THEN Remaining := 0 ELSEπ Remaining := MaxSeconds - ElapsedSeconds;π END;ππ FUNCTION tTimerObject.PrintableTimer(Tics : LONGINT) : STRING;π { return a printable time string }ππ VARπ S, T : STRING;π Hour, Min, Sec, Time : LONGINT;π i : INTEGER;ππ BEGINπ Hour := (Tics div 3600);π Min := (Tics div 60);π Sec := Tics - (Min * 60);π STR(Min : 2, T);π IF T[1] = #32 THEN T[1] := '0';π S := T + ':';π STR(Sec : 2, T);π IF T[1] = #32 THEN T[1] := '0';π S := S + T;π PrintableTimer := S;π END;πEND.ππ{ ---------------------------- DEMO ----------------------- }ππusesπ CRT, Timer;πvarπ t : tTimerObject;ππbeginπ ClrScr;π t.Start(10); { set a 10 second timer }π GoToXY(1,1); Write(t.TimerTicks);π repeatπ GoToXY(1,2); Write(t.PrintableTimer(t.Remaining));π GoToXY(1,3); Write(t.PrintableTimer(t.ElapsedSeconds));π until (t.Expired); { wait until it expires }π Readkey;πend.π 22 08-25-9409:12ALL STEVE ROGERS Clock Ticks SWAG9408 É∩α╠ 8 «u {πPN>Hi, Steve. I know this has been asked before, but am thinkingπ >of using TicksSinceMidnight which is at memory location $0040:006Cπ >as you say. Ny question is to what kind of type (size) variable shouldπ >I assign this to, and how many bytes are reserved for this number?π >$0040:006C .. $0040:006D ????π >word? longint? integer?π .π 60 * 60 * 24 = 86400 seconds per day. . . a longint is needed.π}π varπ TickSinceMidnight : longint ABSOLUTE $0040:$006c;π{π BTW, that second $ is important :)πππ >I appreciate your help. I'm going to try to get a 10ths secondsπ >counter going by test-running the number of ticks in a second. Or wordsπ >to that effect.ππ There are approximately 18.2 ticks per second (thanks, Spock :)π}π
