Измерение времени обращения по зонам адресного пространства

program videotest;
 
const
  Times = 100;
  HexDigits: array [0..15] of char = '0123456789ABCDEF';
var
  TestSeg: word;
  Ticks: word;
  TimeAccess: real;
  Address: char;
begin
  TestSeg := $0000;
  repeat
    asm
        push    ds
        mov     cx,     ds
        cld
 
        xor     ax,     ax
        mov     es,     ax
        mov     ax,     es:[046Ch]
        @@WaitNewTick:
                mov     bx,     es:[046Ch]
                cmp     ax,     bx
        je      @@WaitNewTick
 
        mov     ds,     cx
 
        mov     ax,     [TestSeg]
        mov     ds,     ax
        mov     es,     ax
 
        mov     cx,     Times
        xor     si,     si
        @@for:
                push    cx
                xor     cx,     cx
                @@@for:
                        lodsb
                loop    @@@for
                pop     cx
        loop    @@for
 
        xor     ax,     ax
        mov     ds,     ax
        mov     ax,     ds:[046Ch]
        sub     ax,     bx
        pop     ds
        mov     [Ticks],        ax
    end;
    TimeAccess := Ticks*1000000.0*18.2/(65536.0*Times);
    Address := HexDigits[TestSeg div $1000];
    writeln(Address, '0000 - ', Address, 'FFFF ', TimeAccess:0:0, 'mks');
    {$R-}inc(TestSeg, $1000);{$R+}
  until TestSeg = 0;
end.