diff options
Diffstat (limited to 'lowlevelunit.pas')
-rw-r--r-- | lowlevelunit.pas | 546 |
1 files changed, 546 insertions, 0 deletions
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. + |