summaryrefslogtreecommitdiff
path: root/Build/source/utils/asymptote/runtime.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/utils/asymptote/runtime.pl')
-rwxr-xr-xBuild/source/utils/asymptote/runtime.pl121
1 files changed, 102 insertions, 19 deletions
diff --git a/Build/source/utils/asymptote/runtime.pl b/Build/source/utils/asymptote/runtime.pl
index 74dde0506aa..e43813ad1c4 100755
--- a/Build/source/utils/asymptote/runtime.pl
+++ b/Build/source/utils/asymptote/runtime.pl
@@ -7,8 +7,31 @@
#
#####
+$prefix = shift(@ARGV);
+if (not $prefix) {
+ print STDERR "usage: ./runtime.pl module_name\n";
+ exit(1);
+}
+
$stack = "Stack";
+my $errors = 0;
+
+sub report_error {
+ my $filename = shift;
+ my $line = shift;
+ my $error = shift;
+ print STDERR "$filename:$line: $error\n";
+ $errors = 1;
+}
+
+sub assoc_error {
+ my $filename = shift;
+ my $line = shift;
+ my $type = shift;
+ report_error($filename, $line, "no asy type associated to '$type'");
+}
+
sub clean_type {
for (@_) {
s/\s//g;
@@ -24,19 +47,34 @@ sub clean_params {
my %type_map;
sub read_types {
my @types = split /\n/, shift;
+ my $filename = shift;
+ my $line = shift;
for (@types) {
+ ++$line;
+ # Remove // comments.
+ s/\/\/.*//g;
+
+ # Skip blank lines.
+ next if /^\s*$/;
+
my ($type,$code) =
m|(\w*(?:\s*\*)?)
\s*=>\s*
(.*)
|x;
+ if (not $type) {
+ report_error($filename, $line, "bad type declaration");
+ }
clean_type($type);
$type_map{$type} = $code;
}
}
sub asy_params {
- my @params = @_;
+ my $params = shift;
+ my @params = split m/,\s*/, $params;
+ my $filename = shift;
+ my $line = shift;
for (@params) {
my ($explicit, $type, $name, $default) =
m|^\s*
@@ -44,6 +82,9 @@ sub asy_params {
\s*
(\w*)(=*)|xs;
clean_type($type);
+ if (not $type_map{$type}) {
+ assoc_error($filename, $line, $type);
+ }
$_ = "formal(" . $type_map{$type} . ", \"" . lc($name) . "\"" . ", " .
($default ? "true" : "false") . ", " .
($explicit ? "true" : "false") . ")";
@@ -67,37 +108,57 @@ sub c_params {
$/ = "\f\n";
-open STDIN, "<runtime.in";
-open STDOUT, ">runtime.cc";
+open STDIN, "<$prefix.in" or die "can't open input file $prefix.in";
+open BASE, "<runtimebase.in" or die "can't open runtimebase.in";
+open STDOUT, ">$prefix.cc" or die "can't open output file $prefix.cc";
my $autogenerated=
-"/***** Autogenerated from runtime.in; changes will be overwritten *****/\n\n";
+"/***** Autogenerated from $prefix.in; changes will be overwritten *****/\n\n";
+my $base_source_line = 1;
my $source_line = 1;
print $autogenerated;
-print "#line $source_line \"runtime.in\"\n";
+print "#line $base_source_line \"runtimebase.in\"\n";
+$baseheader = <BASE>;
+print $baseheader;
+$basesource_line += ($baseheader =~ tr/\n//);;
+my $basesource_type_line = $basesource_line;
+
+print "#line $source_line \"$prefix.in\"\n";
$header = <>;
print $header;
$source_line += ($header =~ tr/\n//);;
+my $source_type_line = $source_line;
+
+$basetypes = <BASE>;
+$basesource_line += ($basetypes =~ tr/\n//);;
$types = <>;
$source_line += ($types =~ tr/\n//);;
-print "#line $source_line \"runtime.in\"\n";
+print "#line $base_source_line \"runtimebase.in\"\n";
+$baseheader = <BASE>;
+print $baseheader;
+$basesource_line += ($baseheader =~ tr/\n//);;
+
+print "#line $source_line \"$prefix.in\"\n";
$header = <>;
print $header;
$source_line += ($header =~ tr/\n//);;
print "\nnamespace run {\n";
-read_types($types);
+read_types($basetypes, "runtimebase.in", $basesource_type_line);
+
+read_types($types, "$prefix.in", $source_type_line);
-### Begining of `runtime.h'
+### Begining of `$prefix.h'
push @header, $autogenerated;
-push @header, "#ifndef RUNTIME_H\n";
-push @header, "#define RUNTIME_H\n\n";
+# TODO: Capitalize prefix
+push @header, "#ifndef " . $prefix . "_H\n";
+push @header, "#define " . $prefix . "_H\n";
push @header, "namespace run {\n";
my $count = 0;
@@ -114,8 +175,12 @@ while (<>) {
\{(.*)} # body
|xs;
+ if (not $type) {
+ report_error("$prefix.in", $source_line, "bad function definition");
+ }
+
if($cname) {push @header, "void $cname(vm::stack *);\n";}
- else {$cname="gen${count}";} # Unique C++ function name
+ else {$cname="gen_$prefix${count}";} # Unique C++ function name
clean_type($type);
@@ -124,15 +189,27 @@ while (<>) {
# Build addFunc call for asymptote
if($name) {
$name =~ s/Operator\s*//;
- push @builtin, "#line $source_line \"runtime.in\"\n"
+ if (not $type_map{$type}) {
+ assoc_error("$prefix.in", $source_line, $type);
+ }
+ my @asy_params = asy_params($params, "$prefix.in", $source_line);
+ push @builtin, "#line $source_line \"$prefix.in\"\n"
. " addFunc(ve, run::" . $cname
. ", " . $type_map{$type}
. ", " . '"' . $name . '"'
- . ( @params ? ", " . join(", ",asy_params(@params))
+ . ( @params ? ", " . join(", ",@asy_params)
: "" )
. ");\n";
}
+ # Build REGISTER_BLTIN command for builtin functions which are not added to
+ # the environment.
+ if (not $name and $cname) {
+ push @builtin, "#line $source_line \"$prefix.in\"\n"
+ . " REGISTER_BLTIN(run::" . $cname
+ . ',"' . $cname . '"' . ");\n";
+ }
+
# Handle marshalling of values to/from stack
$qualifier = ($type eq "item" ? "" : "<$type>");
$code =~ s/\breturn ([^;]*);/{$stack->push$qualifier($1); return;}/g;
@@ -141,7 +218,7 @@ while (<>) {
print $comments;
$ncomments = ($comments =~ tr/\n//);
$source_line += $ncomments;
- print "#line $source_line \"runtime.in\"\n";
+ print "#line $source_line \"$prefix.in\"\n";
my $prototype=$type . " " . $name . "(" . $params . ");";
$nprototype = ($prototype =~ tr/\n//)+1;
$source_line += $nprototype;
@@ -152,7 +229,7 @@ while (<>) {
print "void $cname(stack *";
if($type ne "void" or $params ne "") {print $stack;}
print ")\n{\n$args";
- print "#line $source_line \"runtime.in\"";
+ print "#line $source_line \"$prefix.in\"";
print "$code}\n\n";
$source_line -= $ncomments+$nprototype;
@@ -163,20 +240,26 @@ while (<>) {
print "} // namespace run\n";
print "\nnamespace trans {\n\n";
-print "void gen_base_venv(venv &ve)\n{\n";
+print "void gen_${prefix}_venv(venv &ve)\n{\n";
print @builtin;
print "}\n\n";
print "} // namespace trans\n";
### End of `header.h'
push @header, "}\n\n";
-push @header, "#endif // RUNTIME_H\n";
+push @header, "#endif // ". $prefix . "_H\n";
undef $/;
-open HEADER, "<", "runtime.h";
+open HEADER, "<", "$prefix.h";
$orig_header = <HEADER>;
$new_header = join "", @header;
if ($new_header ne $orig_header) {
- open HEADER, ">", "runtime.h";
+ open HEADER, ">", "$prefix.h";
print HEADER $new_header;
}
+
+if ($errors) {
+ unlink("$prefix.h");
+ unlink("$prefix.cc");
+}
+exit($errors);