{ The Computer Language Shootout
   http://shootout.alioth.debian.org/

   Contributed by Marco van de Voort
}
unit revcom;
interface
uses textStream,cpu_timer;


  procedure revRun(amem : integer);
  procedure revrun2(amem : integer);
  procedure revrun3(amem : integer);

  procedure testrevrun;
implementation
//{$mode objfpc}
{$I-}
//uses system;
//Uses BaseUnix;

var lookupComplement : array[#0..#255] of char;
    pa,
    pb : text;

Const FASTAXLAT : array[0..11] of array[0..1] of char = (
		  ( 'A', 'T' ), ( 'C', 'G' ),
		  ( 'B', 'V' ), ( 'D', 'H' ),
	          ( 'K', 'M' ), ( 'R', 'Y' ),
		  ( 'a', 't' ), ( 'c', 'g' ),
		  ( 'b', 'v' ), ( 'd', 'h' ),
	          ( 'k', 'm' ), ( 'r', 'y' ));

      BufferIncrement = 1024;

procedure flushbuffer(buffer:pchar;inbuf:integer);

var p,p2 : pchar;
    c  : char;

begin

  if inbuf>0 then
   begin

     p:=buffer;
     p2:=@buffer[inbuf-1];
     while p<p2 do
      begin
       c:=lookupcomplement[p^];
       p^:=lookupcomplement[p2^];
       inc(p);
       p2^:=c;
       dec(p2);
     end;
    if p2=p then
      p^:=lookupcomplement[p^];

   p:=buffer;
   while (inbuf > 60) do
     begin
    	c := p[60];
	p[60]:=#0;
        writeln(pb,p);
        p[60]:=c;
	inc(p,60);
	dec(inbuf,60);
     end;
     p[inbuf]:=#0;
     writeln(pb,p);
  end;

end;


(*
function FileOpenA(const FileName: ansistring): Integer;
 {$IFNDEF WIN32}
 begin
   result:=fileopen(filename,mode);
 {$ELSE}
begin
    Result := Integer(CreateFileA(PChar(FileName), GENERIC_READ,
      FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
      FILE_ATTRIBUTE_NORMAL+FILE_FLAG_SEQUENTIAL_SCAN, 0));
{$ENDIF}
end;

 *)


procedure revrun(amem :integer);
const    rBufSize    =1024;

var s  : shortstring;
    c  : char;
    buffersize,
    bufferptr,
    len		: integer;
    rBuf        : pchar;

    p  :pchar;
    sss : ansiString;

    io : integer;
   lll : integer;
   hhh : integer;

//   pa  : tream;
begin
//  hhh:=fileOpenA('revcomp-input.txt');
  assign(pa,'revcomp-input.txt');
  reset(pa);
  assign(pb,'revcomp-output.txt');
  rewrite(pb);
  for c:=#0    to #255    do
    lookupcomplement[c]:=c;
  for len:=0 to high(FASTAXLAT) do
    begin
      lookupcomplement[FASTAXLAT[len][0]]:=upcase(FASTAXLAT[len][1]);
      lookupcomplement[FASTAXLAT[len][1]]:=upcase(FASTAXLAT[len][0]);
    end;
  buffersize:=bufferincrement*amem;
  bufferptr :=0;
//  rBufSize:=1024;
  getmem(p,buffersize);
//  getMem(buf,rBufSize+1);
//  lll:=170;
//  while pa.readLN(s)>=0 do begin
//     dec(lll);
//     s:='GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGA';
  while not eof(pa) do begin
    readln(pa,s);

//   while (input.inoutFunc(input))=0 do
   {
   while  readFile(hhh,buf^,rBufSIze,io,nil) and (io>0) do   begin
   }
{     pb:=input.bufferptr;
     pc:=pb+input.buffersize;
     while pb<pc do begin
       pa:=pb;
       while pb^>#19 do inc(pb);
       move (buf,s[1],pb-pa);


       s[0]:=char(pb-pa);
}

       len:=length(s);
       if (len>0) and (s[1]='>') then
          begin
	    flushbuffer(p,bufferptr);
	    writeln(pb,s);
	    bufferptr:=0;
	  end
       else
         begin
           if (bufferptr+len)>=buffersize then
	     begin
	        inc(buffersize,bufferincrement+2);
                reallocmem(p,buffersize);
	     end;
	   move (s[1],p[bufferptr],len);
	   inc(bufferptr,len);
	 end;
//     end;

   end;
   flushbuffer(p,bufferptr);
   close(pb);
   close(pa);
end;



procedure revrun2(amem : integer);
const    rBufSize    =1024;

var s  : shortstring;
    c  : char;
    buffersize,
    bufferptr,
    len		: integer;
    rBuf        : pchar;

    p  :pchar;
    sss : ansiString;

    io : integer;
   lll : integer;
   hhh : integer;

   pa  : tTextStream;
begin
//  hhh:=fileOpenA('revcomp-input.txt');
//  assign(pa,'revcomp-input.txt');
//  reset(pa);
  pa:=tTextStream.create('revcomp-input.txt',0);
  assign(pb,'revcomp-output1.txt');
  rewrite(pb);
  for c:=#0    to #255    do
    lookupcomplement[c]:=c;
  for len:=0 to high(FASTAXLAT) do
    begin
      lookupcomplement[FASTAXLAT[len][0]]:=upcase(FASTAXLAT[len][1]);
      lookupcomplement[FASTAXLAT[len][1]]:=upcase(FASTAXLAT[len][0]);
    end;
  buffersize:=bufferincrement*amem;
  bufferptr :=0;
//  rBufSize:=1024;
  getmem(p,buffersize);
//  getMem(buf,rBufSize+1);
//  lll:=170;
  while pa.readLN(s)>=0 do begin
//     dec(lll);
//     s:='GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGA';
//  while not eof(pa) do begin
//    readln(pa,s);

//   while (input.inoutFunc(input))=0 do
   {
   while  readFile(hhh,buf^,rBufSIze,io,nil) and (io>0) do   begin
   }
{     pb:=input.bufferptr;
     pc:=pb+input.buffersize;
     while pb<pc do begin
       pa:=pb;
       while pb^>#19 do inc(pb);
       move (buf,s[1],pb-pa);


       s[0]:=char(pb-pa);
}

       len:=length(s);
       if (len>0) and (s[1]='>') then
          begin
	    flushbuffer(p,bufferptr);
	    writeln(pb,s);
	    bufferptr:=0;
	  end
       else
         begin
           if (bufferptr+len)>=buffersize then
	     begin
	        inc(buffersize,bufferincrement+2);
                reallocmem(p,buffersize);
	     end;
	   move (s[1],p[bufferptr],len);
	   inc(bufferptr,len);
	 end;
//     end;

   end;
   flushbuffer(p,bufferptr);
   close(pb);
   pa.free;
//   close(pa);
end;



procedure revrun3(amem : integer);
const    rBufSize    =1024;

var s  : shortstring;
    c  : char;
    buffersize,
    bufferptr,
    len		: integer;
    rBuf        : pchar;

    p  :pchar;
    sss : ansiString;

    io : integer;
   lll : integer;
   hhh : integer;

   pa  : tTextStream;
begin
//  hhh:=fileOpenA('revcomp-input.txt');
//  assign(pa,'revcomp-input.txt');
//  reset(pa);
  pa:=tTextStream.create('revcomp-input.txt',0);
  assign(pb,'revcomp-output3.txt');
  rewrite(pb);
  for c:=#0    to #255    do
    lookupcomplement[c]:=c;
  for len:=0 to high(FASTAXLAT) do
    begin
      lookupcomplement[FASTAXLAT[len][0]]:=upcase(FASTAXLAT[len][1]);
      lookupcomplement[FASTAXLAT[len][1]]:=upcase(FASTAXLAT[len][0]);
    end;
  buffersize:=bufferincrement*amem;
  bufferptr :=0;
//  rBufSize:=1024;
  getmem(p,buffersize);
//  getMem(buf,rBufSize+1);
  lll:=170;
//  while pa.readLN(s)>=0 do begin
   while lll>0 do begin
     dec(lll);
     if lll mod 40 =0 then s:='>cos tam                    '
     else   s:='GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGA';

       len:=length(s);
       if (len>0) and (s[1]='>') then
          begin
	    flushbuffer(p,bufferptr);
	    writeln(pb,s);
	    bufferptr:=0;
	  end
       else
         begin
           if (bufferptr+len)>=buffersize then
	     begin
	        inc(buffersize,bufferincrement+2);
                reallocmem(p,buffersize);
	     end;
	   move (s[1],p[bufferptr],len);
	   inc(bufferptr,len);
	 end;
//     end;

   end;
   flushbuffer(p,bufferptr);
   close(pb);
   pa.free;
//   close(pa);
end;



procedure revrun4(amem : integer);
const    rBufSize    =1024;

var s  : shortstring;
    s2 : shortString;
    c  : char;
    buffersize,
    bufferptr,
    len		: integer;
    rBuf        : pchar;

    p  :pchar;
    sss : ansiString;

    io : integer;
   lll : integer;
   hhh : integer;

   pa  : tTextStream;
begin
//  hhh:=fileOpenA('revcomp-input.txt');
//  assign(pa,'revcomp-input.txt');
//  reset(pa);
  pa:=tTextStream.create('revcomp-input.txt',0);
  assign(pb,'revcomp-output3.txt');
  rewrite(pb);
  for c:=#0    to #255    do
    lookupcomplement[c]:=c;
  for len:=0 to high(FASTAXLAT) do
    begin
      lookupcomplement[FASTAXLAT[len][0]]:=upcase(FASTAXLAT[len][1]);
      lookupcomplement[FASTAXLAT[len][1]]:=upcase(FASTAXLAT[len][0]);
    end;
  buffersize:=bufferincrement*amem;
  bufferptr :=0;
//  rBufSize:=1024;
  getmem(p,buffersize);
//  getMem(buf,rBufSize+1);
  lll:=170;
//  while pa.readLN(s)>=0 do begin
   s:='GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGA';
   s2:='>cos tam ddddddddd';

   while lll>0 do begin
     dec(lll);

       len:=length(s);
       if ((len mod 40)=0 ) and (s2[1]='>') then
          begin
	    flushbuffer(p,bufferptr);
	    writeln(pb,s);
	    bufferptr:=0;
	  end
       else
         begin
           if (bufferptr+len)>=buffersize then
	     begin
	        inc(buffersize,bufferincrement+2);
                reallocmem(p,buffersize);
	     end;
	   move (s[1],p[bufferptr],len);
	   inc(bufferptr,len);
	 end;
//     end;

   end;
   flushbuffer(p,bufferptr);
   close(pb);
   pa.free;
//   close(pa);
end;


procedure revrun5(amem : integer);
const    rBufSize    =1024;

var s  : shortstring;
    s2 : shortString;
    c  : char;
    buffersize,
    bufferptr,
    len		: integer;
    rBuf        : pchar;

    p  :pchar;
    sss : ansiString;

    io : integer;
   lll : integer;
   hhh : integer;

   pa  : tTextStream;
begin
//  hhh:=fileOpenA('revcomp-input.txt');
//  assign(pa,'revcomp-input.txt');
//  reset(pa);
  pa:=tTextStream.create('revcomp-input.txt',0);
  assign(pb,'revcomp-output3.txt');
  rewrite(pb);
  for c:=#0    to #255    do
    lookupcomplement[c]:=c;
  for len:=0 to high(FASTAXLAT) do
    begin
      lookupcomplement[FASTAXLAT[len][0]]:=upcase(FASTAXLAT[len][1]);
      lookupcomplement[FASTAXLAT[len][1]]:=upcase(FASTAXLAT[len][0]);
    end;
  buffersize:=bufferincrement*amem;
  bufferptr :=0;
//  rBufSize:=1024;
  getmem(p,buffersize);
//  getMem(buf,rBufSize+1);
  lll:=170;
//  while pa.readLN(s)>=0 do begin
   s:='GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGA';
   s2:='>cos tam ddddddddd';

   while lll>0 do begin
     dec(lll);

       len:=length(s);
       if ((len mod 40)=0 ) and (s2[1]='>') then
          begin
	    flushbuffer(p,bufferptr);
	    writeln(pb,s);
	    bufferptr:=0;
	  end
       else
         begin
           if (bufferptr+len)>=buffersize then
	     begin
	        inc(buffersize,bufferincrement+2);
                reallocmem(p,buffersize);
	     end;
//	   move (s[1],p[bufferptr],len);
	   inc(bufferptr,len);
	 end;
//     end;

   end;
   flushbuffer(p,bufferptr);
   close(pb);
   pa.free;
//   close(pa);
end;




procedure testRevRun;
var
  i,nn : integer;
  pp   : text;
  aa   : int64;
begin
  assign(pp,'result.txt');
  rewrite(pp);
  nn:=100;
  fillchar(lookupComplement,sizeof(lookupComplement),1);
  aa:=clock;
  for i:= 1 to nn do   revRun(4);
  aa:=clock-aa;
  writeln(pp,'  readln ',aa);
  aa:=clock;
  for i:= 1 to nn do   revRun(44);
  aa:=clock-aa;
  writeln(pp,'  readln +big buffer ',aa);
  aa:=clock;
  for i:= 1 to nn do   revRun2(4);
  aa:=clock-aa;
  writeln(pp,'  ttextStream ',aa);
  aa:=clock;
  for i:= 1 to nn do   revRun3(4);
  aa:=clock-aa;
  writeln(pp,'  no read file ',aa);
  aa:=clock;
  for i:= 1 to nn do   revRun3(4);
  aa:=clock-aa;
  writeln(pp,'  no read file +big buffer ',aa);
  aa:=clock;
  for i:= 1 to nn do   revRun3(4);
  aa:=clock-aa;
  writeln(pp,'  no read file ',aa);
  aa:=clock;
  for i:= 1 to nn do   revRun4(4);
  aa:=clock-aa;
  writeln(pp,'  no set string  ',aa);
  aa:=clock;
  for i:= 1 to nn do   revRun5(4);
  aa:=clock-aa;
  writeln(pp,'  no move ',aa);
  aa:=clock;
  for i:= 1 to nn do   revRun2(4);
  aa:=clock-aa;
  writeln(pp,'  ttextStream ',aa);
  aa:=clock;
  for i:= 1 to nn do   revRun(44);
  aa:=clock-aa;
  writeln(pp,'  readln +big buffer ',aa);
  aa:=clock;
  for i:= 1 to nn do   revRun(4);
  aa:=clock-aa;
  writeln(pp,'  readln ',aa);


  close(pp);

end;

begin
// run;
end.
