#!/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.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 =
; $new_header = join "", @header; if ($new_header ne $orig_header) { open HEADER, ">", "runtime.h"; print HEADER $new_header; }