diff options
Diffstat (limited to 'Build/source/utils/asymptote/runtime.pl')
-rwxr-xr-x | Build/source/utils/asymptote/runtime.pl | 182 |
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; +} |