path: root/lowlevelunit.pas

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.