unit Unitmain;
//{$o-}
//{$Q+}
//{$R+}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Run: TButton;
    Label1: TLabel;
    labeltime: TLabel;
    procedure RunClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  procedure main();
  procedure generate_random_kids_to_start();
  procedure fill_up_their_result_tables();
  procedure runlife(inputnumber:cardinal);
  procedure mutate(kidnumber:cardinal);
  procedure tally_results(inputnumber:cardinal);
  procedure mutate_mutation_function;

const
POPULATION_SIZE=5000;
KID_SIZE=5;
//inputs cannot be bigger than 21 bits or whatever current size is.
INPUTS:array[0..2] of cardinal=($00000001,$00000002,$00000003);  //dec eax; mov ebx,[eax];dec eax; mov [eax],ebx;
OUTPUTS:array[0..2] of cardinal=($00000001,$00000001,$00000001);           //this will not exist for meta-gp. that could be a problem
TOTAL_DIFFERENCE=0;
TOTAL_TIME=1;
CYCLES_LIMIT=KID_SIZE;
MAX_TIME_LIMIT_MILLISECONDS=5000;
//NNIT
MUTATE_KID_SIZE= 64; //(will probably take less, but ill have an exitvm at end)

var
  Form1: TForm1;
  kids:array[0..POPULATION_SIZE-1] of array[0..KID_SIZE-1] of cardinal;
  kidsresults:array[0..POPULATION_SIZE-1] of array[TOTAL_DIFFERENCE..TOTAL_TIME] of cardinal;
  tempkid: array[0..KID_SIZE-1] of cardinal;
  tempkidtotal_difference:cardinal;
  tempkidtotal_time:cardinal;
  globalbestkid:array[0..KID_SIZE-1] of cardinal;
  globalbestkidtotal_difference:cardinal = (1 shl 30);
  globalbestkidtotal_time:cardinal=(1 shl 30);
  start_time:cardinal;
  end_time:cardinal;

  //these are not needed for translation
  zerotime,begintime:cardinal;
  mutatebegintime,mutateendtime:cardinal;
  bench1:cardinal;
  mutateglobalbesttime:cardinal=MAX_TIME_LIMIT_MILLISECONDS*2;
  mutateglobalbestkid:array[0..MUTATE_KID_SIZE-1] of cardinal;
  tempmutatekid:array[0..MUTATE_KID_SIZE-1] of cardinal;
  mutate_time_accumulator,mutate_time_average:cardinal;
  number_of_mutate_functions_tested:cardinal;
  default_mutation_function:array[0..MUTATE_KID_SIZE-1] of cardinal=(
33, 3977, 3977, 6334, 4311, 5481, 4073, 3746, 6334, 4010, 4247, 3629, 3738, 3977, 2712, 6334, 4311, 5481, 4073, 3746, 6334, 4010, 4247, 3629, 3738, 3977, 3977, 5404, 4311, 5481, 4073, 3746, 6334, 4010, 4247, 3629, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333, 6333 );

implementation

uses
unit_virtualmachinecore;

const
INPUT_POINTER=(1 shl BITS)-1;
OUTPUT_POINTER=(1 shl BITS)-2;



{$R *.dfm}

procedure TForm1.RunClick(Sender: TObject);
begin
run.enabled:=false;
main();
run.enabled:=true;
if (zerotime =1) then labeltime.caption:='FAILED' else labeltime.caption:=inttostr(zerotime-begintime)+'ms';
end;

