summaryrefslogtreecommitdiff
path: root/Build/source/utils/asymptote/runtime.pl
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2009-05-16 00:19:13 +0000
committerKarl Berry <karl@freefriends.org>2009-05-16 00:19:13 +0000
commitbab45528d65eaafe68a705dbb2a57075c7b7cbd8 (patch)
tree10b4ae2b5195c8dede153ab89359ec00f55f325f /Build/source/utils/asymptote/runtime.pl
parent8643d90372e9c31e0f461c15c596b60a545bd7d3 (diff)
asymptote 1.72 sources (not integrated into build yet)
git-svn-id: svn://tug.org/texlive/trunk@13110 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/utils/asymptote/runtime.pl')
-rwxr-xr-xBuild/source/utils/asymptote/runtime.pl182
1 files changed, 182 insertions, 0 deletions
diff --git a/Build/source/utils/asymptote/runtime.pl b/Build/source/utils/asymptote/runtime.pl
new file mode 100755
index 00000000000..74dde0506aa
--- /dev/null
+++ b/Build/source/utils/asymptote/runtime.pl
@@ -0,0 +1,182 @@
+#!/usr/bin/env perl
+######
+# runtime.pl
+# Tom Prince 2004/4/15
+#
+# Generate the runtime functions used by the vm::stack machine.
+#
+#####
+
+$stack = "Stack";
+
+sub clean_type {
+ for (@_) {
+ s/\s//g;
+ }
+}
+
+sub clean_params {
+ for (@_) {
+ s/\n//g;
+ }
+}
+
+my %type_map;
+sub read_types {
+ my @types = split /\n/, shift;
+ for (@types) {
+ my ($type,$code) =
+ m|(\w*(?:\s*\*)?)
+ \s*=>\s*
+ (.*)
+ |x;
+ clean_type($type);
+ $type_map{$type} = $code;
+ }
+}
+
+sub asy_params {
+ my @params = @_;
+ for (@params) {
+ my ($explicit, $type, $name, $default) =
+ m|^\s*
+ (explicit)*\s*(\w*(?:\s*\*)?)
+ \s*
+ (\w*)(=*)|xs;
+ clean_type($type);
+ $_ = "formal(" . $type_map{$type} . ", \"" . lc($name) . "\"" . ", " .
+ ($default ? "true" : "false") . ", " .
+ ($explicit ? "true" : "false") . ")";
+ }
+ return @params;
+}
+
+sub c_params {
+ my @params = @_;
+ for (@params) {
+ my ($explicit, $type, $name, $default, $value) =
+ m|^\s*
+ (explicit)*\s*(\w*(?:\s*\*)?)
+ \s*
+ (\w*)(=*)([\w.+\-]*)|xs;
+ $_ = " $type $name=vm::pop" . ($type =~ /^item$/ ? "" : "<$type>") .
+ "($stack" . ($default ? "," . $value : "") . ");\n";
+ }
+ reverse @params;
+}
+
+$/ = "\f\n";
+
+open STDIN, "<runtime.in";
+open STDOUT, ">runtime.cc";
+
+my $autogenerated=
+"/***** Autogenerated from runtime.in; changes will be overwritten *****/\n\n";
+
+my $source_line = 1;
+
+print $autogenerated;
+
+print "#line $source_line \"runtime.in\"\n";
+$header = <>;
+print $header;
+$source_line += ($header =~ tr/\n//);;
+
+$types = <>;
+$source_line += ($types =~ tr/\n//);;
+
+print "#line $source_line \"runtime.in\"\n";
+$header = <>;
+print $header;
+$source_line += ($header =~ tr/\n//);;
+
+print "\nnamespace run {\n";
+
+read_types($types);
+
+### Begining of `runtime.h'
+push @header, $autogenerated;
+push @header, "#ifndef RUNTIME_H\n";
+push @header, "#define RUNTIME_H\n\n";
+push @header, "namespace run {\n";
+
+my $count = 0;
+while (<>) {
+ my ($comments,$type,$name,$cname,$params,$code) =
+ m|^((?:\s*//[^\n]*\n)*) # comment lines
+ \s*
+ (\w*(?:\s*\*)?) # return type
+ \s*
+ ([^(:]*)\:*([^(]*) # function name
+ \s*
+ \(([\w\s*,=.+\-]*)\) # parameters
+ \s*
+ \{(.*)} # body
+ |xs;
+
+ if($cname) {push @header, "void $cname(vm::stack *);\n";}
+ else {$cname="gen${count}";} # Unique C++ function name
+
+ clean_type($type);
+
+ my @params = split m/,\s*/, $params;
+
+ # Build addFunc call for asymptote
+ if($name) {
+ $name =~ s/Operator\s*//;
+ push @builtin, "#line $source_line \"runtime.in\"\n"
+ . " addFunc(ve, run::" . $cname
+ . ", " . $type_map{$type}
+ . ", " . '"' . $name . '"'
+ . ( @params ? ", " . join(", ",asy_params(@params))
+ : "" )
+ . ");\n";
+ }
+
+ # Handle marshalling of values to/from stack
+ $qualifier = ($type eq "item" ? "" : "<$type>");
+ $code =~ s/\breturn ([^;]*);/{$stack->push$qualifier($1); return;}/g;
+ $args = join("",c_params(@params));
+
+ print $comments;
+ $ncomments = ($comments =~ tr/\n//);
+ $source_line += $ncomments;
+ print "#line $source_line \"runtime.in\"\n";
+ my $prototype=$type . " " . $name . "(" . $params . ");";
+ $nprototype = ($prototype =~ tr/\n//)+1;
+ $source_line += $nprototype;
+ if($name) {
+ clean_params($prototype);
+ print "// $prototype\n";
+ }
+ print "void $cname(stack *";
+ if($type ne "void" or $params ne "") {print $stack;}
+ print ")\n{\n$args";
+ print "#line $source_line \"runtime.in\"";
+ print "$code}\n\n";
+
+ $source_line -= $ncomments+$nprototype;
+ $source_line += ($_ =~ tr/\n//);
+ ++$count;
+}
+
+print "} // namespace run\n";
+
+print "\nnamespace trans {\n\n";
+print "void gen_base_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";
+
+undef $/;
+open HEADER, "<", "runtime.h";
+$orig_header = <HEADER>;
+$new_header = join "", @header;
+if ($new_header ne $orig_header) {
+ open HEADER, ">", "runtime.h";
+ print HEADER $new_header;
+}