view src/gearsTools/generate_context.pl @ 354:fde5f96c6ff1

use common perl script
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Fri, 12 Jun 2020 20:44:01 +0900
parents 36ed64fea8c1
children 045299ad7e97
line wrap: on
line source

#!/usr/bin/perl

use Getopt::Long;
use strict;

# 
# generrate Gears OS context heaader and initializer from CbC sources
#
# CodeGear
# 
# get stub information from # *.c
#     __code taskManager_stub(struct Context* context) {
# 
# generate CodeGear indexn in context.h
#     C_taskManager,
# 
# generate CodeGear stub reference in context.h
#     extern __code taskManager_stub(struct Context*);
# 
# generate CodeGear stub reference in $name-context.h for each module
#     context->code[C_taskManager]   = taskManager_stub;
# 
# DataGear
# 
# get DataGear information from context.h
#     struct Worker {
#         int id;
#         struct Context* contexts;
#         enum Code execute;
#         enum Code taskSend;
#         enum Code taskRecive;
#         enum Code shutdown;
#         struct Queue* tasks;
#     } Worker;
# 
# generate typedefs and DataGear index in context.h
#     typedef struct Worker Worker;
#     D_Worker,
# 
# generate DataGear allocator in context.h
#      ALLOC_DATA(context, Worker);
#

my $ddir = "c";

our($opt_o,$opt_d,$opt_h,$opt_w, $opt_project);
GetOptions(
    "o=s"     => \$opt_o,
    "d=s"     => \$opt_d,
    "h"       => \$opt_h,
    "w"       => \$opt_w,
    "project" => \$opt_project,
);


my $name = $opt_o?$opt_o:"gears";

if ($opt_d) {
    $ddir = $opt_d;
}

if ( ! -d $ddir) {
    mkdir $ddir;
}

if ($opt_h) {
    print "$0  [-d distdir] [-h]\n";
    exit;
}

my %projects = (
    gears => { name => "gears", cotnext => "context" ,     template => "Gears::Context::Template"},
    xv6   => { name => "xv6"  , context => "cbc_context" , template => "Gears::Context::Template::XV6"},
);


my $context_name = "context";

my $project = $projects{gears};

if ($opt_project && exists $projects{$opt_project}) {
  $context_name = $projects{$opt_project}->{context};
}



my %codeGear;
my %dataGear;
my %constructor;

{
  use FindBin;
  use lib "$FindBin::Bin/lib";

  use File::Spec;
  use Cwd 'getcwd';

  use Gears::Context;
  use Getopt::Std;

  my $output     = $opt_w ? "context.h" : "stdout";

  use Data::Dumper;
  my @cbc_files;
  map { push(@cbc_files,File::Spec->rel2abs($_)); }  @ARGV;
  my $gears      = Gears::Context->new(compile_sources => \@cbc_files, find_root => "$FindBin::Bin/../", output => $output, template => $project->{template});
  my $data_gears = $gears->extraction_dg_compile_sources($gears->{compile_sources});
  my $g          = $gears->set_data_gear_header_path(keys %{$data_gears->{impl}},keys %{$data_gears->{interfaces}});

  my $dg2path    = $gears->update_dg_each_header_path($data_gears,$g);
  my $tree = $gears->createImplTree_from_header($dg2path);
  $gears->tree2create_context_h($tree);
}

# gather module Information for code table initialization
for (@ARGV) {
    next if (/context.c/);
    &getStubInfo($_);
}

my (%mCodeGear) = (%codeGear);