procedure main();
var
x,maincounter,inputcounter,counter3,counter1temp,counter2temp,mutateinnercounter,
mutatecounter1,mutatecounter2,a:integer;
label endloop;
begin
number_of_mutate_functions_tested:=0;
a:=0;
while (a=0) do     //forever do
begin
  //mutate_mutation_function (should eventually be self modifying)
     //copy default mutation function into tempmutatekid;

    mutate_mutation_function; 

    (*for mutatecounter2:=0 to MUTATE_KID_SIZE-1 do
    begin
    tempmutatekid[mutatecounter2]:=default_mutation_function[mutatecounter2];
    end;
      //mutate tempmutatekid by picking a few random opcode and assigning them to tempmutate kid at three random places
     tempmutatekid[random(MUTATE_KID_SIZE)]:= random(8192);
     tempmutatekid[random(MUTATE_KID_SIZE)]:= random(8192);
     tempmutatekid[random(MUTATE_KID_SIZE)]:= random(8192);*)
  //end mutate_mutation_function  (should eventually be self modifying)
  
  //run the stuff in middle (gp system) five times, then take an average to see if below default  (later, i would recommend changing the inptus and outputs, each of those five times)
  //if it is, log it to global_best. AND write it to mutation_kid, so
  //that it is the default mutation functoin from now on rathe rthan the temp one.
  //meaning, it should be used by mutate_mutation_function so that i get the meta-gp speedup
  //as well as being the new parent from which kids will be based upon
  //should i demand low standard deviation from mean as well as low mean time? i think i should. but keep it simple at first
  mutate_time_accumulator:=0;
  for mutateinnercounter:=0 to 5 do
  begin
  begintime:=gettickcount();
  mutatebegintime:=gettickcount();
  zerotime:=1; //NNIT
  globalbestkidtotal_difference:= (1 shl 30);
  globalbestkidtotal_time:=(1 shl 30);
    while ((gettickcount()-begintime)<MAX_TIME_LIMIT_MILLISECONDS) do
    begin
      generate_random_kids_to_start;
      fill_up_their_result_tables;
      for x:=0 to 800 do              //run a population 25 times before giving up and restarting
      begin                            //however, even after giving up, keep the best kid, in
                                      //in case dont find any better ones
        for maincounter:=0 to POPULATION_SIZE-1 do        //run every member of population
        begin
          mutate(maincounter);            //copy kid into tempkid, then mutate it
          tempkidtotal_difference:=0;           //reset results tallys
          tempkidtotal_time:=0;
          for inputcounter:=0 to high(INPUTS) do         //run every input in i/o table
          begin
          runlife(inputcounter);
          tally_results(inputcounter); //after this for loop, results will be total all inputs
          end;
          //TEMP
          if (tempkidtotal_difference=0) then
          begin
          //showmessage('0');
          end;
          //END TEMP
          if (tempkidtotal_difference < kidsresults[maincounter][TOTAL_DIFFERENCE]) OR ((tempkidtotal_difference = 0) AND (tempkidtotal_time < kidsresults[maincounter][TOTAL_TIME])) then  //results include both total_difference, and time it took
          begin                                                                                                                                                                            //for asm, make this faster by asking if <= to kidresults, then and only then splitting it into (< or (0 and lesstime))
            if (tempkidtotal_difference=0) AND (globalbestkidtotal_difference <> 0 ) then
            begin
            zerotime:=gettickcount(); //this is not needed in translation
            end;
            if (tempkidtotal_difference=0) then goto endloop;
          //set them as the parent
          //i.e. copy tempkid into kids[maincounter] and tempresults into kidresults
            for counter3:=0 to KID_SIZE-1 do
            begin
            kids[maincounter][counter3]:=tempkid[counter3];
            end;
            kidsresults[maincounter][TOTAL_DIFFERENCE]:= tempkidtotal_difference;
            kidsresults[maincounter][TOTAL_TIME]:= tempkidtotal_time;
            //then, if (results > globalbest) then record_it_to_globalbest as well;
            if (tempkidtotal_difference < globalbestkidtotal_difference) OR ((tempkidtotal_difference = 0) AND (tempkidtotal_time < globalbestkidtotal_time)) then
            begin
              for counter3:=0 to KID_SIZE-1 do
              begin
              globalbestkid[counter3]:=tempkid[counter3];
              end;
              globalbestkidtotal_difference:= tempkidtotal_difference;
              globalbestkidtotal_time:= tempkidtotal_time;

              //TEMPTEMPTEMPTEMPTEMPTEMPTEMPMTE
              {once have a global best, copy it into all kids}
                    (*     for counter1temp:=0 to POPULATION_SIZE-1 do
                          begin
                            for counter2temp:=0 to KID_SIZE-1 do
                            begin
                            kids[counter1temp][counter2temp]:=globalbestkid[counter2temp];
                            kidsresults[counter1temp][TOTAL_DIFFERENCE]:= globalbestkidtotal_difference;
                            kidsresults[counter1temp][TOTAL_TIME]:=  globalbestkidtotal_time;
                            end;
                          end;   *)
              //END TEMPTEMPMTEPMTEPMTPMEPTME

            end;
          end;
          //else
          //begin
          //implied go back to old parents, by not copying tempkid into them. bascially just do nothing.
          //end;
        end;
      end;
    end;{five second loop}
    endloop:
    mutateendtime:=gettickcount()-mutatebegintime;//should be 5 seconds or greater if no zero was reached
    mutate_time_accumulator:=mutate_time_accumulator+mutateendtime;
  end;
  mutate_time_average:=mutate_time_accumulator div 5;
  if (mutate_time_average < mutateglobalbesttime) then
  begin
  mutateglobalbesttime:=mutate_time_average;
    for mutatecounter1:=0 to MUTATE_KID_SIZE-1 do
    begin
    mutateglobalbestkid[mutatecounter1]:=tempmutatekid[mutatecounter1];
    end;
  end;
  inc(number_of_mutate_functions_tested);
  //will need ot make the abov eloop eixt once it reaches zero
