summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitignore2
-rw-r--r--lowlevelunit.pas546
2 files changed, 548 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..6dd1b30
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+*.bak
+*~
diff --git a/lowlevelunit.pas b/lowlevelunit.pas
new file mode 100644
index 0000000..d97cbf3
--- /dev/null
+++ b/lowlevelunit.pas
@@ -0,0 +1,546 @@
+unit lowlevelunit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ math, Classes, SysUtils, gmp, RegExpr, process;
+
+type
+ tMersenneTwister = class
+ private
+ state: array[0..623] of longword;
+ index: longint;
+ public
+ procedure init(seed: longword);
+ function extract_number: longword;
+ function random(ma: longword): longword; overload;
+ function random: extended; overload;
+ procedure generate_numbers;
+ end;
+
+ tMyStringlist = class;
+
+ tInputThread = class (tThread)
+ fertig: boolean;
+ inhalt: tMyStringList;
+ proc: tProcess;
+ constructor create(p: tProcess; sl: tMyStringList);
+ destructor destroy; override;
+ procedure execute; override;
+ end;
+
+ tMyStringlist = class (tStringlist)
+ private
+ line: longint;
+ public
+ constructor create;
+ procedure loadFromFile(const s: ansiString); override;
+ procedure loadFromGz(const s: ansiString);
+ procedure saveToGz(const s: ansiString);
+ function readln(out s: string): boolean;
+ procedure grep(expr: string);
+ function eof: boolean;
+ end;
+
+function signSqr(x: extended): extended; inline;
+function mpfToStr(f: mpf_t): string;
+function myTimeToStr(t: extended): string;
+function cpuUtilization: extended;
+function numCpus: int64;
+function momentanFreieCpus: int64;
+function mpfMyRoot(rad: mpf_t; wzlExp: int64): extended;
+function belegterSpeicher: int64;
+function minCache: int64;
+function cmpStr(s1,s2: string): longint;
+function mitte(s1,s2: string): string;
+function myFloatToStr(x: extended): string;
+function myStrToFloat(s: string): extended;
+
+implementation
+
+var _cpuLastUsed,_cpuLastIdle: int64;
+
+// tMersenneTwister ************************************************************
+
+procedure tMersenneTwister.init(seed: longword);
+var
+ i: longint;
+begin
+ index:=0;
+ state[0]:=seed;
+ for i:=1 to 623 do
+ state[i]:=longword($ffffffff and (qword(1812433253) * qword(state[i-1] xor state[i-1] shr 30) + i)); // 0x6c078965
+end;
+
+function tMersenneTwister.extract_number: longword;
+begin
+ if index=0 then
+ generate_numbers;
+
+ result:=state[index];
+ result:=result xor (result shr 11);
+ result:=result xor longword(qword(result shl 7) and 2636928640); // 0x9d2c5680
+ result:=result xor longword(qword(result shl 15) and 4022730752); // 0xefc60000
+ result:=result xor (result shr 18);
+
+ index := (index + 1) mod 624;
+end;
+
+function tMersenneTwister.random(ma: longword): longword;
+var
+ i: longword;
+begin
+ repeat
+ i:=extract_number;
+ until i<((high(longword)+1) div qword(ma))*ma;
+ result:=i mod ma;
+end;
+
+function tMersenneTwister.random: extended;
+begin
+ result:=(extract_number/(high(longword)+1) + extract_number)/(high(longword)+1);
+end;
+
+procedure tMersenneTwister.generate_numbers;
+var
+ i,y: longint;
+begin
+ for i:=0 to 623 do begin
+ y:=longint((state[i] and $80000000) or // bit 31 (32nd bit) of MT[i]
+ (state[(i+1) mod 624] and $7fffffff)); // bits 0-30 (first 31 bits) of MT[...]
+ state[i]:=state[(i + 397) mod 624] xor (y shr 1);
+ if odd(y) then
+ state[i]:=longword(state[i] xor 2567483615); // 0x9908b0df
+ end;
+end;
+
+// tInputThread ****************************************************************
+
+constructor tInputThread.create(p: tProcess; sl: tMyStringList);
+begin
+ inherited create(true);
+ fertig:=false;
+ inhalt:=sl;
+ proc:=p;
+ suspended:=false;
+end;
+
+destructor tInputThread.destroy;
+begin
+ inhalt:=nil;
+ proc:=nil;
+ inherited destroy;
+end;
+
+procedure tInputThread.execute;
+var
+ wb,cwb: longint;
+begin
+ wb:=0;
+ while wb<length(inhalt.text) do begin
+ cwb:=proc.input.write(inhalt.text[wb+1],length(inhalt.text)-wb);
+ if cwb=0 then
+ sleep(1)
+ else
+ wb:=wb+cwb;
+ end;
+ proc.CloseInput;
+ fertig:=true;
+end;
+
+// tMyStringlist ***************************************************************
+
+constructor tMyStringlist.create;
+begin
+ inherited create;
+ line:=0;
+end;
+
+procedure tMyStringlist.loadFromFile(const s: ansiString);
+var i: longint;
+begin
+ inherited loadFromFile(s);
+ for i:=0 to count-1 do
+ self[i]:=trim(self[i]);
+ line:=0;
+ writeln(inttostr(count)+' Zeilen eingelesen');
+end;
+
+procedure tMyStringlist.loadFromGz(const s: ansiString);
+var p: tProcess;
+ buf: ansiString;
+ rb,br: longint;
+begin
+ p:=tProcess.create(nil);
+ p.executable:='/usr/bin/zcat';
+ p.parameters.add(s);
+ p.options:=p.options + [poUsePipes];
+ setlength(buf,0);
+ br:=0;
+ p.execute;
+ while p.running do begin
+ rb:=p.output.numBytesAvailable;
+ if rb>0 then begin
+ if length(buf)<br+rb then
+ setlength(buf,br+rb+1048576);
+ rb:=p.output.read(buf[br+1],rb);
+ br:=br+rb;
+ end
+ else sleep(1);
+ end;
+ setlength(buf,br);
+ rb:=p.output.numBytesAvailable;
+ while rb>0 do begin
+ setlength(buf,br+rb);
+ rb:=p.output.read(buf[br+1],rb);
+ br:=br+rb;
+ rb:=p.output.numBytesAvailable;
+ end;
+ text:=buf;
+ setlength(buf,0);
+ p.free;
+ for rb:=0 to count-1 do
+ self[rb]:=trim(self[rb]);
+ line:=0;
+ writeln(inttostr(count)+' Zeilen eingelesen');
+end;
+
+procedure tMyStringlist.saveToGz(const s: ansiString);
+var
+ p: tProcess;
+ buf: array of byte;
+ f: file;
+ rb: longint;
+ it: tInputThread;
+const
+ outBufLen = 1024*1024;
+begin
+ p:=tProcess.create(nil);
+ p.executable:='/usr/bin/gzip';
+ p.parameters.add('--best');
+ p.parameters.add('-c');
+ p.options:=p.options + [poUsePipes];
+ p.execute;
+ setlength(buf,outBufLen);
+ fillchar(buf[0],length(buf)*sizeof(buf[0]),$0);
+ it:=tInputThread.create(p,self);
+ assignfile(f,s);
+ rewrite(f,1);
+ while p.running or (not it.fertig) or (p.output.numBytesAvailable>0) do begin
+ rb:=min(length(buf),p.output.numBytesAvailable);
+ if rb>0 then begin
+ rb:=p.output.read(buf[0],rb);
+ blockwrite(f,buf[0],rb);
+ end
+ else
+ sleep(1); // nix zu Schreiben, nix zu Lesen, also warten wir
+ end;
+ it.free;
+ closefile(f);
+end;
+
+function tMyStringlist.readln(out s: string): boolean;
+begin
+ result:=not eof;
+ if not result then begin
+ s:='';
+ exit;
+ end;
+ s:=self[line];
+ inc(line);
+end;
+
+procedure tMyStringlist.grep(expr: string);
+var
+ re: tRegExpr;
+ i: longint;
+begin
+ re:=tRegExpr.create;
+ re.Expression:=expr;
+ for i:=count-1 downto 0 do
+ if not re.Exec(self[i]) then
+ delete(i);
+ re.free;
+end;
+
+function tMyStringlist.eof: boolean;
+begin
+ result:=line>=count;
+end;
+
+// allgemeine Funktionen *******************************************************
+
+function signSqr(x: extended): extended;
+begin
+ result:=sign(x)*sqr(x);
+end;
+
+function mpfToStr(f: mpf_t): string;
+var
+ ex: int64;
+ off: byte;
+begin
+ result:=mpf_get_str(nil,ex,10,0,f);
+ off:=1+byte(pos('-',result)=1);
+ if result='' then
+ result:='0'
+ else if ex=1 then
+ result:=copy(result,1,off)+','+copy(result,off+1,length(result)-off)
+ else
+ result:=copy(result,1,off)+','+copy(result,off+1,length(result)-off)+' * 10^'+inttostr(ex-1);
+end;
+
+function myTimeToStr(t: extended): string;
+var
+ tim: int64;
+begin
+ tim:=floor(t*24*60*60);
+ result:=inttostr(tim mod 10)+'s';
+ tim:=tim div 10;
+ if tim=0 then exit;
+ result:=inttostr(tim mod 6)+result;
+ tim:=tim div 6;
+ if tim=0 then exit;
+ result:=inttostr(tim mod 10)+'min '+result;
+ tim:=tim div 10;
+ if tim=0 then exit;
+ result:=inttostr(tim mod 6)+result;
+ tim:=tim div 6;
+ if tim=0 then exit;
+ result:=inttostr(tim mod 24)+'h '+result;
+ tim:=tim div 24;
+ if tim=0 then exit;
+ result:=' '+result;
+ if (tim mod 7)<>1 then
+ result:='e'+result;
+ result:=inttostr(tim mod 7)+'Tag'+result;
+ tim:=tim div 7;
+ if tim=0 then exit;
+ result:=' '+result;
+ if tim<>1 then
+ result:='n'+result;
+ result:=inttostr(tim)+'Woche'+result;
+end;
+
+function cpuUtilization: extended;
+var
+ procstat: textfile;
+ s: string;
+ used,idle: int64;
+ i: integer;
+begin
+ result:=0;
+ s:='';
+ assignfile(procstat,'/proc/stat');
+ reset(procstat);
+ while not eof(procstat) do begin
+ readln(procstat,s);
+ if pos('cpu ',s)=1 then break;
+ end;
+ closefile(procstat);
+ if pos('cpu ',s)<>1 then exit;
+ delete(s,1,pos(' ',s));
+ s:=trim(s);
+ used:=0;
+ idle:=0;
+ for i:=0 to 3 do begin
+ used:=used+idle;
+ idle:=strtoint(copy(s,1,pos(' ',s)-1));
+ delete(s,1,pos(' ',s));
+ s:=trim(s);
+ end;
+ result:=(used-_cpuLastUsed)/max(1,used-_cpuLastUsed + idle-_cpuLastIdle);
+ _cpuLastUsed:=used;
+ _cpuLastIdle:=idle;
+end;
+
+function numCpus: int64;
+var
+ procstat: textfile;
+ s: string;
+begin
+ result:=0;
+ s:='';
+ assignfile(procstat,'/proc/stat');
+ reset(procstat);
+ while not eof(procstat) do begin
+ readln(procstat,s);
+ if (pos('cpu',s)=1) and
+ (pos('cpu ',s)<>1) then
+ inc(result);
+ end;
+ closefile(procstat);
+end;
+
+function momentanFreieCpus: int64;
+begin
+ result:=floor(numCpus*(1-cpuUtilization));
+end;
+
+function mpfMyRoot(rad: mpf_t; wzlExp: int64): extended;
+var
+ ex: int64;
+begin
+ result:=power(mpf_get_d_2exp(ex,rad),1/wzlExp);
+ result:=result*power(2,ex/wzlExp);
+end;
+
+function belegterSpeicher: int64;
+var f: textFile;
+ s: string;
+begin
+ s:='/proc/'+inttostr(getProcessId)+'/smaps';
+ result:=0;
+ if not fileexists(s) then exit;
+ assignfile(f,s);
+ reset(f);
+ while not eof(f) do begin
+ readln(f,s);
+ if (leftStr(s,4)='Rss:') and (rightStr(s,3)=' kB') then begin
+ delete(s,1,4);
+ delete(s,length(s)-2,3);
+ s:=trim(s);
+ result:=result+strtoint(s);
+ end;
+ end;
+ closefile(f);
+end;
+
+function minCache: int64;
+var f: textFile;
+ s: string;
+begin
+ s:='/proc/cpuinfo';
+ result:=0;
+ if not fileexists(s) then exit;
+ assignfile(f,s);
+ reset(f);
+ while not eof(f) do begin
+ readln(f,s);
+ if (leftStr(s,10)='cache size') and (rightStr(s,3)=' kB') then begin
+ delete(s,1,pos(':',s));
+ delete(s,length(s)-2,3);
+ s:=trim(s);
+ if result=0 then result:=strtoint(s)
+ else result:=min(result,strtoint(s));
+ end;
+ end;
+ closefile(f);
+end;
+
+function cmpStr(s1,s2: string): longint;
+var
+ i: longint;
+begin
+ for i:=1 to min(length(s1),length(s2)) do
+ if s1[i]<>s2[i] then begin
+ result:=2*byte(s1[i]>s2[i])-1;
+ exit;
+ end;
+ if length(s1)<>length(s2) then begin
+ result:=2*byte(length(s1)>length(s2))-1;
+ exit;
+ end;
+ result:=0;
+end;
+
+function mitte(s1,s2: string): string;
+var
+ i: longint;
+ w,nw: word;
+begin
+ setlength(result,max(length(s1),length(s2)));
+ w:=0;
+ for i:=length(result) downto 1 do begin // result:= "s1+s2";
+ if i<=length(s1) then
+ w:=w+byte(s1[i]);
+ if i<=length(s2) then
+ w:=w+byte(s2[i]);
+ result[i]:=char(w and $ff);
+ w:=w shr 8;
+ end;
+ result:=char(w)+result;
+ w:=0;
+ for i:=1 to length(result) do begin
+ nw:=byte(odd(byte(result[i])+w));
+ result[i]:=char((byte(result[i])+w) div 2);
+ w:=nw shl 8;
+ end;
+ if w<>0 then
+ result:=result+char(w div 2);
+ if result[1]<>#0 then begin
+ writeln('Fehler bei der Mittenfindeung!');
+ halt;
+ end;
+ delete(result,1,1);
+end;
+
+function myFloatToStr(x: extended): string;
+var
+ i,e: longint;
+begin
+ e:=0;
+ if x<0 then begin
+ result:='-';
+ x:=-x;
+ end
+ else
+ result:='';
+ if x=0 then begin
+ result:='0';
+ exit;
+ end;
+ while x<1 do begin
+ dec(e);
+ x:=x*10;
+ end;
+ while x>=10 do begin
+ inc(e);
+ x:=x/10;
+ end;
+ result:=result+char(ord('0')+floor(x))+'.';
+ for i:=0 to 20 do begin
+ x:=(x-floor(x))*10;
+ result:=result+char(ord('0')+floor(x));
+ end;
+ if e<>0 then
+ result:=result+'E'+inttostr(e);
+end;
+
+function myStrToFloat(s: string): extended;
+var
+ i,e: longint;
+ neg: boolean;
+begin
+ if pos('E',s)>0 then begin
+ e:=strtoint(rightStr(s,length(s)-pos('E',s)));
+ delete(s,pos('E',s),length(s));
+ end
+ else e:=0;
+ if pos('.',s)=0 then begin
+ result:=strtoint(s)*power(10,e);
+ exit;
+ end;
+ neg:=leftStr(s,1)='-';
+ if neg then
+ delete(s,1,1);
+ if pos('.',s)=2 then begin
+ result:=0;
+ for i:=length(s) downto 3 do
+ result:=result/10 + ord(s[i])-ord('0');
+ result:=result/10 + ord(s[1])-ord('0');
+ end
+ else result:=strtofloat(s);
+ result:=result*power(10,e);
+ if neg then
+ result:=-result;
+end;
+
+begin
+ _cpuLastUsed:=0;
+ _cpuLastIdle:=0;
+ cpuUtilization;
+end.
+
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-11-21 19:38:14 +0000