# anyway we gather all Gears Information
while (<*.c test/*.c>) {
    next if (/context.c/);
    &getStubInfo($_);
}

&generateContext();

sub getStubInfo {
    my ($filename) = @_;
    open my $fd,"<",$filename or die("can't open $filename $!");
    while (<$fd>) {
        if (/^__code (\w+)_stub\(struct  *Context *\* *${context_name}\)/) {
            $codeGear{$1} = $filename;
        } elsif (/^(\w+)(\*)+  *create(\w+)\(([^]]*)\)/) {
            my $interface = $1;
            my $implementation = $3;
            my $constructorArgs = $4;
            $constructor{$implementation} = [$interface, $constructorArgs];
        }
    }

    open my $cx,"<","context.h" or die("can't open context.h $!");
    my $inUnionData = 0;
    while (<$cx>) {
        if (! $inUnionData) {
            if ( /^union Data/) {
                $inUnionData = 1;
            }
            next;
        }
        last if (/union Data end/);
        if (/struct (\w+) \{/) {
            $dataGear{$1} = 'struct';
        } elsif (/^\s{4}(\w+) (\w+);/) { # primitive type
            my $vtype = $1;
            my $vname = $2;
            if (exists $dataGear{$vname}) {
              next;
            }
            $dataGear{$vtype} = 'primitive';
        }
        $dataGear{"Context"} = "struct";
    }
}

sub generateContext {
    $codeGear{"start_code"} = "$ddir/$name-context.c";
    $codeGear{"exit_code"} = "$ddir/$name-context.c";
    $mCodeGear{"start_code"} = "$ddir/$name-context.c";
    $mCodeGear{"exit_code"} = "$ddir/$name-context.c";
    open my $fd,">","$ddir/extern.h" or die("can't open $ddir/extern.h $!");
    for my $code ( sort keys %codeGear ) {
        print $fd "extern __code ${code}_stub(struct Context*);\n";
    }
    for my $impl ( sort keys %constructor ) {
        my ($interface, $constructorArgs) = @{$constructor{$impl}};
        print $fd "extern ${interface}* create${impl}($constructorArgs);\n";
    }
    print $fd "\n";

    open my $fd,">","$ddir/enumCode.h" or die("can't open $ddir/enumCode.h $!");
    print $fd "enum Code {\n";
    for my $code ( sort keys %codeGear ) {
        print $fd "    C_${code},\n";
    }
    print $fd "};\n";
   
    my $code_init = ''; 
    for my $code ( sort keys %mCodeGear ) {
        $code_init .=  "    context->code[C_${code}]    = ${code}_stub;\n";
    }

    my $data_num = keys(%dataGear);
    $data_num++;
    my $context_c;
    if ($project->{name} eq "xv6") {
      $context_c .= << "EOFEOF";
#ifndef CBCXV6
#include <stdlib.h>
#endif
EOFEOF
    } else {
      $context_c .= << "EOFEOF";
#include <stdlib.h>
EOFEOF
}

$context_c .= << "EOFEOF";

#include "../context.h"

void initContext(struct Context* $context_name) {
    ${context_name}\->heapLimit = sizeof(union Data)*ALLOCATE_SIZE;
    ${context_name}\->code = (__code(**) (struct Context*)) NEWN(ALLOCATE_SIZE, void*);
    ${context_name}\->data = NEWN(ALLOCATE_SIZE, union Data*);
    ${context_name}\->heapStart = NEWN(${context_name}\->heapLimit, char);
    ${context_name}\->heap = ${context_name}\->heapStart;
    // ${context_name}\->codeNum = Exit;

$code_init

#include "dataGearInit.c"
    ${context_name}\->dataNum = $data_num;
}
EOFEOF

    open my $fd,">","$ddir/$name-context.c" or die("can't open $ddir/$name-context.c $!");
    print $fd $context_c;

my $meta_call = <<"EOFEOF";
__code meta(struct Context* ${context_name}, enum Code next) {
    // printf("meta %d\\n",next);
    goto (${context_name}\->code[next])(${context_name});
}

__code parGotoMeta(struct Context* ${context_name}, enum Code next) {
    ${context_name}->task     = NULL;
    ${context_name}->taskList = NULL;
    goto (${context_name}\->code[Gearef(${context_name}, TaskManager)->taskManager->TaskManager.spawnTasks])(${context_name});
}

__code start_code(struct Context* ${context_name}) {
    goto meta(${context_name}, ${context_name}\->next);
}

__code start_code_stub(struct Context* ${context_name}) {
    goto start_code(${context_name});
}
EOFEOF

if ($project->{name} eq "gears") {
    $mata_call .= <<"EOFEOF";
__code exit_code(struct Context* ${context_name}) {
    free(${context_name}->code);
    free(${context_name}->data);
    free(${context_name}->heapStart);
    goto exit(0);
}
EOFEOF

} else {

$mata_call .= <<"EOFEOF";
__code exit_code(struct Context* ${context_name}) {
    // free(${context_name}->code);
    // free(${context_name}->data);
    // free(${context_name}->heapStart);
    goto exit_code(cbc_context);
}
EOFEOF
}

$mata_call .= <<"EOFEOF";
__code exit_code_stub(struct Context* ${context_name}) {
    goto exit_code(${context_name});
}    

// end context_c
EOFEOF

print $fd $meta_call;

open my $fd,">","$ddir/enumData.h" or die("can't open $ddir/enumData.h $!");
print $fd "enum DataType {\n";
print $fd "    D_Code,\n";
for my $data ( sort keys %dataGear ) {
    print $fd "    D_${data},\n";
}
print $fd "};\n\n";

open my $fd,">","$ddir/typedefData.h" or die("can't open $ddir/typedefData.h $!");
for my $data ( sort keys %dataGear ) {
    if ($dataGear{$data} eq 'struct') {
        print $fd "typedef struct ${data} ${data};\n";
    }
}

open my $fd,">","$ddir/dataGearInit.c" or die("can't open $ddir/dataGearInit.c $!");
for my $data ( sort keys %dataGear ) {
    print $fd "    ALLOC_DATA(${context_name}, ${data});\n";
}
}

# end