end; //forever loop

end;

procedure fill_up_their_result_tables();
var
counter1,counter2,counter3,inputcounter:integer;
begin

  for counter1:=0 to POPULATION_SIZE-1 do
  begin
    for counter2:=0 to KID_SIZE-1 do
    begin
    tempkid[counter2]:=kids[counter1][counter2];
    end;

    for inputcounter:=0 to high(INPUTS) do
    begin
    runlife(inputcounter);
    tally_results(inputcounter);
    end;
  kidsresults[counter1][TOTAL_DIFFERENCE]:=tempkidtotal_difference;
  kidsresults[counter1][TOTAL_TIME]:=tempkidtotal_time;
  end;

  if (tempkidtotal_difference < globalbestkidtotal_difference) OR ((tempkidtotal_difference = 0) AND (tempkidtotal_time < globalbestkidtotal_time)) then
  begin
  for counter3:=0 to KID_SIZE-1 do
  begin
  globalbestkid[counter3]:=tempkid[counter3];
  end;
  globalbestkidtotal_difference:= tempkidtotal_difference;
  globalbestkidtotal_time:= tempkidtotal_time;
  end;
//runlife on all randomly generated kids
//tally up the reuslts and save them to the kidresults table

end;

procedure generate_random_kids_to_start();
var
counter1,counter2:integer;
begin


  for counter1:=0 to POPULATION_SIZE-1 do
  begin
    for counter2:=0 to KID_SIZE-1 do
    begin
    kids[counter1][counter2]:=random(6334);
    end;
  end;
//for each kid, fill with random opcodes.
//leave tempkid alone

end;

procedure runlife(inputnumber:cardinal);     //once rewrite in 25x86, this will simply be loading input and jumping

  procedure prepare_vm();
  var
  x:integer;
  begin
    for x:=0 to KID_SIZE-1 do                          //load kid program
    begin
    memoryblock[x]:=tempkid[x];
    end;
    //begin asm for filling memory with rep movsd
    asm
    {for x:=KID_SIZE to high(memoryblock) do               //clear remaining vm memory  by filling it with exit_vm's
    begin
    memoryblock[x]:=6333;
    end;}
    end;
    //end asm for filling memory
    for x:=low(stackblock) to high(stackblock) do      //clear stack  with exit_vms, so it doesnt push before popping
    begin
    stackblock[x]:=6333;
    end;
    memoryblock[INPUT_POINTER]:=INPUTS[inputnumber];      //load input  (output will be input + 1)
    memoryblock[OUTPUT_POINTER]:=0;
  end;
begin
prepare_vm;
start_time:=gettickcount();
loop_limit_memlocation:=CYCLES_LIMIT; //NNIT
run_virtual_machine;   //in teh outer-shell one, will repeat these four steps  like 10 times, and take the mean time, and just require total diff always be zero. (because i will choose problems that hit zero within loop limit like 99 percent of the time)
end_time:=gettickcount();
end;
                                 
                                 
                                 
procedure tally_results(inputnumber:cardinal);
var
marked_different_bits:cardinal;
begin
tempkidtotal_time:=tempkidtotal_time+(end_time-start_time);
//get output from runlife, from memblock[OUTPUT_POINTER]
marked_different_bits:=memoryblock[OUTPUT_POINTER] xor OUTPUTS[inputnumber];
// 0110
// 1100
// xor output with correct_output to get different bits
// 1010
//dont knwo how many bits i am doing, so just do all 32
//this is efetivly doing a tempkidtotal_difference:=tempkidtotal_difference+1, if bit is set.
if ((marked_different_bits and $00000001) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00000002) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00000004) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00000008) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00000010) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00000020) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00000040) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00000080) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00000100) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00000200) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00000400) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00000800) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00001000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00002000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00004000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00008000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00010000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00020000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00040000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00080000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00100000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00200000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00400000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $00800000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $01000000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $02000000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $04000000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $08000000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $10000000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $20000000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $40000000) <> 0) then inc(tempkidtotal_difference);
if ((marked_different_bits and $80000000) <> 0) then inc(tempkidtotal_difference);

