diff --git a/examples/benchmarks.pas b/examples/benchmarks.pas new file mode 100644 index 0000000..c5ec5fe --- /dev/null +++ b/examples/benchmarks.pas @@ -0,0 +1,299 @@ +{$H350} +program benchmarks; +var starttime:DateTime; + endtime:DateTime; + +procedure startBench(name:string); +begin + write(name:35, ' '); + starttime := GetTime; +end; + +procedure endBench; +var secDelta, minDelta, hourDelta:integer; + procedure write2Digits(i:integer); + begin + if i < 10 then + write('0'); + write(i); + end; +begin + endtime := GetTime; + + hourDelta := endtime.hours - starttime.hours; + minDelta := endtime.minutes - starttime.minutes; + secDelta := endtime.seconds - starttime.seconds; + + if secDelta < 0 then + begin + secDelta := 60 + secDelta; + minDelta := minDelta - 1; + end; + + if minDelta < 0 then + begin + minDelta := 60 + minDelta; + hourDelta := hourDelta - 1; + end; + + write2Digits(hourDelta); + write(':'); + write2Digits(minDelta); + write(':'); + write2Digits(secDelta); + writeln; +end; + +procedure bench0; +var i:integer; +begin + startBench('empty loop 10M'); + for i := 1 to 10000000 do; + endBench; +end; + +procedure bench1; +var i:integer; + v:integer; +begin + startBench('write variable 10M'); + for i := 1 to 10000000 do + v := 0; + endBench; +end; + +procedure bench2; +var i:integer; + v,r:integer; +begin + v := 4711; + startBench('read variable 10M'); + for i := 1 to 10000000 do + r := v; + endBench; +end; + +procedure bench3; +var i:integer; + a,b:integer; +begin + a := 0; + b := 100; + + startBench('integer addition 10M'); + for i := 1 to 10000000 do + a := b + i; + endBench; +end; + +procedure bench4; +var i:integer; + a,b:real; +begin + a := 0.0; + b := 100.0; + + startBench('real addition 1M'); + for i := 1 to 1000000 do + a := b + i; + endBench; +end; + +procedure bench5; +var i:integer; + a,b:integer; +begin + a := 0; + b := 100; + + startBench('integer multiplication 1M'); + for i := 1 to 1000000 do + a := b * i; + endBench; +end; + +procedure bench6; +var i:integer; + a,b:real; +begin + a := 0; + b := 100; + + startBench('real multiplication 1M'); + for i := 1 to 1000000 do + a := b * i; + endBench; +end; + +procedure bench7; +var i:integer; + a,b:integer; +begin + a := 0; + b := 31415926; + + startBench('integer division 1M'); + for i := 1 to 1000000 do + a := b div i; + endBench; +end; + +procedure bench8; +var i:integer; + a,b,c:real; +begin + a := 0; + b := 31415926.0; + + startBench('real division 1M'); + for i := 1 to 1000000 do + a := b / i; + endBench; +end; + +procedure bench9; +var i,j:integer; + s:string[100]; + c:char; +begin + s := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn'; + + startBench('string indexing 1M'); + for i := 1 to 100000 do + for j := 1 to 100 do + c := s[j]; + endBench; +end; + +procedure bench10; +var i:integer; + s:string[100]; + c,d:char; +begin + s := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn'; + + startBench('string iteration 1M'); + for i := 1 to 100000 do + for c in s do + d := c; + endBench; +end; + +procedure bench11; +var ptr: ^array[0..255] of integer; + dummy1,dummy2,dummy3: ^array[0..127] of boolean; + i:integer; +begin + new(dummy1); + new(dummy2); + new(dummy3); + dispose(dummy1); + + startBench('new/dispose 1k 1M'); + for i := 1 to 1000000 do + begin + new(ptr); + dispose(ptr); + end; + endBench; + + dispose(dummy2); + dispose(dummy3); +end; + +procedure bench12; +var ptr: ^array[0..32767] of integer; + dummy1,dummy2,dummy3: ^array[0..127] of boolean; + i:integer; +begin + new(dummy1); + new(dummy2); + new(dummy3); + dispose(dummy1); + + startBench('new/dispose 128k 1M'); + for i := 1 to 1000000 do + begin + new(ptr); + dispose(ptr); + end; + endBench; + + dispose(dummy2); + dispose(dummy3); +end; + +procedure bench13; +var ptr1: ^array[0..255] of integer; + ptr2: ^array[0..255] of integer; + i:integer; +begin + new(ptr1); + new(ptr2); + startBench('array copy 1k 10K'); + for i := 1 to 10000 do + ptr1^ := ptr2^; + endBench; + dispose(ptr1); + dispose(ptr2); +end; + +procedure bench14; +var ptr1: ^array[0..32767] of integer; + ptr2: ^array[0..32767] of integer; + i:integer; +begin + new(ptr1); + new(ptr2); + startBench('array copy 128k 1K'); + for i := 1 to 1000 do + ptr1^ := ptr2^; + endBench; + dispose(ptr1); + dispose(ptr2); +end; + +procedure bench15; +var i,j:integer; + a:real; +begin + startBench('exp() 10K'); + for i := 1 to 1000 do + for j := 1 to 10 do + a := exp(j); + endBench; +end; + +procedure bench16; +var i,j:integer; + a,b:real; +begin + startBench('cos() 10K'); + b := 0.0; + for i := 1 to 10000 do + begin + a := cos(b); + b := b + 0.0001; + end; + endBench; +end; + +begin + bench0; + bench1; + bench2; + bench3; + bench4; + bench5; + bench6; + bench7; + bench8; + bench9; + bench10; + bench11; + bench12; + bench13; + bench14; + bench15; + bench16; +end. diff --git a/examples/viewpict.pas b/examples/viewpict.pas index 2d625ac..78e061d 100644 --- a/examples/viewpict.pas +++ b/examples/viewpict.pas @@ -1,79 +1,21 @@ program viewpict; -const FadeDelay = 20; - FadeLevels = 15; - -type PaletteData = array[0..15] of integer; - Palettes = array[1..FadeLevels] of PaletteData; - type PictData = record magic, mode:integer; - palette: PaletteData; + palette: array [0..15] of integer; pixeldata: array [0..31999] of integer; end; + var pic:PictData; filename:string; infile:file; ch:char; -procedure setBlackPalette; +procedure loadPalette(var pic:PictData); var i:integer; begin for i := 0 to 15 do - setPalette(i, 0); -end; - -procedure createFade(var pic:PictData;var fadedPalette: Palettes); -var i:integer; - c:integer; - rgb:integer; - r,g,b:integer; - -procedure fade(var col:integer); -var delta:integer; -begin - - delta := col * 10 div 100; - if delta < 1 then - delta := 1; - col := col - delta; - if col < 0 then - col := 0; -end; - -begin - fadedPalette[1] := pic.palette; - - for i := 2 to FadeLevels - 1 do - begin - for c := 0 to 15 do - begin - rgb := fadedPalette[i-1][c]; - r := (rgb shr 8) and $F; - g := (rgb shr 4) and $F; - b := (rgb) and $F; - - fade(r); - fade(g); - fade(b); - - rgb := (r shl 8) or - (g shl 4) or - (b); - - fadedPalette[i][c] := rgb; - end; - end; - - for c := 0 to 15 do - fadedPalette[FadeLevels][c] := 0; -end; - -procedure loadPalette(var p:PaletteData); -var i:integer; -begin - for i := 0 to 15 do - setpalette(i, p[i]); + setpalette(i, pic.palette[i]); end; procedure loadPic(var pic:PictData); @@ -81,30 +23,6 @@ begin PutScreen(pic.pixeldata); end; -procedure fadeIn(var pic:PictData); -var i:integer; - fadedPalette:Palettes; -begin - createFade(pic, fadedPalette); - for i := FadeLevels - 1 downto 1 do - begin - delay(FadeDelay); - loadPalette(fadedPalette[i]); - end -end; - -procedure fadeOut(var pic:PictData); -var i:integer; - fadedPalette:Palettes; -begin - createFade(pic, fadedPalette); - for i := 1 to FadeLevels do - begin - delay(FadeDelay); - loadPalette(fadedPalette[i]); - end -end; - begin if ParamCount > 0 then filename := ParamStr(1) @@ -120,18 +38,7 @@ begin writeln('magic: ', pic.magic, ' mode:', pic.mode); - initgraphics; - - setBlackPalette; + loadPalette(pic); loadPic(pic); - fadeIn(pic); - read(ch); - - if ch <> 'k' then - begin - fadeOut(pic); - initgraphics; - end; - end.