end;



procedure mutate(kidnumber:cardinal);//NEWMUTATE
var
x:integer;
  procedure prepare_mutate_vm();
  var
  y:integer;
  begin
    //LOAD MUTATION FUNCTION
    for y:=0 to MUTATE_KID_SIZE-1 do                          //load kid program
    begin
    memoryblock[y]:=tempmutatekid[y];
    end;
    //CLEAR STACK
    //do not clear rest of memory. takes too much time, unfortunately
    //however a good function will not be dependent on zeroed out memory, cause it will not read from locations it hasnt yet written
   // for y:=low(stackblock) to high(stackblock) do      //clear stack  with exit_vms, so it doesnt push before popping
   // begin
   // stackblock[y]:=6333;
   // end;
             
    //LOAD INPUT (kid to be mutated)
    for y:=0 to KID_SIZE-1 do
    begin
    memoryblock[INPUT_POINTER-y]:=kids[kidnumber][y];
    end;

  end;
begin

prepare_mutate_vm;


//run vm
loop_limit_memlocation:=100;
run_virtual_machine;
//extract output from INPUT_POINTER (copy it into tempkid.
//it will be same number of elements as input)
  for x:=0 to KID_SIZE-1 do
  begin
  tempkid[x]:=memoryblock[INPUT_POINTER-x];
  end;

end;



      //tempmutatekid[mutatecounter2]:=default_mutation_function[mutatecounter2];
      procedure mutate_mutation_function;
      var
      x:integer;
        procedure prepare_mutate_vm();
        var
        y:integer;
        begin
          //LOAD MUTATION FUNCTION
          for y:=0 to MUTATE_KID_SIZE-1 do                          //load kid program
          begin
          memoryblock[y]:=default_mutation_function[y];
          end;
          //CLEAR STACK
          //do not clear rest of memory. takes too much time, unfortunately
          //however a good function will not be dependent on zeroed out memory, cause it will not read from locations it hasnt yet written
         // for y:=low(stackblock) to high(stackblock) do      //clear stack  with exit_vms, so it doesnt push before popping
         // begin
         // stackblock[y]:=6333;
         // end;
             
          //LOAD INPUT (kid to be mutated)
          for y:=0 to MUTATE_KID_SIZE-1 do
          begin
          memoryblock[INPUT_POINTER-y]:=default_mutation_function[y];
          end;

        end;
      begin

      prepare_mutate_vm;


      //run vm
      loop_limit_memlocation:=100;
      run_virtual_machine;
      //extract output from INPUT_POINTER (copy it into tempkid.
      //it will be same number of elements as input)
        for x:=0 to MUTATE_KID_SIZE-1 do
        begin
        tempmutatekid[x]:=memoryblock[INPUT_POINTER-x];
        end;

      end;










end.








    (*

       //oldmutate
procedure mutate(kidnumber:cardinal);                                         //doing inserts will be easy. just use dynamic arrays + setlength, and when do an insert will increase size of all kids
var                                      //and inc the kidsize var and fill in exitvms on the end of all the kids that have been explicitly mutated yet
chosenpoint:cardinal;
x:integer;
begin

  for x:=0 to KID_SIZE-1 do
  begin
  tempkid[x]:=kids[kidnumber][x];
  end;
//tempkid is the one used for experimenting, kids[kidnumber] always stays the same or gets better

//select three grouped elements of kid, from 0 to kidsize-3. must do kidsize-2 to get in that range
chosenpoint:=random(KID_SIZE-2);

//pick 3 opcodes, one at a time.  and insett them into tempkid at the above chosen point
tempkid[chosenpoint+0]:= random(1000)+3584;//random(6334)
tempkid[chosenpoint+1]:= random(1000)+3584;//random(6334); //3584 4303
tempkid[chosenpoint+2]:= random(1000)+3584;//random(6334);

end;
      //dec eax; mov ebx,[eax];dec eax; mov [eax],ebx;exit_vm;
      //5480,           3662, 5480,   3621          , 6333



       *)