Config.pm000644000765000765 423711533177636 20607 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/Docs/Section# Copyright (C) 2004, Parrot Foundation. =head1 NAME Parrot::Docs::Section::Config - Configuration documentation section =head1 SYNOPSIS use Parrot::Docs::Section::Config; =head1 DESCRIPTION A documentation section describing Parrot's configuration system. =head2 Class Methods =over =cut package Parrot::Docs::Section::Config; use strict; use warnings; use base qw( Parrot::Docs::Section ); =item C Dynamically creates the Configuration section's groups by studying the contents of C<@Parrot::Configure::steps>. =cut sub config_groups { my $self = shift; my $dist = Parrot::Distribution->new; my @groups = (); my %titles = ( 'init' => 'Initialization Steps', 'inter' => 'User Dialogue Steps', 'auto' => 'System Test Steps', 'gen' => 'File Creation Steps', ); foreach my $group (qw(init inter auto gen)) { my $dir = $dist->existing_directory_with_name( 'config/' . $group ); my @files = $dir->files_with_suffix( 'pm', 1 ); push @groups, $self->new_group( $titles{$group}, '', map { $self->new_item( '', $dist->relative_path($_) ) } @files ); } return @groups; } =item C Returns a new section. =cut sub new { my $self = shift; return $self->SUPER::new( 'Configuration', 'config.html', 'Parrot is configured by running the Configure.pl script. This is essentially just a wrapper around Parrot::Configure. The steps are listed below in the order in which they are performed.', $self->new_item( '', 'Configure.pl' ), $self->config_groups, $self->new_group( 'Documentation', '', $self->new_item( 'How to add new configuration steps.', 'docs/configuration.pod' ) ), $self->new_group( 'Library', '', $self->new_item( 'PASM/IMC access to Parrot configuration data.', 'runtime/parrot/library/config.pir' ) ), ); } =back =cut 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: README.pod000644000765000765 56712101554066 21065 0ustar00brucebruce000000000000parrot-5.9.0/examples/sdl/minesweeper# Copyright (C) 2001-2012, Parrot Foundation. =pod =head1 NAME examples/sdl/minesweeper/README.pod - Readme file for the minesweeper example. =head1 DESCRIPTION To run this example, execute the following command from the Parrot directory: =over 4 ./parrot examples/sdl/minesweeper/mines.pir =back =head1 COPYRIGHT Copyright (C) 2001-2012, Parrot Foundation. =cut Search.pm000644000765000765 10130711644422074 17043 0ustar00brucebruce000000000000parrot-5.9.0/lib/Pod/Simple require 5.005; package Pod::Simple::Search; use strict; use vars qw($VERSION $MAX_VERSION_WITHIN $SLEEPY); $VERSION = '3.19'; ## Current version of this package BEGIN { *DEBUG = sub () {0} unless defined &DEBUG; } # set DEBUG level use Carp (); $SLEEPY = 1 if !defined $SLEEPY and $^O =~ /mswin|mac/i; # flag to occasionally sleep for $SLEEPY - 1 seconds. $MAX_VERSION_WITHIN ||= 60; ############################################################################# #use diagnostics; use File::Spec (); use File::Basename qw( basename ); use Config (); use Cwd qw( cwd ); #========================================================================== __PACKAGE__->_accessorize( # Make my dumb accessor methods 'callback', 'progress', 'dir_prefix', 'inc', 'laborious', 'limit_glob', 'limit_re', 'shadows', 'verbose', 'name2path', 'path2name', 'recurse', ); #========================================================================== sub new { my $class = shift; my $self = bless {}, ref($class) || $class; $self->init; return $self; } sub init { my $self = shift; $self->inc(1); $self->recurse(1); $self->verbose(DEBUG); return $self; } #-------------------------------------------------------------------------- sub survey { my($self, @search_dirs) = @_; $self = $self->new unless ref $self; # tolerate being a class method $self->_expand_inc( \@search_dirs ); $self->{'_scan_count'} = 0; $self->{'_dirs_visited'} = {}; $self->path2name( {} ); $self->name2path( {} ); $self->limit_re( $self->_limit_glob_to_limit_re ) if $self->{'limit_glob'}; my $cwd = cwd(); my $verbose = $self->verbose; local $_; # don't clobber the caller's $_ ! foreach my $try (@search_dirs) { unless( File::Spec->file_name_is_absolute($try) ) { # make path absolute $try = File::Spec->catfile( $cwd ,$try); } # simplify path $try = File::Spec->canonpath($try); my $start_in; my $modname_prefix; if($self->{'dir_prefix'}) { $start_in = File::Spec->catdir( $try, grep length($_), split '[\\/:]+', $self->{'dir_prefix'} ); $modname_prefix = [grep length($_), split m{[:/\\]}, $self->{'dir_prefix'}]; $verbose and print "Appending \"$self->{'dir_prefix'}\" to $try, ", "giving $start_in (= @$modname_prefix)\n"; } else { $start_in = $try; } if( $self->{'_dirs_visited'}{$start_in} ) { $verbose and print "Directory '$start_in' already seen, skipping.\n"; next; } else { $self->{'_dirs_visited'}{$start_in} = 1; } unless(-e $start_in) { $verbose and print "Skipping non-existent $start_in\n"; next; } my $closure = $self->_make_search_callback; if(-d $start_in) { # Normal case: $verbose and print "Beginning excursion under $start_in\n"; $self->_recurse_dir( $start_in, $closure, $modname_prefix ); $verbose and print "Back from excursion under $start_in\n\n"; } elsif(-f _) { # A excursion consisting of just one file! $_ = basename($start_in); $verbose and print "Pondering $start_in ($_)\n"; $closure->($start_in, $_, 0, []); } else { $verbose and print "Skipping mysterious $start_in\n"; } } $self->progress and $self->progress->done( "Noted $$self{'_scan_count'} Pod files total"); return unless defined wantarray; # void return $self->name2path unless wantarray; # scalar return $self->name2path, $self->path2name; # list } #========================================================================== sub _make_search_callback { my $self = $_[0]; # Put the options in variables, for easy access my( $laborious, $verbose, $shadows, $limit_re, $callback, $progress, $path2name, $name2path, $recurse) = map scalar($self->$_()), qw(laborious verbose shadows limit_re callback progress path2name name2path recurse); my($file, $shortname, $isdir, $modname_bits); return sub { ($file, $shortname, $isdir, $modname_bits) = @_; if($isdir) { # this never gets called on the startdir itself, just subdirs unless( $recurse ) { $verbose and print "Not recursing into '$file' as per requested.\n"; return 'PRUNE'; } if( $self->{'_dirs_visited'}{$file} ) { $verbose and print "Directory '$file' already seen, skipping.\n"; return 'PRUNE'; } print "Looking in dir $file\n" if $verbose; unless ($laborious) { # $laborious overrides pruning if( m/^(\d+\.[\d_]{3,})\z/s and do { my $x = $1; $x =~ tr/_//d; $x != $] } ) { $verbose and print "Perl $] version mismatch on $_, skipping.\n"; return 'PRUNE'; } if( m/^([A-Za-z][a-zA-Z0-9_]*)\z/s ) { $verbose and print "$_ is a well-named module subdir. Looking....\n"; } else { $verbose and print "$_ is a fishy directory name. Skipping.\n"; return 'PRUNE'; } } # end unless $laborious $self->{'_dirs_visited'}{$file} = 1; return; # (not pruning); } # Make sure it's a file even worth even considering if($laborious) { unless( m/\.(pod|pm|plx?)\z/i || -x _ and -T _ # Note that the cheapest operation (the RE) is run first. ) { $verbose > 1 and print " Brushing off uninteresting $file\n"; return; } } else { unless( m/^[-_a-zA-Z0-9]+\.(?:pod|pm|plx?)\z/is ) { $verbose > 1 and print " Brushing off oddly-named $file\n"; return; } } $verbose and print "Considering item $file\n"; my $name = $self->_path2modname( $file, $shortname, $modname_bits ); $verbose > 0.01 and print " Nominating $file as $name\n"; if($limit_re and $name !~ m/$limit_re/i) { $verbose and print "Shunning $name as not matching $limit_re\n"; return; } if( !$shadows and $name2path->{$name} ) { $verbose and print "Not worth considering $file ", "-- already saw $name as ", join(' ', grep($path2name->{$_} eq $name, keys %$path2name)), "\n"; return; } # Put off until as late as possible the expense of # actually reading the file: if( m/\.pod\z/is ) { # just assume it has pod, okay? } else { $progress and $progress->reach($self->{'_scan_count'}, "Scanning $file"); return unless $self->contains_pod( $file ); } ++ $self->{'_scan_count'}; # Or finally take note of it: if( $name2path->{$name} ) { $verbose and print "Duplicate POD found (shadowing?): $name ($file)\n", " Already seen in ", join(' ', grep($path2name->{$_} eq $name, keys %$path2name)), "\n"; } else { $name2path->{$name} = $file; # Noting just the first occurrence } $verbose and print " Noting $name = $file\n"; if( $callback ) { local $_ = $_; # insulate from changes, just in case $callback->($file, $name); } $path2name->{$file} = $name; return; } } #========================================================================== sub _path2modname { my($self, $file, $shortname, $modname_bits) = @_; # this code simplifies the POD name for Perl modules: # * remove "site_perl" # * remove e.g. "i586-linux" (from 'archname') # * remove e.g. 5.00503 # * remove pod/ if followed by perl*.pod (e.g. in pod/perlfunc.pod) # * dig into the file for case-preserved name if not already mixed case my @m = @$modname_bits; my $x; my $verbose = $self->verbose; # Shaving off leading naughty-bits while(@m and defined($x = lc( $m[0] )) and( $x eq 'site_perl' or($x eq 'pod' and @m == 1 and $shortname =~ m{^perl.*\.pod$}s ) or $x =~ m{\\d+\\.z\\d+([_.]?\\d+)?} # if looks like a vernum or $x eq lc( $Config::Config{'archname'} ) )) { shift @m } my $name = join '::', @m, $shortname; $self->_simplify_base($name); # On VMS, case-preserved document names can't be constructed from # filenames, so try to extract them from the "=head1 NAME" tag in the # file instead. if ($^O eq 'VMS' && ($name eq lc($name) || $name eq uc($name))) { open PODFILE, "<$file" or die "_path2modname: Can't open $file: $!"; my $in_pod = 0; my $in_name = 0; my $line; while ($line = ) { chomp $line; $in_pod = 1 if ($line =~ m/^=\w/); $in_pod = 0 if ($line =~ m/^=cut/); next unless $in_pod; # skip non-pod text next if ($line =~ m/^\s*\z/); # and blank lines next if ($in_pod && ($line =~ m/^X{'fs_recursion_maxdepth'} || 10; my $verbose = $self->verbose; my $here_string = File::Spec->curdir; my $up_string = File::Spec->updir; $modname_bits ||= []; my $recursor; $recursor = sub { my($dir_long, $dir_bare) = @_; if( @$modname_bits >= 10 ) { $verbose and print "Too deep! [@$modname_bits]\n"; return; } unless(-d $dir_long) { $verbose > 2 and print "But it's not a dir! $dir_long\n"; return; } unless( opendir(INDIR, $dir_long) ) { $verbose > 2 and print "Can't opendir $dir_long : $!\n"; closedir(INDIR); return } my @items = sort readdir(INDIR); closedir(INDIR); push @$modname_bits, $dir_bare unless $dir_bare eq ''; my $i_full; foreach my $i (@items) { next if $i eq $here_string or $i eq $up_string or $i eq ''; $i_full = File::Spec->catfile( $dir_long, $i ); if(!-r $i_full) { $verbose and print "Skipping unreadable $i_full\n"; } elsif(-f $i_full) { $_ = $i; $callback->( $i_full, $i, 0, $modname_bits ); } elsif(-d _) { $i =~ s/\.DIR\z//i if $^O eq 'VMS'; $_ = $i; my $rv = $callback->( $i_full, $i, 1, $modname_bits ) || ''; if($rv eq 'PRUNE') { $verbose > 1 and print "OK, pruning"; } else { # Otherwise, recurse into it $recursor->( File::Spec->catdir($dir_long, $i) , $i); } } else { $verbose > 1 and print "Skipping oddity $i_full\n"; } } pop @$modname_bits; return; };; local $_; $recursor->($startdir, ''); undef $recursor; # allow it to be GC'd return; } #========================================================================== sub run { # A function, useful in one-liners my $self = __PACKAGE__->new; $self->limit_glob($ARGV[0]) if @ARGV; $self->callback( sub { my($file, $name) = @_; my $version = ''; # Yes, I know we won't catch the version in like a File/Thing.pm # if we see File/Thing.pod first. That's just the way the # cookie crumbles. -- SMB if($file =~ m/\.pod$/i) { # Don't bother looking for $VERSION in .pod files DEBUG and print "Not looking for \$VERSION in .pod $file\n"; } elsif( !open(INPOD, $file) ) { DEBUG and print "Couldn't open $file: $!\n"; close(INPOD); } else { # Sane case: file is readable my $lines = 0; while() { last if $lines++ > $MAX_VERSION_WITHIN; # some degree of sanity if( s/^\s*\$VERSION\s*=\s*//s and m/\d/ ) { DEBUG and print "Found version line (#$lines): $_"; s/\s*\#.*//s; s/\;\s*$//s; s/\s+$//s; s/\t+/ /s; # nix tabs # Optimize the most common cases: $_ = "v$1" if m{^v?["']?([0-9_]+(\.[0-9_]+)*)["']?$}s # like in $VERSION = "3.14159"; or m{\$Revision:\s*([0-9_]+(?:\.[0-9_]+)*)\s*\$}s # like in sprintf("%d.%02d", q$Revision: 4.13 $ =~ /(\d+)\.(\d+)/); ; # Like in sprintf("%d.%s", map {s/_//g; $_} q$Name: release-0_55-public $ =~ /-(\d+)_([\d_]+)/) $_ = sprintf("v%d.%s", map {s/_//g; $_} $1 =~ m/-(\d+)_([\d_]+)/) # snare just the numeric part if m{\$Name:\s*([^\$]+)\$}s ; $version = $_; DEBUG and print "Noting $version as version\n"; last; } } close(INPOD); } print "$name\t$version\t$file\n"; return; # End of callback! }); $self->survey; } #========================================================================== sub simplify_name { my($self, $str) = @_; # Remove all path components # XXX Why not just use basename()? -- SMB if ($^O eq 'MacOS') { $str =~ s{^.*:+}{}s } else { $str =~ s{^.*/+}{}s } $self->_simplify_base($str); return $str; } #========================================================================== sub _simplify_base { # Internal method only # strip Perl's own extensions $_[1] =~ s/\.(pod|pm|plx?)\z//i; # strip meaningless extensions on Win32 and OS/2 $_[1] =~ s/\.(bat|exe|cmd)\z//i if $^O =~ /mswin|os2/i; # strip meaningless extensions on VMS $_[1] =~ s/\.(com)\z//i if $^O eq 'VMS'; return; } #========================================================================== sub _expand_inc { my($self, $search_dirs) = @_; return unless $self->{'inc'}; if ($^O eq 'MacOS') { push @$search_dirs, grep $_ ne File::Spec->curdir, $self->_mac_whammy(@INC); # Any other OSs need custom handling here? } else { push @$search_dirs, grep $_ ne File::Spec->curdir, @INC; } $self->{'laborious'} = 0; # Since inc said to use INC return; } #========================================================================== sub _mac_whammy { # Tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS my @them; (undef,@them) = @_; for $_ (@them) { if ( $_ eq '.' ) { $_ = ':'; } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) { $_ = ':'. $_; } else { $_ =~ s|^\./|:|; } } return @them; } #========================================================================== sub _limit_glob_to_limit_re { my $self = $_[0]; my $limit_glob = $self->{'limit_glob'} || return; my $limit_re = '^' . quotemeta($limit_glob) . '$'; $limit_re =~ s/\\\?/./g; # glob "?" => "." $limit_re =~ s/\\\*/.*?/g; # glob "*" => ".*?" $limit_re =~ s/\.\*\?\$$//s; # final glob "*" => ".*?$" => "" $self->{'verbose'} and print "Turning limit_glob $limit_glob into re $limit_re\n"; # A common optimization: if(!exists($self->{'dir_prefix'}) and $limit_glob =~ m/^(?:\w+\:\:)+/s # like "File::*" or "File::Thing*" # Optimize for sane and common cases (but not things like "*::File") ) { $self->{'dir_prefix'} = join "::", $limit_glob =~ m/^(?:\w+::)+/sg; $self->{'verbose'} and print " and setting dir_prefix to $self->{'dir_prefix'}\n"; } return $limit_re; } #========================================================================== # contribution mostly from Tim Jenness sub find { my($self, $pod, @search_dirs) = @_; $self = $self->new unless ref $self; # tolerate being a class method # Check usage Carp::carp 'Usage: \$self->find($podname, ...)' unless defined $pod and length $pod; my $verbose = $self->verbose; # Split on :: and then join the name together using File::Spec my @parts = split /::/, $pod; $verbose and print "Chomping {$pod} => {@parts}\n"; #@search_dirs = File::Spec->curdir unless @search_dirs; if( $self->inc ) { if( $^O eq 'MacOS' ) { push @search_dirs, $self->_mac_whammy(@INC); } else { push @search_dirs, @INC; } # Add location of pod documentation for perl man pages (eg perlfunc) # This is a pod directory in the private install tree #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'}, # 'pod'); #push (@search_dirs, $perlpoddir) # if -d $perlpoddir; # Add location of binaries such as pod2text: push @search_dirs, $Config::Config{'scriptdir'}; # and if that's undef or q{} or nonexistent, we just ignore it later } my %seen_dir; Dir: foreach my $dir ( @search_dirs ) { next unless defined $dir and length $dir; next if $seen_dir{$dir}; $seen_dir{$dir} = 1; unless(-d $dir) { print "Directory $dir does not exist\n" if $verbose; next Dir; } print "Looking in directory $dir\n" if $verbose; my $fullname = File::Spec->catfile( $dir, @parts ); print "Filename is now $fullname\n" if $verbose; foreach my $ext ('', '.pod', '.pm', '.pl') { # possible extensions my $fullext = $fullname . $ext; if( -f $fullext and $self->contains_pod( $fullext ) ){ print "FOUND: $fullext\n" if $verbose; return $fullext; } } my $subdir = File::Spec->catdir($dir,'pod'); if(-d $subdir) { # slip in the ./pod dir too $verbose and print "Noticing $subdir and stopping there...\n"; $dir = $subdir; redo Dir; } } return undef; } #========================================================================== sub contains_pod { my($self, $file) = @_; my $verbose = $self->{'verbose'}; # check for one line of POD $verbose > 1 and print " Scanning $file for pod...\n"; unless( open(MAYBEPOD,"<$file") ) { print "Error: $file is unreadable: $!\n"; return undef; } sleep($SLEEPY - 1) if $SLEEPY; # avoid totally hogging the processor on OSs with poor process control local $_; while( ) { if(m/^=(head\d|pod|over|item)\b/s) { close(MAYBEPOD) || die "Bizarre error closing $file: $!\nAborting"; chomp; $verbose > 1 and print " Found some pod ($_) in $file\n"; return 1; } } close(MAYBEPOD) || die "Bizarre error closing $file: $!\nAborting"; $verbose > 1 and print " No POD in $file, skipping.\n"; return 0; } #========================================================================== sub _accessorize { # A simple-minded method-maker shift; no strict 'refs'; foreach my $attrname (@_) { *{caller() . '::' . $attrname} = sub { use strict; $Carp::CarpLevel = 1, Carp::croak( "Accessor usage: \$obj->$attrname() or \$obj->$attrname(\$new_value)" ) unless (@_ == 1 or @_ == 2) and ref $_[0]; # Read access: return $_[0]->{$attrname} if @_ == 1; # Write access: $_[0]->{$attrname} = $_[1]; return $_[0]; # RETURNS MYSELF! }; } # Ya know, they say accessories make the ensemble! return; } #========================================================================== sub _state_as_string { my $self = $_[0]; return '' unless ref $self; my @out = "{\n # State of $self ...\n"; foreach my $k (sort keys %$self) { push @out, " ", _esc($k), " => ", _esc($self->{$k}), ",\n"; } push @out, "}\n"; my $x = join '', @out; $x =~ s/^/#/mg; return $x; } sub _esc { my $in = $_[0]; return 'undef' unless defined $in; $in =~ s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])> <'\\x'.(unpack("H2",$1))>eg; return qq{"$in"}; } #========================================================================== run() unless caller; # run if "perl whatever/Search.pm" 1; #========================================================================== __END__ =head1 NAME Pod::Simple::Search - find POD documents in directory trees =head1 SYNOPSIS use Pod::Simple::Search; my $name2path = Pod::Simple::Search->new->limit_glob('LWP::*')->survey; print "Looky see what I found: ", join(' ', sort keys %$name2path), "\n"; print "LWPUA docs = ", Pod::Simple::Search->new->find('LWP::UserAgent') || "?", "\n"; =head1 DESCRIPTION B is a class that you use for running searches for Pod files. An object of this class has several attributes (mostly options for controlling search options), and some methods for searching based on those attributes. The way to use this class is to make a new object of this class, set any options, and then call one of the search options (probably C or C). The sections below discuss the syntaxes for doing all that. =head1 CONSTRUCTOR This class provides the one constructor, called C. It takes no parameters: use Pod::Simple::Search; my $search = Pod::Simple::Search->new; =head1 ACCESSORS This class defines several methods for setting (and, occasionally, reading) the contents of an object. With two exceptions (discussed at the end of this section), these attributes are just for controlling the way searches are carried out. Note that each of these return C<$self> when you call them as C<< $self->I >>. That's so that you can chain together set-attribute calls like this: my $name2path = Pod::Simple::Search->new -> inc(0) -> verbose(1) -> callback(\&blab) ->survey(@there); ...which works exactly as if you'd done this: my $search = Pod::Simple::Search->new; $search->inc(0); $search->verbose(1); $search->callback(\&blab); my $name2path = $search->survey(@there); =over =item $search->inc( I ); This attribute, if set to a true value, means that searches should implicitly add perl's I<@INC> paths. This automatically considers paths specified in the C environment as this is prepended to I<@INC> by the Perl interpreter itself. This attribute's default value is B. If you want to search only specific directories, set $self->inc(0) before calling $inc->survey or $inc->find. =item $search->verbose( I ); This attribute, if set to a nonzero positive value, will make searches output (via C) notes about what they're doing as they do it. This option may be useful for debugging a pod-related module. This attribute's default value is zero, meaning that no C messages are produced. (Setting verbose to 1 turns on some messages, and setting it to 2 turns on even more messages, i.e., makes the following search(es) even more verbose than 1 would make them.) =item $search->limit_glob( I ); This option means that you want to limit the results just to items whose podnames match the given glob/wildcard expression. For example, you might limit your search to just "LWP::*", to search only for modules starting with "LWP::*" (but not including the module "LWP" itself); or you might limit your search to "LW*" to see only modules whose (full) names begin with "LW"; or you might search for "*Find*" to search for all modules with "Find" somewhere in their full name. (You can also use "?" in a glob expression; so "DB?" will match "DBI" and "DBD".) =item $search->callback( I<\&some_routine> ); This attribute means that every time this search sees a matching Pod file, it should call this callback routine. The routine is called with two parameters: the current file's filespec, and its pod name. (For example: C<("/etc/perljunk/File/Crunk.pm", "File::Crunk")> would be in C<@_>.) The callback routine's return value is not used for anything. This attribute's default value is false, meaning that no callback is called. =item $search->laborious( I ); Unless you set this attribute to a true value, Pod::Search will apply Perl-specific heuristics to find the correct module PODs quickly. This attribute's default value is false. You won't normally need to set this to true. Specifically: Turning on this option will disable the heuristics for seeing only files with Perl-like extensions, omitting subdirectories that are numeric but do I match the current Perl interpreter's version ID, suppressing F as a module hierarchy name, etc. =item $search->shadows( I ); Unless you set this attribute to a true value, Pod::Simple::Search will consider only the first file of a given modulename as it looks thru the specified directories; that is, with this option off, if Pod::Simple::Search has seen a C already in this search, then it won't bother looking at a C later on in that search, because that file is merely a "shadow". But if you turn on C<< $self->shadows(1) >>, then these "shadow" files are inspected too, and are noted in the pathname2podname return hash. This attribute's default value is false; and normally you won't need to turn it on. =item $search->limit_re( I ); Setting this attribute (to a value that's a regexp) means that you want to limit the results just to items whose podnames match the given regexp. Normally this option is not needed, and the more efficient C attribute is used instead. =item $search->dir_prefix( I ); Setting this attribute to a string value means that the searches should begin in the specified subdirectory name (like "Pod" or "File::Find", also expressable as "File/Find"). For example, the search option C<< $search->limit_glob("File::Find::R*") >> is the same as the combination of the search options C<< $search->limit_re("^File::Find::R") -> dir_prefix("File::Find") >>. Normally you don't need to know about the C option, but I include it in case it might prove useful for someone somewhere. (Implementationally, searching with limit_glob ends up setting limit_re and usually dir_prefix.) =item $search->progress( I ); If you set a value for this attribute, the value is expected to be an object (probably of a class that you define) that has a C method and a C method. This is meant for reporting progress during the search, if you don't want to use a simple callback. Normally you don't need to know about the C option, but I include it in case it might prove useful for someone somewhere. While a search is in progress, the progress object's C and C methods are called like this: # Every time a file is being scanned for pod: $progress->reach($count, "Scanning $file"); ++$count; # And then at the end of the search: $progress->done("Noted $count Pod files total"); Internally, we often set this to an object of class Pod::Simple::Progress. That class is probably undocumented, but you may wish to look at its source. =item $name2path = $self->name2path; This attribute is not a search parameter, but is used to report the result of C method, as discussed in the next section. =item $path2name = $self->path2name; This attribute is not a search parameter, but is used to report the result of C method, as discussed in the next section. =back =head1 MAIN SEARCH METHODS Once you've actually set any options you want (if any), you can go ahead and use the following methods to search for Pod files in particular ways. =head2 C<< $search->survey( @directories ) >> The method C searches for POD documents in a given set of files and/or directories. This runs the search according to the various options set by the accessors above. (For example, if the C attribute is on, as it is by default, then the perl @INC directories are implicitly added to the list of directories (if any) that you specify.) The return value of C is two hashes: =over =item C A hash that maps from each pod-name to the filespec (like "Stuff::Thing" => "/whatever/plib/Stuff/Thing.pm") =item C A hash that maps from each Pod filespec to its pod-name (like "/whatever/plib/Stuff/Thing.pm" => "Stuff::Thing") =back Besides saving these hashes as the hashref attributes C and C, calling this function also returns these hashrefs. In list context, the return value of C<< $search->survey >> is the list C<(\%name2path, \%path2name)>. In scalar context, the return value is C<\%name2path>. Or you can just call this in void context. Regardless of calling context, calling C saves its results in its C and C attributes. E.g., when searching in F<$HOME/perl5lib>, the file F<$HOME/perl5lib/MyModule.pm> would get the POD name I, whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be I. The name information can be used for POD translators. Only text files containing at least one valid POD command are found. In verbose mode, a warning is printed if shadows are found (i.e., more than one POD file with the same POD name is found, e.g. F in different directories). This usually indicates duplicate occurrences of modules in the I<@INC> search path, which is occasionally inadvertent (but is often simply a case of a user's path dir having a more recent version than the system's general path dirs in general.) The options to this argument is a list of either directories that are searched recursively, or files. (Usually you wouldn't specify files, but just dirs.) Or you can just specify an empty-list, as in $name2path; with the C option on, as it is by default, teh The POD names of files are the plain basenames with any Perl-like extension (.pm, .pl, .pod) stripped, and path separators replaced by C<::>'s. Calling Pod::Simple::Search->search(...) is short for Pod::Simple::Search->new->search(...). That is, a throwaway object with default attribute values is used. =head2 C<< $search->simplify_name( $str ) >> The method B is equivalent to B, but also strips Perl-like extensions (.pm, .pl, .pod) and extensions like F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively. =head2 C<< $search->find( $pod ) >> =head2 C<< $search->find( $pod, @search_dirs ) >> Returns the location of a Pod file, given a Pod/module/script name (like "Foo::Bar" or "perlvar" or "perldoc"), and an idea of what files/directories to look in. It searches according to the various options set by the accessors above. (For example, if the C attribute is on, as it is by default, then the perl @INC directories are implicitly added to the list of directories (if any) that you specify.) This returns the full path of the first occurrence to the file. Package names (eg 'A::B') are automatically converted to directory names in the selected directory. Additionally, '.pm', '.pl' and '.pod' are automatically appended to the search as required. (So, for example, under Unix, "A::B" is converted to "somedir/A/B.pm", "somedir/A/B.pod", or "somedir/A/B.pl", as appropriate.) If no such Pod file is found, this method returns undef. If any of the given search directories contains a F subdirectory, then it is searched. (That's how we manage to find F, for example, which is usually in F in most Perl dists.) The C and C attributes influence the behavior of this search; notably, C, if true, adds @INC I to the list of directories to search. It is common to simply say C<< $filename = Pod::Simple::Search-> new ->find("perlvar") >> so that just the @INC (well, and scriptdir) directories are searched. (This happens because the C attribute is true by default.) Calling Pod::Simple::Search->find(...) is short for Pod::Simple::Search->new->find(...). That is, a throwaway object with default attribute values is used. =head2 C<< $self->contains_pod( $file ) >> Returns true if the supplied filename (not POD module) contains some Pod documentation. =head1 SUPPORT Questions or discussion about POD and Pod::Simple should be sent to the pod-people@perl.org mail list. Send an empty email to pod-people-subscribe@perl.org to subscribe. This module is managed in an open GitHub repository, L. Feel free to fork and contribute, or to clone L and send patches! Patches against Pod::Simple are welcome. Please send bug reports to . =head1 COPYRIGHT AND DISCLAIMERS Copyright (c) 2002 Sean M. Burke. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. =head1 AUTHOR Pod::Simple was created by Sean M. Burke with code borrowed from Marek Rouchal's L, which in turn heavily borrowed code from Nick Ing-Simmons' C. But don't bother him, he's retired. Pod::Simple is maintained by: =over =item * Allison Randal C =item * Hans Dieter Pearcey C =item * David E. Wheeler C =back =cut gdb-pp-load.py000644000765000765 40011567202626 17050 0ustar00brucebruce000000000000parrot-5.9.0/tools/dev# Copyright (C) 2011, Parrot Foundation. import gdb.printing import sys if not 'blib/lib' in sys.path: sys.path.append('blib/lib') from GDBPrettyPrint import ParrotPrinter gdb.printing.register_pretty_printer(gdb.current_objfile(), ParrotPrinter()) Replay.pir000644000765000765 1025611533177636 22412 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library/Stream =head1 TITLE Stream;Replay - replayable Stream =head1 VERSION version 0.1 =head1 SYNOPSIS load_bytecode 'Stream/Replay.pbc' $P0 = new ['Stream'; 'Replay'] assign $P0, other_stream # .. read from $P0 .. $P1 = clone $P0 # .. read further .. $P0 = $P1 # now, if you read from $P0, you get the same data as after the clone =head1 DESCRIPTION By using C, you can read data from a stream as often as you want. =head1 METHODS =over 4 =cut .namespace ['Stream'; 'Replay'] .sub onload :load :anon $P0 = get_class ['Stream'; 'Replay'] unless null $P0 goto END load_bytecode 'Stream/Base.pbc' # Stream;Replay get_class $P0, ['Stream'; 'Base'] subclass $P0, $P0, ['Stream'; 'Replay'] addattribute $P0, "replay_buffer" addattribute $P0, "pos" # Stream;Replay;Buffer newclass $P0, ['Stream'; 'Replay'; 'Buffer'] addattribute $P0, "strings" addattribute $P0, "clones" END: .end =item init ... =cut .sub init :vtable :method .local pmc temp temp = new 'Integer' setattribute self, 'pos', temp .end =item assign stream, source ... =cut .sub set_pmc :vtable :method .param pmc val .local pmc buffer isa $I0, val, ['Stream'; 'Replay'] unless $I0 goto NOTA # get the buffer getattribute buffer, val, 'replay_buffer' # add us to the buffer buffer."add"( self ) # store the buffer setattribute self, 'replay_buffer', buffer # get the position getattribute $P0, val, 'pos' $P0 = clone $P0 # set the position setattribute val, 'pos', $P0 # assign the source val = val."source"() goto ASSIGN NOTA: buffer = new ['Stream'; 'Replay'; 'Buffer'] setattribute self, 'replay_buffer', buffer ASSIGN: self."setSource"( val ) .end =item stream."rawRead"() (B) ... =cut .sub rawRead :method .local pmc source .local pmc buffer .local pmc pos .local string ret null ret source = self."source"() if_null source, END getattribute buffer, self, 'replay_buffer' if_null buffer, END getattribute pos, self, 'pos' ret = buffer."read"( pos, source ) END: .return(ret) .end =item stream2 = clone stream ... =cut .sub clone :vtable :method .local pmc ret .local pmc temp ret = new ['Stream'; 'Replay'] assign ret, self $P0 = self."byte_buffer"() if_null $P0, END $P0 = clone $P0 ret."byte_buffer"( $P0 ) END: .return(ret) .end .namespace ['Stream'; 'Replay'; 'Buffer'] .sub init :vtable :method .local pmc temp temp = new 'ResizableStringArray' setattribute self, 'strings', temp temp = new 'ResizablePMCArray' setattribute self, 'clones', temp .end .sub compact :method # XXX check the begin of the queue for stale entries noop .end .sub read :method .param pmc pos .param pmc source .local string ret .local pmc strings .local pmc clones null ret $I0 = defined source unless $I0 goto END getattribute strings, self, 'strings' getattribute clones, self, 'clones' $I0 = clones if $I0 <= 1 goto READ_SOURCE $I0 = pos $I1 = strings if $I0 >= $I1 goto READ_SOURCE ret = strings[$I0] inc pos branch END READ_SOURCE: ret = source."read"() $I0 = clones if $I0 <= 1 goto END inc pos push strings, ret END: .return(ret) .end .sub add :method .param pmc stream .local pmc clones getattribute clones, self, 'clones' push clones, stream .end .sub remove :method .param pmc stream .local pmc clones .local pmc entry .local int i .local int j getattribute clones, self, 'clones' i = 0 j = clones LOOP: if i >= j goto END entry = clones[i] null entry clones[i] = entry ne_addr entry, stream, NEXT NEXT: inc i branch LOOP END: .end =back =head1 AUTHOR Jens Rieks Eparrot at jensbeimsurfen dot deE is the author and maintainer. Please send patches and suggestions to the Perl 6 Internals mailing list. =head1 COPYRIGHT Copyright (C) 2004-2009, Parrot Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: past.t000644000765000765 155211533177644 15744 0ustar00brucebruce000000000000parrot-5.9.0/t/examples#!perl # Copyright (C) 2006-2007, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Parrot::Test tests => 2; =head1 NAME t/examples/past.t - Test examples in F =head1 SYNOPSIS % prove t/examples/past.t % prove -v t/examples/past.t =head1 DESCRIPTION Test the examples in F. =head1 SEE ALSO F =head1 AUTHOR Bernhard Schmalhofer - =cut # Set up expected output for examples # A stub for future PAST examples my %expected = ( '01-sub.pir' => "5\n", 'four_plus_one.pir' => "5\n", ); while ( my ( $example, $expected ) = each %expected ) { example_output_is( "examples/past/$example", $expected ); } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: Parrot_Distribution.t000644000765000765 652111533177645 20131 0ustar00brucebruce000000000000parrot-5.9.0/t/perl#! perl # Copyright (C) 2001-2009, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More tests => 26; use File::Spec; =head1 NAME t/perl/Parrot_Distribution.t - Parrot::Distribution unit tests =head1 SYNOPSIS % prove t/perl/Parrot_Distribution.t =head1 DESCRIPTION Test individual Parrot::Distribution methods. =cut BEGIN { use_ok('Parrot::Distribution') } die "Run these tests from the distribution root\n" unless -d 't/perl'; # search upwards chdir 't/perl'; my $d = Parrot::Distribution->new(); isa_ok( $d, 'Parrot::Docs::Directory' ); ok( $d == Parrot::Distribution->new(), 'Parrot::Distribution is a singleton' ); ok( $d->c_source_file_with_name('pf_items'), 'C source file' ); ok( !$d->c_source_file_with_name('moomoo'), 'C source file not there' ); ok( $d->c_header_file_with_name('parrot'), 'C header file' ); ok( !$d->c_header_file_with_name('moomoo'), 'C header file not there' ); ok( $d->pmc_source_file_with_name('parrotinterpreter'), 'PMC code' ); ok( !$d->pmc_source_file_with_name('moomoo'), 'PMC code file not there' ); ok( $d->yacc_source_file_with_name('imcc'), 'Yacc code' ); ok( !$d->yacc_source_file_with_name('moomoo'), 'Yacc code file not there' ); ok( $d->lex_source_file_with_name('imcc'), 'Lex code' ); ok( !$d->lex_source_file_with_name('moomoo'), 'Lex code file not there' ); ok( $d->file_for_perl_module('Parrot::Docs::Section::Parrot'), 'Perl module file' ); ok( !$d->file_for_perl_module('Parrot::Dummy'), 'Perl module file not there' ); my %pmc_source_file_directories = map { $_->path => 1 } $d->pmc_source_file_directories(); my @old_directory_list = ( map { File::Spec->catdir( 'src', $_ ) } qw(dynpmc pmc) ); for my $dir (@old_directory_list) { my $path = $d->directory_with_name($dir)->path(); ok( exists $pmc_source_file_directories{$path}, "Directory from hardcoded list $dir found through MANIFEST" ) or diag( "Missing $dir\n" ); } ## perl files and exemptions { my @perl_files = $d->get_perl_language_files(); ok( @perl_files, 'Got some perl files' ); ok( $d->perl_source_file_with_name('ops2c.pl'), 'Perl source file (.pl)' ); ok( $d->perl_source_file_with_name('Distribution.pm'), 'Perl source file (.pm)' ); ok( $d->perl_source_file_with_name('perlcritic.t'), 'Perl source file (.t)' ); ok( !$d->perl_source_file_with_name('p5rx.t'), 'Not a Perl source file (.t)' ); my $perl_exemption_regexp = $d->get_perl_exemption_regexp(); ok( $perl_exemption_regexp, 'Got perl exemption regexp' ); # we are in 't/perl' { my $dummy_fn = '../../lib/DumbLink.pm'; my $not_exempted_file = Parrot::IO::File->new($dummy_fn); ok( !$d->is_perl_exemption($not_exempted_file), 'DumbLink.pm is not exempted' ); unlike( $not_exempted_file->path(), $perl_exemption_regexp, 'DumbLink.pm is not matched' ); unlink $dummy_fn; } # check that no exemptions turn up in the main file list my @exemptions_in_perl_list = grep { $_ =~ $perl_exemption_regexp } map { $_->path } @perl_files; ok( !@exemptions_in_perl_list, 'No exemptions in Perl source list' ); foreach (@exemptions_in_perl_list) { diag("got exempted perl file: $_"); } } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: api.c000644000765000765 513311716253436 15000 0ustar00brucebruce000000000000parrot-5.9.0/src/nci/* Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME src/nci/api.c - Native Call Interface routines =head1 DESCRIPTION This file implements the interface to the Parrot Native Call Interface system, which builds parrot to C call frames. =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" #include "parrot/nci.h" #include "api.str" /* HEADERIZER HFILE: include/parrot/nci.h */ /* =item C This function serves a single purpose. It takes the function signature for a C function we want to call and returns a PMC with a pointer to a function that can call it. =cut */ PARROT_CANNOT_RETURN_NULL PMC * build_call_func(PARROT_INTERP, ARGIN(PMC *sig)) { ASSERT_ARGS(build_call_func) PMC * const iglobals = interp->iglobals; PMC *nci_funcs; PMC *thunk; if (PMC_IS_NULL(iglobals)) PANIC(interp, "iglobals isn't created yet"); nci_funcs = VTABLE_get_pmc_keyed_int(interp, iglobals, IGLOBALS_NCI_FUNCS); if (PMC_IS_NULL(nci_funcs)) PANIC(interp, "iglobals.nci_funcs isn't created_yet"); /* signatures are FIA internally */ if (sig->vtable->base_type != enum_class_FixedIntegerArray) { size_t i; size_t n = VTABLE_elements(interp, sig); PMC *new_sig = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, new_sig, i, VTABLE_get_integer_keyed_int(interp, sig, i)); sig = new_sig; } thunk = VTABLE_get_pmc_keyed(interp, nci_funcs, sig); if (PMC_IS_NULL(thunk)) { /* try to dynamically build a thunk */ PMC * const nci_fb_cb = VTABLE_get_pmc_keyed_int(interp, iglobals, IGLOBALS_NCI_FB_CB); if (!PMC_IS_NULL(nci_fb_cb)) { void * const cb_ptr = VTABLE_get_pointer(interp, nci_fb_cb); const nci_fb_func_t cb = (nci_fb_func_t)D2FPTR(cb_ptr); if (cb_ptr) { PMC * const nci_fb_ud = VTABLE_get_pmc_keyed_int(interp, iglobals, IGLOBALS_NCI_FB_UD); thunk = cb(interp, nci_fb_ud, sig); } } } if (!PMC_IS_NULL(thunk)) { PARROT_ASSERT(thunk->vtable); return thunk; } Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED, "No NCI thunk available for signature `%Ss'", Parrot_nci_describe_sig(interp, sig)); } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ ch04_pge.pod000644000765000765 11414611631440401 17317 0ustar00brucebruce000000000000parrot-5.9.0/docs/book/pct=pod =head1 Grammar Engine X X The Parrot Grammar Engine (PGE) is a parser generator, one of the key components of the Parrot Compiler Toolkit. It reads grammar files written in the PGE rules format and generates parser modules written in PIR code. PGE rules provide the full power of I and I. Fortunately, you don't need to know what those terms mean in order to make good use of PGE. We'll introduce the necessary concepts as we talk about various features in this chapter. =head2 Grammars The ultimate goal of a parser is to match patterns in a source language and convert them to an internal data structure for later manipulations. As a programmer, you're probably already familiar with some of these types of patterns: function declarations, function calls, statements, and assignments. Each of these different concepts have a particular form called a I. In C for example, the syntax to define a function looks something like this: ( ) { } Things that fit this pattern, so long as all the sub-patterns use the proper syntax also, are valid subroutines in C. Similarly, we can use a slightly different pattern to create a subroutine: sub { } A grammar is a collection of rules like the ones above that specify all the acceptable patterns in a language. Grammars group together these rules in much the same way that a class groups together related data fields and methods N. Each rule defines a pattern for matching one unit of text, and can be made up of various other rules which are called recursively to make a complete match. A rule can contain regular expressions to match patterns of characters: rule id { \d+ } A rule can also contain patterns of references to other rules: rule record { } A grammar contains a group of rules that work together to match the entire language: grammar Contacts; rule name { 'John' | 'Bob ' | 'Fred' } rule id { \d+ } rule record { } ... =head3 Rules and Tokens X X There are two different kinds of rules: C, which we saw above, and C. A C performs smart whitespace matching between the various pieces of the pattern. The C rule given previously would match 6355 John or 6355 John but not 6355John A C matches whitespace only if you specifically request it. To get the same effect with a token, add the C<\s> (match a space character) and C<+> (match the preceding atom -- the space character, in this case -- one or more times) pattern to the rule: token record { \s+ } =head3 The Start Rule X X A recursive descent parser is what's called a I. It starts at the highest-level rule, called C, and works its way down through individual rules to match an entire string or file. Real Perl 6 allows any name for the top-level rule, but PCT expects a rule called C. If PCT was as fully-featured as Perl 6, people would use it instead! Here's an example of a TOP rule: rule TOP { } This rule matches a single C pattern in a string or file. Once the parser has succeeded in matching the entire string or file passed to the start rule, it returns a parse tree. If it cannot match the entire input with the rules provided, it can either return a partial match, or it can throw a parse error. =head3 Testing a Grammar Let's do a small example grammar. Save this example to a file called F: grammar Contacts is PGE::Grammar; rule TOP { } rule record { } token name { 'John' | 'Bob ' | 'Fred' } token id { \d+ } Then compile the grammar: $ parrot Perl6Grammar.pbc --output=Contacts.pir Contacts.pg =for author Assume an installed Parrot for all examples? Anyone working from the source tree should be able to mangle paths appropriately. =end for The path to F and to the F file will vary on different systems. If you compiled Parrot from source, it will be: $ ./parrot runtime/parrot/library/PGE/Perl6Grammar.pbc \ --output=Contacts.pir Contacts.pg Next, create a small PIR script to run your grammar. Save it as F: =begin PIR .sub main :main load_bytecode 'PGE.pbc' # load some required modules load_bytecode 'dumper.pbc' load_bytecode 'PGE/Dumper.pbc' load_bytecode 'Contacts.pir' # load your grammar .local string source source = "3 John" .local pmc top, grammar, match top = get_hll_global ['Contacts'], 'TOP' grammar = get_class 'Contacts' match = top(source, 'grammar' => grammar) _dumper(match, "match") .end =end PIR Run the test script: $ parrot grammar_test.pir It will print out a text representation of the raw parse tree stored in the C variable: "match" => PMC 'Contacts' => "3 John" @ 0 { => PMC 'Contacts' => "3 John" @ 0 { => PMC 'Contacts' => "3" @ 0 => PMC 'Contacts' => "John" @ 2 } } Each node in the tree corresponds to a rule in the grammar. The top-level match variable contains one child named C, which contains two children named C and C. C contains the number 3, and C contains the string "John". This is exactly what the simple grammar should have matched. =head2 Rule Syntax Every language has a set of basic components (words or parts of words) and syntax conventions for combining them. The "words" in rules are literal characters or symbols, some X metacharacters (or metasymbols), and XX escape sequences, while the combining syntax includes other metacharacters, X X quantifiers, bracketing characters, and assertions. =head3 Metacharacters The C<.> metacharacter matches any single character, even a newline character. The C<^> and C<$> metacharacters are zero-width matches which represent the beginning and end of a string. They each have doubled alternates C<^^> and C<$$> that match at the beginning and end of every (newline-delimited) line within a string. The C<|>, C<&>, C<\>, C<#>, and C<:=> metacharacters are all syntax structure elements. C<|> alternates between two options. C<&> matches two patterns simultaneously (the patterns must be the same length). C<\> turns literal characters into metacharacters (producing escape sequences). C<#> starts a comment which proceeds until the end of the line. You can start a comment at any point on any line in a rule. C<:=> binds a hypothetical variable to the result of a subrule or grouped pattern (see L). The metacharacters C<()>, C<[]>, C<{}> and CE> are bracketing pairs. Bracketing pairs must always be balanced within the rule; to use a literal character, escape it with a C<\>. The C<()> and C<[]> pairs group patterns as a single atom. They often capture a result, mark the boundaries of an alternation, or mark a group of patterns with a quantifier. Parentheses C<()> capture, but square brackets C<[]> do not. The C<{}> brackets define a section of code (a closure) within a rule. These closures are always a successful zero-width match. The C...E> brackets mark assertions, which handle a variety of constructs including character classes and user-defined quantifiers (see L). Table 7-2 summarizes the basic metacharacters. =begin table picture Metacharacters Z =headrow =row =cell Symbol =cell Meaning =bodyrows =row =cell C<.> =cell Match any single character, including a newline. X<. (dot);. match single character (rules)> =row =cell C<^> =cell Match the beginning of a string. X<^ (caret);^ beginning of string (rules)> =row =cell C<$> =cell Match the end of a string. X<$ (dollar sign);$ end of string (rules)> =row =cell C<^^> =cell Match the beginning of a line within the string. X<^ (caret);^^ beginning of line (rules)> =row =cell C<$$> =cell Match the end of a line within the string. X<$ (dollar sign);$$ end of line (rules)> =row =cell C<|> =cell Match alternate patterns (OR). =row =cell C<&> =cell Match multiple patterns (AND). =row =cell C<\> =cell Escape a metacharacter to get a literal character, or escape a literal character to get a metacharacter. X<\ (backslash);\ escape sequences (rules)> X<\ (backslash);\ to escape metacharacters (rules)> =row =cell C<#> =cell Mark a comment (to the end of the line). =row =cell C<:=> =cell Bind the result of a match to a hypothetical variable. X<: (colon);:= (binding);in rules> =row =cell C<(...)> =cell Group patterns and capture the result. =row =cell C<[...]> =cell Group patterns without capturing. =row =cell C<{...}> =cell Execute a closure (Perl 6 code) within a rule. =row =cell C...E> =cell Match an assertion. =end table =head3 Escape Sequences Z X X X<\ (backslash);\ escape sequences (rules)> Escape sequences are literal characters acting as metacharacters. A preceding backslash (C<\>) identifies them as escapes. Some escape sequences represent single characters that are difficult to represent literally, such as C<\t> for tab, or C<\x[...]> to specify a character by its hexadecimal number. Some represent limited character classes, such as C<\d> for digits or C<\w> for word characters. Some represent zero-width positions in a match, such as C<\b> for a word boundary. X X If you've used Perl 5 regexps, you may remember the C<\Q> escape sequence which treats everything until the following C<\E> sequence as literal text, containing no escape sequences. Because ordinary variables now interpolate as literal strings by default, the C<\Q> escape sequence is rarely needed. ATable 7-3 shows the escape sequences for rules. =begin table picture Escape sequences Z =headrow =row =cell Escape =cell Meaning =bodyrows =row =cell C<\0[...]> =cell Match a character given in octal (brackets optional). =row =cell C<\b> =cell Match a word boundary. =row =cell C<\B> =cell Match when not on a word boundary. =row =cell C<\c[...]> =cell Match a named character or control character. =row =cell C<\C[...]> =cell Match any character except the bracketed named or control character. =row =cell C<\d> =cell Match a digit. =row =cell C<\D> =cell Match a non-digit. =row =cell C<\e> =cell Match an escape character. =row =cell C<\E> =cell Match anything but an escape character. =row =cell C<\f> =cell Match the form feed character. =row =cell C<\F> =cell Match anything but a form feed. =row =cell C<\n> =cell Match a (logical) newline. =row =cell C<\N> =cell Match anything but a (logical) newline. =row =cell C<\h> =cell Match horizontal whitespace. =row =cell C<\H> =cell Match anything but horizontal whitespace. =row =cell C<\L[...]> =cell Everything within the brackets is lowercase. =row =cell C<\Q[...]> =cell All metacharacters within the brackets match as literal characters. =row =cell C<\r> =cell Match a return. =row =cell C<\R> =cell Match anything but a return. =row =cell C<\s> =cell Match any whitespace character. =row =cell C<\S> =cell Match anything but whitespace. =row =cell C<\t> =cell Match a tab. =row =cell C<\T> =cell Match anything but a tab. =row =cell C<\U[...]> =cell Everything within the brackets is uppercase. =row =cell C<\v> =cell Match vertical whitespace. =row =cell C<\V> =cell Match anything but vertical whitespace. =row =cell C<\w> =cell Match a word character (Unicode alphanumeric characters plus the underscore C<_>). =row =cell C<\W> =cell Match anything but a word character. =row =cell C<\x[...]> =cell Match a character given in hexadecimal (brackets optional). =row =cell C<\X[...]> =cell Match anything but the character given in hexadecimal (brackets optional). =end table =head3 Quantifiers Z Quantifiers specify the number of times an atom (a single character, metacharacter, escape sequence, grouped pattern, assertion, etc) will match. X<. (dot);.. (range);quantifier (rules)> X<. (dot);... (infinite range);quantifier (rules)> The numeric quantifiers use assertion syntax. A single number (C3E>) requires exactly that many matches. A numeric range quantifier (C3C<..>5E>) succeeds if the number of matches is between the minimum and maximum numbers, inclusive. A range with three trailing dots (C2...E>) is shorthand for CR..InfE>; it matches as many times as possible. Each quantifier has a minimal alternate form -- marked with a trailing C -- which matches the shortest possible sequence first. That is, given the string C, C3C<..>5E> will match C and C3C<..>5E?> will match C. ATable 7-4 shows the built-in X X quantifiers. =begin table picture Quantifiers Z =headrow =row =cell Maximal =cell Minimal =cell Meaning =bodyrows =row =cell C<*> =cell C<*?> =cell Match 0 or more times. =row =cell C<+> =cell C<+?> =cell Match 1 or more times. =row =cell C =cell C =cell Match 0 or 1 times. =row =cell C>RC> =cell C>RC?> =cell Match exactly R times. =row =cell C>RC<..>RC> =cell C>RC<..>RC?> =cell Match at least R and no more than R times. =row =cell C>RC<...E> =cell C>RC<...E?> =cell Match at least R times. =end table =head3 Assertions Z X X An assertion states that some condition or state is true. The match fails when that assertion is false. X X Assertions match named and anonymous rules, arrays or hashes containing anonymous rules, and subroutines or closures that return anonymous rules. To interpolate a variable in assertion rules, enclose it in assertion delimiters. A bare scalar in a pattern interpolates as a literal string, while a scalar variable in assertion brackets interpolates as an anonymous rule. A bare array in a pattern matches as a series of alternate literal strings, while an array in assertion brackets interpolates as a series of alternate anonymous rules. A bare hash in a pattern matches a word (C<\w+>) if and only if that word is one of its keysN, while a hash in assertion brackets also matches the associated value as an anonymous rule. X A bare closure in a pattern always matches (unless it calls C), but a closure in assertion brackets C{...}E> must return an anonymous rule to match. An assertion with parentheses C(...)E> resembles a bare closure in a pattern in that it allows you to include Perl code within a rule. C(...)E> evaluates the return value of the closure in boolean context. The match succeeds or fails based on that return value. Assertions match character classes, both named and enumerated. A named rule character class is often more accurate than an enumerated character class. The common C[a-zA-Z]E> idiom matches ASCII alphabetic characters, but the more comprehensive built-in rule CalphaE> matches the full set of Unicode alphabetic characters. ATable 7-5 shows the syntax of assertions. =begin table picture Assertions Z =headrow =row =cell Syntax =cell Meaning =bodyrows =row =cell C...E> =cell Generic assertion delimiter. =row =cell C!...E> =cell Negate any assertion. =row =cell C>RC> =cell Match a named rule or character class. =row =cell C[...]E> =cell Match an enumerated character class. =row =cell C-...E> =cell Complement a character class (named or enumerated). =row =cell C"..."E> =cell Match a literal string (interpolated at match time). =row =cell C'...'E> =cell Match a literal string (not interpolated). =row =cell C(...)E> =cell Boolean assertion. Execute a closure and match if it returns a true result. =row =cell C$scalarE> =cell Match an anonymous rule. =row =cell C@arrayE> =cell Match a series of anonymous rules as alternates. =row =cell C%hashE> =cell Match a key from the hash, then its value (as an anonymous rule). =row =cell CEsub()E> =cell Match an anonymous rule returned by a sub. =row =cell C{>RC<}E> =cell Match an anonymous rule returned by a closure. =row =cell C.E> =cell Match any logical grapheme, including combining character sequences. =end table =head3 Modifiers Z X X<: (colon);: modifier delimiter in rules> Modifiers alter the meaning of a pattern. The standard position for modifiers is at the beginning of the rule, right after the C, C, or C, or after the name in a named rule. Modifiers cannot attach to the outside of a bare C. For example: m:i/marvin/ # case insensitive rule names :i { marvin | ford | arthur } You may group single-character modifiers, but you must separate longer modifiers by colons: m:wig/ zaphod / # OK m:words:ignorecase:globally / zaphod / # OK m:wordsignorecaseglobally / zaphod / # Not OK Most modifiers can also appear inside the rule when attached to rule or grouping delimiters. Internal modifiers are lexically scoped to their enclosing delimiters, so can alter subpatterns: m/:w I saw [:i zaphod] / # only 'zaphod' is case insensitive The repetition modifiers (C<:Rx>, C<:Rth>, C<:once>, C<:globally>, and C<:exhaustive>) and the continue modifier (C<:cont>) alter the return value of the rule as a whole, so you cannot use them lexically inside a rule. The C<:Rx> modifier matches the rule a specific number of times. If the modifier expects more matches than the string has, the match fails. Its alternate form (C<:x(R)>) can take a variable in place of the number. The C<:once> modifier on a rule only allows it to match once. The rule will not match again until the you call the C<.reset> method on the rule object. The C<:globally> modifier matches as many times as possible. The C<:exhaustive> modifier also matches as many times as possible, in as many different ways as possible. The C<:Rth> modifier preserves one result from a particular counted match. If the rule matches fewer times than the modifier expects, the match fails. It has several alternate forms. One form, C<:th(R)>, takes a variable in place of the number. The other forms -- C<:Rst>, C<:Rnd>, and C<:Rrd> -- allow you to write more naturally C<:1st>, C<:2nd>, C<:3rd>. The other way is valid as well; choose whichever is most comfortable. By default, rules ignore literal whitespace within the pattern. The C<:w> modifier makes rules sensitive to literal whitespace, but in an intelligent way. Any cluster of literal whitespace acts like an explicit C<\s+> when it separates two identifiers and C<\s*> everywhere else. I modifiers exist to treat the matched string as a single line or multiple lines. Instead, use the "beginning of string" and "end of string" or "beginning of line" and "end of line" metacharacters. ATable 7-6 lists the available modifiers. =begin table picture Modifiers Z =headrow =row =cell Short =cell Long =cell Meaning =bodyrows =row =cell C<:i> =cell C<:ignorecase> =cell Case-insensitive match. =row =cell C<:I> =cell =cell Case-sensitive match (on by default). =row =cell C<:c> =cell C<:cont> =cell Continue where the previous match on the string left off. =row =cell C<:w> =cell C<:words> =cell Literal whitespace in the pattern matches as C<\s+> or C<\s*>. =row =cell C<:W> =cell =cell Turn off intelligent whitespace matching (return to default). =row =cell =cell :RC/C<:x(>RC<)> =cell Match the pattern R times. =row =cell =cell C<:>RC/C<:nth(>RC<)> =cell Match the Rth occurrence of a pattern. =row =cell =cell C<:once> =cell Match the pattern once and only once. =row =cell C<:g> =cell C<:globally> =cell Match the pattern as many times as possible without overlapping possibilities. =row =cell C<:e> =cell C<:exhaustive> =cell Match every possible occurrence of a pattern, including overlapping possibilities. =row =cell =cell C<:u0> =cell . is a byte. =row =cell =cell C<:u1> =cell . is a Unicode codepoint. =row =cell =cell C<:u2> =cell . is a Unicode grapheme. =row =cell =cell C<:u3> =cell . is language dependent. =row =cell =cell C<:p5> =cell The pattern uses Perl 5 regex syntax. =end table =head3 Built-in Rules Z X PGE provides several named rules, including a complete set of X POSIX-style classes, and X Unicode property classes. The list isn't fully defined yet, but ATable 7-7 shows a few you're likely to see. The CnullE> rule matches a zero-width string (it always matches) and CpriorE> matches whatever the most recent successful rule matched. These replace the two behaviors of X X the Perl 5 null pattern C, which is no longer valid syntax for rules. =begin table picture Built-in rules Z =headrow =row =cell Rule =cell Meaning =bodyrows =row =cell CalphaE> =cell Match a Unicode alphabetic character. =row =cell CdigitE> =cell Match a Unicode digit. =row =cell CspE> =cell Match a single space character (the same as C<\s>). =row =cell CwsE> =cell Match any whitespace (the same as C<\s+>). =row =cell CnullE> =cell Match the null string. =row =cell CpriorE> =cell Match the same thing as the previous match. =row =cell Cbefore ...E> =cell Zero-width lookahead. Assert that the current position I a pattern. =row =cell Cafter ...E> =cell Zero-width lookbehind. Assert that the current position I a pattern. =row =cell Cprop ...E> =cell Match any character with the named property. =row =cell Creplace(...)E> =cell Replace everything matched so far in the rule or subrule with the given string (under consideration). =end table =head3 Backtracking Control Z X X Whenever part of the pattern fails to match, PGE performs backtracking -- backing up to the previous point at which the match could succeed and trying again. You can explicitly trigger backtracking by calling the C function within a closure. ATable 7-8 displays metacharacters and built-in rules relevant to backtracking. =for author This could use an example. =end for =begin table picture Backtracking controls Z =headrow =row =cell Operator =cell Meaning =bodyrows =row =cell C<:> =cell Don't retry the previous atom. Instead, fail to the next earlier atom. X<: (colon);: fail to atom before last (rules)> X =row =cell C<::> =cell Don't backtrack over this point. Instead fail out of the closest enclosing group (C<(...)>, C<[...]>, or the rule delimiters). X<: (colon);:: fail out of group (rules)> X =row =cell C<:::> =cell Don't backtrack over this point. Instead, fail out of the current rule or subrule. X<: (colon);::: fail out of rule (rules)> X =row =cell CcommitE> =cell Don't backtrack over this point. Instead, fail out of the entire match (even from within a subrule). =row =cell CcutE> =cell Like CcommitE>, but also cuts the string matched. The current matching position at this point becomes the new beginning of the string. =end table =head3 Calling Actions Once the parser has matched the entire input N the parse has succeeded. The generated AST is now available to the code generator for conversion into PIR. =for author Please review. The forward declaration is awkward here, but a little bit of explanation might ameliorate this. =end for This AST gets built up by actions -- code snippets attached to rules and tokens. To call an action, insert the C<{*}> token into the rule. When PGE encounters C<{*}>, it will call the associated action method with the current match object as an argument. The best way to demonstrate this is by example. Sprinkle the C rule liberally with action calls: rule persons_name { {*} {*} {*} } The first call to the action method contains an empty match object because the parser hasn't matched anything yet. The second call contains only the first name of the match. The third and final call contains both the matched first and last name. If the match fails halfway through, PGE will still call the actions that have succeeded; it will not call the actions after the failure. If you try to match the string "Leia", PGE will call the first two action methods. When the rule tries to match the last name, it fails, and PGE will not call the third action method. =head3 Alternations and Keys In addition to sub-rules, groups, and quantifiers, you can also express either-or alternations between options. The vertical bar token (C<|>) distinguishes between options where only one may match: rule hero { ['Luke' | 'Leia'] 'Skywalker' } This rule will match either "Luke Skywalker" or "Leia Skywalker" but won't match "Luke Leia Skywalker"N. Given alternations and action methods, it's often important to distinguish which alternation matched: rule hero { [ 'Luke' {*} #= Luke | 'Leia' {*} #= Leia ] 'Skywalker' } This is the same rule, except now it passes two arguments to its action method: the match object and the name of the person who matched. =head3 Warning: Left Recursion If you've worked with parsers before, you may have seen this coming. If not, don't fear. Like functions in ordinary procedural or functional languages, the methods in the PGE parser grammar can call themselves recursively. Consider some rules derived in part from the grammar for the C programming language: rule if_statement { 'if' '{' * '}' ? } rule statement { | } rule else_block { 'else' '{' * '}' } An C can contain a list of Cs, and that each statement may itself be an C. This is I X; it's one of the reasons PGE is a "Recursive descent" parser. Consider the more direct example of a comma-separated list of integer digits which form a list. A recursive definition might be: rule list { ',' | } If there is only one digit, the second option in the alternation matches. If there are multiple digits, recursion will match them through the first alternation. That's the intention. The results are insidious. The recursive descent parser enters the C rule. Its first option is to enter the list rule again, so it does. Recursive descent is a X depth-first algorithm; PGE will continue to descend down a particular path until it finds a successful match or a match failure. In this case, it matches C, then it matches C again, then it matches C again, and so on. This rule forms an infinite loop -- a pattern called X I. The problem is that the left-most item of the left-most alternation is itself a recursion. The rule above does not recurse infinitely when rewritten as: rule list { | ',' } ... or even: rule list { ',' | } Both options ensure that the left-most item in the rule is recursive. Left recursion may be trickier. It's not immediately obvious in this grammar: rule term { '*' | } rule expression { '+' | } Even this common, limited subset of mathematical equations has the same problem. To match a C, the parser first tries to match an C, which in turn matches a C and then an C .... Again, the solution is simple. Rewrite at least one of the rules so that the first condition it tries to match is not itself a recursive situation. =head3 Operator Precedence Parser Recursive descent parsing can be inefficient where statements have lots of little tokens and many possible options to match. For example, mathematical expressions are very open-ended, with many valid forms which are difficult to anticipate. Consider the expression: a + b * c + d A recursive descent parser will undergo significant trial and error to parse this statement. Recursive descent parsing is not ideal for these situations. Instead, a type of bottom-up parser called an I X parser is much better. =for author Is this a categorization of all opps or just PGE's opp? =end for Operator precedence parsers work similarly to more versatile bottom-up parsers such as Lex or Yacc, but are optimized for use with expressions and equations. Equations have two subtypes, I and I. Operators themselves have several subtypes, including prefix (C<-a>), postfix (C), infix (C), circumfix (C<[z]>), postcircumfix (C), and list (C<1, 2, 3>). Each operator gets its own precedence number that specifies how closely it binds to the terms. The previous example should parse as: a + (b * c) + d ... because the C<*> operator has a higher precedence -- binding more tightly to its terms -- than the C<+> operator. Within a grammar, switch from the top-down recursive descent parser to the bottom-up operator precedence parser with an C X rule: rule expression is optable { ... } The C<...> ellipsis isn't an editorial shortcut, it's the Perl 6 operator to to define a function signature. The C<...> indicates that this is just a signature; the actual implementation is elsewhere. In this case, that location in the definition of the optable. =head3 Protofunction Definitions X Protofunctions define operators in the optable in the same way that rules and tokens make up the grammar. A proto declares a rule, defined elsewhere, which other code may override dynamically. In this case, PCT takes information from the proto declaration and fills in the details. The "dynamic overriding" implies that a high-level language itself can modify its own grammar at run time, by overriding the proto definitions for its operator table. Some languages call this process X I. A proto definition resembles: 'proto' [ 'is' ] '{' '...' '}' The name of the operator, noted as C<< >>, contains both a location part and an identifier part. The location is the type of the operator, such as infix, postfix, prefix, circumfix, and postcircumfix. The name of the operator is the symbol used for the operator in any of the quotes that Perl 6 understands: proto infix:<+> # a + b proto postfix:'--' # i-- proto circumfix:«<>» # The C X keyword defines a property of the rule. Examples include: is precedence(1) # Specifies an exact precedence is equiv('+') # Has the same precedence as the "+" operator is assoc('right') # Right associative. May also be "left" or "list" is pirop('add') # Operands are passed to the PIR operator "and" is subname('mySub') # Operands are passed to the function "mySub" is pasttype('if') # Operands are passed as children to an "if" PAST node in # the parse tree is parsed(&myRule) # The token is parsed and identified using the rule # "myRule" from the top-down parser =for author Please review. =end for Protofunction definitions are function signatures; you can override them with multimethod dispatch. This means that you can write functions I as the rule to implement the behavior of the operator. Here's a proto: rule infix:"+" { ... } ... and its corresponding PIR rule: =begin PIR .sub 'infix:+' .param pmc a .param pmc b .local pmc c c = a + b .return(c) .end =end PIR You may ask "Why have an C property, if you can define all operators as subroutines?" Using the C property allows PCT to call a subroutine of a different name then the operator. This is a good idea if there is already a built-in function in the language that duplicates the functionality of the operator. There is no sense in duplicating behavior. The great thing about protos being overloadable is that you can specify different functions to call with different signatures: =begin PIR .sub 'infix:+' :multi('Integer', 'Integer') #... .end .sub 'infix:+' :multi('CLispRatio', 'Number') #... .end .sub 'infix:+' :multi('Perl6Double', 'PythonInteger') #... .end =end PIR This list can be a bit intimidating, and it's hard to imagine that it would be necessary to write up a new function to handle addition between every conceivable pair of operands. Fortunately, this is rarely the case in Parrot, because all these data types support common the VTABLE interface. For most data types Parrot already has basic arithmetic operations built in, and it's only necessary to override for those data types with special needs. =head3 Hypothetical Variables Z X X X Hypothetical variables are a powerful way of building up data structures from within a match. Ordinary captures with C<()> store the result of the captures in C<$1>, C<$2>, etc. PGE stores values in these variables if the match is successful, but throws them away if the match fails. The numbered capture variables are accessible outside the match, but only within the immediate surrounding lexical scope: "Zaphod Beeblebrox" ~~ m:w/ (\w+) (\w+) /; print $1; # prints Zaphod You can also capture into any user-defined variable with the binding operator C<:=> -- I you have declared these variables in a lexical scope enclosing the rule: my $person; "Zaphod's just this guy." ~~ / ^ $person := (\w+) /; print $person; # prints Zaphod You may capture repeated matches into an array: my @words; "feefifofum" ~~ / @words := (f<-[f]>+)* /; # @words contains ("fee", "fi", "fo", "fum") You may capture pairs of repeated matches into a hash: my %customers; $records ~~ m:w/ %customers := [ EidE = EnameE \n]* /; If you don't need the captured value outside the rule, use a C<$?> variable instead. These are only directly accessible within the rule: "Zaphod saw Zaphod" ~~ m:w/ $?name := (\w+) \w+ $?name/; A match of a named rule stores the result in a C<$?> variable with the same name as the rule. These variables are also accessible only within the rule: "Zaphod saw Zaphod" ~~ m:w/ EnameE \w+ $?name /; =for author This next paragraph feels out of place; is there more? =end for When a rule matches a sequence of input tokens, PCT calls an associated method within NQP to convert that match into an AST node, which it inserts into the I. =head3 Basic Rules Consider the simple example rule: rule persons_name { } ... and two example tokens: token first_name { + } token last_name { + } The special token C<< >> is a built-in construct that only accepts upper case and lower case letters. The C<+> after the C<< >> tag is a short way of saying "one or more". The rule will match names like CN real names>, but won't match something like C. This rule I match C, but not as you might expect: way you would expect: It would match the first "Jar" as C<< >>, the second "Jar" as C<< >>, and ignore "Binks"N. =for author The rest seems vestigial. An example like this should precede the rest of the chapter. There are forward references, but it's a decent overview for people who haven't used similar systems before -- if you avoid going out in the weeds. =end for this example shows another new construct, the square brackets. Square brackets are ways to group things together. The star at the end means that we take all the things inside the brackets zero or more times. This is similar to the plus, except the plus matches one or more times. Notice, however, that the above rule always matches a comma at the end, so we would need to have something like: Darth Vader, Luke Skywalker, Instead of something more natural like: Darth Vader, Luke Skywalker We can modify the rule a little bit so that it always ends with a name instead of a comma: rule TOP { [ ',' ]* } Now we don't need a trailing comma, but at the same time we can't match an empty file because it always expects to have at least one name at the end. If we still want to match empty files successfully, we need to make the whole rule optional: rule TOP { [ [ ',' ]* ]? } We've grouped the whole rule together in another set of brackets, and put a "?" question mark at the end. The question mark means zero or one of the prior item. The symbols "*" (zero or more), "+" (one or more) and "?" are called I, and allow an item in the rule to match a variable number of times. These aren't the only quantifiers, but they are the most common. We will talk about other quantifiers later on. =cut # Local variables: # c-file-style: "parrot" # End: # vim: expandtab shiftwidth=4: pge_examples.t000644000765000765 577211533177643 20407 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/pge#! perl # Copyright (C) 2001-2006, Parrot Foundation. use strict; use warnings; use lib qw( t . lib ../lib ../../lib ); use Test::More; use Parrot::Test tests => 2; use Parrot::Test::PGE; =head1 NAME t/library/pge_examples.t =head1 SYNOPSIS % prove t/compilers/pge/pge_examples.t =head1 DESCRIPTION Parrot Grammar Engine tests of examples =cut # 1 pir_output_is( <<'CODE', <<'OUT', "This made Parrot m4 fail" ); .sub 'test' :main load_bytecode "PGE.pbc" .local pmc p6rule p6rule = compreg "PGE::Perl6Regex" .local pmc rulesub_a, rulesub_b rulesub_a = p6rule( "a" ) rulesub_b = p6rule( "^(<[b]>)" ) .local string input_string input_string = "_____________________________________________________________________" rulesub_b( input_string ) print "ok1\n" # end rulesub_a( input_string ) print "ok2\n" .end CODE ok1 ok2 OUT # 2 pir_output_is( <<'CODE', <<'OUT', "parse FASTA" ); # Grok fasta files, which usually contain DNA, RNA or protein sequences. # http://en.wikipedia.org/wiki/FASTA_format .sub "example" :main load_bytecode 'PGE.pbc' load_bytecode 'PGE/Perl6Grammar.pbc' .local string fasta_grammar fasta_grammar = <<'END_FASTA_GRAMMAR' grammar Bio::Fasta; regex databank { + } regex entry { \n } regex desc_line { \s+ } regex start_entry { \> } regex id { (\S+) } regex desc { (\N*) } regex sequence { (<-[>]>*) } END_FASTA_GRAMMAR .local string fasta fasta = <<'END_FASTA' >gi|5524211|gb|AAD44166.1| cytochrome b [Elephas maximus maximus] LCLYTHIGRNIYYGSYLYSETWNTGIMLLLITMATAFMGYVLPWGQMSFWGATVITNLFSAIPYIGTNLV EWIWGGFSVDKATLNRFFAFHFILPFTMVALAGVHLTFLHETGSNNPLGLTSDSDKIPFHPYYTIKDFLG LLILILLLLLLALLSPDMLGDPDNHMPADPLNTPLHIKPEWYFLFAYAILRSVPNKLGGVLALFLSIVIL GLMPFLHTSKHRSMMLRPLSQALFWTLTMDLLTLTWIGSQPVEYPYTIIGQMASILYFSIILAFLPIAGX IENY >poly_a teasing the parser with DNA aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa END_FASTA .local pmc p6grammar p6grammar = compreg "PGE::Perl6Grammar" .local pmc code ( code ) = p6grammar.'compile'(fasta_grammar, 'target'=>'PIR') $P0 = compreg 'PIR' $P1 = $P0(code) $P1() # print code .local pmc fasta_rule fasta_rule = get_global ['Bio';'Fasta'], "databank" .local pmc match ( match ) = fasta_rule( fasta ) # TODO: Extract named or positional captures print match .end CODE >gi|5524211|gb|AAD44166.1| cytochrome b [Elephas maximus maximus] LCLYTHIGRNIYYGSYLYSETWNTGIMLLLITMATAFMGYVLPWGQMSFWGATVITNLFSAIPYIGTNLV EWIWGGFSVDKATLNRFFAFHFILPFTMVALAGVHLTFLHETGSNNPLGLTSDSDKIPFHPYYTIKDFLG LLILILLLLLLALLSPDMLGDPDNHMPADPLNTPLHIKPEWYFLFAYAILRSVPNKLGGVLALFLSIVIL GLMPFLHTSKHRSMMLRPLSQALFWTLTMDLLTLTWIGSQPVEYPYTIIGQMASILYFSIILAFLPIAGX IENY >poly_a teasing the parser with DNA aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa OUT # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: integer.pasm000644000765000765 24312101554067 21176 0ustar00brucebruce000000000000parrot-5.9.0/t/native_pbc/testdata# Copyright (C) 2012, Parrot Foundation. print 0x10203040 end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: pmc.pm000644000765000765 3044612162603275 16076 0ustar00brucebruce000000000000parrot-5.9.0/config/auto# Copyright (C) 2001-2013, Parrot Foundation. =head1 NAME config/auto/pmc.pm - PMC Files =head1 DESCRIPTION Prepare PMC files for inclusion. =cut package auto::pmc; use strict; use warnings; use base qw(Parrot::Configure::Step); use File::Basename qw/basename/; use File::Spec::Functions qw/catfile/; use Parrot::Configure::Utils ':auto'; sub _init { my $self = shift; return { description => 'Which pmc files should be compiled in', result => '', PMC_PARENTS => {}, srcpmc => [ sort map { basename($_) } glob "./src/pmc/*.pmc" ], }; } sub runstep { my ( $self, $conf ) = @_; # $pmc_list is a string holding a space-delimited list of currently active # PMCs, sorted (largely) on the basis of src/pmc/pmc.num. # (By 'current', we take into account the fact that there are PMCs listed # in src/pmc/pmc.num that no longer exist but whose index numbers are # never deleted.) my $pmc_list = get_sorted_pmc_str( @{ $self->{srcpmc} } ); # names of class files for src/pmc/Makefile ( my $TEMP_pmc_o = $pmc_list ) =~ s/\.pmc/\$(O)/g; ( my $TEMP_pmc_str = $pmc_list ) =~ s/\.pmc/\.str/g; # calls to pmc2c.pl for src/pmc/Makefile my $TEMP_pmc_build = <<"E_NOTE"; # the following part of the Makefile was built by 'config/auto/pmc.pm' E_NOTE $TEMP_pmc_build .= <) { next if /^#/; next if /^\s*$/; chomp; $universal_deps{$_} = 1; } for my $pmc ( split( /\s+/, $pmc_list ) ) { $pmc =~ s/\.pmc$//; # make each pmc depend upon its parent. my $parent_dumps = ''; $parent_dumps .= "src/pmc/$_.dump " foreach reverse( ( $self->pmc_parents($pmc) ) ); my $parent_headers = ''; $parent_headers .= "include/pmc/pmc_$_.h " for $self->pmc_parents($pmc); # add dependencies that result from METHOD usage. my $pmc_fname = catfile('src', 'pmc', "$pmc.pmc"); my $pccmethod_depend = ''; my %o_deps = %universal_deps; $o_deps{"src/pmc/$pmc.c"} = 1; $o_deps{"src/pmc/$pmc.str"} = 1; $o_deps{"include/pmc/pmc_$pmc.h"} = 1; if (contains_pccmethod($pmc_fname)) { $o_deps{"include/pmc/pmc_fixedintegerarray.h"} = 1; if ($pmc ne 'fixedintegerarray') { $pccmethod_depend .= ' include/pmc/pmc_fixedintegerarray.h'; } } my $include_headers = get_includes($pmc_fname); my $cc_shared = $conf->data->get('cc_shared'); my $cc_o_out = $conf->data->get('cc_o_out'); my $warnings = $conf->data->get('ccwarn'); my $optimize = $conf->data->get('optimize'); foreach my $header (split ' ', $parent_headers) { $o_deps{$header} = 1; } foreach my $header (split ' ', $include_headers) { $o_deps{$header} = 1; } # includes of includes # (cheat. The right way to handle this is to do what # checkdepend.t does.) if (exists $o_deps{'include/parrot/oplib/core_ops.h'} ) { $o_deps{'include/parrot/runcore_api.h'} = 1; } my $o_deps = " " . join(" \\\n ", keys %o_deps); $TEMP_pmc_build .= <) { if (/^pmclass (\w+)(.*)/) { $name = $1; my $decl = $2; $decl .= <$PMC> until $decl =~ s/\{.*//; $const = 1 if $decl =~ /\bconst_too\b/; next PMC if $decl =~ /\bextension\b/; # the default PMC gets handled specially last if $name eq 'default'; my $parent = 'default'; if ($decl =~ /extends (\w+)/) { $parent = $1; } # set a marker not to initialize an abstract PMC if ($decl =~ /\babstract\b/) { unshift @{ $parents{$name} }, '(abstract)'; } # please note that normal and Const PMCs must be in this order push @{ $parents{$parent} }, $name; push @{ $parents{$parent} }, "Const$name" if $const; last; } } close $PMC; die "No pmclass declaration found in $pmc_file" unless defined $name; } my @names = ('default', $self->order_pmcs_by_hierarchy( \%parents )); $conf->data->set( pmc => $pmc_list, pmc_names => join( ' ', @names ), TEMP_pmc_o => $TEMP_pmc_o, TEMP_pmc_build => $TEMP_pmc_build, TEMP_pmc_classes_o => $TEMP_pmc_classes_o, TEMP_pmc_classes_str => $TEMP_pmc_classes_str, TEMP_pmc_classes_pmc => $TEMP_pmc_classes_pmc, ); return 1; } # Return the (lowercased) name of the immediate parent of the given # (lowercased) pmc name. sub pmc_parent { my ($self, $pmc) = @_; return $self->{PMC_PARENTS}{$pmc} if defined $self->{PMC_PARENTS}{$pmc}; local $/; open( my $PMC, '<', "src/pmc/$pmc.pmc" ) or die "open src/pmc/$pmc.pmc failed: $!"; local $_ = <$PMC>; close $PMC; # Throw out everything but the pmclass declaration s/^.*?pmclass//s; s/\{.*$//s; return $self->{PMC_PARENTS}{$pmc} = lc($1) if m/extends\s+(\w+)/; return $self->{PMC_PARENTS}{$pmc} = 'default'; } # Return an array of all sub pmc_parents { my ($self, $pmc) = @_; my @parents = ($pmc); push @parents, $self->pmc_parent( $parents[-1] ) until $parents[-1] eq 'default'; shift @parents; return @parents; } # Internal sub get_pmc_order parses src/pmc/pmc.num. The hash it builds # includes both active and deactivated PMCs. sub get_pmc_order { open my $IN, '<', 'src/pmc/pmc.num' or die "Can't read src/pmc/pmc.num"; my %order; while (<$IN>) { next unless (/^(\w+\.\w+)\s+(\d+)$/); $order{$1} = $2; } close $IN; return \%order; } sub get_sorted_pmc_str { my @pmcs = @_; my $pmc_order = get_pmc_order(); my $n = keys %$pmc_order; my @sorted_pmcs; for my $pmc (@pmcs) { if ( exists $pmc_order->{$pmc} ) { $sorted_pmcs[ $pmc_order->{$pmc} ] = $pmc; } else { $sorted_pmcs[ $n++ ] = $pmc; } } # With the test for definedness below, we account for PMCs which have been # deactivated but whose index numbers remain in src/pmc/pmc.num. my $active_pmcs = [ grep { defined $_ } @sorted_pmcs ]; # At this point we check to see whether any active_pmcs are missing from # the MANIFEST. We warn about any such missing PMCs but (for the time # being at least) we proceed to compose $pmc_str. my $seen_manifest = pmcs_in_manifest(); check_pmcs_against_manifest( $active_pmcs, $seen_manifest ); return join(' ' => @{ $active_pmcs }); } sub pmcs_in_manifest { my $manifest = shift || 'MANIFEST'; my %seen_manifest = (); open my $MAN, '<', $manifest or die "Unable to open MANIFEST: $!"; while (my $f = <$MAN>) { chomp $f; if ($f =~ m{^src/pmc/(.*\.pmc)}) { my $pmc = $1; $seen_manifest{$pmc}++; } } close $MAN or die "Unable to close MANIFEST: $!"; return \%seen_manifest; } sub check_pmcs_against_manifest { my ($active_pmcs, $seen_manifest) = @_; my @missing_from_manifest = grep { ! exists $seen_manifest->{$_} } @{ $active_pmcs }; if (@missing_from_manifest) { warn "PMCs found in /src/pmc not found in MANIFEST: @missing_from_manifest"; } } sub contains_pccmethod { my $file = shift; open( my $fh, '<', $file ) or die "Can't read '$file': $!\n"; local $_; while (<$fh>) { next unless /\bMETHOD\b/; return 1; } return; } # Given a PMC file name, get a list of all the includes it specifies sub get_includes { my $file = shift; open( my $fh, '<', $file ) or die "Can't read '$file': $!\n"; my @retval; local $_; while (<$fh>) { next unless /^\s*# *include\s+"(.*)"\s+$/; my $include = $1; if ($include =~ m{^parrot}) { # main parrot include dir next if $include eq "parrot/parrot.h"; # already implicit everywhere. next if $include eq "parrot/io.h"; # already implicit everywhere. $include = "include/" . $include; } elsif ($include =~ m/^pmc_|\.str$/) { # local pmc header $include = "src/pmc/" . $include; } elsif ($include =~ m/^pmc\/pmc_/) { # local pmc header $include = "include/" . $include; } elsif ($include =~ m/^imcc/) { # IMCC header. $include = "include/" . $include; } elsif ($include =~ m{^\.\./}) { # relative to include/ dir... $include =~ s{^\.\./}{}; } push @retval, $include; } return join(' ', @retval); } sub order_pmcs_by_hierarchy { my ($self, $parents) = @_; return $self->get_kids_for_parent( $parents, 'default' ); } sub get_kids_for_parent { my ($self, $parents, $parent) = @_; my @kids; for my $kid (@{ $parents->{$parent} }) { # skip abstract PMCs next if $kid eq '(abstract)'; push @kids, $kid unless exists $parents->{$kid} && $parents->{$kid}[0] eq '(abstract)'; # and avoid infinite loops next if $kid eq $parent; push @kids, $self->get_kids_for_parent($parents, $kid); } return @kids; } 1; __DATA__ include/parrot/cclass.h include/parrot/multidispatch.h include/parrot/call.h include/parrot/exit.h include/parrot/pobj.h include/parrot/extend_vtable.h include/parrot/memory.h include/parrot/key.h include/parrot/oo.h include/parrot/feature.h include/parrot/oplib.h include/parrot/library.h include/parrot/string.h include/parrot/settings.h include/parrot/namespace.h include/parrot/extend.h include/parrot/pbcversion.h include/parrot/core_types.h include/parrot/interpreter.h include/parrot/io.h include/parrot/context.h include/parrot/parrot.h include/parrot/dynext.h include/parrot/hash.h include/parrot/enums.h include/parrot/encoding.h include/parrot/vtable.h include/parrot/scheduler.h include/parrot/pmc.h include/parrot/datatypes.h include/parrot/core_pmcs.h include/parrot/misc.h include/parrot/sub.h include/parrot/pmc_freeze.h include/parrot/global_setup.h include/parrot/gc_api.h include/parrot/nci.h include/parrot/vtables.h include/parrot/has_header.h include/parrot/warnings.h include/parrot/op.h include/parrot/debugger.h include/parrot/caches.h include/parrot/config.h include/parrot/platform_interface.h include/parrot/hll.h include/parrot/packfile.h include/parrot/exceptions.h include/parrot/string_funcs.h include/parrot/compiler.h include/pmc/pmc_callcontext.h include/pmc/pmc_continuation.h # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: 51_if_unless.pir000644000765000765 275312101554066 21211 0ustar00brucebruce000000000000parrot-5.9.0/examples/tutorial# Copyright (C) 2007-2012, Parrot Foundation. =pod =head1 DESCRIPTION A tutorial lesson about Parrot's control flow (continued). =head1 IF AND UNLESS Both the if and unless conditionals are supported in PIR. When the tested condition matches the sense of the conditional (true for if, false for unless), then the following C statement is executed. Truth is fairly simple to determine, depending on the data type being considered. =over 4 =item Integers 0 is false, any other number is true. =item Strings The empty string is false, all other strings are true. =item Numbers 0.0 is false, whether it is positive or negative. All other numbers are true, including NaN. NaN is the value you get if you try to divide by zero, or do other illegal operations. =item PMCs The "truthiness" of a PMC depends on how it implements its vtable method C. This changes for each different type of PMC, but is usually straight-forward. =back =cut .sub main :main say "before if" $I0 = 1 if $I0 goto branch_to_here say "never printed" branch_to_here: say "after if\n" say "before unless" unless $I0 goto dont_branch_to_here say "is printed" dont_branch_to_here: say "after unless" $N0 = -0.0 if $N0 goto branch1 say "-0.0 was false" branch1: $N0 = 'NaN' if $N0 goto branch2 say "NaN was false" branch2: .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: nci.pmc000644000765000765 2132012101554067 15350 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME src/pmc/nci.pmc - Native Call Interface =head1 DESCRIPTION The vtable functions for the native C call functions. =head2 Methods =over 4 =cut */ /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_IGNORABLE_RESULT static nci_thunk_t /*@alt void@*/ build_func(PARROT_INTERP, ARGIN(PMC *obj), ARGMOD(Parrot_NCI_attributes *nci)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*nci); #define ASSERT_ARGS_build_func __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(obj) \ , PARROT_ASSERT_ARG(nci)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Actually build the NCI thunk. =cut */ PARROT_IGNORABLE_RESULT static nci_thunk_t build_func(PARROT_INTERP, ARGIN(PMC *obj), ARGMOD(Parrot_NCI_attributes *nci)) { ASSERT_ARGS(build_func) Parrot_nci_sig_to_pcc(interp, nci->signature, &nci->pcc_params_signature, &nci->pcc_return_signature); /* Arity is length of the signature minus one (the return type). */ nci->arity = VTABLE_elements(interp, nci->signature) - 1; /* Build call function. */ nci->fb_info = build_call_func(interp, nci->signature); nci->func = F2DPTR(VTABLE_get_pointer(interp, nci->fb_info)); PARROT_GC_WRITE_BARRIER(interp, obj); return (nci_thunk_t)nci->func; } pmclass NCI auto_attrs provides invokable { /* NCI thunk handling attributes */ ATTR PMC *signature; /* parsed signature */ ATTR void *func; /* function pointer to call */ ATTR PMC *fb_info; /* frame-builder info */ ATTR void *orig_func; /* pointer to wrapped function */ /* Parrot Sub-ish attributes */ ATTR STRING *pcc_params_signature; ATTR STRING *pcc_return_signature; ATTR INTVAL arity; /* MMD fields */ ATTR STRING *long_signature; ATTR PMC *multi_sig; /* =item C Return the MMD signature PMC, if any or C. =cut */ METHOD get_multisig() { PMC *sig; GET_ATTR_multi_sig(INTERP, SELF, sig); if (PMC_IS_NULL(sig)) sig = PMCNULL; RETURN(PMC *sig); } /* =item C Initializes the NCI with a C function pointer. =cut */ VTABLE void init() { UNUSED(INTERP) PObj_custom_mark_SET(SELF); } VTABLE void *get_pointer() { UNUSED(INTERP) return PARROT_NCI(SELF)->orig_func; } /* =item C =item C Call the equivalent C function. =cut */ VTABLE void set_pmc_keyed(PMC *key, PMC *p) { STATICSELF.set_pointer_keyed(key, VTABLE_get_pointer(INTERP, p)); } VTABLE void set_pmc_keyed_str(STRING *key, PMC *p) { STATICSELF.set_pointer_keyed_str(key, VTABLE_get_pointer(INTERP, p)); } /* =item C Sets the specified function pointer and signature (C<*key>). =item C Sets the specified function pointer and siganture as described in the string C. =cut */ VTABLE void set_pointer_keyed(PMC *key, void *func) { /* Store the original function and signature. */ SET_ATTR_orig_func(INTERP, SELF, func); SET_ATTR_signature(INTERP, SELF, key); } VTABLE void set_pointer_keyed_str(STRING *key, void *func) { SELF.set_pointer_keyed(Parrot_nci_parse_signature(INTERP, key), func); } /* =item C Mark any referenced strings and PMCs. =cut */ VTABLE void mark() { if (PARROT_NCI(SELF)) { Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); Parrot_gc_mark_PMC_alive(interp, nci_info->signature); Parrot_gc_mark_PMC_alive(interp, nci_info->fb_info); Parrot_gc_mark_PMC_alive(interp, nci_info->multi_sig); Parrot_gc_mark_STRING_alive(interp, nci_info->long_signature); Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_params_signature); Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_return_signature); } } /* =item C Creates and returns a clone of the NCI. =cut */ VTABLE PMC *clone() { Parrot_NCI_attributes * const nci_info_self = PARROT_NCI(SELF); PMC * const ret = Parrot_pmc_new(INTERP, SELF->vtable->base_type); Parrot_NCI_attributes * const nci_info_ret = PARROT_NCI(ret); /* FIXME if data is malloced (JIT/i386!) then we need * the length of data here, to memcpy it * ManagedStruct or Buffer? */ nci_info_ret->func = nci_info_self->func; nci_info_ret->fb_info = nci_info_self->fb_info; nci_info_ret->orig_func = nci_info_self->orig_func; nci_info_ret->signature = nci_info_self->signature; nci_info_ret->pcc_params_signature = nci_info_self->pcc_params_signature; nci_info_ret->pcc_return_signature = nci_info_self->pcc_params_signature; nci_info_ret->arity = nci_info_self->arity; PObj_get_FLAGS(ret) = PObj_get_FLAGS(SELF); return ret; } /* =item C Returns whether the NCI is defined. =cut */ VTABLE INTVAL defined() { UNUSED(INTERP) const Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); return nci_info->orig_func != NULL; } /* =item C Calls the associated C function, returning C<*next>. If the invocant is a class, the PMC arguments are shifted down. =cut */ VTABLE opcode_t *invoke(void *next) { Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); nci_thunk_t func; PMC *fb_info; PMC *cont; func = (nci_thunk_t)D2FPTR(nci_info->func); if (!func) { /* build the thunk only when necessary */ func = build_func(interp, SELF, nci_info); if (!func) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "attempt to call NULL function"); } GET_ATTR_fb_info(INTERP, SELF, fb_info); cont = INTERP->current_cont; func(INTERP, SELF, fb_info); /* * If the NCI function was tailcalled, the return result * is already passed back to the caller of this frame * - see Parrot_init_ret_nci(). We therefore invoke the * return continuation here, which gets rid of this frame * and returns the real return address */ if (!PMC_IS_NULL(cont) && (PObj_get_FLAGS(cont) & SUB_FLAG_TAILCALL)) { cont = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp)); next = VTABLE_invoke(INTERP, cont, next); } return (opcode_t *)next; } /* =item C Returns the function pointer as an integer. =cut */ VTABLE INTVAL get_integer() { Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); if (!nci_info->func) build_func(INTERP, SELF, nci_info); return (INTVAL)nci_info->func; } /* =item C Returns the boolean value of the pointer. =cut */ VTABLE INTVAL get_bool() { UNUSED(INTERP) const Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); return (0 != (INTVAL)nci_info->orig_func); } /* =item C Return the arity of the NCI (the number of arguments). =cut */ METHOD arity() { Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); if (nci_info) { if (!nci_info->func) build_func(INTERP, SELF, nci_info); if (nci_info->func) { const INTVAL arity = nci_info->arity; RETURN(INTVAL arity); } } Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "You cannot get the arity of an undefined NCI."); } } /* =back =head1 SEE ALSO F. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ new_changelog_skeleton.pl000644000765000765 270112110761327 21470 0ustar00brucebruce000000000000parrot-5.9.0/tools/dev#! perl # Copyright (C) 2012-2013, Parrot Foundation. use strict; use warnings; =head1 NAME F =head1 DESCRIPTION This program adds a new release announcement skeleton to ChangeLog. =head1 EXAMPLE Run this command perl tools/dev/new_changelog_skeleton.pl and then "git status" should show a modification to the ChangeLog file. =head1 AUTHOR Jonathan "Duke" Leto =cut sub read_changelog { my ($x,$y,$z); my ($year, $month, $day); open (my $fh, '<', 'ChangeLog') or die $!; for my $line (<$fh>) { if ($line =~ m/(\d+)-(\d+)-(\d+).*release (\d+)\.(\d+)\.(\d+)/) { ($year, $month, $day, $x,$y,$z) = ($1,$2,$3,$4,$5,$6); return ($year, $month, $day, $x,$y,$z); } } close $fh; return; } sub run { my ($year, $month, $day, $x, $y, $z) = read_changelog(); return unless $year && $x; $month eq '12' ? $month=1 : $month++; $y eq '11' ? ($x++, $y = 0, $z =0 ) : $y++; local $/; open (my $fh, '<', 'ChangeLog') or die $!; my $changelog = <$fh>; my $skeleton =<', 'ChangeLog') or die $!; print $wfh $skeleton, $changelog; close $wfh; } run(); # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: Manifest.pm000644000765000765 3504512101554067 16662 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot# Copyright (C) 2007-2012, Parrot Foundation. =head1 NAME Parrot::Manifest - Re-create MANIFEST and MANIFEST.SKIP =head1 SYNOPSIS use Parrot::Manifest; $mani = Parrot::Manifest->new($0); $manifest_lines_ref = $mani->prepare_manifest(); $need_for_files = $mani->determine_need_for_manifest($manifest_lines_ref); $mani->print_manifest($manifest_lines_ref) if $need_for_files; $print_str = $mani->prepare_manifest_skip(); $need_for_skip = $mani->determine_need_for_manifest_skip($print_str); $mani->print_manifest_skip($print_str) if $need_for_skip; =head1 DESCRIPTION This package exports no functions. A Parrot::Manifest object is used in F, which in turn is the basis of C. =cut package Parrot::Manifest; use strict; use warnings; use Carp; use File::Basename; use Parrot::BuildUtil; =head1 METHODS =head2 new $mani = Parrot::Manifest->new({ script => $0, file => $filename, skip => $skipfilename, }) Creates a Parrot::Manifest object by asking C for verbose output, and parsing the results. C is the name of the file that the manifest will eventually be written to, and defaults to F. C is the name of the file that will hold the list of files to be skipped, and defaults to F. =cut sub new { my $class = shift; my $argsref = shift; my %data = ( time => scalar gmtime, cmd => 'git', script => $argsref->{script}, file => $argsref->{file} ? $argsref->{file} : q{MANIFEST}, skip => $argsref->{skip} ? $argsref->{skip} : q{MANIFEST.SKIP}, ); my $lsfiles = qx($data{cmd} ls-files ); # grab the versioned resources: my @versioned_files; my @versioned_output = split /\n/, $lsfiles; for my $filename (@versioned_output) { next if $filename =~ m[/\.git|^blib|^ports]; push @versioned_files, $filename; } $data{versioned_files} = \@versioned_files; return bless( \%data, $class ); } =head2 prepare_manifest $manifest_lines_ref = $mani->prepare_manifest(); Prepares the manifest from the data read in by the C method, and returns a hash of the files. The keys of the hash are the filenames, and the values are strings representing the package and a list of the meta flags. =cut sub prepare_manifest { my $self = shift; my %manifest_lines; for my $file ( @{ $self->{versioned_files} } ) { $manifest_lines{$file} = _get_manifest_entry($file); } return \%manifest_lines; } =head2 determine_need_for_manifest $need_for_files = $mani->determine_need_for_manifest($manifest_lines_ref); Determines the need for the manifest. The checks are: =over 4 =item * If there's no manifest yet, we need one. =item * If there's a difference between what's already there and what's in the list, we need a new one. =back If a new manifest is needed, the return value is C<1>; otherwise it is undefined. The value passed in is the hash as returned from I, C. =cut sub determine_need_for_manifest { my $self = shift; my $proposed_files_ref = shift; return 1 unless -f $self->{file}; my $current_files_ref = $self->_get_current_files(); my $different_patterns_count = 0; my %missing; foreach my $cur ( keys %{$current_files_ref} ) { unless ($proposed_files_ref->{$cur}) { $different_patterns_count++; $missing{"+".$cur}++; } } foreach my $pro ( keys %{$proposed_files_ref} ) { unless ($current_files_ref->{$pro}) { $different_patterns_count++; $missing{"-".$pro}++; } } $different_patterns_count ? return \%missing : return; } =head2 print_manifest $mani->print_manifest($manifest_lines_ref) if $need_for_files; Writes the manifest to a file. The example above does so only if an update is needed. =cut my $text_file_coda = <<'CODA'; # Local variables: # mode: text # buffer-read-only: t # End: CODA sub print_manifest { my $self = shift; my $manifest_lines_ref = shift; my $print_str = <<"END_HEADER"; # ex: set ro: # # generated by $self->{script} # # See below for documentation on the format of this file. # # See docs/submissions.pod and the documentation in # $self->{script}. END_HEADER for my $k ( sort keys %{$manifest_lines_ref} ) { $print_str .= sprintf "%- 59s %s\n", ( $k, $manifest_lines_ref->{$k} ); } $print_str .= $text_file_coda; open my $MANIFEST, '>', $self->{file} or croak "Unable to open $self->{file} for writing"; print {$MANIFEST} $print_str; close $MANIFEST or croak "Unable to close $self->{file} after writing"; return 1; } # Gets the package and the meta flags for the given file. This function does # it based on the directory the file is in. If a particular file is needed, # then _get_special (below) provides that functionality. sub _get_manifest_entry { my $file = shift; my $special = _get_special(); my $loc = '[]'; for ($file) { $loc = exists( $special->{$_} ) ? $special->{$_} : !m[/] ? '[]' : m[^docs/book/draft/] ? '[]' : m[^docs/] ? '[doc]' : m[^examples/] ? '[examples]' : m[README] ? '[]doc' : m[^include/] ? '[main]include' : m[^t/] ? '[test]' : m[/t/] ? '[test]' : ( m[^languages/(\w+)/] and $1 ne 'conversion' ) ? "[$1]" : ( m[^compilers/(\w+)/] and $1 ne 'conversion' ) ? "[$1]" : m[^lib/Parrot/] ? '[devel]lib' : m[^runtime/] ? '[library]' : m[^src/pmc/.*\.h] ? '[devel]include' : m[^runtime/parrot/library/PCT] ? '[pct]' : m[^runtime/parrot/library/PCT] ? '[pge]' : m[^runtime/parrot/library/TGE] ? '[tge]' : m[^runtime/parrot/library/JSON] ? '[json]' : '[]'; # default } return $loc; } # See comments for _get_manifest_entry, above sub _get_special { my %special = qw( CREDITS [main]doc DEPRECATED.yaml [devel]doc DONORS.pod [main]doc LICENSE [main]doc PBC_COMPAT [main]doc PLATFORMS [devel]doc README.pod [devel]doc README_win32.pod [devel]doc README_cygwin.pod [devel]doc RESPONSIBLE_PARTIES [main]doc TODO [devel]doc VERSION [devel] languages/t/harness [test] lib/File/Which.pm [devel]lib src/vtable.tbl [devel]src tools/build/ops2c.pl [devel] tools/build/pmc2c.pl [devel] tools/dev/create_language.pl [devel] tools/dev/gen_makefile.pl [devel] tools/dev/mk_language_shell.pl [devel] tools/dev/pbc_to_exe.pir [devel] tools/dev/pprof2cg.pl [devel] tools/dev/reconfigure.pl [devel] ); return \%special; } # Gets files currently listed in manifest, and returns a hash sub _get_current_files { my $self = shift; my %current_files; open my $FILE, "<", $self->{file} or die "Unable to open $self->{file} for reading"; while ( my $line = <$FILE> ) { chomp $line; next if $line =~ /^\s*$/; next if $line =~ /^#/; my ($file) = split /\s+/, $line; $current_files{ $file }++; } close $FILE or die "Unable to close $self->{file} after reading"; return \%current_files; } =head2 prepare_manifest_skip $print_str = $mani->prepare_manifest_skip(); Gets a list of the files that Git ignores, and returns a string that can be put into F. =cut sub prepare_manifest_skip { my $self = shift; my $ignores_ref = $self->_get_ignores(); return $self->_compose_manifest_skip($ignores_ref); } =head2 determine_need_for_manifest_skip $need_for_skip = $mani->determine_need_for_manifest_skip($print_str); Determines whether F is needed. The tests used are: =over 4 =item * If the file doesn't exist, we need one. =item * If the proposed and existing contents differ, we need one. =back =cut sub determine_need_for_manifest_skip { my $self = shift; my $print_str = shift; if ( !-f $self->{skip} ) { return 1; } else { my $current_skips_ref = $self->_get_current_skips(); my $proposed_skips_ref = _get_proposed_skips($print_str); my $different_patterns_count = 0; foreach my $cur ( keys %{$current_skips_ref} ) { $different_patterns_count++ unless $proposed_skips_ref->{$cur}; } foreach my $pro ( keys %{$proposed_skips_ref} ) { $different_patterns_count++ unless $current_skips_ref->{$pro}; } $different_patterns_count ? return 1 : return; } } =head2 print_manifest_skip $mani->print_manifest_skip($print_str) if $need_for_skip; Writes F to a file. The example above does so only if needed. =cut sub print_manifest_skip { my $self = shift; my $print_str = shift; open my $MANIFEST_SKIP, '>', $self->{skip} or die "Unable to open $self->{skip} for writing"; $print_str .= $text_file_coda; print $MANIFEST_SKIP $print_str; close $MANIFEST_SKIP or die "Unable to close $self->{skip} after writing"; return 1; } # Gets a list of files that Git ignores sub _get_ignores { my $self = shift; my $gitignore = Parrot::BuildUtil::slurp_file('.gitignore'); my %ignores; my @ignore = sort grep { $_ !~ /^#/ } split( /\n/, $gitignore ); for my $ignore (@ignore) { my ($dirname, $basename) = (dirname($ignore), basename($ignore)); # .gitignore has different regexen than MANIFEST $ignore =~ s/\./\\./g; $ignore =~ s/\*/.\*/g; # printf "%s:%s:%s\n", $ignore, $dirname, $basename; $ignores{$ignore} = ""; } return \%ignores; } # Turns list of ignored files into F format sub _compose_manifest_skip { my $self = shift; my $ignore_ref = shift; my %ignore = %{$ignore_ref}; my $print_str = <<"END_HEADER"; # ex: set ro: # # generated by $self->{script} # # This file should contain a list of directories and files created in Parrot's # configuration and build processes which are not meant for inclusion in # distributions. # # Ignore the .git directory \\B\\.git\\b # ports/ should not go into release tarballs ^ports\$ ^ports/ END_HEADER foreach my $file ( sort keys %ignore ) { my $dir = $file; # printf "dir=$dir,file=$ignore{$file}\n"; foreach ( $ignore{$file} ) { $print_str .= ( $dir ne '.' ) ? "^$dir$_\$\n^$dir$_/\n" : "^$_\$\n^$_/\n"; } } return $print_str; } # Gets a list of the currently skipped files from F sub _get_current_skips { my $self = shift; my %current_skips; open my $SKIP, "<", $self->{skip} or die "Unable to open $self->{skip} for reading"; while ( my $line = <$SKIP> ) { chomp $line; next if $line =~ /^\s*$/; next if $line =~ /^#/; $current_skips{$line}++; } close $SKIP or die "Unable to close $self->{skip} after reading"; return \%current_skips; } # Gets list of files we're proposing to skip sub _get_proposed_skips { my $print_str = shift; my @proposed_lines = split /\n/, $print_str; my %proposed_skips = (); for my $line (@proposed_lines) { next if $line =~ /^\s*$/; next if $line =~ /^#/; $proposed_skips{$line}++; } return \%proposed_skips; } 1; =head1 MANIFEST FORMAT The format of the F (currently F and F are used) is: source_path [package]meta1,meta2,... or you may optionally specify a different destination path: source_path [package]meta1,meta2,... destination Additionally, there may be a C<*> in front of the whole line to designate a generated file: source_path *[package]meta1,meta2,... destination The square brackets around C are literal. C gives the name of the RPM that the given file will be installed for, and is only used by this script to skip files that are not members of any package. The various meta flags recognized are: =over 4 =item C Tag this file with C<%doc> in the RPM, and omit the leading path (because F will put it into a directory of its choosing). =item C Write this file to the location given by the C<--includedir> option. =item C Write this file to the location given by the C<--libdir> option. =item C Write this file to the location given by the C<--bindir> option. =back The optional C field provides a general way to change where a file will be written to. It will be applied before any metadata tags. Example: if this line is in the F file languages/snorkfest/snork-compile [main]bin and the C<--bindir=/usr/parroty/bin>, then the generated FVERSIONE-1.EarchE.rpm> file will contain the file C. =head1 SEE ALSO F. =head1 AUTHOR James E. Keenan (jkeenan@cpan.org) refactored code from earlier versions of F. =head1 LICENSE This is free software which you may distribute under the same terms as Perl itself. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: README.pod000644000765000765 132711533177633 17127 0ustar00brucebruce000000000000parrot-5.9.0/compilers/opsc# Copyright (C) 2010, Parrot Foundation. =head1 NAME opsc - An opcode compiler for Parrot =head1 DESCRIPTION Ops-to-C is a compiler to generate opcode definition files in C from Parrot's opcode definition language. =head1 SYNOPSIS opsc [-options] =head1 OPTIONS =over 4 =item -c, --core Generate C code for core ops (for use only in building the Parrot VM) =item -d, --dynamic Generate C code for dynamic ops in a single file. =item -q, --quiet Only report error messages, other messages are silent. =item -h, --help Print usage information. =item -n, --no-lines Do not print #line directives in generated C code. =item -g, --debug Perform all processing but do not write to any files. =back =cut tables.c000644000765000765 576711716253437 20042 0ustar00brucebruce000000000000parrot-5.9.0/src/string/encoding/* * Copyright (C) 2005-2011, Parrot Foundation. * * DO NOT EDIT THIS FILE DIRECTLY! * please update the tools/dev/gen_charset_tables.pl script instead. * * Created by gen_charset_tables.pl 19534 2007-07-02 02:12:08Z petdance * Overview: * This file contains various charset tables. * Data Structure and Algorithms: * History: * Notes: * References: */ /* HEADERIZER HFILE: none */ #include "tables.h" const INTVAL Parrot_iso_8859_1_typetable[256] = { 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, /* 0-7 */ 0x0200, 0x0320, 0x1220, 0x0220, 0x1220, 0x1220, 0x0200, 0x0200, /* 8-15 */ 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, /* 16-23 */ 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, /* 24-31 */ 0x0160, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, /* 32-39 */ 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, /* 40-47 */ 0x28d8, 0x28d8, 0x28d8, 0x28d8, 0x28d8, 0x28d8, 0x28d8, 0x28d8, /* 48-55 */ 0x28d8, 0x28d8, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, /* 56-63 */ 0x04c0, 0x28d5, 0x28d5, 0x28d5, 0x28d5, 0x28d5, 0x28d5, 0x28c5, /* 64-71 */ 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, /* 72-79 */ 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, /* 80-87 */ 0x28c5, 0x28c5, 0x28c5, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x24c0, /* 88-95 */ 0x04c0, 0x28d6, 0x28d6, 0x28d6, 0x28d6, 0x28d6, 0x28d6, 0x28c6, /* 96-103 */ 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, /* 104-111 */ 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, /* 112-119 */ 0x28c6, 0x28c6, 0x28c6, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x0200, /* 120-127 */ 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x1220, 0x0200, 0x0200, /* 128-135 */ 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, /* 136-143 */ 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, /* 144-151 */ 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, 0x0200, /* 152-159 */ 0x04e0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, /* 160-167 */ 0x04c0, 0x04c0, 0x28c4, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, /* 168-175 */ 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x28c6, 0x04c0, 0x04c0, /* 176-183 */ 0x04c0, 0x04c0, 0x28c4, 0x04c0, 0x04c0, 0x04c0, 0x04c0, 0x04c0, /* 184-191 */ 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, /* 192-199 */ 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, /* 200-207 */ 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x04c0, /* 208-215 */ 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c5, 0x28c6, /* 216-223 */ 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, /* 224-231 */ 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, /* 232-239 */ 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x04c0, /* 240-247 */ 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, 0x28c6, /* 248-255 */ }; /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ number.t000644000765000765 3711111715102036 15066 0ustar00brucebruce000000000000parrot-5.9.0/t/op#!./parrot # Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME t/op/number.t - Number Registers =head1 SYNOPSIS % prove t/op/number.t =head1 DESCRIPTION Tests the use of Parrot floating-point number registers. =cut .sub main :main .include 'test_more.pir' plan(126) test_set_n_nc() test_set_n() test_add_n_n_n() test_add_n_n() test_sub_n_n_n() test_sub_n_n() test_abs_n_i_ic_n_nc() test_mul_i() test_div_i() test_mod_n() test_eq_n_ic() test_eq_nc_ic() test_ne_n_ic() test_ne_n_nc_ic() test_lt_n_ic() test_lt_nc_ic() test_le_n_ic() test_le_nc_ic() test_gt_n_ic() test_gt_nc_ic() test_ge_n_ic() test_ge_nc_ic() test_if_n_ic() test_inc_n() test_dec_n() test_set_i_n() test_neg_n() test_neg_0_dot_0() test_mul_n_n() test_op_n_nc_nc() test_lt_nc_nc_ic() test_string_gt_num() test_null() test_dot_dig_parsing() test_sqrt_n_n() test_exception_div_n_n_by_zero() test_exception_div_n_nc_by_zero() test_exception_div_n_n_n_by_zero() test_exception_div_n_nc_n_by_zero() test_exception_div_n_n_nc_by_zero() test_exception_fdiv_n_n_by_zero() test_exception_fdiv_n_nc_by_zero() test_exception_fdiv_n_n_n_by_zero() test_exception_fdiv_n_nc_n_by_zero() test_exception_fdiv_n_n_nc_by_zero() test_mod_n_n_n_by_zero() test_mod_n_nc_n_by_zero() test_mod_n_n_nc_by_zero() # END_OF_TESTS .end .macro exception_is ( M ) .local pmc exception .local string message .get_results (exception) message = exception['message'] is( message, .M, .M ) .endm .sub test_set_n_nc set $N0, 1.0 set $N1, 4.0 set $N2, 16.0 set $N3, 64.0 set $N4, 256.0 set $N5, 1024.0 set $N6, 4096.0 set $N7, 16384.0 set $N8, 65536.0 set $N9, 262144.0 set $N10, 1048576.0 set $N11, 4194304.0 set $N12, 16777216.0 set $N13, 67108864.0 set $N14, 268435456.0 set $N15, 1073741824.0 set $N16, 4294967296.0 set $N17, 17179869184.0 set $N18, 68719476736.0 set $N19, 274877906944.0 set $N20, 1099511627776.0 set $N21, 4398046511104.0 set $N22, 17592186044416.0 set $N23, 70368744177664.0 set $N24, 281474976710656.0 set $N25, 1.12589990684262e+15 is( $N0, "1", 'set_n_nc' ) is( $N1, "4", 'set_n_nc' ) is( $N2, "16", 'set_n_nc' ) is( $N3, "64", 'set_n_nc' ) is( $N4, "256", 'set_n_nc' ) is( $N5, "1024", 'set_n_nc' ) is( $N6, "4096", 'set_n_nc' ) is( $N7, "16384", 'set_n_nc' ) is( $N8, "65536", 'set_n_nc' ) is( $N9, "262144", 'set_n_nc' ) is( $N10, "1048576", 'set_n_nc' ) is( $N11, "4194304", 'set_n_nc' ) is( $N12, "16777216", 'set_n_nc' ) is( $N13, "67108864", 'set_n_nc' ) is( $N14, "268435456", 'set_n_nc' ) is( $N15, "1073741824", 'set_n_nc' ) is( $N16, "4294967296", 'set_n_nc' ) is( $N17, "17179869184", 'set_n_nc' ) is( $N18, "68719476736", 'set_n_nc' ) is( $N19, "274877906944", 'set_n_nc' ) is( $N20, "1099511627776", 'set_n_nc' ) is( $N21, "4398046511104", 'set_n_nc' ) is( $N22, "17592186044416", 'set_n_nc' ) is( $N23, "70368744177664", 'set_n_nc' ) is( $N24, "281474976710656", 'set_n_nc' ) is( $N25, "1.12589990684262e+15", 'set_n_nc' ) .end .sub test_set_n set $N0, 42.0 set $N1, $N0 is( $N1, "42", 'set_n' ) .end .sub test_add_n_n_n set $N0, 1.0 add $N1, $N0, $N0 is( $N1, "2", 'add_n_n_n' ) add $N2, $N0, $N1 is( $N2, "3", 'add_n_n_n' ) add $N2, $N2, $N2 is( $N2, "6", 'add_n_n_n' ) .end .sub test_add_n_n set $N0, 1.0 add $N0, $N0 is( $N0, "2", 'add_n_n' ) set $N1, 1.0 add $N0, $N1 is( $N0, "3", 'add_n_n' ) add $N0, 3.0 is( $N0, "6", 'add_n_n' ) .end .sub test_sub_n_n_n set $N0, 424242.0 set $N1, 4200.0 sub $N2, $N0, $N1 is( $N2, "420042", 'sub_n_n_n' ) .end .sub test_sub_n_n set $N0, 424242.0 set $N1, 4200.0 sub $N0, $N1 is( $N0, "420042", 'sub_n_n' ) sub $N0, $N0 is( $N0, "0", 'sub_n_n' ) .end .sub test_abs_n_i_ic_n_nc set $I0, -1 abs $N0, $I0 abs $N1, -1 set $I1, 1 abs $N2, $I1 abs $N3, 1 set $N4, -1 abs $N4, $N4 abs $N5, -1.0 set $N6, 1.0 abs $N6, $N6 abs $N7, 1.0 is( $N0, "1", 'abs(n, i|ic|n|nc)' ) is( $N1, "1", 'abs(n, i|ic|n|nc)' ) is( $N2, "1", 'abs(n, i|ic|n|nc)' ) is( $N3, "1", 'abs(n, i|ic|n|nc)' ) is( $N4, "1", 'abs(n, i|ic|n|nc)' ) is( $N5, "1", 'abs(n, i|ic|n|nc)' ) is( $N6, "1", 'abs(n, i|ic|n|nc)' ) is( $N7, "1", 'abs(n, i|ic|n|nc)' ) .end .sub test_mul_i set $N0, 2.0 mul $N1, $N0, $N0 mul $N1, $N1, $N0 mul $N1, $N1, $N0 mul $N1, $N1, $N0 mul $N1, $N1, $N0 mul $N1, $N1, $N0 mul $N1, $N1, $N0 is( $N1, "256", 'mul_i' ) .end .sub test_div_i set $N0, 10.0 set $N1, 2.0 div $N2, $N0, $N1 is( $N2, "5", 'div_i' ) set $N3, 7.0 set $N4, 2.0 div $N3, $N3, $N4 is( $N3, "3.5", 'div_i' ) set $N5, 9.0 set $N6, -4.0 div $N7, $N5, $N6 is( $N7, "-2.25", 'div_i' ) .end .sub test_mod_n set $N0, 5.0 set $N1, 0.0 mod $N2, $N0, $N1 is( $N2, "5", 'mod_n' ) set $N0, 0.0 set $N1, 3.0 mod $N2, $N0, $N1 is( $N2, "0", 'mod_n' ) set $N0, 5.0 set $N1, 3.0 mod $N2, $N0, $N1 is( $N2, "2", 'mod_n' ) set $N0, 5.0 set $N1, -3.0 mod $N2, $N0, $N1 is( $N2, "-1", 'mod_n' ) set $N0, -5.0 set $N1, 3.0 mod $N2, $N0, $N1 is( $N2, "1", 'mod_n' ) set $N0, -5.0 set $N1, -3.0 mod $N2, $N0, $N1 is( $N2, "-2", 'mod_n' ) .end .sub test_eq_n_ic set $N0, 5.000001 set $N1, 5.000001 set $N2, 5.000002 eq $N0, $N1, ONE branch ERROR ok( 0, 'test eq_n_ic bad' ) ONE: ok( 1, 'eq_n_ic ok 1') eq $N1, $N2, ERROR branch TWO ok( 0, 'eq_n_ic bad 1' ) TWO: ok( 1, 'eq_n_ic ok 2') goto END ERROR: ok( 0, 'eq_n_ic bad 2' ) END: .end .sub test_eq_nc_ic set $N0, 1.000001 eq $N0, 1, ERROR branch ONE ok( 0, 'eq_nc_ic') ONE: ok( 1, 'eq_nc_ic ok 1') eq $N0, 1.000001, TWO branch ERROR ok( 0, 'eq_nc_ic') TWO: ok( 1, 'eq_nc_ic ok 2') goto END ERROR: ok( 0, 'eq_nc_ic') END: .end .sub test_ne_n_ic set $N0, -22.222222 set $N1, -22.222222 set $N2, 0.0 ne $N0, $N2, ONE branch ERROR ok( 0, 'ne_n_ic') ONE: ok( 1, 'ne_n_ic ok 1') ne $N0, $N1, ERROR branch TWO ok( 0, 'ne_n_ic') TWO: ok( 1, 'ne_n_ic ok 2') goto END ERROR: ok( 0, 'ne_n_ic') END: .end .sub test_ne_n_nc_ic set $N0, 1073741824.0 ne $N0, 1073741824.0, nok1 ok( 1, 'ne_n_nc_ic ok 1') branch ONE nok1: ok( 0, 'ne_n_nc_ic') ONE: ne $N0, 0.0, TWO branch ERROR TWO: ok( 1, 'ne_n_nc_ic ok 2') goto END ERROR: ok( 0, 'ne_n_nc_ic') END: .end .sub test_lt_n_ic set $N0, 1000.0 set $N1, 500.0 set $N2, 0.0 set $N3, 0.0 lt $N1, $N0, ONE branch ERROR ok( 0, 'lt_n_ic') ONE: ok( 1, 'lt_n_ic ok 1') lt $N0, $N1, ERROR branch TWO ok( 0, 'lt_n_ic') TWO: ok( 1, 'lt_n_ic ok 2') lt $N2, $N3, ERROR branch THREE ok( 0, 'lt_n_ic') THREE: ok( 1, 'lt_n_ic ok 3') goto END ERROR: ok( 0, 'lt_n_ic') END: .end .sub test_lt_nc_ic set $N0, 1000.0 set $N1, 500.0 set $N2, 0.0 lt $N0, 500.0, ERROR branch ONE ok( 0, 'lt_nc_ic') ONE: ok( 1, 'lt_nc_ic ok 1') lt $N1, 1000.0, TWO branch ERROR ok( 0, 'lt_nc_ic') TWO: ok( 1, 'lt_nc_ic ok 2') lt $N0, 0.0, ERROR branch THREE ok( 0, 'lt_nc_ic') THREE: ok( 1, 'lt_nc_ic ok 3') goto END ERROR: ok( 0, 'lt_nc_ic') END: .end .sub test_le_n_ic set $N0, 1000.0 set $N1, 500.0 set $N2, 0.0 set $N3, 0.0 le $N1, $N0, ONE branch ERROR ok( 0, 'le_n_ic') ONE: ok( 1, 'le_n_ic ok 1') le $N0, $N1, ERROR branch TWO ok( 0, 'le_n_ic') TWO: ok( 1, 'le_n_ic ok 2') le $N2, $N3, THREE branch ERROR ok( 0, 'le_n_ic') THREE: ok( 1, 'le_n_ic ok 3') goto END ERROR: ok( 0, 'le_n_ic') END: .end .sub test_le_nc_ic set $N0, 1000.0 set $N1, 500.0 set $N2, 0.0 le $N0, 500.0, ERROR branch ONE ok( 0, 'le_nc_ic') ONE: ok( 1, 'le_nc_ic ok 1') le $N1, 1000.0, TWO branch ERROR ok( 0, 'le_nc_ic') TWO: ok( 1, 'le_nc_ic ok 2') le $N2, 0.0, THREE branch ERROR ok( 0, 'le_nc_ic') THREE: ok( 1, 'le_nc_ic ok 3') goto END ERROR: ok( 0, 'le_nc_ic') END: .end .sub test_gt_n_ic set $N0, 500.0 set $N1, 1000.0 set $N2, 0.0 set $N3, 0.0 gt $N1, $N0, ONE branch ERROR ok( 0, 'gt_n_ic') ONE: ok( 1, 'gt_n_ic ok 1') gt $N0, $N1, ERROR branch TWO ok( 0, 'gt_n_ic') TWO: ok( 1, 'gt_n_ic ok 2') gt $N2, $N3, ERROR branch THREE ok( 0, 'gt_n_ic') THREE: ok( 1, 'gt_n_ic ok 3') goto END ERROR: ok( 0, 'gt_n_ic') END: .end .sub test_gt_nc_ic set $N0, 500.0 set $N1, 1000.0 set $N2, 0.0 gt $N0, 1000.0, ERROR branch ONE ok( 0, 'gt_nc_ic') ONE: ok( 1, 'gt_nc_ic ok 1') gt $N1, 500.0, TWO branch ERROR ok( 0, 'gt_nc_ic') TWO: ok( 1, 'gt_nc_ic ok 2') gt $N2, 0.0, ERROR branch THREE ok( 0, 'gt_nc_ic') THREE: ok( 1, 'gt_nc_ic ok 3') goto END ERROR: ok( 0, 'gt_nc_ic') END: .end .sub test_ge_n_ic set $N0, 500.0 set $N1, 1000.0 set $N2, 0.0 set $N3, 0.0 ge $N1, $N0, ONE branch ERROR ok( 0, 'ge_n_ic') ONE: ok( 1, 'ge_n_ic ok 1') ge $N0, $N1, ERROR branch TWO ok( 0, 'ge_n_ic') TWO: ok( 1, 'ge_n_ic ok 2') ge $N2, $N3, THREE branch ERROR ok( 0, 'ge_n_ic') THREE: ok( 1, 'ge_n_ic ok 3') goto END ERROR: ok( 0, 'ge_n_ic') END: .end .sub test_ge_nc_ic set $N0, 500.0 set $N1, 1000.0 set $N2, 0.0 ge $N0, 1000.0, ERROR branch ONE ok( 0, 'ge_nc_ic') ONE: ok( 1, 'ge_nc_ic ok 1') ge $N1, 500.0, TWO branch ERROR ok( 0, 'ge_nc_ic') TWO: ok( 1, 'ge_nc_ic ok 2') ge $N2, 0.0, THREE branch ERROR ok( 0, 'ge_nc_ic') THREE: ok( 1, 'ge_nc_ic ok 3') goto END ERROR: ok( 0, 'ge_nc_ic') END: .end .sub test_if_n_ic set $N0, 1000.0 set $N1, 500.0 set $N2, 0.0 if $N0, ONE branch ERROR ok( 0, 'if_n_ic') ONE: ok( 1, 'if_n_ic ok 1') if $N1, TWO branch ERROR ok( 0, 'if_n_ic') TWO: ok( 1, 'if_n_ic ok 2') if $N2, ERROR branch THREE ok( 0, 'if_n_ic') THREE: ok( 1, 'if_n_ic ok 3') goto END ERROR: ok( 0, 'if_n_ic') END: .end .sub test_inc_n set $N0, 0.0 inc $N0 is( $N0, "1", 'inc_n' ) inc $N0 inc $N0 inc $N0 inc $N0 is( $N0, "5", 'inc_n' ) .end .sub test_dec_n set $N0, 0.0 dec $N0 is( $N0, "-1", 'dec_n' ) dec $N0 dec $N0 dec $N0 dec $N0 is( $N0, "-5", 'dec_n' ) .end .sub test_set_i_n set $N0, 0.0 set $I0, $N0 is( $I0, "0", 'set_i_n' ) set $N1, 2147483647.0 set $I1, $N1 is( $I1, "2147483647", 'set_i_n' ) set $N2, -2147483648.0 set $I2, $N2 is( $I2, "-2147483648", 'set_i_n' ) .end .sub test_neg_n neg $N0,3.0 neg $N0,$N0 neg $N0 is( $N0, "-3", 'neg_n' ) .end .sub test_neg_0_dot_0 load_bytecode 'config.pbc' $P1 = _config() $P2 = $P1['has_negative_zero'] unless $P2 goto negative_zero_todoed set $N1, 0 neg $N1 is( $N1, "-0", 'neg 0.0' ) .return () negative_zero_todoed: todo(0, '-0.0 not implemented, GH #366') .end .sub test_mul_n_n set $N0,3.0 set $N1,4.0 mul $N0,$N1 is( $N0, "12", 'mul_n_n' ) .end .sub test_op_n_nc_nc add $N1, 2.0, 3.0 is( $N1, "5", 'op_n_nc_nc' ) sub $N1, 2.0, 4.0 is( $N1, "-2", 'op_n_nc_nc' ) .end .sub test_lt_nc_nc_ic lt 2.0, 1.0, nok ok( 1, 'lt_nc_nc_ic ok 1') lt 3.0, 4.0, ok_2 nok: ok( 0, 'lt_nc_nc_ic') goto END ok_2: ok( 1, 'lt_nc_nc_ic ok 2') END: .end .sub test_string_gt_num set $S0, "1" set $S1, "12.0" set $S2, "-2.45" set $S3, "25e2" set $S4, "Banana" set $N0, $S0 set $N1, $S1 set $N2, $S2 set $N3, $S3 set $N4, $S4 is( $N0, "1", 'string -> num' ) is( $N1, "12", 'string -> num' ) is( $N2, "-2.45", 'string -> num' ) is( $N3, "2500", 'string -> num' ) is( $N4, "0", 'string -> num' ) .end .sub test_null set $N31, 12.5 is( $N31, "12.5", 'null' ) null $N31 is( $N31, "0", 'null' ) .end .sub test_dot_dig_parsing set $N0, .5 is( $N0, "0.5", '.dig parsing' ) .end # Don't check exact string representation. Last digit part can be different */ .sub test_sqrt_n_n $P0 = new 'Float' $N1 = 2 $N2 = sqrt $N1 $P0 = $N2 is( $P0, 1.414213562373, 'sqrt_n_n',1e-6 ) $N2 = sqrt 2.0 $P0 = $N2 is( $P0, 1.414213562373, 'sqrt_n_n',1e-6 ) .end .sub test_exception_div_n_n_by_zero push_eh handler set $N0, 0 set $N1, 10 div $N1, $N0 handler: .exception_is( 'Divide by zero' ) .end .sub test_exception_div_n_nc_by_zero push_eh handler set $N1, 10 div $N1, 0 handler: .exception_is( 'Divide by zero' ) .end .sub test_exception_div_n_n_n_by_zero push_eh handler set $N0, 0 set $N1, 10 div $N2, $N1, $N0 handler: .exception_is( 'Divide by zero' ) .end .sub test_exception_div_n_nc_n_by_zero push_eh handler set $N0, 0 div $N2, 10, $N0 handler: .exception_is( 'Divide by zero' ) .end .sub test_exception_div_n_n_nc_by_zero push_eh handler set $N1, 10 div $N2, $N1, 0 handler: .exception_is( 'Divide by zero' ) .end .sub test_exception_fdiv_n_n_by_zero push_eh handler set $N0, 0 set $N1, 10 fdiv $N1, $N0 handler: .exception_is( 'Divide by zero' ) .end .sub test_exception_fdiv_n_nc_by_zero push_eh handler set $N1, 10 fdiv $N1, 0 handler: .exception_is( 'Divide by zero' ) .end .sub test_exception_fdiv_n_n_n_by_zero push_eh handler set $N0, 0 set $N1, 10 fdiv $N2, $N1, $N0 handler: .exception_is( 'Divide by zero' ) .end .sub test_exception_fdiv_n_nc_n_by_zero push_eh handler set $N0, 0 fdiv $N2, 10, $N0 handler: .exception_is( 'Divide by zero' ) .end .sub test_exception_fdiv_n_n_nc_by_zero push_eh handler set $N1, 10 fdiv $N2, $N1, 0 handler: .exception_is( 'Divide by zero' ) .end .sub test_mod_n_n_n_by_zero set $N0, 0 set $N1, 10 mod $N2, $N1, $N0 is( $N2, "10", 'mod_n_n_n by zero' ) .end .sub test_mod_n_nc_n_by_zero set $N0, 0 mod $N2, 10, $N0 is( $N2, 10, 'mod_n_nc_n by zero' ) .end .sub test_mod_n_n_nc_by_zero set $N1, 10 mod $N2, $N1, 0 is( $N2, '10', 'mod_n_n_nc by zero' ) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: isreg.pm000644000765000765 275311533177633 16415 0ustar00brucebruce000000000000parrot-5.9.0/config/auto# Copyright (C) 2001-2003, Parrot Foundation. =head1 NAME config/auto/isreg - S_ISREG =head1 DESCRIPTION Determines if the C library has a working C. =cut package auto::isreg; use strict; use warnings; use base qw(Parrot::Configure::Step); use Parrot::Configure::Utils ':auto'; sub _init { my $self = shift; my %data; $data{description} = q{Does your C library have a working S_ISREG}; $data{result} = q{}; return \%data; } sub runstep { my ( $self, $conf ) = @_; my $errormsg = _first_probe_for_isreg($conf); if (! $errormsg) { $errormsg = _second_probe_for_isreg($conf); } $conf->cc_clean(); $self->_evaluate_isreg($conf, $errormsg); return 1; } sub _first_probe_for_isreg { my $conf = shift; my $errormsg; $conf->cc_gen('config/auto/isreg/test_c.in'); eval { $conf->cc_build(); }; $errormsg = 1 if $@; return $errormsg; } sub _second_probe_for_isreg { my $conf = shift; my $ccrunfailure; $ccrunfailure++ if ( $conf->cc_run() !~ /ok/ ); return $ccrunfailure; } sub _evaluate_isreg { my ($self, $conf, $anyerror) = @_; my $test; $test = (! defined $anyerror) ? 1 : 0; $conf->data->set( isreg => $test ); my $test_str = $test ? " (Yep) " : " (no) "; $conf->debug($test_str); $self->set_result( $test ? 'yes' : 'no' ); return 1; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: mime_base64.t000644000765000765 2600512101554067 16724 0ustar00brucebruce000000000000parrot-5.9.0/t/library#!./parrot # Copyright (C) 2006-2012, Parrot Foundation. =head1 NAME t/library/mime_base64.t - MIME::Base64 tests =head1 SYNOPSIS % prove t/library/mime_base64.t =head1 DESCRIPTION This file contains various tests related to base64 encoding and decoding. Some test cases were taken from base64.t of MIME::Base64 from Perl 5. =cut .sub test :main load_bytecode "dumper.pbc" load_bytecode 'Test/More.pbc' load_bytecode 'MIME/Base64.pbc' load_bytecode 'PGE.pbc' load_bytecode 'PGE/Util.pbc' load_language 'data_json' .local pmc plan, is, ok, lives_ok plan = get_hll_global [ 'Test'; 'More' ], 'plan' is = get_hll_global [ 'Test'; 'More' ], 'is' ok = get_hll_global [ 'Test'; 'More' ], 'ok' plan(551) .local pmc json json = compreg 'data_json' .local pmc encode_decode_tests, decode_tests encode_decode_tests = json.'compile'( <<'END_JSON' ) [ ["Hello, World!\n","SGVsbG8sIFdvcmxkIQo="], ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", "YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFh\nYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYQ=="], ["\u0000","AA=="], ["\u0001","AQ=="], ["\u0002","Ag=="], ["\u0003","Aw=="], ["\u0004","BA=="], ["\u0005","BQ=="], ["\u0006","Bg=="], ["\u0007","Bw=="], ["\b","CA=="], ["\t","CQ=="], ["\n","Cg=="], ["\u000b","Cw=="], ["\f","DA=="], ["\r","DQ=="], ["\u000e","Dg=="], ["\u000f","Dw=="], ["\u0010","EA=="], ["\u0011","EQ=="], ["\u0012","Eg=="], ["\u0013","Ew=="], ["\u0014","FA=="], ["\u0015","FQ=="], ["\u0016","Fg=="], ["\u0017","Fw=="], ["\u0018","GA=="], ["\u0019","GQ=="], ["\u001a","Gg=="], ["\u001b","Gw=="], ["\u001c","HA=="], ["\u001d","HQ=="], ["\u001e","Hg=="], ["\u001f","Hw=="], [" ","IA=="], ["!","IQ=="], ["\"","Ig=="], ["#","Iw=="], ["$","JA=="], ["%","JQ=="], ["&","Jg=="], ["'","Jw=="], ["(","KA=="], [")","KQ=="], ["*","Kg=="], ["+","Kw=="], [",","LA=="], ["-","LQ=="], [".","Lg=="], ["/","Lw=="], ["0","MA=="], ["1","MQ=="], ["2","Mg=="], ["3","Mw=="], ["4","NA=="], ["5","NQ=="], ["6","Ng=="], ["7","Nw=="], ["8","OA=="], ["9","OQ=="], [":","Og=="], [";","Ow=="], ["<","PA=="], ["=","PQ=="], [">","Pg=="], ["?","Pw=="], ["@","QA=="], ["A","QQ=="], ["B","Qg=="], ["C","Qw=="], ["D","RA=="], ["E","RQ=="], ["F","Rg=="], ["G","Rw=="], ["H","SA=="], ["I","SQ=="], ["J","Sg=="], ["K","Sw=="], ["L","TA=="], ["M","TQ=="], ["N","Tg=="], ["O","Tw=="], ["P","UA=="], ["Q","UQ=="], ["R","Ug=="], ["S","Uw=="], ["T","VA=="], ["U","VQ=="], ["V","Vg=="], ["W","Vw=="], ["X","WA=="], ["Y","WQ=="], ["Z","Wg=="], ["[","Ww=="], ["\\","XA=="], ["]","XQ=="], ["^","Xg=="], ["_","Xw=="], ["`","YA=="], ["a","YQ=="], ["b","Yg=="], ["c","Yw=="], ["d","ZA=="], ["e","ZQ=="], ["f","Zg=="], ["g","Zw=="], ["h","aA=="], ["i","aQ=="], ["j","ag=="], ["k","aw=="], ["l","bA=="], ["m","bQ=="], ["n","bg=="], ["o","bw=="], ["p","cA=="], ["q","cQ=="], ["r","cg=="], ["s","cw=="], ["t","dA=="], ["u","dQ=="], ["v","dg=="], ["w","dw=="], ["x","eA=="], ["y","eQ=="], ["z","eg=="], ["{","ew=="], ["|","fA=="], ["}","fQ=="], ["~","fg=="], ["\u007f","fw=="], ["\u0080","woA="], ["\u0081","woE="], ["\u0082","woI="], ["\u0083","woM="], ["\u0084","woQ="], ["\u0085","woU="], ["\u0086","woY="], ["\u0087","woc="], ["\u0088","wog="], ["\u0089","wok="], ["\u008a","woo="], ["\u008b","wos="], ["\u008c","wow="], ["\u008d","wo0="], ["\u008e","wo4="], ["\u008f","wo8="], ["\u0090","wpA="], ["\u0091","wpE="], ["\u0092","wpI="], ["\u0093","wpM="], ["\u0094","wpQ="], ["\u0095","wpU="], ["\u0096","wpY="], ["\u0097","wpc="], ["\u0098","wpg="], ["\u0099","wpk="], ["\u009a","wpo="], ["\u009b","wps="], ["\u009c","wpw="], ["\u009d","wp0="], ["\u009e","wp4="], ["\u009f","wp8="], ["\u00a0","wqA="], ["\u00a1","wqE="], ["\u00a2","wqI="], ["\u00a3","wqM="], ["\u00a4","wqQ="], ["\u00a5","wqU="], ["\u00a6","wqY="], ["\u00a7","wqc="], ["\u00a8","wqg="], ["\u00a9","wqk="], ["\u00aa","wqo="], ["\u00ab","wqs="], ["\u00ac","wqw="], ["\u00ad","wq0="], ["\u00ae","wq4="], ["\u00af","wq8="], ["\u00b0","wrA="], ["\u00b1","wrE="], ["\u00b2","wrI="], ["\u00b3","wrM="], ["\u00b4","wrQ="], ["\u00b5","wrU="], ["\u00b6","wrY="], ["\u00b7","wrc="], ["\u00b8","wrg="], ["\u00b9","wrk="], ["\u00ba","wro="], ["\u00bb","wrs="], ["\u00bc","wrw="], ["\u00bd","wr0="], ["\u00be","wr4="], ["\u00bf","wr8="], ["\u00c0","w4A="], ["\u00c1","w4E="], ["\u00c2","w4I="], ["\u00c3","w4M="], ["\u00c4","w4Q="], ["\u00c5","w4U="], ["\u00c6","w4Y="], ["\u00c7","w4c="], ["\u00c8","w4g="], ["\u00c9","w4k="], ["\u00ca","w4o="], ["\u00cb","w4s="], ["\u00cc","w4w="], ["\u00cd","w40="], ["\u00ce","w44="], ["\u00cf","w48="], ["\u00d0","w5A="], ["\u00d1","w5E="], ["\u00d2","w5I="], ["\u00d3","w5M="], ["\u00d4","w5Q="], ["\u00d5","w5U="], ["\u00d6","w5Y="], ["\u00d7","w5c="], ["\u00d8","w5g="], ["\u00d9","w5k="], ["\u00da","w5o="], ["\u00db","w5s="], ["\u00dc","w5w="], ["\u00dd","w50="], ["\u00de","w54="], ["\u00df","w58="], ["\u00e0","w6A="], ["\u00e1","w6E="], ["\u00e2","w6I="], ["\u00e3","w6M="], ["\u00e4","w6Q="], ["\u00e5","w6U="], ["\u00e6","w6Y="], ["\u00e7","w6c="], ["\u00e8","w6g="], ["\u00e9","w6k="], ["\u00ea","w6o="], ["\u00eb","w6s="], ["\u00ec","w6w="], ["\u00ed","w60="], ["\u00ee","w64="], ["\u00ef","w68="], ["\u00f0","w7A="], ["\u00f1","w7E="], ["\u00f2","w7I="], ["\u00f3","w7M="], ["\u00f4","w7Q="], ["\u00f5","w7U="], ["\u00f6","w7Y="], ["\u00f7","w7c="], ["\u00f8","w7g="], ["\u00f9","w7k="], ["\u00fa","w7o="], ["\u00fb","w7s="], ["\u00fc","w7w="], ["\u00fd","w70="], ["\u00fe","w74="], ["\u00ff","w78="], ["\u0000\u00ff","AMO/"], ["\u00ff\u0000","w78A"], ["\u0000\u0000\u0000","AAAA"], ["",""], ["a","YQ=="], ["aa","YWE="], ["aaa","YWFh"], ["aaa","YWFh"], ["aaa","YWFh"], ["aaa","YWFh"], ["Aladdin:open sesame","QWxhZGRpbjpvcGVuIHNlc2FtZQ=="], ["Multipurpose Internet Mail Extensions: The Base64 Content-Transfer-Encoding is designed to represent sequences of octets in a form that is not humanly readable. ", "TXVsdGlwdXJwb3NlIEludGVybmV0IE1haWwgRXh0ZW5zaW9uczogVGhlIEJhc2U2NCBDb250ZW50\nLVRyYW5zZmVyLUVuY29kaW5nIGlzIGRlc2lnbmVkIHRvIHJlcHJlc2VudCBzZXF1ZW5jZXMgb2Yg\nb2N0ZXRzIGluIGEgZm9ybSB0aGF0IGlzIG5vdCBodW1hbmx5IHJlYWRhYmxlLiA="] ] END_JSON decode_tests = json.'compile'( <<'END_JSON' ) [ ["YWE=","aa"], [" YWE=","aa"], ["Y WE=","aa"], ["YWE= ","aa"], ["Y\nW\r\nE=","aa"], ["YWE=====","aa"], ["YWE","aa"], ["YWFh====","aaa"], ["YQ","a"], ["",""] ] END_JSON # TODO: These decoding tests seem to cause weird output # ["Y",""], # ["x==",""], .local int count count = 0 .local pmc test_iterator, test_case .local string plain, base64, comment, comment_count, enc, esc_plain encode_decode_tests = encode_decode_tests() test_iterator = iter encode_decode_tests enc_dec_loop: unless test_iterator goto enc_dec_loop_end test_case = shift test_iterator plain = shift test_case base64 = shift test_case comment = 'encode' comment_count = count $I0 = encoding plain enc = encodingname $I0 esc_plain = escape plain comment = concat comment, comment_count comment = concat comment, " " comment = concat comment, enc comment = concat comment, ":\"" comment = concat comment, esc_plain comment = concat comment, "\"" test_encode( plain, base64, comment ) comment = 'decode' comment_count = count comment = concat comment, comment_count test_decode( plain, base64, comment ) inc count goto enc_dec_loop enc_dec_loop_end: decode_tests = decode_tests() test_iterator = iter decode_tests dec_loop: unless test_iterator goto dec_loop_end test_case = shift test_iterator base64 = shift test_case plain = shift test_case comment = 'decode' comment_count = count comment = concat comment, comment_count test_decode( plain, base64, comment ) inc count goto dec_loop dec_loop_end: gh813_base64_utf8() .end .sub gh813_base64_utf8 .local pmc lives_ok lives_ok = get_hll_global [ 'Test'; 'More' ], 'lives_ok' lives_ok(<<'CODE', 'enc_sub("\x{203e}") # Github issue #813') .sub foo .local pmc enc_sub enc_sub = get_global [ "MIME"; "Base64" ], 'encode_base64' .local string result_encode result_encode = enc_sub(utf8:"\x{203e}") .end CODE .end .sub test_encode .param string plain .param string base64 .param string comment .local pmc enc_sub enc_sub = get_global [ "MIME"; "Base64" ], 'encode_base64' .local pmc is is = get_hll_global [ 'Test'; 'More' ], 'is' .local string result_encode result_encode = enc_sub( plain ) is( result_encode, base64, comment ) .end .sub test_decode .param string plain .param string base64 .param string comment .include "iglobals.pasm" .local pmc interp interp = getinterp .local pmc config config = interp[.IGLOBALS_CONFIG_HASH] .local int has_icu has_icu = config['has_icu'] .local int bigendian bigendian = config['bigendian'] .local pmc dec_sub dec_sub = get_global [ "MIME"; "Base64" ], 'decode_base64' .local pmc is, skip is = get_hll_global [ 'Test'; 'More' ], 'is' skip = get_hll_global [ 'Test'; 'More' ], 'skip' $S0 = 'AAAA' ne base64, $S0, CONT_TEST ## Note: also fails on solaris little-endian skip(1, '\0\0\0 fails to compare for unknown reasons GH #855') goto END unless bigendian goto CONT_TEST skip(1, 'multi-byte codepoint test in big-endian') goto END CONT_TEST: .local string decode, result_decode .local string enc, enc1 $I0 = encoding plain enc = encodingname $I0 if $I0 > 2 goto DEC_ENC # ascii, latin1 decode = dec_sub( base64 ) decode = trans_encoding decode, $I0 goto DEC_2 DEC_ENC: decode = dec_sub( base64, enc ) DEC_2: $I1 = encoding decode enc1 = encodingname $I1 comment = concat comment, " " comment = concat comment, enc1 comment = concat comment, " <-" comment = concat comment, enc .local string plain_norm, result_norm if has_icu goto HAS_ICU is( decode, plain, comment ) goto END HAS_ICU: result_norm = compose decode plain_norm = compose plain is( result_norm, plain_norm, comment ) END: .end =head1 AUTHOR Bernhard Schmalhofer and Reini Urban. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: optimizer.pod000644000765000765 1160011533177634 16775 0ustar00brucebruce000000000000parrot-5.9.0/docs/dev# Copyright (C) 2001-2007, Parrot Foundation. =head1 NAME docs/dev/optimizer.pod - About the IMCC optimizer =head1 ABSTRACT This document describes how the IMCC optimizer works. =head1 DESCRIPTION The objective of the IMCC optimizer is to take a PASM function as input and apply code-improving transformations to it to be more efficient, i.e. improving execution time and reducing code size. It must do this while preserving the same code behavior. =head2 Data Structures The optimizer uses a number of data structures to build a model of the code to be optimized. =over 4 =item IMC_Unit The IMC_Unit structure contains all the information known about a function. It is passed in to each optimizer method. =item Instruction Each instruction line has an Instruction structure. Pointers to the first and last Instruction are stored in IMC_Unit. Instructions are stored as a linked list. To iterate through all Instructions, use: Instruction *ins; for (ins = unit->instructions; ins; ins = ins->next) { ... } =item Basic_block Basic blocks are the most important structure for optimization. A basic block identifies a block of instructions that will all execute in sequence without jumps into or out of that block. All labels will appear at the beginning of a block, and all conditional or unconditional jumps will appear at the end. Basic_block structures are stored as an array of pointers, each with an index that denotes their position in the array. Block 0 is implicitly the top block. To iterate through all Basic_blocks, use: int i; for (i = 0; i < unit->n_basic_blocks; i++) { ... } =item Edge Edges denote the flow of control between Basic_blocks. Edges and Basic_blocks together make up the basic CFG. Each Basic_block has *pred_list and *succ_list pointer to the first predecessor edge and successor edge, respectively. Each edge has a *to and *from pointer to the Basic_blocks it joins. To iterate through all predecessor Edges, use: Edge *pred; for (pred = to->pred_list; pred; pred=pred->pred_next) { ... } =item Loop_info Loop_info structures denote the presence of loops in the instructions. They are found by identifying backedges, where control passes from a tail block to the head of the loop. Loop_info stores the header, preheader, exit blocks, and depth of the loop. =item Set Set is a useful structure for defining sets of integers, which map to indexes of structures. This is used most often to create sets of Basic_blocks. Dominators, dominance frontiers, and loops use Set. A Set must be a defined size, and cannot grow or shrink. Most standard set operations are implemented: add, contains, copy, equal, union, and intersection. =back =head2 Optimizations Optimizations are organized into an optimization loop within imc_reg_alloc() in reg_alloc.c. The ordering is based on the amount of CFG information needed by each group of optimizations: pre_optimize(), cfg_optimize(), and optimize(). Each optimization function (group and individual) returns an int, with TRUE denoting that an optimization has been performed and a change to the code has been made. The power of the optimizer is that performing one optimization may often allow another to be performed as well. Once all optimizations have been run without changes, the optimizer is finished. The optimizer loop works as follows: =over 4 =item 1. Run all pre_optimize() optimizations until none make a change. =item 2. Build basic block info. =item 3. Run all cfg_optimize() optimizations. If one makes a change, go to step 1. =item 4. Build all other CFG info (dominators, loops, life analysis). =item 5. Run all optimize() optimizations. If one makes a change, go to step 1. =back Two cfg_optimize() or optimize() optimizations cannot be run in a row. This is because most of these make the CFG information invalid when a change is performed, and the CFG must be rebuilt. =head3 Pre optimizer Optimizations using only Instruction info, no CFG constructed. =over 4 =item strength_reduce() Converts an expensive instruction to a simpler one =item if_branch() Converts if/branch/label constructs to a simpler form =back =head3 CFG optimizer Optimizations using Basic_block info. These functions invalidate the CFG when a change is made. =over 4 =item branch_reorg() Moves statements following an unconditional jump in order to remove the jump =item branch_branch() Replaces a branch directly to another branch with a single branch to the end of the chain =item unused_label() Removes unused labels =item dead_code_remove() Removes unreachable code =back =head3 Optimizer =over 4 =item constant_propagation() Does conservative constant propagation, i.e. replaces "1 + 2" with "3" =item used_once() Removes an instruction when the register written is only used once (only appears in that instruction) =back =head1 AUTHOR Curtis Rawls =cut 03-past.t000644000765000765 603612101554067 17277 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/opsc#! ./parrot-nqp # Copyright (C) 2010-2012, Parrot Foundation. # "Comprehensive" test for creating PAST for op. # Parse single op and check various aspects of created PAST. pir::load_bytecode('opsc.pbc'); pir::load_bytecode('dumper.pbc'); Q:PIR{ .include "test_more.pir" }; my $buf := q| BEGIN_OPS_PREAMBLE /* THE HEADER */ END_OPS_PREAMBLE op bar() { /* Nothing here */ } inline op foo(out INT, in PMC, inconst NUM) :flow :deprecated { foo(); } inline op bar(out PMC) { foo(); } inline op bar(out PMC, in INT) { foo(); } |; my $compiler := pir::compreg__Ps('Ops'); my $past := $compiler.compile($buf, target => 'past'); my $trans := Ops::Trans::C.new; ok(1, "PAST::Node created"); my $preambles := $past; ok(~$preambles[0] ~~ /HEADER/, 'Header parsed'); my @ops := @($past); # One "bar" and two "foo" is(+@ops, 6, 'We have 6 ops'); my $op := @ops[1]; ok($op.name == 'foo', "Name parsed"); my %flags := $op; ok(%flags, ':flow flag parsed'); ok(%flags, ':deprecated flag parsed'); ok(%flags == 2, "And there are only 2 flags"); # Check op params my @args := $op; ok(+@args == 3, "Got 3 parameters"); my $arg; $arg := @args[0]; ok($arg eq 'out', 'First direction is correct'); ok($arg eq 'INT', 'First type is correct'); $arg := @args[1]; ok($arg eq 'in', 'Second direction is correct'); ok($arg eq 'PMC', 'Second type is correct'); $arg := @args[2]; ok($arg eq 'inconst', 'Third direction is correct'); ok($arg eq 'NUM', 'Third type is correct'); # Check normalization @args := $op; $arg := @args[0]; ok($arg eq 'o', 'First direction is correct'); ok($arg eq 'i', 'First type is correct'); ok(!($arg), 'First arg without variant'); $arg := @args[1]; ok($arg eq 'i', 'Second direction is correct'); ok($arg eq 'p', 'Second type is correct'); ok($arg eq 'pc', 'Second variant is correct'); $arg := @args[2]; ok($arg eq 'i', 'Third direction is correct'); ok($arg eq 'nc', 'Third type is correct'); ok(!($arg), 'Third arg without variant'); ok( ($op.arg_types).join('_') eq 'i_p_nc', "First variant correct"); # Second created op should have _pc_ $op := @ops[2]; ok( $op.arg_types.join('_') eq 'i_pc_nc', "Second variant correct"); # Check body munching. $op := @ops[0]; ok( $op.get_body($trans) ~~ /'return cur_opcode + 1'/ , "goto NEXT appended for non :flow ops"); # Check write barriers. ok( !$op.need_write_barrier, "Write Barrier is not required"); $op := @ops[3]; ok( $op.need_write_barrier, "'out PMC' Write Barrier"); $op := @ops[4]; ok( $op.need_write_barrier, "'inout STR' Write Barrier"); $op := @ops[5]; ok( $op.need_write_barrier, "Write Barrier calculated properly"); ok( $op.get_body($trans) ~~ /PARROT_GC_WRITE_BARRIER/, "We have Write Barrier inserted into op"); done_testing(); # Don't forget to update plan! # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=perl6: test_c.in000644000765000765 106311567202622 17276 0ustar00brucebruce000000000000parrot-5.9.0/config/auto/gcc/* Copyright (C) 2002-2009, Parrot Foundation. figure out if the compiler is gcc. */ #include #include int main(int argc, char **argv) { puts("("); #if defined(__GNUC__) && ! defined(__INTEL_COMPILER) printf("__GNUC__ => %d,\n", __GNUC__); # ifdef __GNUC_MINOR__ printf("__GNUC_MINOR__ =>%d,\n", __GNUC_MINOR__); # endif #else puts("__GNUC__ => undef,"); #endif puts(");"); return EXIT_SUCCESS; } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ triangle.p6000644000765000765 522611533177634 17706 0ustar00brucebruce000000000000parrot-5.9.0/examples/opengluse v6; =begin pod =head1 TITLE triangle.p6 - Initialize GLUT and render a simple OpenGL animation =head1 SYNOPSIS $ cd rakudo-home $ export PERL6LIB=rakudo-home:parrot-home/runtime/parrot/library $ ./perl6 parrot-home/examples/opengl/triangle.p6 =head1 DESCRIPTION This simple example shows how to load the OpenGL/GLU/GLUT wrapper, create a small GLUT window and register the appropriate callbacks, and finally display a simple OpenGL animation until the user closes the window. It is a simple translation of F to Perl 6. To quit the example, press C or the C key, or close the window using your window manager (using the X in the corner of the window title bar, for example). To pause or restart the animation, press any other ASCII key. For a more complex and well-behaved example, try F. =end pod # None of these currently work; they all create an inescapable new lexical pad # require 'glutconst.p6'; # 'glutconst.p6'.evalfile; # eval open('glutconst.p6').slurp; constant GLUT_RGBA = 0x0000; constant GLUT_DOUBLE = 0x0002; constant GL_TRIANGLES = 0x0004; constant GL_DEPTH_BUFFER_BIT = 0x0100; constant GL_COLOR_BUFFER_BIT = 0x4000; use OpenGL:from; use NCI::Utils:from; our $rotating = 1; our $prev_time = time(); our $window; sub MAIN(*@ARGS is rw) { # Initialize GLUT @ARGS = call_toolkit_init(&glutInit, @ARGS, $*PROGRAM_NAME); # Set display mode glutInitDisplayMode(GLUT_DOUBLE +| GLUT_RGBA); # Create GLUT window $window = glutCreateWindow('Rotating Triangle NCI Test'); # Set up GLUT callbacks glutDisplayFunc( &draw ); glutIdleFunc( &idle ); glutKeyboardFunc( &keyboard ); # Enter the GLUT main loop glutMainLoop(); # Rakudo bug -- glutMainLoop() never returns, but Rakudo dies without this return; } sub draw { glClear(GL_COLOR_BUFFER_BIT +| GL_DEPTH_BUFFER_BIT); glBegin(GL_TRIANGLES); glColor3f(1, 0, 0); glVertex3f(-.5, -.5, 0); glColor3f(0, 1, 0); glVertex3f( .5, -.5, 0); glColor3f(0, 0, 1); glVertex3f(0 , .5, 0); glEnd(); glutSwapBuffers(); } sub idle { my $now = time(); my $dt = 360 * ($now - $prev_time); $prev_time = $now; if ($rotating) { glRotatef($dt, 0, 1, 0); glutPostRedisplay(); } } sub keyboard($key, $x, $y) { # For ESCAPE, 'Q', and 'q', exit program if ($key == 27 | 81 | 113) { glutDestroyWindow($window); } # For all other keys, just toggle rotation else { $rotating = !$rotating; } } # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=perl6: P6Rule.grammar000644000765000765 654611466337256 17776 0ustar00brucebruce000000000000parrot-5.9.0/compilers/pge=pod PGE::P6Rule Grammar =head1 DESCRIPTION This file contains a "reference grammar" that closely describes the syntax for perl 6 rules. It closely models the parser used by PGE's "p6rule" compiler function, which is presently a recursive descent parser. Eventually the parser is likely to be replaced by a table-based (shift/reduce) parser, so that some of the rules below will disappear. Still, this grammar may be useful for testing and for understanding the syntax of Perl 6 grammars. Patches, discussion, and comments welcome on the perl6-compiler mailing list. =cut grammar PGE::P6Rule; rule pattern { * } # XXX: PGE understands :flag, but it doesn't yet # understand :flag() or :flag[] rule flag { \: [ \( \) | \[ \] ]? } rule alternation { [ \| ]? } rule conjunction { [ \& ]? } rule concatenation { * } rule quantified_term { \s* \s* } # rule quantifier { \*\* \{ \} | <[?*+]> \?? } rule quantifier { \*\* \{ \d+ [ \.\. [\d+ | \.]]? \} | <[?*+]> \?? } # XXX: PGE doesn't understand yet rule singlecut { \: } # Internally PGE currently handles terms using a p6meta token hash, # i.e., it does the equivalent of # rule term { %p6meta } # and then the entries in %p6meta take care of routing us to the # correct rule. However, for descriptive and test-parsing # purposes we'll go ahead and write it out here. rule term { | | | | | | | | | | | | | | \:\:?\:? | } rule whitemeta { \s+ | [ \# \N* \n \s* ]+ } rule subpattern { \( \) | \[ \] } rule subrule { \< <[!?]>? [\s ]? \> } rule enumerated_class { \<-\[ .*? <-[\\]> \]\> } rule charclass { \<[<[+\-]> [ | \[ [ \\. | <-[]]> ]+ \] ]+ \> } rule string_assertion { \<' .*? <-[\\]>'\> | <" .*? <-[\\]>"\> } rule indirect_rule { \< <[$@%]> \> } rule symbolic_indirect_rule { \<\:\:\( \$ \)\> } rule closure_rule { \<\{ \}\> } rule match_alias { <[$@%]> [ \< \> | \d+ ] [ \s* \:= ]? } rule interpolate_alias { <[$@%]> [ \s* \:= ]? } rule closure { \{ \} } rule assertions { \^\^? | \$\$? } # XXX: This rule will eventually be managed by the %p6meta hash # in conjunction with the rxmodinternal: syntax category. # In the meantime, we'll explicitly list the backslash-metas # that PGE knows about or will know about soon. rule rxmodinternal { \\ <[bBdDeEfFhHnNrRsStTvVwW]> } # XXX: PGE doesn't know how to handle \s in enumerated character # classes yet, so we'll explicitly list a space below. rule metachar { <[ \\<>{}[]()@#$%^&|]> } rule literal { [ <-[ \\%*+?:|.^$@[]()<>{}]> # actually, should be <-metachar> | | | \\ ]+ } rule hexadecimal_character { \\ <[xX]> + } rule named_character { \\[cC] \[ <-[]]>+ \] } =head1 AUTHOR Patrick Michaud (pmichaud@pobox.com) is the author and maintainer. Patches and suggestions are welcome on the Perl 6 compiler list (perl6-compiler@perl.org). =cut byteorder.pod000644000765000765 1037212101554066 16745 0ustar00brucebruce000000000000parrot-5.9.0/docs/dev# Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME docs/dev/byteorder.pod - Byteorder Conversion Functions =head1 DESCRIPTION This document addresses the byteorder conversion functions for the Parrot Virtual Machine. =head1 OVERVIEW The platform byteorder is stored for C code in F #define PARROT_BYTEORDER 0x1234 for parrot code in =begin PIR_FRAGMENT $P0 = getinterp .include 'iglobals.pasm' $P1 = $P0[.IGLOBALS_CONFIG_HASH] $P2 = $P1["byteorder"] =end PIR_FRAGMENT or for perl code via use Parrot::Config; $PConfig{byteorder}; The byteorder values are analog to perl, see L: 1234 little-endian 32-bit, 12345678 little-endian 64-bit 4321 big-endian 32-bit, 87654321 big-endian 64-bit When reading a pbc stored in a different architecture, the pbc header defines the pbc byteorder for the architecture which stored the pbc, and the F functions are used to convert the values to the native endianness, wordsize and ptrsize. The byteorder code will check the endianness of an C or an C value and swap from little to big, or big to little when appropriate. Functions also exist to convert a 4, 8, 12, or 16 byte character buffer to big or little endian. The functions are be placed in the PackFile vtable and are be called when necessary. The Parrot interpreter is be smart enough to avoid calling these functions when converting from and to the same byteorder. =head1 DATA STRUCTURES AND ALGORITHMS The algorithm to change from one endianness to another is identical and simple to understand. Basically, the size of an C or C is used to determine at compile time how many bits should be shifted around. Then the correct bits are shifted by the correct amounts (please look at source code for exact amounts). The buffer change functions are implemented by a straight forward algorithm that assigns swaps all of the bytes. =head1 IMPORTANT FUNCTIONS =over 4 =item C This function will convert an C into little endian format. It is a no-op if the native format is already little endian. =item C This function will convert an C into big endian format. It is a no-op if the native format is already big endian. =item C This function will convert an C into little endian format. It is a no-op if the native format is already little endian. =item C This function will convert an C into big endian format. It is a no-op if the native format is already big endian. =item C(4,8,12,16) This set of functions will convert an unsigned character buffer into little endian format. Only a C is performed if the native format is already little endian. =item C(4,8,12,16) This set of functions will convert an unsigned character buffer into big endian format. Only a C is performed if the native format is already big endian. =back =head1 LOW LEVEL FLOATVAL FETCH AND CONVERT FUNCTIONS We support two different floattypes, stored in the pbc header as 0 or 1. Floattype 0 = IEEE-754 8 byte double Floattype 1 = x86 little endian 12 byte long double =over 4 =item C Converts i386 LE 12-byte long double to IEEE 754 8 byte double. =item C Converts a 12-byte i386 long double into a big-endian IEEE 754 8-byte double. Converting to BE is not yet implemented (throws internal_exception). =item C Converts a 12-byte i386 long double into a little-endian IEEE 754 8-byte double. =back =head1 UNIMPLEMENTED FUNCTIONS =over 4 =item C Fetch an C directly from a bytestream =item C Put an C directly on a bytestream =back =head1 HISTORY Initial version by Melvin on 2002-01-05, more byteorder explanations by Reini Urban 2009-02-02 =head1 NOTES This assumes big or little endianness...other, more esoteric forms (such as middle endian) are not supported. Also, an assumption of 4 or 8 byte C's and C's is made. =head1 REFERENCES The fetch and transformer functions are implemented in F =cut __END__ Local Variables: fill-column:78 End: vim: expandtab shiftwidth=2 textwidth=70: stress3.pasm000644000765000765 347611567202623 20752 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks# Copyright (C) 2001-2006, Parrot Foundation. =head1 NAME examples/benchmarks/stress3.pasm - GC stress-testing =head1 SYNOPSIS % time ./parrot examples/benchmarks/stress3.pasm =head1 DESCRIPTION Creates a lot of PMCs, and then prints out some statistics indicating: =over 4 =item * the total number of GC runs made =item * the number of active PMCs =item * the total number of PMC created =back Note that a command-line argument of 1 is supposed to cause the PMCs to be destroyed before a 2nd loop is run. However, this seems to be broken at the moment: FixedPMCArray: Entry not an integer! =cut .pcc_sub :main main: # How can I get to the command line args? #set I10, P5 #lt I10, 2, noarg #set I11, P5[1] set I11, 0 new P10, 'ResizableIntegerArray' noarg: set I0, 100 new P0, 'ResizablePMCArray' ol: local_branch P10, buildarray set P0[I0], P1 dec I0 if I0, ol # now check reusage, destroy them depending on I11 unless I11, no_dest new P0, 'Undef' no_dest: set I0, 5000000 new P3, 'ResizablePMCArray' l2: new P1, 'Integer' set P3[0], P1 dec I0 if I0, l2 interpinfo I1, 2 print "A total of " print I1 print " GC runs were made\n" interpinfo I1, 4 print I1 print " active PMCs\n" interpinfo I1, 6 print I1 print " total PMCs\n" end # Our inner loop, 10000 times buildarray: set I1, 10000 new P1, 'ResizablePMCArray' loop1: new P9, 'Integer' set P9, I1 set P1[I1], P9 dec I1 if I1, loop1 local_return P10 =head1 SEE ALSO F, F, F, F, F, F, F. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: libparrot-01.t000644000765000765 2554711533177646 17706 0ustar00brucebruce000000000000parrot-5.9.0/t/steps/inter#! perl # Copyright (C) 2007, Parrot Foundation. # inter/libparrot-01.t use strict; use warnings; use Test::More tests => 74; use Carp; use lib qw( lib t/configure/testlib ); use_ok('config::inter::libparrot'); use Parrot::Configure::Options qw( process_options ); use Parrot::Configure::Step::Test; use Parrot::Configure::Test qw( test_step_constructor_and_description ); use Tie::Filehandle::Preempt::Stdin; ########## no ask; no other options ########## my ($args, $step_list_ref) = process_options( { argv => [], mode => q{configure}, } ); my $conf = Parrot::Configure::Step::Test->new; $conf->include_config_results( $args ); my $pkg = q{inter::libparrot}; $conf->add_steps($pkg); my $serialized = $conf->pcfreeze(); $conf->options->set( %{$args} ); my $step = test_step_constructor_and_description($conf); { open STDOUT, '>', "/dev/null" or croak "Unable to open to myout"; my $ret = $step->runstep($conf); close STDOUT or croak "Unable to close after myout"; ok( $ret, "runstep() returned true value" ); } $conf->replenish($serialized); ########## no ask; parrot_is_shared ########## ($args, $step_list_ref) = process_options( { argv => [ q{--parrot_is_shared} ], mode => q{configure}, } ); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); { open STDOUT, '>', "/dev/null" or croak "Unable to open to myout"; my $ret = $step->runstep($conf); close STDOUT or croak "Unable to close after myout"; ok( $ret, "runstep() returned true value" ); } $conf->replenish($serialized); ########## no ask; parrot_is_shared; has_dynamic_linking ########## ($args, $step_list_ref) = process_options( { argv => [ q{--parrot_is_shared} ], mode => q{configure}, } ); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); my $has_dynamic_linking_orig = $conf->data->get('has_dynamic_linking'); $conf->data->set('has_dynamic_linking' => 1); { open STDOUT, '>', "/dev/null" or croak "Unable to open to myout"; my $ret = $step->runstep($conf); close STDOUT or croak "Unable to close after myout"; ok( $ret, "runstep() returned true value" ); } is($step->result(), 'yes', "Expected result was set"); # re-set for next test $step->set_result(q{}); $conf->data->set('has_dynamic_linking' => $has_dynamic_linking_orig); $conf->replenish($serialized); ########## no ask; parrot_is_shared; has_dynamic_linking; rpath ########## ($args, $step_list_ref) = process_options( { argv => [ q{--parrot_is_shared} ], mode => q{configure}, } ); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); $conf->data->set('has_dynamic_linking' => 1); my $rpath_orig = $conf->data->get('rpath'); $conf->data->set('rpath' => q{-L}); { open STDOUT, '>', "/dev/null" or croak "Unable to open to myout"; my $ret = $step->runstep($conf); close STDOUT or croak "Unable to close after myout"; ok( $ret, "runstep() returned true value" ); } is($step->result(), 'yes', "Expected result was set"); # re-set for next test $step->set_result(q{}); $conf->data->set('has_dynamic_linking' => $has_dynamic_linking_orig); $conf->data->set('rpath' => $rpath_orig); $conf->replenish($serialized); ########## no ask; parrot_is_shared; has_dynamic_linking; rpath ########## ($args, $step_list_ref) = process_options( { argv => [ q{--parrot_is_shared} ], mode => q{configure}, } ); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); $conf->data->set('has_dynamic_linking' => 1); $rpath_orig = $conf->data->get('rpath'); $conf->data->set('rpath' => q{-L}); { open STDOUT, '>', "/dev/null" or croak "Unable to open to myout"; my $ret = $step->runstep($conf); close STDOUT or croak "Unable to close after myout"; ok( $ret, "runstep() returned true value" ); } is($step->result(), 'yes', "Expected result was set"); # re-set for next test $step->set_result(q{}); $conf->data->set('has_dynamic_linking' => $has_dynamic_linking_orig); $conf->data->set('rpath' => $rpath_orig); $conf->replenish($serialized); ########## no ask; libparrot_ldflags ########## ($args, $step_list_ref) = process_options( { argv => [], mode => q{configure}, } ); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); my $libparrot_ldflags_orig = $conf->data->get('libparrot_ldflags'); $conf->data->set('libparrot_ldflags' => 'libparrot.lib'); { open STDOUT, '>', "/dev/null" or croak "Unable to open to myout"; my $ret = $step->runstep($conf); close STDOUT or croak "Unable to close after myout"; ok( $ret, "runstep() returned true value" ); } $conf->data->set('libparrot_ldflags' => $libparrot_ldflags_orig); $conf->replenish($serialized); ########## ask; no has_dynamic_linking ########## ($args, $step_list_ref) = process_options( { argv => [ q{--ask} ], mode => q{configure}, } ); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); $conf->data->set('has_dynamic_linking' => 0); { open STDOUT, '>', "/dev/null" or croak "Unable to open to myout"; my $ret = $step->runstep($conf); close STDOUT or croak "Unable to close after myout"; ok( $ret, "runstep() returned true value" ); } is($step->result(), 'no', "Expected result was set"); # re-set for next test $step->set_result(q{}); $conf->data->set('has_dynamic_linking' => $has_dynamic_linking_orig); $conf->replenish($serialized); ########## ask; parrot_is_shared; has_dynamic_linking ########## ($args, $step_list_ref) = process_options( { argv => [ q{--ask}, q{--parrot_is_shared} ], mode => q{configure}, } ); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); $conf->data->set('has_dynamic_linking' => 1); my ( @prompts, $prompt, $object ); $prompt = q{y}; push @prompts, $prompt; $object = tie *STDIN, 'Tie::Filehandle::Preempt::Stdin', @prompts; can_ok( 'Tie::Filehandle::Preempt::Stdin', ('READLINE') ); isa_ok( $object, 'Tie::Filehandle::Preempt::Stdin' ); { open STDOUT, '>', "/dev/null" or croak "Unable to open to myout"; my $ret = $step->runstep($conf); close STDOUT or croak "Unable to close after myout"; ok( $ret, "runstep() returned true value" ); } undef $object; untie *STDIN; is($step->result(), 'yes', "Expected result was set"); # re-set for next test $step->set_result(q{}); $conf->data->set('has_dynamic_linking' => $has_dynamic_linking_orig); @prompts = (); $conf->replenish($serialized); ########## ask; has_dynamic_linking ########## ($args, $step_list_ref) = process_options( { argv => [ q{--ask} ], mode => q{configure}, } ); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); $conf->data->set('has_dynamic_linking' => 1); $prompt = q{n}; push @prompts, $prompt; $object = tie *STDIN, 'Tie::Filehandle::Preempt::Stdin', @prompts; can_ok( 'Tie::Filehandle::Preempt::Stdin', ('READLINE') ); isa_ok( $object, 'Tie::Filehandle::Preempt::Stdin' ); { open STDOUT, '>', "/dev/null" or croak "Unable to open to myout"; my $ret = $step->runstep($conf); close STDOUT or croak "Unable to close after myout"; ok( $ret, "runstep() returned true value" ); } undef $object; untie *STDIN; is($step->result(), 'no', "Expected result was set"); # re-set for next test $step->set_result(q{}); $conf->data->set('has_dynamic_linking' => $has_dynamic_linking_orig); @prompts = (); ##### get_libs() ##### my %seen; { local $^O = 'foobar'; %seen = map { $_ => 1 } inter::libparrot::get_libs(); is( scalar keys %seen, 1, "Got expected number of libs: generic" ); ok( $seen{'libparrot.so'}, "Got expected lib" ); } { local $^O = 'MSWin32'; %seen = map { $_ => 1 } inter::libparrot::get_libs(); is( scalar keys %seen, 3, "Got expected number of libs: Win32" ); is_deeply( \%seen, { 'libparrot.dll' => 1, 'libparrot.lib' => 1, 'libparrot.dll.a' => 1, }, "Got expected libs" ); } { local $^O = 'cygwin'; %seen = map { $_ => 1 } inter::libparrot::get_libs(); is( scalar keys %seen, 1, "Got expected number of libs: cygwin" ); is_deeply( \%seen, { 'libparrot.dll.a' => 1, }, "Got expected libs" ); } { local $^O = 'darwin'; %seen = map { $_ => 1 } inter::libparrot::get_libs(); is( scalar keys %seen, 2, "Got expected number of libs: darwin" ); is_deeply( \%seen, { 'libparrot.dylib' => 1, 'libparrot.a' => 1, }, "Got expected libs" ); } ##### get_libpaths() ##### %seen = map { $_ => 1 } inter::libparrot::get_libpaths($conf); ok( $seen{'/usr/local/lib'}, "Got expected lib: generic" ); ok( $seen{'/usr/lib'}, "Got expected lib: generic" ); { local $^O = 'MSWin32'; local $ENV{PATH} = 'alpha;beta'; %seen = map { $_ => 1 } inter::libparrot::get_libpaths($conf); ok( $seen{'/usr/local/lib'}, "Got expected lib: MSWin32" ); ok( $seen{'/usr/lib'}, "Got expected lib: MSWin32" ); ok( $seen{'alpha'}, "Got expected lib: MSWin32" ); ok( $seen{'beta'}, "Got expected lib: MSWin32" ); } { local $ENV{LD_LIBRARY_PATH} = 'alpha:beta'; %seen = map { $_ => 1 } inter::libparrot::get_libpaths($conf); ok( $seen{'/usr/local/lib'}, "Got expected lib: LD_LIBRARY_PATH" ); ok( $seen{'/usr/lib'}, "Got expected lib: LD_LIBRARY_PATH" ); ok( $seen{'alpha'}, "Got expected lib: LD_LIBRARY_PATH" ); ok( $seen{'beta'}, "Got expected lib: LD_LIBRARY_PATH" ); } { local $ENV{LD_RUN_PATH} = 'alpha:beta'; %seen = map { $_ => 1 } inter::libparrot::get_libpaths($conf); ok( $seen{'/usr/local/lib'}, "Got expected lib: LD_RUN_PATH" ); ok( $seen{'/usr/lib'}, "Got expected lib: LD_RUN_PATH" ); ok( $seen{'alpha'}, "Got expected lib: LD_RUN_PATH" ); ok( $seen{'beta'}, "Got expected lib: LD_RUN_PATH" ); } { local $ENV{DYLD_LIBRARY_PATH} = 'alpha:beta'; %seen = map { $_ => 1 } inter::libparrot::get_libpaths($conf); ok( $seen{'/usr/local/lib'}, "Got expected lib: DYLD_LIBRARY_PATH" ); ok( $seen{'/usr/lib'}, "Got expected lib: DYLD_LIBRARY_PATH" ); ok( $seen{'alpha'}, "Got expected lib: DYLD_LIBRARY_PATH" ); ok( $seen{'beta'}, "Got expected lib: DYLD_LIBRARY_PATH" ); } pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME inter/libparrot-01.t - test inter::libparrot =head1 SYNOPSIS % prove t/steps/inter/libparrot-01.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file test inter::libparrot. =head1 AUTHOR James E Keenan =head1 SEE ALSO config::inter::libparrot, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: README.pod000644000765000765 66712101554067 15351 0ustar00brucebruce000000000000parrot-5.9.0/t/perl# Copyright (C) 2003-2012, Parrot Foundation. =pod =head1 NAME t/perl/README.pod - Readme file for the 't/perl/' directory. =head1 DESCRIPTION This directory contains test code for Perl5 modules used as helpers for Parrot. I the documentation in F<../../docs/tests.pod>. Test of the Perl5 modules used for Parrot configuration are in '../t/configure'. =head1 COPYRIGHT Copyright (C) 2003-2012, Parrot Foundation. =cut string.h000644000765000765 2054011606346601 17146 0ustar00brucebruce000000000000parrot-5.9.0/include/parrot/* string.h * Copyright (C) 2001-2003, Parrot Foundation. * Overview: * This is the api header for the string subsystem * Data Structure and Algorithms: * History: * Notes: * References: */ #ifndef PARROT_STRING_H_GUARD #define PARROT_STRING_H_GUARD #include "parrot/core_types.h" #include "parrot/config.h" #ifdef PARROT_IN_CORE #include "parrot/compiler.h" #include "parrot/pobj.h" #include "parrot/cclass.h" #define STREQ(x, y) (strcmp((x), (y))==0) #define STRNEQ(x, y) (strcmp((x), (y))!=0) #define STRING_length(src) ((src) ? (src)->strlen : 0U) #define STRING_byte_length(src) ((src) ? (src)->bufused : 0U) #define STRING_max_bytes_per_codepoint(src) ((src)->encoding)->max_bytes_per_codepoint #define STRING_equal(interp, lhs, rhs) ((lhs)->encoding)->equal((interp), (lhs), (rhs)) #define STRING_compare(interp, lhs, rhs) ((lhs)->encoding)->compare((interp), (lhs), (rhs)) #define STRING_index(interp, src, search, offset) ((src)->encoding)->index((interp), (src), (search), (offset)) #define STRING_rindex(interp, src, search, offset) ((src)->encoding)->rindex((interp), (src), (search), (offset)) #define STRING_hash(i, src, seed) ((src)->encoding)->hash((i), (src), (seed)) #define STRING_scan(i, src) ((src)->encoding)->scan((i), (src)) #define STRING_ord(i, src, offset) ((src)->encoding)->ord((i), (src), (offset)) #define STRING_substr(i, src, offset, count) ((src)->encoding)->substr((i), (src), (offset), (count)) #define STRING_is_cclass(interp, flags, src, offset) ((src)->encoding)->is_cclass((interp), (flags), (src), (offset)) #define STRING_find_cclass(interp, flags, src, offset, count) ((src)->encoding)->find_cclass((interp), (flags), (src), (offset), (count)) #define STRING_find_not_cclass(interp, flags, src, offset, count) ((src)->encoding)->find_not_cclass((interp), (flags), (src), (offset), (count)) #define STRING_get_graphemes(interp, src, offset, count) ((src)->encoding)->get_graphemes((interp), (src), (offset), (count)) #define STRING_compose(interp, src) ((src)->encoding)->compose((interp), (src)) #define STRING_decompose(interp, src) ((src)->encoding)->decompose((interp), (src)) #define STRING_upcase(interp, src) ((src)->encoding)->upcase((interp), (src)) #define STRING_downcase(interp, src) ((src)->encoding)->downcase((interp), (src)) #define STRING_titlecase(interp, src) ((src)->encoding)->titlecase((interp), (src)) #define STRING_upcase_first(interp, src) ((src)->encoding)->upcase_first((interp), (src)) #define STRING_downcase_first(interp, src) ((src)->encoding)->downcase_first((interp), (src)) #define STRING_titlecase_first(interp, src) ((src)->encoding)->titlecase_first((interp), (src)) #define STRING_ITER_INIT(i, iter) (iter)->charpos = (iter)->bytepos = 0 #define STRING_iter_get(i, str, iter, offset) ((str)->encoding)->iter_get((i), (str), (iter), (offset)) #define STRING_iter_skip(i, str, iter, skip) ((str)->encoding)->iter_skip((i), (str), (iter), (skip)) #define STRING_iter_get_and_advance(i, str, iter) ((str)->encoding)->iter_get_and_advance((i), (str), (iter)) #define STRING_iter_set_and_advance(i, str, iter, c) ((str)->encoding)->iter_set_and_advance((i), (str), (iter), (c)) /* stringinfo parameters */ /* &gen_from_def(stringinfo.pasm) */ #define STRINGINFO_HEADER 1 #define STRINGINFO_STRSTART 2 #define STRINGINFO_BUFLEN 3 #define STRINGINFO_FLAGS 4 #define STRINGINFO_BUFUSED 5 #define STRINGINFO_STRLEN 6 /* &end_gen */ typedef struct parrot_string_t STRING; /* String iterator */ typedef struct string_iterator_t { UINTVAL bytepos; UINTVAL charpos; } String_iter; typedef struct _Parrot_String_Bounds { UINTVAL bytes; INTVAL chars; INTVAL delim; } Parrot_String_Bounds; /* constructors */ typedef STRING * (*str_vtable_to_encoding_t)(PARROT_INTERP, ARGIN(const STRING *src)); typedef STRING * (*str_vtable_chr_t)(PARROT_INTERP, UINTVAL codepoint); typedef INTVAL (*str_vtable_equal_t)(PARROT_INTERP, ARGIN(const STRING *lhs), ARGIN(const STRING *rhs)); typedef INTVAL (*str_vtable_compare_t)(PARROT_INTERP, ARGIN(const STRING *lhs), ARGIN(const STRING *rhs)); typedef INTVAL (*str_vtable_index_t)(PARROT_INTERP, ARGIN(const STRING *src), ARGIN(const STRING *search_string), INTVAL offset); typedef INTVAL (*str_vtable_rindex_t)(PARROT_INTERP, ARGIN(const STRING *src), ARGIN(const STRING *search_string), INTVAL offset); typedef size_t (*str_vtable_hash_t)(PARROT_INTERP, ARGIN(const STRING *s), size_t hashval); typedef void (*str_vtable_scan_t)(PARROT_INTERP, ARGMOD(STRING *src)); typedef INTVAL (*str_vtable_partial_scan_t)(PARROT_INTERP, ARGIN(const char *buf), ARGMOD(Parrot_String_Bounds *bounds)); typedef UINTVAL (*str_vtable_ord_t)(PARROT_INTERP, ARGIN(const STRING *src), INTVAL offset); typedef STRING * (*str_vtable_substr_t)(PARROT_INTERP, ARGIN(const STRING *src), INTVAL offset, INTVAL count); /* character classes */ typedef INTVAL (*str_vtable_is_cclass_t)(PARROT_INTERP, INTVAL, ARGIN(const STRING *src), UINTVAL offset); typedef INTVAL (*str_vtable_find_cclass_t)(PARROT_INTERP, INTVAL, ARGIN(const STRING *src), UINTVAL offset, UINTVAL count); typedef INTVAL (*str_vtable_find_not_cclass_t)(PARROT_INTERP, INTVAL, ARGIN(const STRING *src), UINTVAL offset, UINTVAL count); /* graphemes */ typedef STRING * (*str_vtable_get_graphemes_t)(PARROT_INTERP, ARGIN(const STRING *src), UINTVAL offset, UINTVAL count); typedef STRING * (*str_vtable_compose_t)(PARROT_INTERP, ARGIN(const STRING *src)); typedef STRING * (*str_vtable_decompose_t)(PARROT_INTERP, ARGIN(const STRING *src)); /* case conversion, TODO: move to single function with a flag */ typedef STRING * (*str_vtable_upcase_t)(PARROT_INTERP, ARGIN(const STRING *src)); typedef STRING * (*str_vtable_downcase_t)(PARROT_INTERP, ARGIN(const STRING *src)); typedef STRING * (*str_vtable_titlecase_t)(PARROT_INTERP, ARGIN(const STRING *src)); typedef STRING * (*str_vtable_upcase_first_t)(PARROT_INTERP, ARGIN(const STRING *src)); typedef STRING * (*str_vtable_downcase_first_t)(PARROT_INTERP, ARGIN(const STRING *src)); typedef STRING * (*str_vtable_titlecase_first_t)(PARROT_INTERP, ARGIN(const STRING *src)); /* iterator functions */ typedef UINTVAL (*str_vtable_iter_get_t)(PARROT_INTERP, ARGIN(const STRING *str), ARGIN(const String_iter *i), INTVAL offset); typedef void (*str_vtable_iter_skip_t)(PARROT_INTERP, ARGIN(const STRING *str), ARGIN(String_iter *i), INTVAL skip); typedef UINTVAL (*str_vtable_iter_get_and_advance_t)(PARROT_INTERP, ARGIN(const STRING *str), ARGMOD(String_iter *i)); typedef void (*str_vtable_iter_set_and_advance_t)(PARROT_INTERP, ARGIN(STRING *str), ARGMOD(String_iter *i), UINTVAL c); struct _str_vtable { int num; const char *name; STRING *name_str; UINTVAL bytes_per_unit; UINTVAL max_bytes_per_codepoint; str_vtable_to_encoding_t to_encoding; str_vtable_chr_t chr; str_vtable_equal_t equal; str_vtable_compare_t compare; str_vtable_index_t index; str_vtable_rindex_t rindex; str_vtable_hash_t hash; str_vtable_scan_t scan; str_vtable_partial_scan_t partial_scan; str_vtable_ord_t ord; str_vtable_substr_t substr; str_vtable_is_cclass_t is_cclass; str_vtable_find_cclass_t find_cclass; str_vtable_find_not_cclass_t find_not_cclass; str_vtable_get_graphemes_t get_graphemes; str_vtable_compose_t compose; str_vtable_decompose_t decompose; str_vtable_upcase_t upcase; str_vtable_downcase_t downcase; str_vtable_titlecase_t titlecase; str_vtable_upcase_first_t upcase_first; str_vtable_downcase_first_t downcase_first; str_vtable_titlecase_first_t titlecase_first; str_vtable_iter_get_t iter_get; str_vtable_iter_skip_t iter_skip; str_vtable_iter_get_and_advance_t iter_get_and_advance; str_vtable_iter_set_and_advance_t iter_set_and_advance; }; typedef struct _str_vtable STR_VTABLE; #endif /* PARROT_IN_CORE */ #endif /* PARROT_STRING_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ signal.t000644000765000765 564011533177645 15216 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc#! perl # Copyright (C) 2001-2008, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Test; =head1 NAME t/pmc/signal.t - Signal Handling =head1 SYNOPSIS % prove t/pmc/signal.t =head1 DESCRIPTION Tests signal handling. =cut # actually more platforms should work - all POSIX compliant ones # a second problem is to get the test doing the right thing: mainly figuring # out what PID to kill. The "ps" command isn't one of the portable ones. my %platforms = map { $_ => 1 } qw/ darwin hpux linux cygwin /; if ( $platforms{$^O} ) { #plan tests => 3; plan skip_all => 'Signals currently disabled'; } else { plan skip_all => 'No events yet'; } # # A SIGHUP is sent to parrot from the alarm handler # This is a non-portable hack. my $pid; sub parrot_pids { grep { !/harness/ && !/sh -c/ } `ps axw | grep '[p]arrot'`; } sub send_SIGHUP { $SIG{ALRM} = sub { # get PID of parrot my @ps = parrot_pids; die 'no output from ps' unless @ps; # the IO thread parrot process # on linux 2.2.x there are 4 processes, last is the IO thread # posix compliant threads have exactly one PID for parrot my $io_thread = pop @ps; if ( $io_thread =~ /^\s*(\d+)/ ) { $pid = $1; # send a kill 'SIGHUP', $pid; } else { die 'no pid found for parrot'; } }; alarm 1; } sub check_running { select undef, undef, undef, 0.1; my @ps = parrot_pids; my $thread = pop @ps; if ( $thread =~ /^\s*(\d+)/ && $1 == $pid ) { ok( 0, "parrot $pid still running" ); } else { ok( 1, 'parrot stopped' ); } } send_SIGHUP; pasm_output_is( <<'CODE', <<'OUTPUT', "SIGHUP event - sleep" ); print "start\n" # no exception handler - parrot should die silently sleep 2 print "never\n" end CODE start OUTPUT # check_running; send_SIGHUP; pasm_output_is( <<'CODE', <<'OUTPUT', "SIGHUP event - loop" ); bounds 1 # no JIT print "start\n" # no exception handler - parrot should die silently lp: dec I20 if I20, lp # if 4G loops take less then 1 second, this will fail :) print "never\n" end CODE start OUTPUT # check_running; SKIP: { skip( "works standalone but not in test", 1 ); send_SIGHUP; pasm_output_is( <<'CODE', <<'OUTPUT', "SIGHUP event - sleep, catch" ); push_eh _handler print "start\n" sleep 2 print "never\n" end _handler: .include "signal.pasm" print "catched " set I0, P5["type"] neg I0, I0 ne I0, .SIGHUP, nok print "SIGHUP\n" end nok: print "something _type = " neg I0, I0 print I0 print "\n" end CODE start catched SIGHUP OUTPUT # check_running; } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: stringbuilder.pmc000644000765000765 3334512101554067 17466 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2010-2011, Parrot Foundation. =head1 NAME src/pmc/stringbuilder.pmc - StringBuilder PMC Class =head1 DESCRIPTION TODO: Add description here. =head2 Methods =over 4 =cut */ #include "parrot/string_funcs.h" /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_WARN_UNUSED_RESULT PARROT_CONST_FUNCTION static size_t calculate_capacity(PARROT_INTERP, size_t needed); static void convert_encoding(PARROT_INTERP, ARGIN(STR_VTABLE *dest_encoding), ARGMOD(STRING *buffer), size_t size_to_add) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*buffer); #define ASSERT_ARGS_calculate_capacity __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) #define ASSERT_ARGS_convert_encoding __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(dest_encoding) \ , PARROT_ASSERT_ARG(buffer)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ #define INITIAL_STRING_CAPACITY 128 pmclass StringBuilder provides string auto_attrs { ATTR STRING *buffer; /* Mutable string to gather results */ /* =item C Initializes the StringBuilder. =cut */ VTABLE void init() { STATICSELF.init_int(INITIAL_STRING_CAPACITY); } /* =item C Initializes the StringBuilder with initial size of buffer. =cut */ VTABLE void init_int(INTVAL initial_size) { STRING * const buffer = Parrot_gc_new_string_header(INTERP, 0); if (initial_size < INITIAL_STRING_CAPACITY) initial_size = INITIAL_STRING_CAPACITY; Parrot_gc_allocate_string_storage(INTERP, buffer, initial_size); buffer->encoding = Parrot_default_encoding_ptr; SET_ATTR_buffer(INTERP, SELF, buffer); PObj_custom_mark_SET(SELF); } /* =item C Initializes the StringBuilder with an array of STRINGs. =cut */ VTABLE void init_pmc(PMC *ar) { const INTVAL count = VTABLE_elements(INTERP, ar); if (!count) STATICSELF.init_int(INITIAL_STRING_CAPACITY); else { STRING * const first = VTABLE_get_string_keyed_int(INTERP, ar, 0); const INTVAL size = Parrot_str_byte_length(INTERP, first); INTVAL i; /* it's just an estimate, but estimates help */ STATICSELF.init_int(size * count); SELF.push_string(first); for (i = 1; i < count; ++i) SELF.push_string(VTABLE_get_string_keyed_int(INTERP, ar, i)); } } /* =item C Mark the buffer. =cut */ VTABLE void mark() { if (PMC_data(SELF)) { STRING *buffer; GET_ATTR_buffer(INTERP, SELF, buffer); Parrot_gc_mark_STRING_alive(INTERP, buffer); } } /* =item C Returns created string. =cut */ VTABLE STRING *get_string() { STRING *buffer; GET_ATTR_buffer(INTERP, SELF, buffer); /* We need to build a new string because outside of StringBuilder * strings are immutable. */ return Parrot_str_clone(INTERP, buffer); } /* =item C Append string to current buffer. =cut */ VTABLE void push_string(STRING *s) { STRING *buffer; size_t total_size; /* Early return on NULL strings */ if (STRING_IS_NULL(s) || s->strlen == 0) return; GET_ATTR_buffer(INTERP, SELF, buffer); if (buffer->bufused == 0) { /* Always copy the encoding of the first string. The IO functions assume that the concatenation of utf8 strings doesn't change the encoding. */ buffer->encoding = s->encoding; } else { const STR_VTABLE * const enc = buffer->encoding == s->encoding ? buffer->encoding : Parrot_str_rep_compatible(interp, buffer, s); if (enc) { buffer->encoding = enc; } else { /* If strings are incompatible - convert them to utf8 */ if (s->encoding != Parrot_utf8_encoding_ptr) s = Parrot_utf8_encoding_ptr->to_encoding(interp, s); if (buffer->encoding != Parrot_utf8_encoding_ptr) convert_encoding(INTERP, Parrot_utf8_encoding_ptr, buffer, s->bufused); } } total_size = buffer->bufused + s->bufused; /* Reallocate if necessary */ if (total_size > buffer->_buflen) { /* Calculate (possibly new) total size */ total_size = calculate_capacity(INTERP, total_size); Parrot_gc_reallocate_string_storage(INTERP, buffer, total_size); buffer->_buflen = total_size; } /* Tack s on the end of buffer */ memcpy((char *)buffer->_bufstart + buffer->bufused, s->strstart, s->bufused); /* Update buffer */ buffer->bufused += s->bufused; buffer->strstart = (char *)buffer->_bufstart; buffer->strlen += s->strlen; buffer->hashval = 0; /* hash is invalid */ PARROT_ASSERT(buffer->bufused <= Buffer_buflen(buffer)); } VTABLE void push_integer(INTVAL value) { STRING * s = PARROT_STRINGBUILDER(SELF)->buffer; String_iter iter; size_t total_size; if (s->encoding != Parrot_utf8_encoding_ptr && value > 0x7F) { if (s->strlen == 0) s->encoding = Parrot_utf8_encoding_ptr; else convert_encoding(INTERP, Parrot_utf8_encoding_ptr, s, sizeof (INTVAL)); } total_size = s->bufused + sizeof (INTVAL); if (total_size > s->_buflen) { total_size = calculate_capacity(INTERP, total_size); Parrot_gc_reallocate_string_storage(INTERP, s, total_size); } STRING_ITER_INIT(INTERP, &iter); iter.charpos = s->strlen; iter.bytepos = s->bufused; STRING_iter_set_and_advance(INTERP, s, &iter, value); s->strlen = iter.charpos; s->bufused = iter.bytepos; } /* =item C =item C Append string. Synonym for push_string =cut */ VTABLE void i_concatenate_str(STRING *s) { STATICSELF.push_string(s); } VTABLE void i_concatenate(PMC *p) { STATICSELF.push_string(VTABLE_get_string(INTERP, p)); } VTABLE void push_pmc(PMC *p) { STATICSELF.push_string(VTABLE_get_string(INTERP, p)); } /* =item C =item C Set content of buffer to passed string or PMC =cut */ VTABLE void set_string_native(STRING *s) { STRING * buffer; /* Calculate (possibly new) total size */ const size_t total_size = calculate_capacity(INTERP, s->bufused); GET_ATTR_buffer(INTERP, SELF, buffer); /* Reallocate if necessary */ if (total_size > Buffer_buflen(buffer)) { Parrot_gc_reallocate_string_storage(INTERP, buffer, total_size); buffer->strstart = (char*)buffer->_bufstart; } /* Tack s on the buffer */ memcpy((void *)((char*)buffer->_bufstart), s->strstart, s->bufused); /* Update buffer */ buffer->bufused = s->bufused; buffer->strlen = Parrot_str_length(INTERP, s); buffer->encoding = s->encoding; } VTABLE void set_pmc(PMC *s) { STATICSELF.set_string_native(VTABLE_get_string(INTERP, s)); } /* =item C Returns current capacity of allocated buffer. For testing purpose only? =cut */ INTVAL get_integer() { STRING *buffer; GET_ATTR_buffer(INTERP, SELF, buffer); return Buffer_buflen(buffer); } /* =item C =cut */ VTABLE STRING *substr(INTVAL offset, INTVAL length) { STRING *buffer; GET_ATTR_buffer(INTERP, SELF, buffer); /* We must clone here because we can reallocate buffer behind the scene... */ /* TODO Optimize it to avoid creation of redundant STRING */ return Parrot_str_clone(INTERP, STRING_substr(INTERP, buffer, offset, length)); } /* =item C Add a line to a C object according to C. The C string can contain any number of "%-replacements" which are replaced by the corresponding values from C or C prior to being appended to the string. (Here C is a slurpy array, and C is a slurpy hash.) The currently defined replacements include: %0 %1 ... %9 the value from the args array at index 0..9 %, the values of the args array separated by commas %% a percent sign A percent-sign followed by any other character that is a hash key receives the value of the hash element. =cut */ METHOD append_format(STRING *fmt, PMC *args :slurpy, PMC *hash :slurpy :named) { STRING * const percent = CONST_STRING(INTERP, "%"); STRING * const comma = CONST_STRING(INTERP, ","); STRING * const comma_space = CONST_STRING(INTERP, ", "); PMC *stringbuilder = SELF; INTVAL pos = 0; /* Loop over the format string, splitting it into chunks * for the string builder. */ while (pos >= 0) { /* Find the next % */ const INTVAL percentPos = STRING_index(INTERP, fmt, percent, pos); STRING *key; if (percentPos < 0) { if (pos == 0) { VTABLE_push_string(INTERP, stringbuilder, fmt); } else { /* remaining string can be added as is. */ VTABLE_push_string(INTERP, stringbuilder, STRING_substr(INTERP, fmt, pos, Parrot_str_length(INTERP, fmt) -pos)); } break; } else { /* slurp up to just before the % sign... */ VTABLE_push_string(INTERP, stringbuilder, STRING_substr(INTERP, fmt, pos, percentPos - pos)); /* skip the % sign */ pos = percentPos + 1 ; } /* key is always a single character */ key = STRING_substr(INTERP, fmt, pos++, 1); if (VTABLE_exists_keyed_str(INTERP, hash, key)) { VTABLE_push_string(INTERP, stringbuilder, VTABLE_get_string_keyed_str(INTERP, hash, key)); } else if (Parrot_str_is_cclass(INTERP, enum_cclass_numeric, key, 0)) { VTABLE_push_string(INTERP, stringbuilder, VTABLE_get_string_keyed_int(INTERP, args, Parrot_str_to_int(INTERP, key))); } else if (STRING_equal(INTERP, key, comma)) { INTVAL num_args = VTABLE_elements(INTERP, args); INTVAL pos_args; for (pos_args = 0; pos_args < num_args; ++pos_args) { if (pos_args > 0) VTABLE_push_string(INTERP, stringbuilder, comma_space); VTABLE_push_string(INTERP, stringbuilder, VTABLE_get_string_keyed_int(INTERP, args, pos_args)); } } else if (STRING_equal(INTERP, key, percent)) { VTABLE_push_string(INTERP, stringbuilder, percent); } else { /* %foo has no special meaning, pass it through unchanged */ VTABLE_push_string(INTERP, stringbuilder, STRING_substr(INTERP, fmt, pos-2, 2)); } } RETURN(PMC *SELF); } /* =item C Returns length of currently built string. =cut */ METHOD get_string_length() { STRING *buffer; INTVAL length; GET_ATTR_buffer(INTERP, SELF, buffer); length = Parrot_str_length(INTERP, buffer); RETURN(INTVAL length); } /* =back =cut */ } /* =head2 Helper functions. =over 4 =cut */ /* =item C Calculate capacity for string. We allocate double the amount needed. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CONST_FUNCTION static size_t calculate_capacity(SHIM_INTERP, size_t needed) { ASSERT_ARGS(calculate_capacity) needed *= 2; /* round up to 16 */ needed = (needed + 15) & ~15; return needed; } /* =item C Convert buffer content to the encoding specified and increase its size, reallocating it if needed. =back =cut */ static void convert_encoding(PARROT_INTERP, ARGIN(STR_VTABLE *dest_encoding), ARGMOD(STRING *buffer), size_t size_to_add) { ASSERT_ARGS(convert_encoding) STRING * new_buffer; size_t total_size; new_buffer = dest_encoding->to_encoding(interp, buffer); total_size = new_buffer->bufused + size_to_add; if (total_size > buffer->_buflen) { /* Reallocate */ total_size = calculate_capacity(interp, total_size); Parrot_gc_reallocate_string_storage(interp, buffer, total_size); } buffer->bufused = new_buffer->bufused; buffer->encoding = new_buffer->encoding; memcpy(buffer->strstart, new_buffer->strstart, new_buffer->bufused); } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ spectralnorm.pir000644000765000765 455011533177635 21457 0ustar00brucebruce000000000000parrot-5.9.0/examples/shootout#!./parrot # Copyright (C) 2006-2009, Parrot Foundation. # # ./parrot -R jit spectralnorm.pir N (N = 100 for shootout) # by Michal Jurosz # modified by Karl Forner to accept shootout default value of N=100 .sub eval_A .param int i .param int j # return 1.0/((i+j)*(i+j+1)/2+i+1); $N0 = i + j $N1 = $N0 + 1 $N0 *= $N1 $N0 /= 2 $N0 += i $N0 += 1 $N0 = 1 / $N0 .return ($N0) .end .sub eval_A_times_u .param int N .param pmc u .param pmc Au .local int i, j i = 0 beginfor_i: unless i < N goto endfor_i Au[i] = 0 j = 0 beginfor_j: unless j < N goto endfor_j # Au[i]+=eval_A(i,j)*u[j] $N0 = eval_A(i,j) $N1 = u[j] $N0 *= $N1 $N1 = Au[i] $N0 += $N1 Au[i] = $N0 inc j goto beginfor_j endfor_j: inc i goto beginfor_i endfor_i: .end .sub eval_At_times_u .param int N .param pmc u .param pmc Au .local int i, j i = 0 beginfor_i: unless i < N goto endfor_i Au[i] = 0 j = 0 beginfor_j: unless j < N goto endfor_j # Au[i]+=eval_A(j,i)*u[j] $N0 = eval_A(j,i) $N1 = u[j] $N0 *= $N1 $N1 = Au[i] $N0 += $N1 Au[i] = $N0 inc j goto beginfor_j endfor_j: inc i goto beginfor_i endfor_i: .end .sub eval_AtA_times_u .param int N .param pmc u .param pmc AtAu .local pmc v v = new 'FixedFloatArray' v = N eval_A_times_u(N,u,v) eval_At_times_u(N,v,AtAu) .end .sub main :main .param pmc argv .local int argc, N N = 100 argc = argv if argc == 1 goto default $S0 = argv[1] N = $S0 default: .local pmc u, v u = new 'FixedFloatArray' u = N v = new 'FixedFloatArray' v = N .local int i i = 0 beginfor_init: unless i < N goto endfor_init u[i] = 1 inc i goto beginfor_init endfor_init: i = 0 beginfor_eval: unless i < 10 goto endfor_eval eval_AtA_times_u(N,u,v) eval_AtA_times_u(N,v,u) inc i goto beginfor_eval endfor_eval: .local num vBv, vv vBv = 0.0 vv = 0.0 i = 0 beginfor_calc: unless i < N goto endfor_calc # vBv+=u[i]*v[i]; vv+=v[i]*v[i]; $N0 = u[i] $N1 = v[i] $N0 *= $N1 vBv += $N0 $N0 = $N1 $N0 *= $N0 vv += $N0 inc i goto beginfor_calc endfor_calc: # print "%0.9f" % (sqrt(vBv/vv)) $N0 = vBv / vv $N0 = sqrt $N0 .local pmc spf spf = new 'FixedFloatArray' spf = 1 spf[0] = $N0 $S0 = sprintf "%.9f\n", spf print $S0 exit 0 .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: pgegrep000755000765000765 1472211533177635 17107 0ustar00brucebruce000000000000parrot-5.9.0/examples/tools#! parrot =head1 NAME pgegrep - A simple grep using PGE for matching =head1 SYNOPSIS B [I] B [I] =head1 DESCRIPTION pgegrep aims to be a small and easy to use program in replacement of the standard grep utility. Regex support is whatever PGE will allow. It searches through files line by line and tests if the given pattern matches. =head1 OPTIONS =over 4 =item -v =item --invert-match print lines not matching PATTERN =item -V =item --version print the version and exit =item --help show this help and exit =item -r =item --recursive recursively descend into directories =item -L =item --files-without-matches print a list of files that do not match PATTERN =item -l =item --files-with-matches print a list of files that do match PATTERN =item -a =item --text treat binary files as text. This uses a basic heuristic to discover if a file is binary or not. Files are read line by line, and it keeps processing "normally" until a control character is found, and then stops and goes onto the next file is that line matches. =item -n =item --line-number print the line number for each match =item -H =item --with-filename print the filename for each match =back =cut # Readability improved! .include 'hllmacros.pir' # for getstdin and friends .loadlib 'io_ops' .sub main :main .param pmc argv # the script name, then our options. .local string progname progname = shift argv load_bytecode 'Getopt/Obj.pbc' load_bytecode 'PGE.pbc' .local pmc getopts getopts = new [ 'Getopt';'Obj' ] getopts.'notOptStop'(1) push getopts, 'with-filename|H' push getopts, 'files-with-matches|l' push getopts, 'files-without-matches|L' push getopts, 'line-number|n' push getopts, 'text|a' push getopts, 'recursive|r' push getopts, 'invert-match|v' push getopts, 'version|V' push getopts, 'help' push_eh handler .local pmc opts opts = getopts.'get_options'(argv) $I0 = defined opts['help'] .If($I0, { showhelp() }) $I0 = defined opts['version'] .If($I0, { showversion() }) .local int argc argc = elements argv .Unless(argc>1, { showhelp() }) # need rule and at least one file .local string rule .local pmc p6rule_compile, matchsub rule = shift argv p6rule_compile = compreg 'PGE::Perl6Regex' matchsub = p6rule_compile(rule) .If(null matchsub, { die 'Unable to compile regex' }) .local int i, filecount .local string filename .local pmc File, OS, files, handle files = new 'ResizableStringArray' files = argv filecount = files # define with-filename if there's more than one file .If(filecount >= 2, { opts['with-filename'] = 1 }) $P0 = loadlib 'file' File = new 'File' $P0 = loadlib 'os' OS = new 'OS' # This must be here, or else it'll get filled with junk data we use stdin... i = 0 .Unless(filecount, { # no args, use stdin stdindashhack: handle = getstdin filename = '(standard input)' goto stdinhack }) .For(, i < filecount, inc i, { filename = files[i] .If(filename == '-', { goto stdindashhack }) $I1 = File.'is_file'(filename) .IfElse($I1, { # Is a file handle = open filename, 'r' },{ # Not a file, hopefully a directory $I1 = File.'is_dir'(filename) $I0 = defined opts['recursive'] $I1 &= $I0 .Unless($I1, { printerr "pgegrep: '" printerr filename printerr "': Operation not supported.\n" goto nextfor_0 }) $P0 = OS.'readdir'(filename) .Foreach($S0, $P0, { .If($S0 != '.', { .If($S0 != '..', { $S1 = filename . '/' $S0 = $S1 . $S0 $P1 = new 'ResizableStringArray' $P1[0] = $S0 $I0 = i + 1 splice files, $P1, $I0, 0 }) }) }) filecount = files goto nextfor_0 }) stdinhack: checkfile(handle, filename, matchsub, opts) close handle nextfor_0: }) end handler: .local pmc exception, pmcmsg .local string message .get_results (exception) pmcmsg = getattribute exception, 'message' pop_eh message = pmcmsg message = "pgegrep: " . message die message .end .sub checkfile .param pmc handle .param string filename .param pmc matchsub .param pmc opts .local pmc match .local string line .local int lineno, linelen, matched lineno = 1 matched = 0 # Only used for --files-without-matches line = readline handle linelen = length line .local pmc p6rule_compile, cntrlchar $S0 = '<+cntrl-[\t\r\n]>' p6rule_compile = compreg 'PGE::Perl6Regex' cntrlchar = p6rule_compile($S0) .For(, linelen, { line = readline handle linelen = length line inc lineno }, { match = matchsub(line) $I1 = istrue match match = cntrlchar(line) $I2 = istrue match $I0 = defined opts['files-without-matches'] .If($I0, { .If($I1, { matched = 1 }) goto next }) $I0 = defined opts['files-with-matches'] $I0 = $I0 && $I1 .If($I0, { say filename .return() }) $I0 = defined opts['invert-match'] not $I0 $I1 = xor $I1, $I0 .Unless($I1, { $I0 = defined opts['text'] $I0 = xor $I0, $I2 .If($I0, { print 'Binary file ' print filename say ' matches' .return() }) $I0 = defined opts['with-filename'] $I1 = defined opts['recursive'] $I0 = $I0 || $I1 .If($I0, { print filename print ':' }) $I0 = defined opts['line-number'] .If($I0, { print lineno print ':' }) print line }) #--------- next: }) $I0 = defined opts['files-without-matches'] .If($I0, { say filename }) .return() .end .sub showhelp print <<'HELP' Usage: pgegrep [OPTIONS] PATTERN [FILE...] Search for the Perl 6 Rule PATTERN in each file. -v --invert-match print lines not matching PATTERN -V --version print the version and exit --help show this help and exit -r --recursive recursively descend into directories -L --files-without-matches print a list of files that do not match PATTERN -l --files-with-matches print a list of files that do match PATTERN -a --text treat binary files as text -n --line-number print the line number for each match -H --with-filename print the filename for each match HELP end .end .sub showversion print <<'VERSION' pgegrep v0.0.1 VERSION end .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: main.c000644000765000765 10217212101554067 17407 0ustar00brucebruce000000000000parrot-5.9.0/frontend/pbc_merge/* Copyright (C) 2005-2012, Parrot Foundation. =head1 NAME pbc_merge - Merge multiple Parrot bytecode (PBC) files into a single PBC file. =head1 SYNOPSIS pbc_merge -o out.pbc input1.pbc input2.pbc ... =head1 DESCRIPTION This program takes two or more PBC files and produces a single merged output PBC file with a single fix-up table and constants table. =head2 Command-Line Options =over 4 =item C<-o out.pbc> The name of the PBC file to produce, containing the merged segments from the input PBC files. =back =head2 Functions =over 4 =cut */ #define PARROT_IN_EXTENSION #include "parrot/parrot.h" #include "parrot/longopt.h" #include "parrot/oplib/ops.h" #include "parrot/oplib/core_ops.h" #include "pmc/pmc_sub.h" extern const unsigned char * Parrot_get_config_hash_bytes(void); extern int Parrot_get_config_hash_length(void); /* This struct describes an input file. */ typedef struct pbc_merge_input { const char *filename; /* name of the input file */ PackFile *pf; /* loaded packfile struct */ opcode_t code_start; /* where the bytecode is located in the merged packfile */ struct { opcode_t const_start; /* where the const table is located within the merged table */ opcode_t *const_map; /* map constants from input files to their location in the output file */ } num, str, pmc; } pbc_merge_input; /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void ensure_libdep(PARROT_INTERP, ARGMOD(PackFile_ByteCode *bc), ARGIN(STRING *lib)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*bc); PARROT_DOES_NOT_RETURN static void help(void); static void pbc_fixup_bytecode(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs), int num_inputs, ARGMOD(PackFile_ByteCode *bc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(4) FUNC_MODIFIES(*inputs) FUNC_MODIFIES(*bc); static void pbc_fixup_constants(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs), int num_inputs) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*inputs); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PackFile_Annotations* pbc_merge_annotations(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs), int num_inputs, ARGMOD(PackFile *pf), ARGMOD(PackFile_ByteCode *bc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(4) __attribute__nonnull__(5) FUNC_MODIFIES(*inputs) FUNC_MODIFIES(*pf) FUNC_MODIFIES(*bc); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PackFile* pbc_merge_begin(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs), int num_inputs) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*inputs); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PackFile_ByteCode* pbc_merge_bytecode(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs), int num_inputs, ARGMOD(PackFile *pf)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(4) FUNC_MODIFIES(*inputs) FUNC_MODIFIES(*pf); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PackFile_ConstTable* pbc_merge_constants(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs), int num_inputs, ARGMOD(PackFile *pf)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(4) FUNC_MODIFIES(*inputs) FUNC_MODIFIES(*pf); static void pbc_merge_debugs(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs), int num_inputs, ARGMOD(PackFile_ByteCode *bc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(4) FUNC_MODIFIES(*inputs) FUNC_MODIFIES(*bc); static void pbc_merge_write(PARROT_INTERP, ARGMOD(PackFile *pf), ARGIN(const char *filename)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*pf); #define ASSERT_ARGS_ensure_libdep __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(bc) \ , PARROT_ASSERT_ARG(lib)) #define ASSERT_ARGS_help __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) #define ASSERT_ARGS_pbc_fixup_bytecode __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(inputs) \ , PARROT_ASSERT_ARG(bc)) #define ASSERT_ARGS_pbc_fixup_constants __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(inputs)) #define ASSERT_ARGS_pbc_merge_annotations __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(inputs) \ , PARROT_ASSERT_ARG(pf) \ , PARROT_ASSERT_ARG(bc)) #define ASSERT_ARGS_pbc_merge_begin __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(inputs)) #define ASSERT_ARGS_pbc_merge_bytecode __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(inputs) \ , PARROT_ASSERT_ARG(pf)) #define ASSERT_ARGS_pbc_merge_constants __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(inputs) \ , PARROT_ASSERT_ARG(pf)) #define ASSERT_ARGS_pbc_merge_debugs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(inputs) \ , PARROT_ASSERT_ARG(bc)) #define ASSERT_ARGS_pbc_merge_write __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(pf) \ , PARROT_ASSERT_ARG(filename)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Print out the user help info. =cut */ PARROT_DOES_NOT_RETURN static void help(void) { printf("pbc_merge - merge multiple parrot bytecode files into one\n"); printf("Usage:\n"); printf(" pbc_merge -o out.pbc file1.pbc file2.pbc ...\n\n"); exit(0); } /* =item C Ensures that the libdep C is in the libdeps list for C. =cut */ static void ensure_libdep(PARROT_INTERP, ARGMOD(PackFile_ByteCode *bc), ARGIN(STRING *lib)) { ASSERT_ARGS(ensure_libdep) size_t i; for (i = 0; i < bc->n_libdeps; i++) { if (Parrot_str_equal(interp, bc->libdeps[i], lib)) { return; } } /* not found, add to libdeps list */ bc->libdeps = mem_gc_realloc_n_typed_zeroed(interp, bc->libdeps, bc->n_libdeps + 1, bc->n_libdeps, STRING *); bc->libdeps[bc->n_libdeps] = lib; bc->n_libdeps++; } /* =item C This function merges the bytecode from the input packfiles, storing the offsets that each bit of bytecode now exists at. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PackFile_ByteCode* pbc_merge_bytecode(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs), int num_inputs, ARGMOD(PackFile *pf)) { ASSERT_ARGS(pbc_merge_bytecode) int i; size_t j; opcode_t *bc = mem_gc_allocate_typed(interp, opcode_t); opcode_t cursor = 0; /* Add a bytecode segment. */ PackFile_ByteCode * const bc_seg = (PackFile_ByteCode *)PackFile_Segment_new_seg(interp, &pf->directory, PF_BYTEC_SEG, BYTE_CODE_SEGMENT_NAME, 1); if (!bc_seg) { Parrot_io_eprintf(interp, "PBC Merge: Can not create bytecode segment"); exit(1); } /* Loop over input files. */ for (i = 0; i < num_inputs; ++i) { /* Get the bytecode segment from the input file. */ PackFile_ByteCode * const in_seg = inputs[i]->pf->cur_cs; if (in_seg == NULL) { Parrot_io_eprintf(interp, "PBC Merge: Cannot locate bytecode segment in %s", inputs[i]->filename); exit(1); } /* Re-allocate the current buffer. */ bc = mem_gc_realloc_n_typed(interp, bc, cursor + in_seg->base.size, opcode_t); /* Copy data and store cursor. */ memcpy(bc + cursor, in_seg->base.data, in_seg->base.size * sizeof (opcode_t)); inputs[i]->code_start = cursor; /* Update cursor. */ cursor += in_seg->base.size; /* Update libdeps. */ for (j = 0; j < in_seg->n_libdeps; j++) ensure_libdep(interp, bc_seg, in_seg->libdeps[j]); /* Update main_sub. */ if (in_seg->main_sub >= 0) { if (bc_seg->main_sub < 0) bc_seg->main_sub = in_seg->main_sub + inputs[i]->pmc.const_start; /* XXX hide incessant warning messages triggered by implicit :main this can be added when GH #571 is implemented else Parrot_io_eprintf(interp, "PBC Merge: multiple :main subs encountered, using first " "and ignoring sub found in `%s'", inputs[i]->filename); */ } } /* Stash produced bytecode. */ bc_seg->base.data = bc; bc_seg->base.size = cursor; bc_seg->base.name = Parrot_str_new_constant(interp, "MERGED"); return bc_seg; } /* =item C This function merges the constants tables from the input PBC files. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PackFile_ConstTable* pbc_merge_constants(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs), int num_inputs, ARGMOD(PackFile *pf)) { ASSERT_ARGS(pbc_merge_constants) /* STRING -> idx mapping for all strings */ Hash *all_seen_strings = Parrot_hash_create(interp, enum_type_INTVAL, Hash_key_type_STRING); FLOATVAL *num_constants = mem_gc_allocate_typed(interp, FLOATVAL); STRING **str_constants = mem_gc_allocate_typed(interp, STRING *); PMC **pmc_constants = mem_gc_allocate_typed(interp, PMC *); opcode_t num_cursor = 0; opcode_t str_cursor = 0; opcode_t pmc_cursor = 0; opcode_t tag_cursor = 0; int i; /* Add a constant table segment. */ PackFile_ConstTable * const const_seg = (PackFile_ConstTable *) PackFile_Segment_new_seg(interp, &pf->directory, PF_CONST_SEG, CONSTANT_SEGMENT_NAME, 1); if (const_seg == NULL) { Parrot_io_eprintf(interp, "PBC Merge: Error creating constant table segment."); exit(1); } /* Loop over input files. */ for (i = 0; i < num_inputs; ++i) { opcode_t pmc_cursor_start = pmc_cursor; int j; /* Get the constant table segment from the input file. */ PackFile_ConstTable * const in_seg = inputs[i]->pf->cur_cs->const_table; if (in_seg == NULL) { Parrot_io_eprintf(interp, "PBC Merge: Cannot locate constant table segment in %s\n", inputs[i]->filename); exit(1); } /* Store cursor as position where constant table starts. */ inputs[i]->num.const_start = num_cursor; inputs[i]->str.const_start = str_cursor; inputs[i]->pmc.const_start = pmc_cursor; /* Allocate space for the constant list, provided we have some. */ if (in_seg->num.const_count > 0) num_constants = mem_gc_realloc_n_typed(interp, num_constants, num_cursor + in_seg->num.const_count, FLOATVAL); if (in_seg->pmc.const_count > 0) pmc_constants = mem_gc_realloc_n_typed(interp, pmc_constants, pmc_cursor + in_seg->pmc.const_count, PMC *); /* Allocate enough space for all strings, even though de-duplication may mean some slots are not filled */ if (in_seg->str.const_count > 0) str_constants = mem_gc_realloc_n_typed(interp, str_constants, str_cursor + in_seg->str.const_count, STRING *); /* Loop over the constants and copy them to the output PBC. */ for (j = 0; j < in_seg->num.const_count; j++) { num_constants[num_cursor] = in_seg->num.constants[j]; inputs[i]->num.const_map[j] = num_cursor; num_cursor++; } for (j = 0; j < in_seg->str.const_count; j++) { STRING * const str = in_seg->str.constants[j]; if (Parrot_hash_exists(interp, all_seen_strings, str)) { opcode_t new_idx = (opcode_t)Parrot_hash_get(interp, all_seen_strings, str); inputs[i]->str.const_map[j] = new_idx; continue; } str_constants[str_cursor] = str; Parrot_hash_put(interp, all_seen_strings, str, (void *)str_cursor); inputs[i]->str.const_map[j] = str_cursor; str_cursor++; } for (j = 0; j < in_seg->pmc.const_count; j++) { pmc_constants[pmc_cursor] = in_seg->pmc.constants[j]; inputs[i]->pmc.const_map[j] = pmc_cursor; pmc_cursor++; } /* Update the pointers and counts here, so we have that information when we add tags*/ const_seg->num.const_count = num_cursor; const_seg->num.constants = num_constants; const_seg->str.const_count = str_cursor; const_seg->str.constants = str_constants; const_seg->pmc.const_count = pmc_cursor; const_seg->pmc.constants = pmc_constants; /* Loop over the tags, inserting tags into the tag_map, keeping them ordered by tag name */ for (j = 0; j < in_seg->ntags; j++) { opcode_t old_tag_idx = in_seg->tag_map[j].tag_idx; opcode_t new_tag_idx = inputs[i]->str.const_map[old_tag_idx]; opcode_t old_pmc_idx = in_seg->tag_map[j].const_idx; opcode_t new_pmc_idx = inputs[i]->pmc.const_map[old_pmc_idx]; /* Parrot_io_eprintf(interp, "\nmerging tag [%d->%d '%S','%S'] = %d->%d\n", old_tag_idx, new_tag_idx, in_seg->str.constants[old_tag_idx], str_constants[new_tag_idx], in_seg->tag_map[j].const_idx, in_seg->tag_map[j].const_idx + pmc_cursor_start); */ Parrot_pf_tag_constant(interp, const_seg, new_tag_idx, new_pmc_idx); tag_cursor++; } } /* Return the merged segment */ return const_seg; } /* =item C Merge Annotations segments from C into a new C segment. Returns the new merged segment (which is also already appended to the directory in C). =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PackFile_Annotations* pbc_merge_annotations(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs), int num_inputs, ARGMOD(PackFile *pf), ARGMOD(PackFile_ByteCode *bc)) { ASSERT_ARGS(pbc_merge_annotations) int i; PackFile_Annotations * const merged = Parrot_pf_get_annotations_segment(interp, pf, bc); int key_cursor = 0; for (i = 0; i < num_inputs; i++) { PackFile_ByteCode * const in_bc = inputs[i]->pf->cur_cs; PackFile_Annotations * const in_ann = Parrot_pf_get_annotations_segment(interp, inputs[i]->pf, in_bc); int j; for (j = 0; j < in_ann->num_keys; j++) { const opcode_t old_name_idx = in_ann->keys[j].name; const opcode_t old_len = in_ann->keys[j].len; const opcode_t old_start = in_ann->keys[j].start; const opcode_t new_key = inputs[i]->str.const_map[old_name_idx]; int k; for (k = 0; k < old_len; k++) { const opcode_t idx = (old_start + k) * 2; const opcode_t old_offset = in_ann->base.data[idx]; const opcode_t old_value = in_ann->base.data[idx + 1]; opcode_t new_value; switch (in_ann->keys[j].type) { case PF_ANNOTATION_KEY_TYPE_INT: new_value = old_value; break; case PF_ANNOTATION_KEY_TYPE_STR: new_value = inputs[i]->str.const_map[old_value]; break; case PF_ANNOTATION_KEY_TYPE_PMC: new_value = inputs[i]->pmc.const_map[old_value]; break; default: Parrot_io_eprintf(interp, "Cannot find annotation type %d", in_ann->keys[j].type); exit(1); } PackFile_Annotations_add_entry(interp, merged, old_offset + inputs[i]->code_start, new_key, in_ann->keys[j].type, new_value); } key_cursor++; } } return merged; } /* =item C This function merges the debug segments from the input PBC files. =cut */ static void pbc_merge_debugs(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs), int num_inputs, ARGMOD(PackFile_ByteCode *bc)) { ASSERT_ARGS(pbc_merge_debugs) PackFile_Debug *debug_seg; opcode_t *lines = mem_gc_allocate_typed(interp, opcode_t); PackFile_DebugFilenameMapping *mappings = mem_gc_allocate_typed(interp, PackFile_DebugFilenameMapping); opcode_t num_mappings = 0; opcode_t num_lines = 0; int i; /* We need to merge both the mappings and the list of line numbers. The line numbers can just be concatenated. The mappings must have their offsets fixed up. */ for (i = 0; i < num_inputs; ++i) { const PackFile_Debug * const in_seg = inputs[i]->pf->cur_cs->debugs; int j; /* Concatenate line numbers. */ lines = mem_gc_realloc_n_typed(interp, lines, num_lines + in_seg->base.size, opcode_t); memcpy(lines + num_lines, in_seg->base.data, in_seg->base.size * sizeof (opcode_t)); /* Concatenate mappings. */ mappings = mem_gc_realloc_n_typed(interp, mappings, num_mappings + in_seg->num_mappings, PackFile_DebugFilenameMapping); for (j = 0; j < in_seg->num_mappings; ++j) { PackFile_DebugFilenameMapping *mapping = mappings + num_mappings + j; STRUCT_COPY_FROM_STRUCT(mapping, in_seg->mappings[j]); mapping->offset += num_lines; mapping->filename = inputs[i]->str.const_map[mapping->filename]; } num_lines += in_seg->base.size - 1; num_mappings += in_seg->num_mappings; } /* Create merged debug segment. Replace created data and mappings with merged ones we have created. */ debug_seg = Parrot_new_debug_seg(interp, bc, num_lines); mem_gc_free(interp, debug_seg->base.data); debug_seg->base.data = lines; mem_gc_free(interp, debug_seg->mappings); debug_seg->mappings = mappings; debug_seg->num_mappings = num_mappings; } static opcode_t bytecode_remap_op(PARROT_INTERP, PackFile *pf, opcode_t op) { int i; op_info_t *info = pf->cur_cs->op_info_table[op]; op_lib_t *lib = info->lib; op_func_t op_func = pf->cur_cs->op_func_table[op]; PackFile_ByteCode *bc = interp->code; PackFile_ByteCode_OpMappingEntry *om; for (i = 0; i < bc->op_mapping.n_libs; i++) { if (lib == bc->op_mapping.libs[i].lib) { om = &bc->op_mapping.libs[i]; goto found_lib; } } /* library not yet mapped */ bc->op_mapping.n_libs++; bc->op_mapping.libs = mem_gc_realloc_n_typed_zeroed(interp, bc->op_mapping.libs, bc->op_mapping.n_libs, bc->op_mapping.n_libs - 1, PackFile_ByteCode_OpMappingEntry); /* initialize a new lib entry */ om = &bc->op_mapping.libs[bc->op_mapping.n_libs - 1]; om->lib = lib; om->n_ops = 0; om->lib_ops = mem_gc_allocate_n_zeroed_typed(interp, 0, opcode_t); om->table_ops = mem_gc_allocate_n_zeroed_typed(interp, 0, opcode_t); found_lib: for (i = 0; i < om->n_ops; i++) { if (bc->op_func_table[om->table_ops[i]] == op_func) return om->table_ops[i]; } /* op not yet mapped */ bc->op_count++; bc->op_func_table = mem_gc_realloc_n_typed_zeroed(interp, bc->op_func_table, bc->op_count, bc->op_count - 1, op_func_t); bc->op_func_table[bc->op_count - 1] = op_func; bc->op_info_table = mem_gc_realloc_n_typed_zeroed(interp, bc->op_info_table, bc->op_count, bc->op_count - 1, op_info_t *); bc->op_info_table[bc->op_count - 1] = info; /* initialize new op mapping */ om->n_ops++; om->lib_ops = mem_gc_realloc_n_typed_zeroed(interp, om->lib_ops, om->n_ops, om->n_ops - 1, opcode_t); for (i = 0; i < lib->op_count; i++) { if (lib->op_func_table[i] == op_func) { om->lib_ops[om->n_ops - 1] = i; break; } } PARROT_ASSERT(om->lib_ops[om->n_ops - 1] || !i); om->table_ops = mem_gc_realloc_n_typed_zeroed(interp, om->table_ops, om->n_ops, om->n_ops - 1, opcode_t); om->table_ops[om->n_ops - 1] = bc->op_count - 1; return bc->op_count - 1; } /* =item C Fixup bytecode. This includes correcting pointers into the constant table and updating the ops mapping. =cut */ static void pbc_fixup_bytecode(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs), int num_inputs, ARGMOD(PackFile_ByteCode *bc)) { ASSERT_ARGS(pbc_fixup_bytecode) opcode_t *ops = bc->base.data; opcode_t cur_op = 0; int cur_input = 0; op_lib_t *core_ops = PARROT_GET_CORE_OPLIB(interp); /* Loop over the ops in the merged bytecode. */ while (cur_op < (opcode_t)bc->base.size) { op_info_t *op; opcode_t op_num; op_func_t op_func; opcode_t *op_ptr; int cur_arg; /* Keep track of the current input file. */ if (cur_input + 1 < num_inputs && cur_op >= inputs[cur_input + 1]->code_start) ++cur_input; /* Get info about this op, remap it, and jump over it. */ op_num = ops[cur_op] = bytecode_remap_op(interp, inputs[cur_input]->pf, ops[cur_op]); op = bc->op_info_table[op_num]; op_ptr = ops + cur_op; ++cur_op; /* Loop over the arguments. */ for (cur_arg = 1; cur_arg < op->op_count; ++cur_arg) { /* Pick out any indexes into the constant table and correct them. */ switch (op->types[cur_arg - 1]) { case PARROT_ARG_NC: ops[cur_op] = inputs[cur_input]->num.const_map[ ops[cur_op] ]; break; case PARROT_ARG_SC: case PARROT_ARG_NAME_SC: ops[cur_op] = inputs[cur_input]->str.const_map[ ops[cur_op] ]; break; case PARROT_ARG_PC: case PARROT_ARG_KC: ops[cur_op] = inputs[cur_input]->pmc.const_map[ ops[cur_op] ]; break; default: break; } /* Move along the bytecode array. */ ++cur_op; } /* Handle special case variable argument opcodes. */ op_func = interp->code->op_func_table[op_num]; if (op_func == core_ops->op_func_table[PARROT_OP_set_args_pc] || op_func == core_ops->op_func_table[PARROT_OP_get_results_pc] || op_func == core_ops->op_func_table[PARROT_OP_get_params_pc] || op_func == core_ops->op_func_table[PARROT_OP_set_returns_pc]) { /* Get the signature. */ PMC * const sig = bc->const_table->pmc.constants[op_ptr[1]]; /* Loop over the arguments to locate any that need a fixup. */ const int sig_items = VTABLE_elements(interp, sig); for (cur_arg = 0; cur_arg < sig_items; ++cur_arg) { switch (VTABLE_get_integer_keyed_int(interp, sig, cur_arg)) { case PARROT_ARG_NC: ops[cur_op] = inputs[cur_input]->num.const_map[ ops[cur_op] ]; break; case PARROT_ARG_SC: case PARROT_ARG_NAME_SC: ops[cur_op] = inputs[cur_input]->str.const_map[ ops[cur_op] ]; break; case PARROT_ARG_PC: case PARROT_ARG_KC: ops[cur_op] = inputs[cur_input]->pmc.const_map[ ops[cur_op] ]; break; default: break; } ++cur_op; } } } } /* =item C Fixup constants. This includes correcting pointers into bytecode. =cut */ static void pbc_fixup_constants(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs), int num_inputs) { ASSERT_ARGS(pbc_fixup_constants) int i, j; /* Loop over input files. */ for (i = 0; i < num_inputs; ++i) { /* Get the constant table segment from the input file. */ PackFile_ConstTable * const in_seg = inputs[i]->pf->cur_cs->const_table; for (j = 0; j < in_seg->pmc.const_count; j++) { PMC * const v = in_seg->pmc.constants[j]; /* If it's a sub PMC, need to deal with offsets. */ switch (v->vtable->base_type) { case enum_class_Sub: case enum_class_Coroutine: { Parrot_Sub_attributes *sub; PMC_get_sub(interp, v, sub); sub->start_offs += inputs[i]->code_start; sub->end_offs += inputs[i]->code_start; } break; default: break; } } } } /* =item C This is the function that drives PBC merging process. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PackFile* pbc_merge_begin(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs), int num_inputs) { ASSERT_ARGS(pbc_merge_begin) PackFile_ByteCode *bc; PackFile_ConstTable *ct; int i; /* Create a new empty packfile. */ PackFile * const merged = PackFile_new(interp, 0); if (merged == NULL) { Parrot_io_eprintf(interp, "PBC Merge: Error creating new packfile.\n"); Parrot_x_exit(interp, 1); } /* calculate how many constants are stored in the packfiles to be merged */ for (i = 0; i < num_inputs; ++i) { PackFile_Directory *pf_dir = &inputs[i]->pf->directory; unsigned int j = 0; for (j = 0; j < pf_dir->num_segments; ++j) { const PackFile_Segment * const seg = pf_dir->segments[j]; if (seg->type == PF_CONST_SEG) { const PackFile_ConstTable * const ct = (const PackFile_ConstTable *)seg; inputs[i]->num.const_map = mem_gc_allocate_n_typed(interp, ct->num.const_count, opcode_t); inputs[i]->str.const_map = mem_gc_allocate_n_typed(interp, ct->str.const_count, opcode_t); inputs[i]->pmc.const_map = mem_gc_allocate_n_typed(interp, ct->pmc.const_count, opcode_t); } } } /* Merge the various stuff. */ ct = pbc_merge_constants(interp, inputs, num_inputs, merged); bc = pbc_merge_bytecode(interp, inputs, num_inputs, merged); bc->const_table = ct; ct->code = bc; interp->code = bc; pbc_merge_debugs(interp, inputs, num_inputs, bc); /* Walk bytecode and fix ops that reference the constants table. */ pbc_fixup_bytecode(interp, inputs, num_inputs, bc); /* Walk constants and fix references into bytecode. */ pbc_fixup_constants(interp, inputs, num_inputs); for (i = 0; i < num_inputs; ++i) { mem_gc_free(interp, inputs[i]->num.const_map); mem_gc_free(interp, inputs[i]->str.const_map); mem_gc_free(interp, inputs[i]->pmc.const_map); } /* Return merged result. */ return merged; } /* =item C This functions writes out the merged packfile. =cut */ static void pbc_merge_write(PARROT_INTERP, ARGMOD(PackFile *pf), ARGIN(const char *filename)) { ASSERT_ARGS(pbc_merge_write) FILE *fp; /* Get size of packfile we'll write. */ const size_t size = PackFile_pack_size(interp, pf) * sizeof (opcode_t); /* Allocate memory. */ opcode_t * const pack = (opcode_t*) Parrot_gc_allocate_memory_chunk(interp, size); /* Write and clean up. */ PackFile_pack(interp, pf, pack); if ((fp = fopen(filename, "wb")) == 0) { Parrot_io_eprintf(interp, "PBC Merge: Couldn't open %s\n", filename); exit(1); } if ((1 != fwrite(pack, size, 1, fp))) { Parrot_io_eprintf(interp, "PBC Merge: Couldn't write %s\n", filename); exit(1); } fclose(fp); mem_gc_free(interp, pack); } /* =item C The main function that grabs console input, reads in the packfiles provided they exist, hands them to another function that runs the merge process and finally writes out the produced packfile. =cut */ static struct longopt_opt_decl options[] = { { 'o', 'o', OPTION_required_FLAG, { "--output" } }, { 0 , 0 , OPTION_optional_FLAG, { NULL } } }; int main(int argc, const char **argv) { int status; pbc_merge_input** input_files; PackFile *merged; int i; const char *output_file = NULL; struct longopt_opt_info opt = LONGOPT_OPT_INFO_INIT; Interp * const interp = Parrot_interp_new(NULL); STRING * pbcname = NULL; PMC * pbcpmc = NULL; Parrot_block_GC_mark(interp); /* Get options, ensuring we have at least one input file and an output file. */ if (argc < 4) help(); while ((status = longopt_get(argc, argv, options, &opt)) > 0) { switch (opt.opt_id) { case 'o': if (output_file == NULL) output_file = opt.opt_arg; else help(); break; case '?': help(); break; default: break; } } if (status == -1 || !output_file) help(); argc -= opt.opt_index; /* Now the number of input files. */ argv += opt.opt_index; /* Now at first input filename. */ /* Load each packfile that we are to merge and set up an input structure for each of them. */ input_files = mem_gc_allocate_n_typed(interp, argc, pbc_merge_input*); for (i = 0; i < argc; ++i) { /* Allocate a struct. */ input_files[i] = mem_gc_allocate_typed(interp, pbc_merge_input); /* Set filename */ input_files[i]->filename = *argv; pbcname = Parrot_str_new(interp, input_files[i]->filename, strlen(input_files[i]->filename)); { PackFile * const pf = Parrot_pf_read_pbc_file(interp, pbcname); pbcpmc = Parrot_pf_get_packfile_pmc(interp, pf, pbcname); } /* Load the packfile and unpack it. */ input_files[i]->pf = (PackFile *)VTABLE_get_pointer(interp, pbcpmc); if (input_files[i]->pf == NULL) { Parrot_io_eprintf(interp, "PBC Merge: Unknown error while reading and unpacking %s\n", *argv); exit(1); } /* Next file. */ ++argv; } /* Merge. */ merged = pbc_merge_begin(interp, input_files, argc); /* Write merged packfile. */ pbc_merge_write(interp, merged, output_file); /* Finally, we're done. */ exit(0); } /* =back */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ strings.c000644000765000765 1535712101554067 16245 0ustar00brucebruce000000000000parrot-5.9.0/src/embed/* Copyright (C) 2010, Parrot Foundation. =head1 NAME src/embed/strings.c - The Parrot String embedding interface =head1 DESCRIPTION This file implements string functions of the Parrot embedding interface. =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" #include "embed_private.h" #include "parrot/api.h" /* HEADERIZER HFILE: include/parrot/api.h */ /* =item C Exports the ascii Parrot_String C into a C string and stores it in C. This function returns a true value if this call is successful and false value otherwise. =cut */ PARROT_API Parrot_Int Parrot_api_string_export_ascii(ARGIN(Parrot_PMC interp_pmc), ARGIN(Parrot_String string), ARGOUT(char ** strout)) { ASSERT_ARGS(Parrot_api_string_export_ascii) EMBED_API_CALLIN(interp_pmc, interp); if (!STRING_IS_NULL(string)) *strout = Parrot_str_to_cstring(interp, string); else *strout = NULL; EMBED_API_CALLOUT(interp_pmc, interp); } /* =item C Releases the allocated memory for C. This function returns a true value if this call is successful and false value otherwise. =cut */ PARROT_API Parrot_Int Parrot_api_string_free_exported_ascii(ARGIN(Parrot_PMC interp_pmc), ARGIN(char * const str)) { ASSERT_ARGS(Parrot_api_string_free_exported_ascii) EMBED_API_CALLIN(interp_pmc, interp); if (str != NULL) Parrot_str_free_cstring(str); EMBED_API_CALLOUT(interp_pmc, interp); } /* =item C Exports the wchar Parrot_String C into a C string and stores it in C. This function returns a true value if this call is successful and false value otherwise. =cut */ PARROT_API Parrot_Int Parrot_api_string_export_wchar(ARGIN(Parrot_PMC interp_pmc), ARGIN(Parrot_String string), ARGOUT(wchar_t ** strout)) { ASSERT_ARGS(Parrot_api_string_export_wchar) EMBED_API_CALLIN(interp_pmc, interp) if (!STRING_IS_NULL(string)) { char * const cstr = Parrot_str_to_cstring(interp, string); const size_t len = strlen(cstr); wchar_t * const wstrout = (wchar_t *) malloc(sizeof (wchar_t) * (len + 1)); mbstowcs(wstrout, cstr, len); wstrout[len] = L'\0'; *strout = wstrout; } else *strout = NULL; EMBED_API_CALLOUT(interp_pmc, interp); } /* =item C Releases the allocated memory for C. This function returns a true value if this call is successful and false value otherwise. =cut */ PARROT_API Parrot_Int Parrot_api_string_free_exported_wchar(ARGIN(Parrot_PMC interp_pmc), ARGIN(wchar_t * const str)) { ASSERT_ARGS(Parrot_api_string_free_exported_wchar) EMBED_API_CALLIN(interp_pmc, interp) if (str != NULL) free(str); EMBED_API_CALLOUT(interp_pmc, interp); } /* =item C Transforms string C into a Parrot_String and stores the result in C using the platform encoding. This function returns a true value if this call is successful and false value otherwise. =cut */ PARROT_API Parrot_Int Parrot_api_string_import(ARGIN(Parrot_PMC interp_pmc), ARGIN(const char * str), ARGOUT(Parrot_String * out)) { ASSERT_ARGS(Parrot_api_string_import) EMBED_API_CALLIN(interp_pmc, interp) *out = Parrot_str_from_platform_cstring(interp, str); EMBED_API_CALLOUT(interp_pmc, interp); } /* =item C Transforms ascii string C into a Parrot_String and stores the result in C. This function returns a true value if this call is successful and false value otherwise. =cut */ PARROT_API Parrot_Int Parrot_api_string_import_ascii(ARGIN(Parrot_PMC interp_pmc), ARGIN(const char * str), ARGOUT(Parrot_String * out)) { ASSERT_ARGS(Parrot_api_string_import_ascii) EMBED_API_CALLIN(interp_pmc, interp) *out = Parrot_str_new(interp, str, 0); EMBED_API_CALLOUT(interp_pmc, interp); } /* =item C Transforms wchar string C into a Parrot_String and stores the result in C. This function returns a true value if this call is successful and false value otherwise. =cut */ PARROT_API Parrot_Int Parrot_api_string_import_wchar(ARGIN(Parrot_PMC interp_pmc), ARGIN(wchar_t * str), ARGOUT(Parrot_String * out)) { ASSERT_ARGS(Parrot_api_string_import_wchar) EMBED_API_CALLIN(interp_pmc, interp) const size_t len = wcslen(str); char * const cstr = (char *) malloc(sizeof (char) * (len + 1)); wcstombs(cstr, str, len); cstr[len] = '\0'; *out = Parrot_str_new(interp, cstr, 0); free(cstr); EMBED_API_CALLOUT(interp_pmc, interp); } /* =item C Transforms the buffer C of size C with the encoding C into a Parrot_String and stores the result in C. This function returns a true value if this call is successful and false value otherwise. Supported encodings are: "ascii", "iso-8859-1", "binary", "utf8", "utf16", "ucs2", and "ucs4". =cut */ PARROT_API Parrot_Int Parrot_api_string_import_binary(ARGIN(Parrot_PMC interp_pmc), ARGIN(const unsigned char *bytes), Parrot_Int length, ARGIN(const char *encoding_name), ARGOUT(Parrot_String *out)) { ASSERT_ARGS(Parrot_api_string_import_binary) EMBED_API_CALLIN(interp_pmc, interp) const STR_VTABLE * const encoding = Parrot_find_encoding(interp, encoding_name); *out = Parrot_str_new_init(interp, (const char *)bytes, length, encoding, 0); EMBED_API_CALLOUT(interp_pmc, interp); } /* =item C Returns the byte length of a string. =cut */ PARROT_API Parrot_Int Parrot_api_string_byte_length(Parrot_PMC interp_pmc, Parrot_String str, ARGOUT(Parrot_Int * len)) { ASSERT_ARGS(Parrot_api_string_byte_length) EMBED_API_CALLIN(interp_pmc, interp) *len = Parrot_str_byte_length(interp, str); EMBED_API_CALLOUT(interp_pmc, interp) } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ past_building_blocks.pod000644000765000765 111533177646 25557 0ustar00brucebruce000000000000parrot-5.9.0/t/tools/install/testlib/docs/pct show_deprecated.nqp000755000765000765 220211606346603 20313 0ustar00brucebruce000000000000parrot-5.9.0/tools/dev#! parrot-nqp # Copyright (C) 2011, Parrot Foundation. pir::load_bytecode("YAML/Tiny.pbc"); pir::load_bytecode("nqp-setting.pbc"); =begin NAME show_deprecated.nqp - Show deprecated features listed in api.yaml =end NAME =begin SYNOPSIS parrot-nqp tools/dev/show_deprecated.nqp =end SYNOPSIS =begin DESCRIPTION Shows all currently deprecated features. This script could be used to generate documentation about deprecated features in the future. =end DESCRIPTION my @yaml := YAML::Tiny.new.read_string(slurp('api.yaml'))[0]; for @yaml -> %e { my @tags := %e; my $title := %e; my $eligible := %e // 'NONE'; my $ticket := %e // '*************** no ticket ****************'; next if any(-> $_ { $_ eq 'completed' }, @tags); # This format is ugly, but is functional for now say( "$ticket\t$eligible\t$title" ) if any( -> $_ { $_ eq 'deprecated' }, @tags); } sub any(&code, @list) { for @list { return 1 if &code($_); } 0; } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=perl6: configure.t000644000765000765 1064511533177644 16627 0ustar00brucebruce000000000000parrot-5.9.0/t/library#!./parrot # Copyright (C) 2009-2010, Parrot Foundation. =head1 NAME t/library/configure.t =head1 DESCRIPTION Test the Configure PBC =head1 SYNOPSIS % prove t/library/configure.t =cut .sub 'main' :main .include 'test_more.pir' load_bytecode 'Configure/genfile.pbc' plan(40) test_conditioned_line() test_eval_expr() test_interpolate_var() test_replace_slash() .end .sub 'test_conditioned_line' .local pmc config config = new 'Hash' config['foo'] = 1 config['bar'] = 0 config['baz'] = 1 $S0 = conditioned_line("plain text\nwithout #", config) is($S0, "plain text\nwithout #\n", "plain text") $S0 = conditioned_line("#IF(malformed", config) is($S0, "#IF(malformed\n", "malformed") $S0 = conditioned_line("#IF(foo):positive", config) is($S0, "positive\n", "#IF positive") $S0 = conditioned_line("#IF(bar):negative", config) is($S0, "", "#IF negative") $S0 = conditioned_line("#UNLESS(bar):positive", config) is($S0, "positive\n", "#UNLESS positive") $S0 = conditioned_line("#UNLESS(foo):negative", config) is($S0, "", "#UNLESS negative") $S0 = conditioned_line("#IF(foo):positive\n#ELSE:alternate", config) is($S0, "positive\n", "#IF/ELSE positive") $S0 = conditioned_line("#IF(bar):negative\n#ELSE:alternate", config) is($S0, "alternate\n", "#IF/ELSE alternate") $S0 = conditioned_line("#IF(foo):positive\n#ELSIF(baz):alternate", config) is($S0, "positive\n", "#IF/ELSIF positive") $S0 = conditioned_line("#IF(bar):negative\n#ELSIF(baz):alternate", config) is($S0, "alternate\n", "#IF/ELSIF alternate") $S0 = conditioned_line("#IF(bar):negative\n#ELSIF(bar):negative", config) is($S0, "", "#IF/ELSIF negative") .end .sub 'test_eval_expr' .local pmc config config = new 'Hash' config['foo'] = 1 config['bar'] = 0 config['baz'] = 1 $I0 = cond_eval("foo", config) is($I0, 1, "foo") $I0 = cond_eval(" foo ", config) is($I0, 1, " foo ") $I0 = cond_eval("bar", config) is($I0, 0, "bar") $I0 = cond_eval(" unknown ", config) is($I0, 0, " unknown ") $I0 = cond_eval(" ( foo ) ", config) is($I0, 1, " ( foo ) ") $I0 = cond_eval("NOT foo", config) is($I0, 0, "NOT foo") $I0 = cond_eval(" NOT bar", config) is($I0, 1, " NOT bar") $I0 = cond_eval("!!foo", config) is($I0, 1, "!!foo") $I0 = cond_eval(" foo OR bar ", config) is($I0, 1, " foo OR bar ") $I0 = cond_eval("foo||bar", config) is($I0, 1, "foo||bar") $I0 = cond_eval(" foo AND bar ", config) is($I0, 0, " foo AND bar ") $I0 = cond_eval("foo&&bar", config) is($I0, 0, "foo&&bar") $I0 = cond_eval(" foo == bar ", config) is($I0, 0, " foo == bar ") $I0 = cond_eval(" foo == baz ", config) is($I0, 1, " foo == baz ") $I0 = cond_eval(" foo != bar ", config) is($I0, 1, " foo != bar ") $I0 = cond_eval(" foo != baz ", config) is($I0, 0, " foo != baz ") .end .sub 'test_interpolate_var' .local pmc config config = new 'Hash' config['foo'] = 'bar' $S0 = interpolate_var("# plain text", config) is($S0, "# plain text\n", "plain text") $S0 = interpolate_var("\t@echo foo", config) is($S0, "\t@echo foo\n", "@ alone") $S0 = interpolate_var("here @foo@ variable", config) is($S0, "here bar variable\n", "variable") $S0 = interpolate_var("here @foo@ variable, and here @foo@.", config) is($S0, "here bar variable, and here bar.\n", "variable") $S0 = interpolate_var("\t@echo var @foo@.", config) is($S0, "\t@echo var bar.\n", "gives a second change") .end .sub 'test_replace_slash' $S1 = "path/to/somewhere/" $S0 = replace_slash($S1, 'MSWin32') is($S0, "path\\to\\somewhere\\", "paths on win32") $S0 = replace_slash($S1, '*nix') is($S0, $S1, "paths on *nix") $S1 = "prove t/*.t" $S0 = replace_slash($S1, 'MSWin32') is($S0, "prove t\\\\*.t") $S0 = replace_slash($S1, '*nix') is($S0, $S1) $S1 = "prove t//*.t" $S0 = replace_slash($S1, 'MSWin32') is($S0, "prove t/*.t") $S0 = replace_slash($S1, '*nix') is($S0, "prove t/*.t") $S1 = "http:////host//paths//" $S0 = replace_slash($S1, 'MSWin32') is($S0, "http://host/paths/", "url on win32") $S0 = replace_slash($S1, '*nix') is($S0, "http://host/paths/", "url on *nix") .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: ro.t000644000765000765 1215111533177645 14374 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc#!./parrot # Copyright (C) 2006-2010, Parrot Foundation. =head1 NAME t/pmc/ro.t -- tests read-only value support =head1 SYNOPSIS % prove t/pmc/ro.t =head1 DESCRIPTION Tests automatically generated read-only PMC support. =cut .namespace [] .include "except_types.pasm" .sub make_readonly .param pmc arg .local pmc one one = new ['Integer'] one = 1 setprop arg, '_ro', one .end .sub make_writable .param pmc arg .local pmc zero zero = new ['Integer'] zero = 0 setprop arg, '_ro', zero .end .sub main :main .include 'test_more.pir' plan(13) integer_set_read_only_is_not_writable() # 1 test integer_set_read_only_can_be_read() # 6 tests integer_stays_integer() # 1 test integer_add() # 1 test complex_i_add() # 1 test resizablepmcarray_non_recursive_part() # 1 test objects() # 1 test resizablepmcarray_recursive() # 1 test .end .sub integer_set_read_only_is_not_writable .local pmc foo, eh foo = new ['Integer'] foo = 42 eh = new ['ExceptionHandler'] eh.'handle_types'(.EXCEPTION_WRITE_TO_CONSTCLASS) set_label eh, eh_label make_readonly(foo) push_eh eh foo = 43 pop_eh ok( 0, "integer_set_read_only_is_not_writable" ) goto end eh_label: .local string message .get_results($P0) message = $P0['message'] is( message, "set_integer_native() in read-only instance of 'Integer'", "integer_set_read_only_is_not_writable" ) end: .end .sub integer_set_read_only_can_be_read .local pmc foo .local pmc tmp foo = new ['Integer'] foo = 42 make_readonly(foo) is(foo, 42, 'foo initialised to 42 is readable after make_readonly') $I0 = foo is($I0, 42, 'foo copied to int correctly') $S0 = foo is($S0, 42, 'foo copied to string correctly') tmp = new ['Integer'] add tmp, foo, foo is(tmp, 84, 'foo can be added to foo correctly and stored elsewhere') $P0 = foo add foo, foo, foo is(foo, 84, 'foo can be added to foo correctly and stored to foo') is($P0, 42, 'copied foo retains its value') .end .sub integer_stays_integer .local pmc foo foo = new ['Integer'] foo = 42 make_readonly(foo) typeof $S0, foo is($S0, 'Integer', 'integer_stays_integer') .end .sub integer_add .local pmc foo, eh foo = new ['Integer'] foo = 42 eh = new ['ExceptionHandler'] eh.'handle_types'(.EXCEPTION_WRITE_TO_CONSTCLASS) set_label eh, eh_label make_readonly(foo) push_eh eh foo += 16 pop_eh ok(0, 'integer_add') goto end eh_label: .local string message .get_results($P0) message = $P0['message'] is( message, "i_add_int() in read-only instance of 'Integer'", 'integer_add' ) end: .end .sub complex_i_add .local pmc foo, eh foo = new ['Complex'] foo[0] = 1.0 foo[1] = 1.0 eh = new ['ExceptionHandler'] eh.'handle_types'(.EXCEPTION_WRITE_TO_CONSTCLASS) set_label eh, eh_label make_readonly(foo) push_eh eh add foo, 4 pop_eh ok( 0, 'complex_i_add') goto end eh_label: .local string message .get_results($P0) message = $P0['message'] is( message, "i_add_int() in read-only instance of 'Complex'", 'complex_i_add' ) end: .end .sub resizablepmcarray_non_recursive_part .local pmc foo, three, four, eh foo = new ['ResizablePMCArray'] three = new ['Integer'] three = 3 four = new ['Integer'] four = 4 eh = new ['ExceptionHandler'] eh.'handle_types'(.EXCEPTION_WRITE_TO_CONSTCLASS) set_label eh, eh_label foo = 3 foo[0] = three foo[1] = three foo[2] = three make_readonly(foo) push_eh eh foo[0] = four pop_eh ok(0, 'resizablepmcarray_non_recursive_part') goto end eh_label: .local string message .get_results($P0) message = $P0['message'] is( message, "set_pmc_keyed_int() in read-only instance of 'ResizablePMCArray'", 'resizablepmcarray_non_recursive_part' ) end: .end .sub objects .local pmc fooclass, foo, eh, i i = new ['Integer'] i = 1 eh = new ['ExceptionHandler'] eh.'handle_types'(.EXCEPTION_WRITE_TO_CONSTCLASS) set_label eh, eh_label fooclass = newclass 'Foo' addattribute fooclass, 'bar' foo = new ['Foo'] setattribute foo, 'bar', i make_readonly(foo) inc i push_eh eh setattribute foo, 'bar', i pop_eh ok( 0, 'objects') goto end eh_label: .local string message .get_results($P0) message = $P0['message'] is( message, "set_attr_str() in read-only instance of 'Foo'", 'objects' ) end: .end .sub resizablepmcarray_recursive .local pmc foo .local pmc three .local pmc four foo = new ['ResizablePMCArray'] three = new ['Integer'] three = 3 foo = 1 foo[0] = three make_readonly(foo) four = foo[0] four = 4 four = foo[0] is(four, 4, 'TT #1036 - readonly should be shallow') .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: IMCC.pm000644000765000765 155211533177636 20112 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/Docs/Section# Copyright (C) 2004, Parrot Foundation. =head1 NAME Parrot::Docs::Section::IMCC - IMCC documentation section =head1 SYNOPSIS use Parrot::Docs::Section::IMCC; =head1 DESCRIPTION A documentation section describing IMCC. =head2 Class Methods =over =cut package Parrot::Docs::Section::IMCC; use strict; use warnings; use base qw( Parrot::Docs::Section ); =item C Returns a new section. =cut sub new { my $self = shift; return $self->SUPER::new( 'IMCC', 'imcc.html', '', $self->new_group( 'Documentation', '', 'docs/imcc' ), $self->new_group( 'Examples', '', 'examples/pir' ), $self->new_group( 'Tests', '', 't/compilers/imcc' ), ); } =back =cut 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: coroutine.t000644000765000765 1507211567202625 15762 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc#! perl # Copyright (C) 2001-2005, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Test tests => 12; =head1 NAME t/pmc/coroutines.t - Coroutines =head1 SYNOPSIS % prove t/pmc/coroutine.t =head1 DESCRIPTION Tests the C PMC. =cut pasm_output_is( <<'CODE', <<'OUTPUT', "Coroutine 1" ); .include "interpinfo.pasm" .pcc_sub :main _main: .const 'Sub' P0 = "_coro" new P10, ['Integer'] set P10, 2 set_global "i", P10 lp: invokecc P0 print "back " print P10 print "\n" if P10, lp print "done\n" end .pcc_sub _coro: loop: get_global P11, "i" dec P11 yield branch loop CODE back 1 back 0 done OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "Coroutines - M. Wallace yield example" ); .sub __main__ :main .local pmc return .local pmc counter .const 'Sub' itr = "_iterator" .local pmc zero zero = new ['Integer'] zero = 0 return = new ['Continuation'] set_label return, return_here loop: .begin_call .call itr, return .get_result counter .end_call print counter print " " zero = 0 print zero print "\n" goto loop return_here: .get_results () end .end .sub _iterator .local pmc x x = new ['Integer'] x = 0 iloop: .begin_yield .set_yield x .end_yield x = x + 1 if x <= 10 goto iloop returncc .end CODE 0 0 1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 0 9 0 10 0 OUTPUT pasm_output_is( <<'CODE', <<'OUTPUT', "Coroutine - exception in main" ); .include "interpinfo.pasm" .pcc_sub :main _main: .const 'Sub' P0 = "_coro" push_eh _catchm new P16, ['Integer'] set P16, 2 set_global "i", P16 lp: invokecc P0 print "back " print P16 print "\n" null S0 get_global P17, S0 if P16, lp print "done\n" end _catchm: get_results '0', P5 print "catch main\n" end .pcc_sub _coro: push_eh _catchc corolp: get_global P17, "i" dec P17 yield branch corolp _catchc: get_results '0', P5 print "catch coro\n" end CODE back 1 catch main OUTPUT pasm_output_is( <<'CODE', <<'OUTPUT', "Coroutine - exception in coro" ); .include "interpinfo.pasm" .pcc_sub :main _main: .const 'Sub' P0 = "_coro" push_eh _catchm new P16, ['Integer'] set P16, 2 set_global "i", P16 lp: invokecc P0 print "back " print P16 print "\n" if P16, lp print "done\n" end _catchm: get_results '0', P5 print "catch main\n" end .pcc_sub _coro: push_eh _catchc corolp: get_global P17, "i" dec P17 yield null S0 get_global P17, S0 branch corolp _catchc: get_results '0', P5 print "catch coro\n" end CODE back 1 catch coro OUTPUT pasm_output_is( <<'CODE', <<'OUTPUT', "Coroutine - exception in coro no handler" ); .include "interpinfo.pasm" .pcc_sub :main _main: .const 'Sub' P0 = "_coro" push_eh _catchm new P16, ['Integer'] set P16, 2 set_global "i", P16 lp: invokecc P0 print "back " print P16 print "\n" if P16, lp print "done\n" end _catchm: get_results '0', P5 print "catch main\n" end .pcc_sub _coro: corolp: get_global P17, "i" dec P17 yield null S0 get_global P17, S0 branch corolp _catchc: print "catch coro\n" end CODE back 1 catch main OUTPUT pasm_output_is( <<'CODE', <<'OUTPUT', "Coroutine - exception in coro rethrow" ); .include "interpinfo.pasm" .pcc_sub :main _main: .const 'Sub' P0 = "_coro" push_eh _catchm new P16, ['Integer'] set P16, 2 set_global "i", P16 lp: invokecc P0 print "back " print P16 print "\n" if P16, lp print "done\n" end _catchm: get_results '0', P5 print "catch main\n" end .pcc_sub _coro: push_eh _catchc corolp: get_global P17, "i" dec P17 yield null S0 get_global P17, S0 branch corolp _catchc: get_results '0', P5 print "catch coro\n" rethrow P5 end CODE back 1 catch coro catch main OUTPUT pir_output_is( <<'CODE', 'Coroutine', "Coro new - type" ); .sub main :main .local pmc c c = get_global "coro" typeof $S0, c print $S0 .end .sub coro .local pmc x x = new ['Integer'] x = 0 iloop: .yield (x) x = x + 1 if x <= 4 goto iloop .end CODE pir_output_is( <<'CODE', '01234', "Coro new - yield" ); .sub main :main .local pmc c c = get_global "coro" loop: .begin_call .call c .get_result $P0 :optional .get_result $I0 :opt_flag .end_call unless $I0, ex print $P0 goto loop ex: .end .sub coro .local pmc x x = new ['Integer'] x = 0 iloop: .yield (x) x = x + 1 if x <= 4 goto iloop .end CODE pir_output_like( <<'CODE', <<'OUTPUT', "Call an exited coroutine", todo => 'goes one iteration too far TT #1003' ); .sub main :main .local pmc c c = get_global "coro" loop: $P0 = c() print $P0 goto loop .end .sub coro .local pmc x x = new ['Integer'] x = 0 iloop: .yield (x) x = x + 1 if x <= 4 goto iloop .end CODE /\A01234Cannot resume dead coroutine/ OUTPUT pir_output_is( << 'CODE', << 'OUTPUT', "check whether interface is done" ); .sub _main :main .local pmc pmc1 pmc1 = new ['Coroutine'] .local int bool1 does bool1, pmc1, "invokable" print bool1 print "\n" does bool1, pmc1, "no_interface" print bool1 print "\n" end .end CODE 1 0 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "re-entering coro from another sub" ); .sub main :main .local int z .const 'Sub' corou = "_coroufn" corou("from main") z = 0 loop: unless z < 4 goto end met(corou) inc z goto loop end: .end .sub met .param pmc corou corou() .end .sub _coroufn .param string x .local int j print "coroutine: first call " print x print "\n" j = 0 coroufn_1: inc j print "yield #" print j print "\n" .yield() goto coroufn_1 .end CODE coroutine: first call from main yield #1 yield #2 yield #3 yield #4 yield #5 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "Continue coroutine with params"); .sub 'main' :main coro(1) coro(2) coro(3) .end .sub coro .param int x .local int y y = 0 loop: say x .yield(x) .param int y x += y if y >= 0 goto loop .end CODE 1 3 6 OUTPUT # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: Regex-s0.pir000644000765000765 26755712101554066 20704 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx/src/stage0# =head1 NAME Regex - Regex library =head1 DESCRIPTION This file brings together the various Regex modules needed for Regex.pbc . =cut ### .include 'src/Regex/Cursor.pir' # Copyright (C) 2009, The Perl Foundation. # =head1 NAME Regex::Cursor - Regex Cursor nodes =head1 DESCRIPTION This file implements the Regex::Cursor class, used for managing regular expression control flow. Regex::Cursor is also a base class for grammars. =cut .include 'cclass.pasm' ### .include 'src/Regex/constants.pir' .const int CURSOR_FAIL = -1 .const int CURSOR_FAIL_GROUP = -2 .const int CURSOR_FAIL_RULE = -3 .const int CURSOR_FAIL_MATCH = -4 .const int CURSOR_TYPE_SCAN = 1 .const int CURSOR_TYPE_PEEK = 2 .namespace ['Regex';'Cursor'] .sub '' :anon :load :init load_bytecode 'P6object.pbc' .local pmc p6meta p6meta = new 'P6metaclass' $P0 = p6meta.'new_class'('Regex::Cursor', 'attr'=>'$!target $!from $!pos $!match $!names $!debug @!bstack @!cstack @!caparray &!regex') $P0 = box 0 set_global '$!generation', $P0 $P0 = new ['Boolean'] assign $P0, 0 set_global '$!FALSE', $P0 $P0 = new ['Boolean'] assign $P0, 1 set_global '$!TRUE', $P0 .return () .end =head2 Methods =over 4 =item new_match() A method that creates an empty Match object, by default of type C. This method can be overridden for generating HLL-specific Match objects. =cut .sub 'new_match' :method .local pmc match match = new ['Regex';'Match'] .return (match) .end =item new_array() A method that creates an empty array object, by default of type C. This method can be overridden for generating HLL-specific arrays for usage within Match objects. =cut .sub 'new_array' :method .local pmc arr arr = new ['ResizablePMCArray'] .return (arr) .end =item MATCH() Return this cursor's current Match object, generating a new one for the Cursor if one hasn't been created yet. =cut .sub 'MATCH' :method .local pmc match match = getattribute self, '$!match' if null match goto match_make $P0 = get_global '$!TRUE' $I0 = issame match, $P0 unless $I0 goto match_done # First, create a Match object and bind it match_make: match = self.'new_match'() setattribute self, '$!match', match setattribute match, '$!cursor', self .local pmc target, from, to target = getattribute self, '$!target' setattribute match, '$!target', target from = getattribute self, '$!from' setattribute match, '$!from', from to = getattribute self, '$!pos' setattribute match, '$!to', to # Create any arrayed subcaptures. .local pmc caparray, caparray_it, caphash caparray = getattribute self, '@!caparray' if null caparray goto caparray_done caparray_it = iter caparray caphash = new ['Hash'] caparray_loop: unless caparray_it goto caparray_done .local string subname .local pmc arr .local int keyint subname = shift caparray_it arr = self.'new_array'() caphash[subname] = arr keyint = is_cclass .CCLASS_NUMERIC, subname, 0 if keyint goto caparray_int match[subname] = arr goto caparray_loop caparray_int: $I0 = subname match[$I0] = arr goto caparray_loop caparray_done: # If it's not a successful match, or if there are # no saved subcursors, we're done. if to < from goto match_done .local pmc cstack, cstack_it cstack = getattribute self, '@!cstack' if null cstack goto cstack_done unless cstack goto cstack_done cstack_it = iter cstack cstack_loop: unless cstack_it goto cstack_done .local pmc subcur, submatch, names subcur = shift cstack_it $I0 = isa subcur, ['Regex';'Cursor'] unless $I0 goto cstack_loop # If the subcursor isn't bound with a name, skip it names = getattribute subcur, '$!names' if null names goto cstack_loop submatch = subcur.'MATCH'() # See if we have multiple binds .local pmc names_it subname = names names_it = get_global '$!FALSE' $I0 = index subname, '=' if $I0 < 0 goto cstack_subname names_it = split '=', subname cstack_subname_loop: subname = shift names_it cstack_subname: keyint = is_cclass .CCLASS_NUMERIC, subname, 0 if null caparray goto cstack_bind $I0 = exists caphash[subname] unless $I0 goto cstack_bind if keyint goto cstack_array_int $P0 = match[subname] push $P0, submatch goto cstack_bind_done cstack_array_int: $I0 = subname $P0 = match[$I0] push $P0, submatch goto cstack_bind_done cstack_bind: if keyint goto cstack_bind_int match[subname] = submatch goto cstack_bind_done cstack_bind_int: $I0 = subname match[$I0] = submatch cstack_bind_done: if names_it goto cstack_subname_loop goto cstack_loop cstack_done: match_done: .return (match) .end =item parse(target [, 'rule'=>regex]) Parse C in the current grammar starting with C. If C is omitted, then use the C rule for the grammar. =cut .sub 'parse' :method .param pmc target .param pmc regex :named('rule') :optional .param int has_regex :opt_flag .param pmc actions :named('actions') :optional .param int rxtrace :named('rxtrace') :optional .param pmc options :slurpy :named if has_regex goto have_regex regex = box 'TOP' have_regex: $I0 = isa regex, ['String'] unless $I0 goto regex_done $S0 = regex regex = find_method self, $S0 regex_done: .lex '$*ACTIONS', actions .local pmc cur, match cur = self.'!cursor_init'(target, options :flat :named) unless rxtrace goto rxtrace_done cur.'DEBUG'() rxtrace_done: cur = cur.regex() match = cur.'MATCH'() .return (match) .end =item next() Return the next match from a successful Cursor. =cut .sub 'next' :method .local pmc cur, match cur = self.'!cursor_next'() match = cur.'MATCH'() .return (match) .end =item pos() Return the cursor's current position. =cut .sub 'pos' :method $P0 = getattribute self, '$!pos' .return ($P0) .end =item from() Return the cursor's from position. =cut .sub 'from' :method $P0 = getattribute self, '$!from' .return ($P0) .end =back =head2 Private methods =over 4 =item !cursor_init(target) Create a new cursor for matching C. =cut .sub '!cursor_init' :method .param string target .param int pos :named('p') :optional .param int has_pos :opt_flag .param int cont :named('c') :optional .param int has_cont :opt_flag .local pmc parrotclass, cur $P0 = self.'HOW'() parrotclass = getattribute $P0, 'parrotclass' cur = new parrotclass $P0 = box target setattribute cur, '$!target', $P0 if has_cont goto cursor_cont $P0 = box pos setattribute cur, '$!from', $P0 $P0 = box pos setattribute cur, '$!pos', $P0 goto cursor_done cursor_cont: $P0 = box CURSOR_FAIL setattribute cur, '$!from', $P0 $P0 = box cont setattribute cur, '$!pos', $P0 cursor_done: .return (cur) .end =item !cursor_start([lang]) Create and initialize a new cursor from C. If C is provided, then the new cursor has the same type as lang. =cut .sub '!cursor_start' :method .param pmc lang :optional .param int has_lang :opt_flag if has_lang goto have_lang lang = self have_lang: .local pmc parrotclass, cur $P0 = lang.'HOW'() parrotclass = getattribute $P0, 'parrotclass' cur = new parrotclass .local pmc regex regex = getattribute self, '&!regex' unless null regex goto cursor_restart .local pmc from, target, debug from = getattribute self, '$!pos' setattribute cur, '$!from', from setattribute cur, '$!pos', from target = getattribute self, '$!target' setattribute cur, '$!target', target debug = getattribute self, '$!debug' setattribute cur, '$!debug', debug .return (cur, from, target, 0) cursor_restart: .local pmc pos, cstack, bstack from = getattribute self, '$!from' target = getattribute self, '$!target' debug = getattribute self, '$!debug' cstack = getattribute self, '@!cstack' bstack = getattribute self, '@!bstack' pos = box CURSOR_FAIL setattribute cur, '$!from', from setattribute cur, '$!pos', pos setattribute cur, '$!target', target setattribute cur, '$!debug', debug if null cstack goto cstack_done cstack = clone cstack setattribute cur, '@!cstack', cstack cstack_done: if null bstack goto bstack_done bstack = clone bstack setattribute cur, '@!bstack', bstack bstack_done: .return (cur, from, target, 1) .end =item !cursor_fail(pos) Permanently fail this cursor. =cut .sub '!cursor_fail' :method .local pmc pos pos = box CURSOR_FAIL_RULE setattribute self, '$!pos', pos null $P0 setattribute self, '$!match', $P0 setattribute self, '@!bstack', $P0 setattribute self, '@!cstack', $P0 .end =item !cursor_pass(pos, name) Set the Cursor as passing at C; calling any reduction action C associated with the cursor. This method simply sets C<$!match> to a boolean true value to indicate the regex was successful; the C method above replaces this boolean true with a "real" Match object when requested. =cut .sub '!cursor_pass' :method .param pmc pos .param string name setattribute self, '$!pos', pos .local pmc match match = get_global '$!TRUE' setattribute self, '$!match', match unless name goto done self.'!reduce'(name) done: .return (self) .end =item !cursor_backtrack() Configure this cursor for backtracking via C. =cut .sub '!cursor_backtrack' :method $P0 = getinterp $P1 = $P0['sub';1] setattribute self, '&!regex', $P1 .end =item !cursor_next() Continue a regex match from where the current cursor left off. =cut .sub '!cursor_next' :method .local pmc regex, cur regex = getattribute self, '&!regex' if null regex goto fail cur = self.regex() .return (cur) fail: cur = self.'!cursor_start'() cur.'!cursor_fail'() .return (cur) .end =item !cursor_caparray(caparray :slurpy) Set the list of subcaptures that produce arrays to C. =cut .sub '!cursor_caparray' :method .param pmc caparray :slurpy setattribute self, '@!caparray', caparray .end =item !cursor_names(names) Set the Cursor's name (for binding) to C. =cut .sub '!cursor_names' :method .param pmc names setattribute self, '$!names', names .end =item !cursor_pos(pos) Set the cursor's position to C. =cut .sub '!cursor_pos' :method .param pmc pos setattribute self, '$!pos', pos .end =item !cursor_debug(args :slurpy) Log a debug message. =cut .sub '!cursor_debug' :method .param string tag .param pmc args :slurpy $P0 = getattribute self, '$!debug' if null $P0 goto done unless $P0 goto done .local pmc fmt, from, pos, orig, line fmt = new ['ResizablePMCArray'] from = getattribute self, '$!from' orig = getattribute self, '$!target' $P0 = get_hll_global ['HLL'], 'Compiler' line = $P0.'lineof'(orig, from, 'cache'=>1) $P0 = getinterp $P1 = $P0.'stderr_handle'() $N0 = time push fmt, $N0 push fmt, from push fmt, line push fmt, tag $S0 = sprintf "%.6f %d/%d %-8s ", fmt print $P1, $S0 $S0 = join '', args print $P1, $S0 print $P1, "\n" done: .return (self) .end =item !mark_push(rep, pos, mark) Push a new backtracking point onto the cursor with the given C, C, and backtracking C. (The C is typically the address of a label to branch to when backtracking occurs.) =cut .sub '!mark_push' :method .param int rep .param int pos .param int mark .param pmc subcur :optional .param int has_subcur :opt_flag # cptr contains the desired number of elements in the cstack .local int cptr cptr = 0 # Initialize bstack if needed, and set cptr to be the cstack # size requested by the top frame. .local pmc bstack bstack = getattribute self, '@!bstack' if null bstack goto bstack_new unless bstack goto bstack_done $I0 = elements bstack dec $I0 cptr = bstack[$I0] goto bstack_done bstack_new: bstack = new ['ResizableIntegerArray'] setattribute self, '@!bstack', bstack bstack_done: # If a new subcursor is being pushed, then save it in cstack # and change cptr to include the new subcursor. Also clear # any existing match object, as we may have just changed the # match state. unless has_subcur goto subcur_done null $P0 setattribute self, '$!match', $P0 .local pmc cstack cstack = getattribute self, '@!cstack' unless null cstack goto have_cstack cstack = new ['ResizablePMCArray'] setattribute self, '@!cstack', cstack have_cstack: cstack[cptr] = subcur inc cptr subcur_done: # Save our mark frame information. push bstack, mark push bstack, pos push bstack, rep push bstack, cptr .end =item !mark_peek(mark) Return information about the latest frame for C. If C is zero, return information about the latest frame. =cut .sub '!mark_peek' :method .param int tomark .local pmc bstack bstack = getattribute self, '@!bstack' if null bstack goto no_mark unless bstack goto no_mark .local int bptr bptr = elements bstack bptr_loop: bptr = bptr - 4 if bptr < 0 goto no_mark .local int rep, pos, mark, cptr mark = bstack[bptr] unless tomark goto bptr_done unless mark == tomark goto bptr_loop bptr_done: $I0 = bptr + 1 pos = bstack[$I0] inc $I0 rep = bstack[$I0] inc $I0 cptr = bstack[$I0] .return (rep, pos, mark, bptr, bstack, cptr) no_mark: .return (0, CURSOR_FAIL_GROUP, 0, 0, bstack, 0) .end =item !mark_fail(tomark) Remove the most recent C and backtrack the cursor to the point given by that mark. If C is zero, then backtracks the most recent mark. Returns the backtracked values of repetition count, cursor position, and mark (address). =cut .sub '!mark_fail' :method .param int mark # Get the frame information for C. .local int rep, pos, mark, bptr, cptr .local pmc bstack (rep, pos, mark, bptr, bstack, cptr) = self.'!mark_peek'(mark) # clear any existing Match object null $P0 setattribute self, '$!match', $P0 .local pmc subcur null subcur # If there's no bstack, there's nothing else to do. if null bstack goto done # If there's a subcursor associated with this mark, return it. unless cptr > 0 goto cstack_done .local pmc cstack cstack = getattribute self, '@!cstack' dec cptr subcur = cstack[cptr] # Set the cstack to the size requested by the soon-to-be-top mark frame. unless bptr > 0 goto cstack_zero $I0 = bptr - 1 $I0 = bstack[$I0] assign cstack, $I0 goto cstack_done cstack_zero: assign cstack, 0 cstack_done: # Pop the current mark frame and all above it. assign bstack, bptr done: .return (rep, pos, mark, subcur) .end =item !mark_commit(mark) Like C above this backtracks the cursor to C (releasing any intermediate marks), but preserves the current capture states. =cut .sub '!mark_commit' :method .param int mark # find mark .local int rep, pos, mark, bptr, cptr .local pmc bstack (rep, pos, mark, bptr, bstack) = self.'!mark_peek'(mark) # get current cstack size into cptr if null bstack goto done unless bstack goto done $I0 = elements bstack dec $I0 cptr = bstack[$I0] # Pop the mark frame and everything above it. assign bstack, bptr # If we don't need to hold any cstack information, we're done. unless cptr > 0 goto done # If the top frame is an auto-fail frame, (re)use it to hold # our needed cptr, otherwise create a new auto-fail frame to do it. unless bptr > 0 goto cstack_push $I0 = bptr - 3 # pos is at top-3 $I1 = bstack[$I0] unless $I1 < 0 goto cstack_push $I0 = bptr - 1 # cptr is at top-1 bstack[$I0] = cptr goto done cstack_push: push bstack, 0 # mark push bstack, CURSOR_FAIL # pos push bstack, 0 # rep push bstack, cptr # cptr done: .return (rep, pos, mark) .end =item !reduce(name [, key] [, match]) Perform any action associated with the current regex match. =cut .sub '!reduce' :method .param string name .param string key :optional .param int has_key :opt_flag .param pmc match :optional .param int has_match :opt_flag .local pmc actions actions = find_dynamic_lex '$*ACTIONS' if null actions goto actions_done $I0 = can actions, name unless $I0 goto actions_done if has_match goto match_done match = self.'MATCH'() match_done: if has_key goto actions_key actions.name(match) goto actions_done actions_key: .tailcall actions.name(match, key) actions_done: .return () .end =item !BACKREF(name) Match the backreference given by C. =cut .sub '!BACKREF' :method .param string name .local pmc cur .local int pos, eos .local string tgt (cur, pos, tgt) = self.'!cursor_start'() # search the cursor cstack for the latest occurrence of C .local pmc cstack cstack = getattribute self, '@!cstack' if null cstack goto pass .local int cstack_it cstack_it = elements cstack cstack_loop: dec cstack_it unless cstack_it >= 0 goto pass .local pmc subcur subcur = cstack[cstack_it] $P0 = getattribute subcur, '$!names' if null $P0 goto cstack_loop $S0 = $P0 if name != $S0 goto cstack_loop # we found a matching subcursor, get the literal it matched cstack_done: .local int litlen .local string litstr $I1 = subcur.'pos'() $I0 = subcur.'from'() litlen = $I1 - $I0 litstr = substr tgt, $I0, litlen # now test the literal against our target $S0 = substr tgt, pos, litlen unless $S0 == litstr goto fail pos += litlen pass: cur.'!cursor_pass'(pos, '') fail: .return (cur) .end =item !INTERPOLATE(var [, convert]) Perform regex interpolation on C. If C is a regex (sub), it is used directly, otherwise it is used for a string literal match. If C is an array, then all of the elements of C are considered, and the longest match is returned. =cut .sub '!INTERPOLATE' :method .param pmc var .local pmc cur .local int pos, eos .local string tgt $I0 = does var, 'array' if $I0 goto var_array var_scalar: $I0 = does var, 'invokable' if $I0 goto var_sub var_string: (cur, pos, tgt) = self.'!cursor_start'() eos = length tgt $S0 = var $I0 = length $S0 $I1 = pos + $I0 if $I1 > eos goto string_fail $S1 = substr tgt, pos, $I0 if $S0 != $S1 goto string_fail pos += $I0 string_pass: cur.'!cursor_pass'(pos, '') string_fail: .return (cur) var_sub: cur = var(self) .return (cur) var_array: (cur, pos, tgt) = self.'!cursor_start'() eos = length tgt .local pmc var_it, elem .local int maxlen var_it = iter var maxlen = -1 array_loop: unless var_it goto array_done elem = shift var_it $I0 = does elem, 'invokable' if $I0 goto array_sub array_string: $S0 = elem $I0 = length $S0 if $I0 <= maxlen goto array_loop $I1 = pos + $I0 if $I1 > eos goto array_loop $S1 = substr tgt, pos, $I0 if $S0 != $S1 goto array_loop maxlen = $I0 goto array_loop array_sub: $P0 = elem(self) unless $P0 goto array_loop $I0 = $P0.'pos'() $I0 -= pos if $I0 <= maxlen goto array_loop maxlen = $I0 goto array_loop array_done: if maxlen < 0 goto array_fail $I0 = pos + maxlen cur.'!cursor_pass'($I0, '') array_fail: .return (cur) .end =item !INTERPOLATE_REGEX(var) Same as C above, except that any non-regex values are first compiled to regexes prior to being matched. =cut .sub '!INTERPOLATE_REGEX' :method .param pmc var $I0 = does var, 'invokable' if $I0 goto done .local pmc p6regex p6regex = compreg 'Regex::P6Regex' $I0 = does var, 'array' if $I0 goto var_array var = p6regex.'compile'(var) goto done var_array: .local pmc var_it, elem var_it = iter var var = new ['ResizablePMCArray'] var_loop: unless var_it goto done elem = shift var_it $I0 = does elem, 'invokable' if $I0 goto var_next elem = p6regex.'compile'(elem) var_next: push var, elem goto var_loop done: .tailcall self.'!INTERPOLATE'(var) .end =back =head2 Vtable functions =over 4 =item get_bool =cut .sub '' :vtable('get_bool') :method .local pmc match match = getattribute self, '$!match' if null match goto false $I0 = istrue match .return ($I0) false: .return (0) .end =back =head1 AUTHORS Patrick Michaud is the author and maintainer. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: ### .include 'src/Regex/Cursor-builtins.pir' # Copyright (C) 2009, The Perl Foundation. # =head1 NAME Regex::Cursor-builtins - builtin regexes for Cursor objects =cut .include 'cclass.pasm' .namespace ['Regex';'Cursor'] .sub 'before' :method .param pmc regex :optional .local pmc cur .local int pos (cur, pos) = self.'!cursor_start'() if null regex goto fail $P0 = cur.regex() unless $P0 goto fail cur.'!cursor_pass'(pos, 'before') fail: .return (cur) .end .sub 'ident' :method .local pmc cur .local int pos, eos .local string tgt (cur, pos, tgt) = self.'!cursor_start'() eos = length tgt $S0 = substr tgt, pos, 1 if $S0 == '_' goto ident_1 $I0 = is_cclass .CCLASS_ALPHABETIC, tgt, pos unless $I0 goto fail ident_1: pos = find_not_cclass .CCLASS_WORD, tgt, pos, eos cur.'!cursor_pass'(pos, 'ident') fail: .return (cur) .end .sub 'wb' :method .local pmc cur .local int pos, eos .local string tgt (cur, pos, tgt) = self.'!cursor_start'() if pos == 0 goto pass eos = length tgt if pos == eos goto pass $I0 = pos - 1 $I1 = is_cclass .CCLASS_WORD, tgt, $I0 $I2 = is_cclass .CCLASS_WORD, tgt, pos if $I1 == $I2 goto fail pass: cur.'!cursor_pass'(pos, 'wb') fail: .return (cur) .end .sub 'ww' :method .local pmc cur .local int pos, eos .local string tgt (cur, pos, tgt) = self.'!cursor_start'() .local pmc debug debug = getattribute cur, '$!debug' if null debug goto debug_1 cur.'!cursor_debug'('START', 'ww') debug_1: if pos == 0 goto fail eos = length tgt if pos == eos goto fail $I0 = is_cclass .CCLASS_WORD, tgt, pos unless $I0 goto fail $I1 = pos - 1 $I0 = is_cclass .CCLASS_WORD, tgt, $I1 unless $I0 goto fail pass: cur.'!cursor_pass'(pos, 'ww') if null debug goto done cur.'!cursor_debug'('PASS', 'ww') goto done fail: if null debug goto done cur.'!cursor_debug'('FAIL', 'ww') done: .return (cur) .end .sub 'ws' :method .local pmc cur .local int pos, eos .local string tgt (cur, pos, tgt) = self.'!cursor_start'() eos = length tgt if pos >= eos goto pass if pos == 0 goto ws_scan $I0 = is_cclass .CCLASS_WORD, tgt, pos unless $I0 goto ws_scan $I1 = pos - 1 $I0 = is_cclass .CCLASS_WORD, tgt, $I1 if $I0 goto fail ws_scan: pos = find_not_cclass .CCLASS_WHITESPACE, tgt, pos, eos pass: cur.'!cursor_pass'(pos, 'ws') fail: .return (cur) .end .sub '!cclass' :anon .param pmc self .param string name .param int cclass .local pmc cur .local int pos .local string tgt (cur, pos, tgt) = self.'!cursor_start'() .local pmc debug debug = getattribute cur, '$!debug' if null debug goto debug_1 cur.'!cursor_debug'('START', name) debug_1: $I0 = is_cclass cclass, tgt, pos unless $I0 goto fail inc pos pass: cur.'!cursor_pass'(pos, name) if null debug goto done cur.'!cursor_debug'('PASS', name) goto done fail: if null debug goto done cur.'!cursor_debug'('FAIL', name) done: .return (cur) .end .sub 'alpha' :method .local pmc cur .local int pos .local string tgt (cur, pos, tgt) = self.'!cursor_start'() .local pmc debug debug = getattribute cur, '$!debug' if null debug goto debug_1 cur.'!cursor_debug'('START', 'alpha') debug_1: $I0 = is_cclass .CCLASS_ALPHABETIC, tgt, pos if $I0 goto pass $I0 = length tgt if pos >= $I0 goto fail $S0 = substr tgt, pos, 1 if $S0 != '_' goto fail pass: inc pos cur.'!cursor_pass'(pos, 'alpha') if null debug goto done cur.'!cursor_debug'('PASS', 'alpha') goto done fail: if null debug goto done cur.'!cursor_debug'('FAIL', 'alpha') done: .return (cur) .end .sub 'upper' :method .tailcall '!cclass'(self, 'upper', .CCLASS_UPPERCASE) .end .sub 'lower' :method .tailcall '!cclass'(self, 'lower', .CCLASS_LOWERCASE) .end .sub 'digit' :method .tailcall '!cclass'(self, 'digit', .CCLASS_NUMERIC) .end .sub 'xdigit' :method .tailcall '!cclass'(self, 'xdigit', .CCLASS_HEXADECIMAL) .end .sub 'print' :method .tailcall '!cclass'(self, 'print', .CCLASS_PRINTING) .end .sub 'graph' :method .tailcall '!cclass'(self, 'graph', .CCLASS_GRAPHICAL) .end .sub 'cntrl' :method .tailcall '!cclass'(self, 'cntrl', .CCLASS_CONTROL) .end .sub 'punct' :method .tailcall '!cclass'(self, 'punct', .CCLASS_PUNCTUATION) .end .sub 'alnum' :method .tailcall '!cclass'(self, 'alnum', .CCLASS_ALPHANUMERIC) .end .sub 'space' :method .tailcall '!cclass'(self, 'space', .CCLASS_WHITESPACE) .end .sub 'blank' :method .tailcall '!cclass'(self, 'blank', .CCLASS_BLANK) .end .sub 'FAILGOAL' :method .param string goal .local string dba $P0 = getinterp $P0 = $P0['sub';1] dba = $P0 have_dba: .local string message message = concat "Unable to parse ", dba message .= ", couldn't find final " message .= goal message .= ' at line ' $P0 = getattribute self, '$!target' $P1 = get_hll_global ['HLL'], 'Compiler' $I0 = self.'pos'() $I0 = $P1.'lineof'($P0, $I0) inc $I0 $S0 = $I0 message .= $S0 have_line: die message .end .sub 'DEBUG' :method .param pmc arg :optional .param int has_arg :opt_flag if has_arg goto have_arg arg = get_global '$!TRUE' have_arg: setattribute self, '$!debug', arg .return (1) .end =head1 AUTHORS Patrick Michaud is the author and maintainer. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: ### .include 'src/Regex/Cursor-protoregex-peek.pir' # Copyright (C) 2009, The Perl Foundation. =head1 NAME Regex::Cursor-protoregex-peek - simple protoregex implementation =head1 DESCRIPTION =over 4 =item !protoregex(name) Perform a match for protoregex C. =cut .sub '!protoregex' :method .param string name .local pmc debug debug = getattribute self, '$!debug' if null debug goto have_debug if debug goto have_debug null debug have_debug: .local pmc tokrx, toklen (tokrx, toklen) = self.'!protoregex_tokrx'(name) have_tokrx: if null debug goto debug_skip_1 self.'!cursor_debug'('PROTO', name) debug_skip_1: # If there are no entries at all for this protoregex, we fail outright. unless tokrx goto fail # Figure out where we are in the current match. .local pmc target .local int pos target = getattribute self, '$!target' $P1 = getattribute self, '$!pos' pos = $P1 # Use the character at the current match position to determine # the longest possible token we could encounter at this point. .local string token1, token token1 = substr target, pos, 1 $I0 = toklen[token1] token = substr target, pos, $I0 if null debug goto debug_skip_2 $S0 = escape token $S1 = escape token1 self.'!cursor_debug'('NOTE', 'token1="', $S1, '", token="', $S0, '"') debug_skip_2: # Create a hash to keep track of the methods we've already called, # so that we don't end up calling it twice. .local pmc mcalled mcalled = new ['Hash'] # Look in the tokrx hash for any rules that are keyed with the # current token. If there aren't any, or the rules we have don't # match, then shorten the token by one character and try again # until we either have a match or we've run out of candidates. token_loop: .local pmc rx, result rx = tokrx[token] if null rx goto token_next $I0 = isa rx, ['ResizablePMCArray'] if $I0 goto rx_array .local int rxaddr rxaddr = get_addr rx $P0 = mcalled[rxaddr] unless null $P0 goto token_next result = self.rx() mcalled[rxaddr] = mcalled if result goto done goto token_next rx_array: .local pmc rx_it rx_it = iter rx cand_loop: unless rx_it goto cand_done rx = shift rx_it rxaddr = get_addr rx $P0 = mcalled[rxaddr] unless null $P0 goto cand_loop result = self.rx() mcalled[rxaddr] = mcalled if result goto done goto cand_loop cand_done: token_next: unless token > '' goto fail token = chopn token, 1 goto token_loop done: pos = result.'pos'() if null debug goto debug_skip_3 self.'!cursor_debug'('PASS', name, ' at pos=', pos) debug_skip_3: .return (result) fail: if null debug goto debug_skip_4 self.'!cursor_debug'('FAIL', name) debug_skip_4: unless null result goto fail_1 result = self.'!cursor_start'() result.'!cursor_fail'() fail_1: .return (result) .end =item !protoregex_generation() Reset the C<$!generation> flag to indicate that protoregexes need to be recalculated (because new protoregexes have been added). =cut .sub '!protoregex_generation' :method $P0 = get_global '$!generation' # don't change this to 'inc' -- we want to ensure new PMC $P1 = add $P0, 1 set_global '$!generation', $P1 .return ($P1) .end =item !protoregex_tokrx(name) Return the token list for protoregex C. If the list doesn't already exist, or if the existing list is stale, create a new one and return it. =cut .sub '!protoregex_tokrx' :method .param string name .local pmc generation generation = get_global '$!generation' # Get the protoregex table for the current grammar. If # a table doesn't exist or it's out of date, generate a # new one. .local pmc parrotclass, prototable parrotclass = typeof self prototable = getprop parrotclass, '%!prototable' if null prototable goto make_prototable $P0 = getprop prototable, '$!generation' $I0 = issame $P0, generation if $I0 goto have_prototable make_prototable: prototable = self.'!protoregex_gen_table'(parrotclass) have_prototable: # Obtain the toxrk and toklen hashes for the current grammar # from the protoregex table. If they already exist, we're # done, otherwise we create new ones below. # yet for this table, then do that now. .local pmc tokrx, toklen $S0 = concat name, '.tokrx' tokrx = prototable[$S0] $S0 = concat name, '.toklen' toklen = prototable[$S0] unless null tokrx goto tokrx_done self.'!cursor_debug'('NOTE','Generating protoregex table for ', name) .local pmc toklen, tokrx toklen = new ['Hash'] tokrx = new ['Hash'] # The prototable has already collected all of the names of # protoregex methods as keys in C. First # get a list of all of the methods that begin with "name:sym<". .local string mprefix .local int mlen mprefix = concat name, ':sym<' mlen = length mprefix .local pmc methodlist, proto_it methodlist = new ['ResizableStringArray'] proto_it = iter prototable proto_loop: unless proto_it goto proto_done .local string methodname methodname = shift proto_it $S0 = substr methodname, 0, mlen if $S0 != mprefix goto proto_loop push methodlist, methodname goto proto_loop proto_done: # Now, walk through all of the methods, building the # tokrx and toklen tables as we go. .local pmc sorttok sorttok = new ['ResizablePMCArray'] method_loop: unless methodlist goto method_done methodname = shift methodlist # Look up the method itself. .local pmc rx rx = find_method self, methodname # Now find the prefix tokens for the method; calling the # method name with a !PREFIX__ prefix should return us a list # of valid token prefixes. If no such method exists, then # our token prefix is a null string. .local pmc tokens, tokens_it $S0 = concat '!PREFIX__', methodname $I0 = can self, $S0 unless $I0 goto method_peek_none tokens = self.$S0() goto method_peek_done method_peek_none: tokens = new ['ResizablePMCArray'] push tokens, '' method_peek_done: # Now loop through all of the tokens for the method, updating # the longest length per initial token character and adding # the token to the tokrx hash. Entries in the tokrx hash # are automatically promoted to arrays when there's more # than one candidate, and any arrays created are placed into # sorttok so they can have a secondary sort below. .local pmc seentok seentok = new ['Hash'] tokens_loop: unless tokens goto tokens_done .local string tkey, tfirst $P0 = shift tokens $I0 = isa $P0, ['ResizablePMCArray'] unless $I0 goto token_item splice tokens, $P0, 0, 0 goto tokens_loop token_item: tkey = $P0 # If we've already processed this token for this rule, # don't enter it twice into tokrx. $I0 = exists seentok[tkey] if $I0 goto tokens_loop seentok[tkey] = seentok # Keep track of longest token lengths by initial character tfirst = substr tkey, 0, 1 $I0 = length tkey $I1 = toklen[tfirst] if $I0 <= $I1 goto toklen_done toklen[tfirst] = $I0 toklen_done: # Add the regex to the list under the token key, promoting # entries to lists as appropriate. .local pmc rxlist rxlist = tokrx[tkey] if null rxlist goto rxlist_0 $I0 = isa rxlist, ['ResizablePMCArray'] if $I0 goto rxlist_n rxlist_1: $I0 = issame rx, rxlist if $I0 goto tokens_loop $P0 = rxlist rxlist = new ['ResizablePMCArray'] push sorttok, rxlist push rxlist, $P0 push rxlist, rx tokrx[tkey] = rxlist goto tokens_loop rxlist_n: push rxlist, rx goto tokens_loop rxlist_0: tokrx[tkey] = rx goto tokens_loop tokens_done: goto method_loop method_done: # in-place sort the keys that ended up with multiple entries .const 'Sub' $P99 = '!protoregex_cmp' sorttok_loop: unless sorttok goto sorttok_done rxlist = shift sorttok rxlist.'sort'($P99) goto sorttok_loop sorttok_done: # It's built! Now store the tokrx and toklen hashes in the # prototable and return them to the caller. $S0 = concat name, '.tokrx' prototable[$S0] = tokrx $S0 = concat name, '.toklen' prototable[$S0] = toklen tokrx_done: .return (tokrx, toklen) .end .sub '!protoregex_cmp' :anon .param pmc a .param pmc b $S0 = a $I0 = length $S0 $S1 = b $I1 = length $S1 $I2 = cmp $I1, $I0 .return ($I2) .end =item !protoregex_gen_table(parrotclass) Generate a new protoregex table for C. This involves creating a hash keyed with method names containing ':sym<' from C and all of its superclasses. This new hash is then given the current C<$!generate> property so we can avoid recreating it on future calls. =cut .sub '!protoregex_gen_table' :method .param pmc parrotclass .local pmc prototable prototable = new ['Hash'] .local pmc class_it, method_it $P0 = parrotclass.'inspect'('all_parents') class_it = iter $P0 class_loop: unless class_it goto class_done $P0 = shift class_it $P0 = $P0.'methods'() method_it = iter $P0 method_loop: unless method_it goto class_loop $S0 = shift method_it $I0 = index $S0, ':sym<' if $I0 < 0 goto method_loop prototable[$S0] = prototable goto method_loop class_done: $P0 = get_global '$!generation' setprop prototable, '$!generation', $P0 setprop parrotclass, '%!prototable', prototable .return (prototable) .end =item !PREFIX__!protoregex(name) Return the set of initial tokens for protoregex C. These are conveniently available as the keys of the tokrx hash. =cut .sub '!PREFIX__!protoregex' :method .param string name .local pmc tokrx tokrx = self.'!protoregex_tokrx'(name) unless tokrx goto peek_none .local pmc results, tokrx_it results = new ['ResizablePMCArray'] tokrx_it = iter tokrx tokrx_loop: unless tokrx_it goto tokrx_done $S0 = shift tokrx_it push results, $S0 goto tokrx_loop tokrx_done: .return (results) peek_none: .return ('') .end .sub '!PREFIX__!subrule' :method .param string name .param string prefix .local string peekname peekname = concat '!PREFIX__', name $I0 = can self, peekname unless $I0 goto subrule_none # make sure we aren't recursing .local pmc context $P0 = getinterp context = $P0['context';1] caller_loop: if null context goto caller_done $P0 = getattribute context, 'current_sub' $S0 = $P0 # stop if we find a name that doesn't begin with ! (33) $I0 = ord $S0 if $I0 != 33 goto caller_done if $S0 == peekname goto subrule_none context = getattribute context, 'caller_ctx' goto caller_loop caller_done: .local pmc subtokens, tokens subtokens = self.peekname() unless subtokens goto subrule_none unless prefix goto prefix_none tokens = new ['ResizablePMCArray'] subtokens_loop: unless subtokens goto subtokens_done $P0 = shift subtokens $I0 = isa $P0, ['ResizablePMCArray'] unless $I0 goto subtokens_item splice subtokens, $P0, 0, 0 goto subtokens_loop subtokens_item: $S0 = $P0 $S0 = concat prefix, $S0 push tokens, $S0 goto subtokens_loop subtokens_done: .return (tokens) prefix_none: .return (subtokens) subrule_none: .return (prefix) .end .sub 'DUMP_TOKRX' :method .param string name .local pmc tokrx tokrx = self.'!protoregex_tokrx'(name) _dumper(tokrx, name) .return (1) .end =back =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: ### .include 'src/Regex/Match.pir' # Copyright (C) 2009, The Perl Foundation. # =head1 NAME Regex::Match - Regex Match objects =head1 DESCRIPTION This file implements Match objects for the regex engine. =cut .namespace ['Regex';'Match'] .sub '' :anon :load :init load_bytecode 'P6object.pbc' .local pmc p6meta p6meta = new 'P6metaclass' $P0 = p6meta.'new_class'('Regex::Match', 'parent'=>'Capture', 'attr'=>'$!cursor $!target $!from $!to $!ast') .return () .end =head2 Methods =over 4 =item CURSOR() Returns the Cursor associated with this match object. =cut .sub 'CURSOR' :method $P0 = getattribute self, '$!cursor' .return ($P0) .end =item from() Returns the offset in the target string of the beginning of the match. =cut .sub 'from' :method $P0 = getattribute self, '$!from' .return ($P0) .end =item to() Returns the offset in the target string of the end of the match. =cut .sub 'to' :method $P0 = getattribute self, '$!to' .return ($P0) .end =item chars() Returns C<.to() - .from()> =cut .sub 'chars' :method $I0 = self.'to'() $I1 = self.'from'() $I2 = $I0 - $I1 if $I2 >= 0 goto done .return (0) done: .return ($I2) .end =item orig() Return the original item that was matched against. =cut .sub 'orig' :method $P0 = getattribute self, '$!target' .return ($P0) .end =item Str() Returns the portion of the target corresponding to this match. =cut .sub 'Str' :method $S0 = self.'orig'() $I0 = self.'from'() $I1 = self.'to'() $I1 -= $I0 $S1 = substr $S0, $I0, $I1 .return ($S1) .end =item ast() Returns the "abstract object" for the Match; if no abstract object has been set then returns C above. =cut .sub 'ast' :method .local pmc ast ast = getattribute self, '$!ast' unless null ast goto have_ast ast = new ['Undef'] setattribute self, '$!ast', ast have_ast: .return (ast) .end =back =head2 Vtable functions =over 4 =item get_bool() Returns 1 (true) if this is the result of a successful match, otherwise returns 0 (false). =cut .sub '' :vtable('get_bool') :method $P0 = getattribute self, '$!from' $P1 = getattribute self, '$!to' $I0 = isge $P1, $P0 .return ($I0) .end =item get_integer() Returns the integer value of the matched text. =cut .sub '' :vtable('get_integer') :method $I0 = self.'Str'() .return ($I0) .end =item get_number() Returns the numeric value of this match =cut .sub '' :vtable('get_number') :method $N0 = self.'Str'() .return ($N0) .end =item get_string() Returns the string value of the match =cut .sub '' :vtable('get_string') :method $S0 = self.'Str'() .return ($S0) .end =item !make(obj) Set the "ast object" for the invocant. =cut .sub '!make' :method .param pmc obj setattribute self, '$!ast', obj .return (obj) .end =back =head1 AUTHORS Patrick Michaud is the author and maintainer. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: ### .include 'src/Regex/Method.pir' # Copyright (C) 2009, The Perl Foundation. # =head1 NAME Regex::Regex, Regex::Method - Regex subs =head1 DESCRIPTION This file implements the Regex::Method and Regex::Regex types, used as containers for Regex subs that need .ACCEPTS and other regex attributes. =cut .namespace ['Regex';'Method'] .sub '' :anon :load :init load_bytecode 'P6object.pbc' .local pmc p6meta, mproto, rproto p6meta = new 'P6metaclass' mproto = p6meta.'new_class'('Regex::Method', 'parent'=>'parrot;Sub') rproto = p6meta.'new_class'('Regex::Regex', 'parent'=>mproto) .end =head2 Methods =over 4 =item new(sub) Create a new Regex::Regex object from C. =cut .sub 'new' :method .param pmc parrotsub $P0 = self.'WHO'() $P0 = new $P0 assign $P0, parrotsub .return ($P0) .end =item ACCEPTS(target) Perform a match against target, return the result. =cut .sub 'ACCEPTS' :method .param pmc target .local pmc curproto, match curproto = get_hll_global ['Regex'], 'Cursor' match = curproto.'parse'(target, 'rule'=>self) .return (match) .end .namespace ['Regex';'Regex'] .sub 'ACCEPTS' :method .param pmc target .local pmc curproto, match curproto = get_hll_global ['Regex'], 'Cursor' match = curproto.'parse'(target, 'rule'=>self, 'c'=>0) .return (match) .end =back =head1 AUTHORS Patrick Michaud is the author and maintainer. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: ### .include 'src/Regex/Dumper.pir' # Copyright (C) 2005-2009, Parrot Foundation. # Copyright (C) 2009, The Perl Foundation. # =head1 TITLE Regex::Dumper - various methods for displaying Match structures =head2 C Methods =over 4 =item C<__dump(PMC dumper, STR label)> This method enables Data::Dumper to work on Regex::Match objects. =cut .namespace ['Regex';'Match'] .sub "__dump" :method .param pmc dumper .param string label .local string indent, subindent .local pmc it, val .local string key .local pmc hash, array .local int hascapts (subindent, indent) = dumper."newIndent"() print "=> " $S0 = self dumper."genericString"("", $S0) print " @ " $I0 = self.'from'() print $I0 hascapts = 0 hash = self.'hash'() if_null hash, dump_array it = iter hash dump_hash_1: unless it goto dump_array if hascapts goto dump_hash_2 print " {" hascapts = 1 dump_hash_2: print "\n" print subindent key = shift it val = hash[key] print "<" print key print "> => " dumper."dump"(label, val) goto dump_hash_1 dump_array: array = self.'list'() if_null array, dump_end $I1 = elements array $I0 = 0 dump_array_1: if $I0 >= $I1 goto dump_end if hascapts goto dump_array_2 print " {" hascapts = 1 dump_array_2: print "\n" print subindent val = array[$I0] print "[" print $I0 print "] => " dumper."dump"(label, val) inc $I0 goto dump_array_1 dump_end: unless hascapts goto end print "\n" print indent print "}" end: dumper."deleteIndent"() .end =item C An alternate dump output for a Match object and all of its subcaptures. =cut .sub "dump_str" :method .param string prefix :optional # name of match variable .param int has_prefix :opt_flag .param string b1 :optional # bracket open .param int has_b1 :opt_flag .param string b2 :optional # bracket close .param int has_b2 :opt_flag .local pmc capt .local int spi, spc .local pmc it .local string prefix1, prefix2 .local pmc jmpstack jmpstack = new 'ResizableIntegerArray' if has_b2 goto start b2 = "]" if has_b1 goto start b1 = "[" start: .local string out out = concat prefix, ':' unless self goto subpats out .= ' <' $S0 = self out .= $S0 out .= ' @ ' $S0 = self.'from'() out .= $S0 out .= '> ' subpats: $I0 = self $S0 = $I0 out .= $S0 out .= "\n" capt = self.'list'() if_null capt, subrules spi = 0 spc = elements capt subpats_1: unless spi < spc goto subrules prefix1 = concat prefix, b1 $S0 = spi prefix1 = concat prefix1, $S0 prefix1 = concat prefix1, b2 $I0 = defined capt[spi] unless $I0 goto subpats_2 $P0 = capt[spi] local_branch jmpstack, dumper subpats_2: inc spi goto subpats_1 subrules: capt = self.'hash'() if_null capt, end it = iter capt subrules_1: unless it goto end $S0 = shift it prefix1 = concat prefix, '<' prefix1 = concat prefix1, $S0 prefix1 = concat prefix1, ">" $I0 = defined capt[$S0] unless $I0 goto subrules_1 $P0 = capt[$S0] local_branch jmpstack, dumper goto subrules_1 dumper: $I0 = isa $P0, ['Regex';'Match'] unless $I0 goto dumper_0 $S0 = $P0.'dump_str'(prefix1, b1, b2) out .= $S0 local_return jmpstack dumper_0: $I0 = does $P0, 'array' unless $I0 goto dumper_3 $I0 = 0 $I1 = elements $P0 dumper_1: if $I0 >= $I1 goto dumper_2 $P1 = $P0[$I0] prefix2 = concat prefix1, b1 $S0 = $I0 prefix2 = concat prefix2, $S0 prefix2 = concat prefix2, b2 $S0 = $P1.'dump_str'(prefix2, b1, b2) out .= $S0 inc $I0 goto dumper_1 dumper_2: local_return jmpstack dumper_3: out .= prefix1 out .= ': ' $S0 = $P0 out .= $S0 out .= "\n" local_return jmpstack end: .return (out) .end =back =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: ### .include 'src/PAST/Regex.pir' # $Id$ =head1 NAME PAST::Regex - Regex nodes for PAST =head1 DESCRIPTION This file implements the various abstract syntax tree nodes for regular expressions. =over 4 =cut .namespace ['PAST';'Regex'] .sub '' :init :load load_bytecode 'PCT/PAST.pbc' .local pmc p6meta p6meta = get_hll_global 'P6metaclass' p6meta.'new_class'('PAST::Regex', 'parent'=>'PAST::Node') .end .sub 'backtrack' :method .param pmc value :optional .param int has_value :opt_flag .tailcall self.'attr'('backtrack', value, has_value) .end .sub 'capnames' :method .param pmc value :optional .param int has_value :opt_flag .tailcall self.'attr'('capnames', value, has_value) .end .sub 'negate' :method .param pmc value :optional .param int has_value :opt_flag .tailcall self.'attr'('negate', value, has_value) .end .sub 'min' :method .param pmc value :optional .param int has_value :opt_flag .tailcall self.'attr'('min', value, has_value) .end .sub 'max' :method .param pmc value :optional .param int has_value :opt_flag .tailcall self.'attr'('max', value, has_value) .end .sub 'pasttype' :method .param pmc value :optional .param int has_value :opt_flag .tailcall self.'attr'('pasttype', value, has_value) .end .sub 'sep' :method .param pmc value :optional .param int has_value :opt_flag .tailcall self.'attr'('sep', value, has_value) .end .sub 'subtype' :method .param pmc value :optional .param int has_value :opt_flag .tailcall self.'attr'('subtype', value, has_value) .end .sub 'zerowidth' :method .param pmc value :optional .param int has_value :opt_flag .tailcall self.'attr'('zerowidth', value, has_value) .end =item prefix() Returns the prefixes associated with the regex tree rooted at this node. =cut .sub 'prefix' :method .param string prefix .param pmc tail :slurpy .local string pasttype pasttype = self.'pasttype'() if pasttype goto have_pasttype pasttype = 'concat' have_pasttype: if pasttype == 'scan' goto prefix_skip $S0 = concat 'prefix_', pasttype $I0 = can self, $S0 unless $I0 goto prefix_done .tailcall self.$S0(prefix, tail) prefix_skip: unless tail goto prefix_done .local pmc head head = shift tail .tailcall head.'prefix'(prefix, tail :flat) prefix_done: .return (prefix) .end .sub 'prefix_alt' :method .param string prefix .param pmc tail .local pmc child_it, results child_it = self.'iterator'() results = new ['ResizablePMCArray'] child_loop: unless child_it goto child_done $P0 = shift child_it ($P1 :slurpy) = $P0.'prefix'(prefix, tail :flat) splice results, $P1, 0, 0 goto child_loop child_done: .return (results :flat) .end .sub 'prefix_alt_longest' :method .param string prefix .param pmc tail .tailcall self.'prefix_alt'(prefix, tail :flat) .end .sub 'prefix_anchor' :method .param string prefix .param pmc tail unless tail goto anchor_done .local pmc head head = shift tail .tailcall head.'prefix'(prefix, tail :flat) anchor_done: .return (prefix) .end .sub 'prefix_concat' :method .param string prefix .param pmc tail $P0 = self.'list'() splice tail, $P0, 0, 0 unless tail goto done $P1 = shift tail .tailcall $P1.'prefix'(prefix, tail :flat) done: .return (prefix) .end .sub 'prefix_literal' :method .param string prefix .param pmc tail .local pmc lpast lpast = self[0] $I0 = isa lpast, ['String'] unless $I0 goto done .local string subtype subtype = self.'subtype'() if subtype == 'ignorecase' goto done $S0 = lpast prefix = concat prefix, $S0 unless tail goto done $P0 = shift tail .tailcall $P0.'prefix'(prefix, tail :flat) done: .return (prefix) .end .sub 'prefix_enumcharlist' :method .param string prefix .param pmc tail .local pmc negate negate = self.'negate'() .local string subtype, charlist subtype = self.'subtype'() charlist = self[0] if negate goto charlist_negate unless tail goto charlist_notail if subtype == 'zerowidth' goto charlist_notail .local pmc result, head result = new ['ResizablePMCArray'] head = shift tail .local int pos, eos eos = length charlist pos = 0 charlist_loop: unless pos < eos goto charlist_done .local string char char = substr charlist, pos, 1 $S0 = concat prefix, char ($P0 :slurpy) = head.'prefix'($S0, tail :flat) splice result, $P0, 0, 0 inc pos goto charlist_loop charlist_done: .return (result :flat) charlist_notail: $P0 = split '', charlist .return ($P0 :flat) charlist_negate: if subtype == 'zerowidth' goto charlist_negate_0 unless tail goto charlist_negate_0 .return (prefix) charlist_negate_0: head = shift tail .tailcall head.'prefix'(prefix, tail :flat) .end .sub 'prefix_pastnode' :method .param string prefix .param pmc tail unless tail goto pastnode_none .local string subtype subtype = self.'subtype'() if subtype != 'declarative' goto pastnode_none .local pmc head head = shift tail .tailcall head.'prefix'(prefix, tail :flat) pastnode_none: .return (prefix) .end .sub 'prefix_subcapture' :method .param string prefix .param pmc tail .tailcall self.'prefix_concat'(prefix, tail) .end .sub 'prefix_subrule' :method .param string prefix .param pmc tail .local pmc name, negate, subtype name = self[0] negate = self.'negate'() subtype = self.'subtype'() $I0 = does name, 'string' unless $I0 goto subrule_none if negate goto subrule_none if subtype == 'zerowidth' goto subrule_none .local pmc selfpast, spast $P99 = get_hll_global ['PAST'], 'Var' selfpast = $P99.'new'( 'name'=>'self', 'scope'=>'register') $P99 = get_hll_global ['PAST'], 'Op' spast = $P99.'new'( selfpast, name, prefix, 'name'=>'!PREFIX__!subrule', 'pasttype'=>'callmethod') .return (spast) subrule_none: .return (prefix) .end =back =head1 AUTHOR Patrick Michaud is the author and maintainer. Please send patches and suggestions to the Parrot porters or Perl 6 compilers mailing lists. =head1 COPYRIGHT Copyright (C) 2009, The Perl Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: ### .include 'src/PAST/Compiler-Regex.pir' # =head1 NAME PAST::Compiler-Regex - Compiler for PAST::Regex nodes =head1 DESCRIPTION PAST::Compiler-Regex implements the transformations to convert PAST::Regex nodes into POST. It's still a part of PAST::Compiler; we've separated out the regex-specific transformations here for better code management and debugging. =head2 Compiler methods =head3 C =over 4 =item as_post(PAST::Regex node) Return the POST representation of the regex AST rooted by C. =cut .include 'cclass.pasm' ### .include 'src/Regex/constants.pir' .const int CURSOR_FAIL = -1 .const int CURSOR_FAIL_GROUP = -2 .const int CURSOR_FAIL_RULE = -3 .const int CURSOR_FAIL_MATCH = -4 .const int CURSOR_TYPE_SCAN = 1 .const int CURSOR_TYPE_PEEK = 2 .namespace ['PAST';'Compiler'] .sub 'as_post' :method :multi(_, ['PAST';'Regex']) .param pmc node .param pmc options :slurpy :named .local pmc ops ops = self.'post_new'('Ops', 'node'=>node) .local pmc reghash reghash = new ['Hash'] .lex '$*REG', reghash .local pmc regexname, regexname_esc $P0 = find_dynamic_lex '@*BLOCKPAST' $P1 = $P0[0] $S0 = $P1.'name'() regexname = box $S0 regexname_esc = self.'escape'($S0) .lex '$*REGEXNAME', regexname .local string prefix, rname, rtype prefix = self.'unique'('rx') prefix = concat prefix, '_' $P0 = split ' ', 'tgt string pos int off int eos int rep int cur pmc debug pmc' $P1 = iter $P0 iter_loop: unless $P1 goto iter_done rname = shift $P1 rtype = shift $P1 $S1 = concat prefix, rname reghash[rname] = $S1 $S2 = concat '.local ', rtype ops.'push_pirop'($S2, $S1) goto iter_loop iter_done: .local pmc startlabel, donelabel, faillabel, restartlabel $S0 = concat prefix, 'start' startlabel = self.'post_new'('Label', 'result'=>$S0) $S0 = concat prefix, 'done' donelabel = self.'post_new'('Label', 'result'=>$S0) $S0 = concat prefix, 'fail' faillabel = self.'post_new'('Label', 'result'=>$S0) $S0 = concat prefix, 'restart' restartlabel = self.'post_new'('Label', 'result'=>$S0) reghash['fail'] = faillabel # If capnames is available, it's a hash where each key is the # name of a potential subcapture and the value is greater than 1 # if it's to be an array. This builds a list of arrayed subcaptures # for use by "!cursor_caparray" below. .local pmc capnames, capnames_it, caparray capnames = node.'capnames'() caparray = box 0 unless capnames goto capnames_done capnames_it = iter capnames caparray = new ['ResizablePMCArray'] capnames_loop: unless capnames_it goto capnames_done $S0 = shift capnames_it $I0 = capnames[$S0] unless $I0 > 1 goto capnames_loop $S0 = self.'escape'($S0) push caparray, $S0 goto capnames_loop capnames_done: .local string cur, rep, pos, tgt, off, eos, debug (cur, rep, pos, tgt, off, eos, debug) = self.'!rxregs'('cur rep pos tgt off eos debug') unless regexname goto peek_done .local pmc tpast, token, tpost $P99 = get_hll_global ['PAST'], 'Op' tpast = $P99.'new'( 'pasttype'=>'list', 'node'=>node ) (token :slurpy) = node.'prefix'('') token_loop: unless token goto token_done $P0 = shift token push tpast, $P0 goto token_loop token_done: $S0 = regexname $S0 = concat '!PREFIX__', $S0 $P99 = get_hll_global ['PAST'], 'Block' tpast = $P99.'new'(tpast, 'name'=>$S0, 'lexical'=>0, 'blocktype'=>'method') tpost = self.'as_post'(tpast, 'rtype'=>'v') ops.'push'(tpost) peek_done: $S0 = concat '(', cur $S0 = concat $S0, ', ' $S0 = concat $S0, pos $S0 = concat $S0, ', ' $S0 = concat $S0, tgt $S0 = concat $S0, ', $I10)' ops.'push_pirop'('callmethod', '"!cursor_start"', 'self', 'result'=>$S0) unless caparray goto caparray_skip self.'!cursorop'(ops, '!cursor_caparray', 0, caparray :flat) caparray_skip: ops.'push_pirop'('getattribute', debug, cur, '"$!debug"') ops.'push_pirop'('.lex', 'unicode:"$\x{a2}"', cur) ops.'push_pirop'('.local pmc', 'match') ops.'push_pirop'('.lex', '"$/"', 'match') ops.'push_pirop'('length', eos, tgt, 'result'=>eos) ops.'push_pirop'('gt', pos, eos, donelabel) # On Parrot, indexing into variable-width encoded strings # (such as utf8) becomes much more expensive as we move # farther away from the beginning of the string (via calls # to utf8_skip_forward). For regexes that are starting a match # at a position other than the beginning of the string (e.g., # a subrule call), we can save a lot of useless scanning work # in utf8_skip_forward by removing the first C # characters from the target and then performing all indexed # operations on the resulting target relative to C. ops.'push_pirop'('set', off, 0) ops.'push_pirop'('lt', pos, 2, startlabel) ops.'push_pirop'('sub', off, pos, 1, 'result'=>off) ops.'push_pirop'('substr', tgt, tgt, off, 'result'=>tgt) ops.'push'(startlabel) ops.'push_pirop'('eq', '$I10', 1, restartlabel) self.'!cursorop'(ops, '!cursor_debug', 0, '"START"', regexname_esc) $P0 = self.'post_regex'(node) ops.'push'($P0) ops.'push'(restartlabel) self.'!cursorop'(ops, '!cursor_debug', 0, '"NEXT"', regexname_esc) ops.'push'(faillabel) self.'!cursorop'(ops, '!mark_fail', 4, rep, pos, '$I10', '$P10', 0) ops.'push_pirop'('lt', pos, CURSOR_FAIL, donelabel) ops.'push_pirop'('eq', pos, CURSOR_FAIL, faillabel) ops.'push_pirop'('jump', '$I10') ops.'push'(donelabel) self.'!cursorop'(ops, '!cursor_fail', 0) self.'!cursorop'(ops, '!cursor_debug', 0, '"FAIL"', regexname_esc) ops.'push_pirop'('return', cur) .return (ops) .end =item !cursorop(ops, func, retelems, arg :slurpy) Helper function to push POST nodes onto C that perform C on the regex's current cursor. By default this ends up being a method call on the cursor, but some values of C can result in inlined code to perform the equivalent operation without using the method call. The C argument is the number of elements in C that represent return values from the function; any remaining elements in arg are passed to the function as input arguments. =cut .sub '!cursorop' :method .param pmc ops .param string func .param int retelems .param pmc args :slurpy $S0 = concat '!cursorop_', func $I0 = can self, $S0 unless $I0 goto cursorop_default $P0 = self.$S0(ops, func, retelems, args :flat) unless null $P0 goto done cursorop_default: if retelems < 1 goto result_done .local pmc retargs retargs = new ['ResizableStringArray'] $I0 = retelems retargs_loop: unless $I0 > 0 goto retargs_done $S0 = shift args push retargs, $S0 dec $I0 goto retargs_loop retargs_done: .local string result result = join ', ', retargs result = concat '(', result result = concat result, ')' result_done: .local pmc cur cur = self.'!rxregs'('cur') $S0 = self.'escape'(func) $P0 = ops.'push_pirop'('callmethod', $S0, cur, args :flat) if retelems < 1 goto done $P0.'result'(result) done: .return (ops) .end .sub '!cursorop_!cursor_debug' :method .param pmc ops .param string func .param int retelems .param pmc args :slurpy .local pmc cur, debug, debuglabel $P99 = get_hll_global ['POST'], 'Label' debuglabel = $P99.'new'('name'=>'debug_') (cur, debug) = self.'!rxregs'('cur debug') ops.'push_pirop'('if_null', debug, debuglabel) $S0 = self.'escape'(func) ops.'push_pirop'('callmethod', $S0, cur, args :flat) ops.'push'(debuglabel) .return (ops) .end =item !rxregs(keystr) Helper function -- looks up the current regex register table in the dynamic scope and returns a slice based on the keys given in C. =cut .sub '!rxregs' :method .param string keystr .local pmc keys, reghash, vals keys = split ' ', keystr reghash = find_dynamic_lex '$*REG' vals = new ['ResizablePMCArray'] keys_loop: unless keys goto keys_done $S0 = shift keys $P0 = reghash[$S0] push vals, $P0 goto keys_loop keys_done: .return (vals :flat) .end =item post_regex(PAST::Regex node) Return the POST representation of the regex component given by C. Normally this is handled by redispatching to a method corresponding to the node's "pasttype" and "backtrack" attributes. If no "pasttype" is given, then "concat" is assumed. =cut .sub 'post_regex' :method :multi(_, ['PAST';'Regex']) .param pmc node .param string cur :optional .param int have_cur :opt_flag .local string pasttype pasttype = node.'pasttype'() if pasttype goto have_pasttype pasttype = 'concat' have_pasttype: $P0 = find_method self, pasttype $P1 = self.$P0(node) unless have_cur goto done $S0 = $P1.'result'() if $S0 == cur goto done $P1 = self.'coerce'($P1, cur) done: .return ($P1) .end .sub 'post_regex' :method :multi(_, _) .param pmc node .param string cur :optional .param int have_cur :opt_flag $P0 = self.'as_post'(node) unless have_cur goto done $P0 = self.'coerce'($P0, cur) done: .return ($P0) .end =item alt(PAST::Regex node) =cut .sub 'alt' :method :multi(_, ['PAST';'Regex']) .param pmc node .local pmc cur, pos (cur, pos) = self.'!rxregs'('cur pos') .local string name name = self.'unique'('alt') name = concat name, '_' .local pmc ops, iter ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) iter = node.'iterator'() unless iter goto done .local int acount .local pmc alabel, endlabel acount = 0 $S0 = acount $S0 = concat name, $S0 alabel = self.'post_new'('Label', 'result'=>$S0) $S0 = concat name, 'end' endlabel = self.'post_new'('Label', 'result'=>$S0) iter_loop: ops.'push'(alabel) .local pmc apast, apost apast = shift iter apost = self.'post_regex'(apast, cur) unless iter goto iter_done inc acount $S0 = acount $S0 = concat name, $S0 alabel = self.'post_new'('Label', 'result'=>$S0) ops.'push_pirop'('set_addr', '$I10', alabel) self.'!cursorop'(ops, '!mark_push', 0, 0, pos, '$I10') ops.'push'(apost) ops.'push_pirop'('goto', endlabel) goto iter_loop iter_done: ops.'push'(apost) ops.'push'(endlabel) done: .return (ops) .end =item alt_longest(PAST::Regex node) Same as 'alt' above, but use declarative/LTM semantics. (Currently we cheat and just use 'alt' above.) =cut .sub 'alt_longest' :method .param pmc node .tailcall self.'alt'(node) .end =item anchor(PAST::Regex node) Match various anchor points, including ^, ^^, $, $$. =cut .sub 'anchor' :method :multi(_, ['PAST';'Regex']) .param pmc node .local pmc cur, tgt, pos, off, eos, fail, ops (cur, tgt, pos, off, eos, fail) = self.'!rxregs'('cur tgt pos off eos fail') ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) .local string subtype subtype = node.'subtype'() ops.'push_pirop'('inline', subtype, 'inline'=>' # rxanchor %0') if subtype == 'null' goto done if subtype == 'fail' goto anchor_fail if subtype == 'bos' goto anchor_bos if subtype == 'eos' goto anchor_eos if subtype == 'lwb' goto anchor_lwb if subtype == 'rwb' goto anchor_rwb .local pmc donelabel $S0 = self.'unique'('rxanchor') $S0 = concat $S0, '_done' donelabel = self.'post_new'('Label', 'result'=>$S0) if subtype == 'bol' goto anchor_bol if subtype == 'eol' goto anchor_eol self.'panic'('Unrecognized subtype "', subtype, '" in PAST::Regex anchor node') anchor_fail: ops.'push_pirop'('goto', fail) goto done anchor_bos: ops.'push_pirop'('ne', pos, 0, fail) goto done anchor_eos: ops.'push_pirop'('ne', pos, eos, fail) goto done anchor_bol: ops.'push_pirop'('eq', pos, 0, donelabel) ops.'push_pirop'('ge', pos, eos, fail) ops.'push_pirop'('sub', '$I10', pos, off) ops.'push_pirop'('dec', '$I10') ops.'push_pirop'('is_cclass', '$I11', .CCLASS_NEWLINE, tgt, '$I10') ops.'push_pirop'('unless', '$I11', fail) ops.'push'(donelabel) goto done anchor_eol: ops.'push_pirop'('sub', '$I10', pos, off) ops.'push_pirop'('is_cclass', '$I11', .CCLASS_NEWLINE, tgt, '$I10') ops.'push_pirop'('if', '$I11', donelabel) ops.'push_pirop'('ne', pos, eos, fail) ops.'push_pirop'('eq', pos, 0, donelabel) ops.'push_pirop'('dec', '$I10') ops.'push_pirop'('is_cclass', '$I11', .CCLASS_NEWLINE, tgt, '$I10') ops.'push_pirop'('if', '$I11', fail) ops.'push'(donelabel) goto done anchor_lwb: ops.'push_pirop'('ge', pos, eos, fail) ops.'push_pirop'('sub', '$I10', pos, off) ops.'push_pirop'('is_cclass', '$I11', .CCLASS_WORD, tgt, '$I10') ops.'push_pirop'('unless', '$I11', fail) ops.'push_pirop'('dec', '$I10') ops.'push_pirop'('is_cclass', '$I11', .CCLASS_WORD, tgt, '$I10') ops.'push_pirop'('if', '$I11', fail) goto done anchor_rwb: ops.'push_pirop'('le', pos, 0, fail) ops.'push_pirop'('sub', '$I10', pos, off) ops.'push_pirop'('is_cclass', '$I11', .CCLASS_WORD, tgt, '$I10') ops.'push_pirop'('if', '$I11', fail) ops.'push_pirop'('dec', '$I10') ops.'push_pirop'('is_cclass', '$I11', .CCLASS_WORD, tgt, '$I10') ops.'push_pirop'('unless', '$I11', fail) goto done done: .return (ops) .end =item charclass(PAST::Regex node) Match something in a character class, such as \w, \d, \s, dot, etc. =cut .sub 'charclass' :method .param pmc node .local string subtype .local int cclass, negate (subtype, cclass, negate) = self.'!charclass_init'(node) .local pmc cur, tgt, pos, off, eos, fail, ops (cur, tgt, pos, off, eos, fail) = self.'!rxregs'('cur tgt pos off eos fail') ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) ops.'push_pirop'('inline', subtype, 'inline'=>' # rx charclass %0') ops.'push_pirop'('ge', pos, eos, fail) if cclass == .CCLASS_ANY goto charclass_done .local pmc cctest cctest = self.'??!!'(negate, 'if', 'unless') ops.'push_pirop'('sub', '$I10', pos, off) ops.'push_pirop'('is_cclass', '$I11', cclass, tgt, '$I10') ops.'push_pirop'(cctest, '$I11', fail) unless subtype == 'nl' goto charclass_done # handle logical newline here ops.'push_pirop'('substr', '$S10', tgt, '$I10', 2) ops.'push_pirop'('iseq', '$I11', '$S10', '"\r\n"') ops.'push_pirop'('add', pos, '$I11') charclass_done: ops.'push_pirop'('inc', pos) .return (ops) .end =item !charclass_init(PAST::Regex node) Return the subtype, cclass value, and negation for a charclass C. =cut .sub '!charclass_init' :method .param pmc node .local string subtype .local int negate subtype = node.'subtype'() $S0 = downcase subtype negate = isne subtype, $S0 $I0 = node.'negate'() negate = xor negate, $I0 if $S0 == '.' goto cclass_dot if $S0 == 'd' goto cclass_digit if $S0 == 's' goto cclass_space if $S0 == 'w' goto cclass_word if $S0 == 'n' goto cclass_newline if $S0 == 'nl' goto cclass_newline self.'panic'('Unrecognized subtype "', subtype, '" in PAST::Regex charclass node') cclass_dot: .local int cclass cclass = .CCLASS_ANY goto cclass_done cclass_digit: cclass = .CCLASS_NUMERIC goto cclass_done cclass_space: cclass = .CCLASS_WHITESPACE goto cclass_done cclass_word: cclass = .CCLASS_WORD goto cclass_done cclass_newline: cclass = .CCLASS_NEWLINE cclass_done: .return (subtype, cclass, negate) .end =item charclass_q(PAST::Regex node) Optimize certain quantified character class shortcuts, if it makes sense to do so. If not, return a null PMC and the standard quantifier code will handle it. =cut .sub 'charclass_q' :method :multi(_, ['PAST';'Regex']) .param pmc node .param string backtrack .param int min .param int max .param pmc sep if backtrack != 'r' goto pessimistic if sep goto pessimistic .local string subtype .local int cclass, negate (subtype, cclass, negate) = self.'!charclass_init'(node) # positive logical newline matching is special, don't try to optimize it if negate goto nl_done if subtype == 'nl' goto pessimistic nl_done: .local pmc findop findop = self.'??!!'(negate, 'find_cclass', 'find_not_cclass') quant_r: .local pmc cur, tgt, pos, off, eos, fail, ops (cur, tgt, pos, off, eos, fail) = self.'!rxregs'('cur tgt pos off eos fail') ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) ops.'push_pirop'('inline', subtype, backtrack, min, max, 'inline'=>' # rx charclass_q %0 %1 %2..%3') ops.'push_pirop'('sub', '$I10', pos, off) ops.'push_pirop'(findop, '$I11', cclass, tgt, '$I10', eos) unless min > 0 goto min_done ops.'push_pirop'('add', '$I12', '$I10', min) ops.'push_pirop'('lt', '$I11', '$I12', fail) min_done: unless max > 0 goto max_done .local pmc maxlabel maxlabel = self.'post_new'('Label', 'name'=>'rx_charclass_') ops.'push_pirop'('add', '$I12', '$I10', max) ops.'push_pirop'('le', '$I11', '$I12', maxlabel) ops.'push_pirop'('set', '$I11', '$I12') ops.'push'(maxlabel) max_done: ops.'push_pirop'('add', pos, off, '$I11') .return (ops) pessimistic: null ops .return (ops) .end =item concat(PAST::Regex node) Handle a concatenation of regexes. =cut .sub 'concat' :method :multi(_, ['PAST';'Regex']) .param pmc node .local pmc cur, ops, iter (cur) = self.'!rxregs'('cur') ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) iter = node.'iterator'() iter_loop: unless iter goto iter_done .local pmc cpast, cpost cpast = shift iter cpost = self.'post_regex'(cpast, cur) ops.'push'(cpost) goto iter_loop iter_done: .return (ops) .end =item conj(PAST::Regex node) =cut .sub 'conj' :method :multi(_, ['PAST';'Regex']) .param pmc node .local pmc cur, pos, fail (cur, pos, fail) = self.'!rxregs'('cur pos fail') .local string name name = self.'unique'('conj') name = concat name, '_' .local pmc ops, iter ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) iter = node.'iterator'() unless iter goto done .local pmc clabel $S0 = concat name, 'mark' clabel = self.'post_new'('Label', 'result'=>$S0) .local int acount .local pmc alabel, apast, apost acount = 0 $S0 = acount $S0 = concat name, $S0 alabel = self.'post_new'('Label', 'result'=>$S0) ops.'push_pirop'('inline', name, 'inline'=>' # rx %0') ops.'push_pirop'('set_addr', '$I10', clabel) self.'!cursorop'(ops, '!mark_push', 0, pos, CURSOR_FAIL, '$I10') ops.'push_pirop'('goto', alabel) ops.'push'(clabel) ops.'push_pirop'('goto', fail) ops.'push'(alabel) apast = shift iter apost = self.'post_regex'(apast, cur) ops.'push'(apost) ops.'push_pirop'('set_addr', '$I10', clabel) self.'!cursorop'(ops, '!mark_peek', 1, '$I11', '$I10') self.'!cursorop'(ops, '!mark_push', 0, '$I11', pos, '$I10') iter_loop: inc acount $S0 = acount $S0 = concat name, $S0 alabel = self.'post_new'('Label', 'result'=>$S0) ops.'push'(alabel) ops.'push_pirop'('set', pos, '$I11') apast = shift iter apost = self.'post_regex'(apast, cur) ops.'push'(apost) ops.'push_pirop'('set_addr', '$I10', clabel) self.'!cursorop'(ops, '!mark_peek', 2, '$I11', '$I12', '$I10') ops.'push_pirop'('ne', pos, '$I12', fail) if iter goto iter_loop iter_done: done: .return (ops) .end =item cut(PAST::Regex node) Generate POST for the cut-group and cut-rule operators. =cut .sub 'cut' :method :multi(_, ['PAST';'Regex']) .param pmc node .local pmc cur, fail, ops (cur, fail) = self.'!rxregs'('cur fail') ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) ops.'push_pirop'('set_addr', '$I10', fail) self.'!cursorop'(ops, '!mark_commit', 0, '$I10') .return (ops) .end =item enumcharlist(PAST::Regex node) Generate POST for matching a character from an enumerated character list. =cut .sub 'enumcharlist' :method :multi(_, ['PAST';'Regex']) .param pmc node .local pmc cur, tgt, pos, off, eos, fail, ops (cur, tgt, pos, off, eos, fail) = self.'!rxregs'('cur tgt pos off eos fail') ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) .local string charlist charlist = node[0] charlist = self.'escape'(charlist) .local pmc negate, testop negate = node.'negate'() testop = self.'??!!'(negate, 'ge', 'lt') .local string subtype .local int zerowidth subtype = node.'subtype'() zerowidth = iseq subtype, 'zerowidth' ops.'push_pirop'('inline', negate, subtype, 'inline'=>' # rx enumcharlist negate=%0 %1') if zerowidth goto skip_zero_1 ops.'push_pirop'('ge', pos, eos, fail) skip_zero_1: ops.'push_pirop'('sub', '$I10', pos, off) ops.'push_pirop'('substr', '$S10', tgt, '$I10', 1) ops.'push_pirop'('index', '$I11', charlist, '$S10') ops.'push_pirop'(testop, '$I11', 0, fail) if zerowidth goto skip_zero_2 ops.'push_pirop'('inc', pos) skip_zero_2: .return (ops) .end .sub 'enumcharlist_q' :method :multi(_, ['PAST';'Regex']) .param pmc node .param string backtrack .param int min .param int max .param pmc sep if backtrack != 'r' goto pessimistic if sep goto pessimistic .local pmc cur, tgt, pos, off, eos, fail, rep, ops (cur, tgt, pos, off, eos, fail, rep) = self.'!rxregs'('cur tgt pos off eos fail rep') ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) .local string charlist charlist = node[0] charlist = self.'escape'(charlist) .local pmc negate, testop negate = node.'negate'() testop = self.'??!!'(negate, 'ge', 'lt') .local string subtype subtype = node.'subtype'() if subtype == 'zerowidth' goto pessimistic .local pmc looplabel, donelabel .local string name name = self.'unique'('rxenumcharlistq') $S1 = concat name, '_loop' looplabel = self.'post_new'('Label', 'result'=>$S1) $S1 = concat name, '_done' donelabel = self.'post_new'('Label', 'result'=>$S1) ops.'push_pirop'('inline', negate, subtype, backtrack, min, max, 'inline'=>' # rx enumcharlist_q negate=%0 %1 %2 %3..%4') ops.'push_pirop'('sub', '$I10', pos, off) ops.'push_pirop'('set', rep, 0) ops.'push_pirop'('sub', '$I12', eos, pos) unless max > 0 goto max1_done ops.'push_pirop'('le', '$I12', max, looplabel) ops.'push_pirop'('set', '$I12', max) max1_done: ops.'push'(looplabel) ops.'push_pirop'('le', '$I12', 0, donelabel) ops.'push_pirop'('substr', '$S10', tgt, '$I10', 1) ops.'push_pirop'('index', '$I11', charlist, '$S10') ops.'push_pirop'(testop, '$I11', 0, donelabel) ops.'push_pirop'('inc', rep) if max == 1 goto max2_done ops.'push_pirop'('inc', '$I10') ops.'push_pirop'('dec', '$I12') ops.'push_pirop'('goto', looplabel) max2_done: ops.'push'(donelabel) unless min > 0 goto min2_done ops.'push_pirop'('lt', rep, min, fail) min2_done: ops.'push_pirop'('add', pos, pos, rep) .return (ops) pessimistic: null ops .return (ops) .end =item literal(PAST::Regex node) Generate POST for matching a literal string provided as the second child of this node. =cut .sub 'literal' :method :multi(_,['PAST';'Regex']) .param pmc node .local pmc cur, pos, eos, tgt, fail, off (cur, pos, eos, tgt, fail, off) = self.'!rxregs'('cur pos eos tgt fail off') .local pmc ops, lpast, lpost ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) .local string subtype .local int ignorecase subtype = node.'subtype'() ignorecase = iseq subtype, 'ignorecase' # literal to be matched is our first child .local int litconst lpast = node[0] litconst = isa lpast, ['String'] if litconst goto lpast_string litconst = isa lpast, ['PAST';'Val'] if litconst goto lpast_val lpast_expr: lpost = self.'as_post'(lpast, 'rtype'=>'~') unless ignorecase goto lpast_done $S0 = lpost.'result'() lpost.'push_pirop'('downcase', $S0, $S0) goto lpast_done lpast_val: $S0 = lpast.'value'() lpast = box $S0 lpast_string: unless ignorecase goto lpast_const $S0 = lpast $S0 = downcase $S0 lpast = box $S0 lpast_const: unless lpast > '' goto done lpost = self.'as_post'(lpast, 'rtype'=>'~') lpast_done: $S0 = lpost.'result'() ops.'push_pirop'('inline', subtype, $S0, 'inline'=>' # rx literal %0 %1') ops.'push'(lpost) .local string litlen if litconst goto litlen_const litlen = '$I10' ops.'push_pirop'('length', '$I10', lpost) goto have_litlen litlen_const: $S0 = lpast $I0 = length $S0 litlen = $I0 have_litlen: # fail if there aren't enough characters left in string ops.'push_pirop'('add', '$I11', pos, litlen) ops.'push_pirop'('gt', '$I11', eos, fail) # compute string to be matched and fail if mismatch ops.'push_pirop'('sub', '$I11', pos, off) if ignorecase goto literal_ignorecase if litlen == "1" goto literal_1 ops.'push_pirop'('substr', '$S10', tgt, '$I11', litlen) ops.'push_pirop'('ne', '$S10', lpost, fail) goto literal_pass literal_1: $S0 = lpast $I0 = ord $S0 ops.'push_pirop'('ord', '$I11', tgt, '$I11') ops.'push_pirop'('ne', '$I11', $I0, fail) goto literal_pass literal_ignorecase: ops.'push_pirop'('substr', '$S10', tgt, '$I11', litlen) ops.'push_pirop'('downcase', '$S10', '$S10') ops.'push_pirop'('ne', '$S10', lpost, fail) literal_pass: # increase position by literal length and move on ops.'push_pirop'('add', pos, litlen) done: .return (ops) .end =item 'pastnode'(PAST::Regex node) =cut .sub 'pastnode' :method :multi(_, ['PAST';'Regex']) .param pmc node .local pmc cur, pos, fail, ops (cur, pos, fail) = self.'!rxregs'('cur pos fail') ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) .local pmc cpast, cpost cpast = node[0] cpost = self.'as_post'(cpast, 'rtype'=>'P') self.'!cursorop'(ops, '!cursor_pos', 0, pos) ops.'push'(cpost) .local pmc subtype, negate, testop subtype = node.'subtype'() if subtype != 'zerowidth' goto done negate = node.'negate'() testop = self.'??!!'(negate, 'if', 'unless') ops.'push_pirop'(testop, cpost, fail) done: .return (ops) .end =item pass(PAST::Regex node) =cut .sub 'pass' :method :multi(_,['PAST';'Regex']) .param pmc node .local pmc cur, pos, ops (cur, pos) = self.'!rxregs'('cur pos') ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) .local string regexname $P0 = find_dynamic_lex '$*REGEXNAME' regexname = self.'escape'($P0) ops.'push_pirop'('inline', 'inline'=>' # rx pass') self.'!cursorop'(ops, '!cursor_pass', 0, pos, regexname) self.'!cursorop'(ops, '!cursor_debug', 0, '"PASS"', regexname, '" at pos="', pos) .local string backtrack backtrack = node.'backtrack'() if backtrack == 'r' goto backtrack_done self.'!cursorop'(ops, '!cursor_backtrack', 0) backtrack_done: ops.'push_pirop'('return', cur) .return (ops) .end =item reduce =cut .sub 'reduce' :method :multi(_,['PAST';'Regex']) .param pmc node .local pmc cur, pos, ops (cur, pos) = self.'!rxregs'('cur pos') ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) .local pmc cpost, posargs, namedargs (cpost, posargs, namedargs) = self.'post_children'(node, 'signature'=>'v:') .local string regexname, key $P0 = find_dynamic_lex '$*REGEXNAME' regexname = self.'escape'($P0) key = posargs[0] ops.'push_pirop'('inline', regexname, key, 'inline'=>' # rx reduce name=%0 key=%1') ops.'push'(cpost) self.'!cursorop'(ops, '!cursor_pos', 0, pos) self.'!cursorop'(ops, '!reduce', 0, regexname, posargs :flat, namedargs :flat) .return (ops) .end =item quant(PAST::Regex node) =cut .sub 'quant' :method :multi(_,['PAST';'Regex']) .param pmc node .local string backtrack backtrack = node.'backtrack'() if backtrack goto have_backtrack backtrack = 'g' have_backtrack: .local pmc sep .local int min, max sep = node.'sep'() min = node.'min'() $P0 = node.'max'() max = $P0 $I0 = defined $P0 if $I0 goto have_max max = -1 # -1 represents Inf have_max: optimize: $I0 = node.'list'() if $I0 != 1 goto optimize_done .local pmc cpast cpast = node[0] $S0 = cpast.'pasttype'() $S0 = concat $S0, '_q' $I0 = can self, $S0 unless $I0 goto optimize_done $P0 = self.$S0(cpast, backtrack, min, max, sep) if null $P0 goto optimize_done .return ($P0) optimize_done: .local pmc cur, pos, rep, fail (cur, pos, rep, fail) = self.'!rxregs'('cur pos rep fail') .local string qname, btreg .local pmc ops, q1label, q2label, cpost $S0 = concat 'rxquant', backtrack qname = self.'unique'($S0) ops = self.'post_new'('Ops', 'node'=>node) $S0 = concat qname, '_loop' q1label = self.'post_new'('Label', 'result'=>$S0) $S0 = concat qname, '_done' q2label = self.'post_new'('Label', 'result'=>$S0) cpost = self.'concat'(node) .local pmc seppast, seppost null seppost seppast = node.'sep'() unless seppast goto have_seppost seppost = self.'post_regex'(seppast) have_seppost: $S0 = max .local int needrep $I0 = isgt min, 1 $I1 = isgt max, 1 needrep = or $I0, $I1 unless max < 0 goto have_s0 $S0 = '*' have_s0: ops.'push_pirop'('inline', qname, min, $S0, 'inline'=>' # rx %0 ** %1..%2') if backtrack == 'f' goto frugal greedy: btreg = '$I10' .local int needmark .local string peekcut needmark = needrep peekcut = '!mark_peek' if backtrack != 'r' goto greedy_1 needmark = 1 peekcut = '!mark_commit' greedy_1: if min == 0 goto greedy_2 unless needmark goto greedy_loop ops.'push_pirop'('set_addr', btreg, q2label) self.'!cursorop'(ops, '!mark_push', 0, 0, CURSOR_FAIL, btreg) goto greedy_loop greedy_2: ops.'push_pirop'('set_addr', btreg, q2label) self.'!cursorop'(ops, '!mark_push', 0, 0, pos, btreg) greedy_loop: ops.'push'(q1label) ops.'push'(cpost) unless needmark goto greedy_3 ops.'push_pirop'('set_addr', btreg, q2label) self.'!cursorop'(ops, peekcut, 1, rep, btreg) unless needrep goto greedy_3 ops.'push_pirop'('inc', rep) greedy_3: unless max > 1 goto greedy_4 ops.'push_pirop'('ge', rep, max, q2label) greedy_4: unless max != 1 goto greedy_5 ops.'push_pirop'('set_addr', btreg, q2label) self.'!cursorop'(ops, '!mark_push', 0, rep, pos, btreg) if null seppost goto greedy_4a ops.'push'(seppost) greedy_4a: ops.'push_pirop'('goto', q1label) greedy_5: ops.'push'(q2label) unless min > 1 goto greedy_6 ops.'push_pirop'('lt', rep, min, fail) greedy_6: .return (ops) frugal: .local pmc ireg ireg = self.'uniquereg'('I') if min == 0 goto frugal_1 unless needrep goto frugal_0 ops.'push_pirop'('set', rep, 0) frugal_0: if null seppost goto frugal_2 .local pmc seplabel $S0 = concat qname, '_sep' seplabel = self.'post_new'('Label', 'result'=>$S0) ops.'push_pirop'('goto', seplabel) goto frugal_2 frugal_1: ops.'push_pirop'('set_addr', '$I10', q1label) self.'!cursorop'(ops, '!mark_push', 0, 0, pos, '$I10') ops.'push_pirop'('goto', q2label) frugal_2: ops.'push'(q1label) if null seppost goto frugal_2a ops.'push'(seppost) ops.'push'(seplabel) frugal_2a: unless needrep goto frugal_3 ops.'push_pirop'('set', ireg, rep) unless max > 1 goto frugal_3 ops.'push_pirop'('ge', rep, max, fail) frugal_3: ops.'push'(cpost) unless needrep goto frugal_4 ops.'push_pirop'('add', rep, ireg, 1) frugal_4: unless min > 1 goto frugal_5 ops.'push_pirop'('lt', rep, min, q1label) frugal_5: frugal_6: unless max != 1 goto frugal_7 ops.'push_pirop'('set_addr', '$I10', q1label) self.'!cursorop'(ops, '!mark_push', 0, rep, pos, '$I10') frugal_7: ops.'push'(q2label) .return (ops) .end =item scan(POST::Regex) Code for initial regex scan. =cut .sub 'scan' :method :multi(_, ['PAST';'Regex']) .param pmc node .local pmc cur, pos, eos, ops (cur, pos, eos) = self.'!rxregs'('cur pos eos') ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) .local pmc looplabel, scanlabel, donelabel $S0 = self.'unique'('rxscan') $S1 = concat $S0, '_loop' looplabel = self.'post_new'('Label', 'result'=>$S1) $S1 = concat $S0, '_scan' scanlabel = self.'post_new'('Label', 'result'=>$S1) $S1 = concat $S0, '_done' donelabel = self.'post_new'('Label', 'result'=>$S1) ops.'push_pirop'('callmethod', "'from'", 'self', 'result'=>'$I10') ops.'push_pirop'('ne', '$I10', CURSOR_FAIL, donelabel) ops.'push_pirop'('goto', scanlabel) ops.'push'(looplabel) self.'!cursorop'(ops, 'from', 1, '$P10') ops.'push_pirop'('inc', '$P10') ops.'push_pirop'('set', pos, '$P10') ops.'push_pirop'('ge', pos, eos, donelabel) ops.'push'(scanlabel) ops.'push_pirop'('set_addr', '$I10', looplabel) self.'!cursorop'(ops, '!mark_push', 0, 0, pos, '$I10') ops.'push'(donelabel) .return (ops) .end =item subcapture(PAST::Regex node) Perform a subcapture (capture of a portion of a regex). =cut .sub 'subcapture' :method :multi(_, ['PAST';'Regex']) .param pmc node .local pmc cur, pos, tgt, fail (cur, pos, tgt, fail) = self.'!rxregs'('cur pos tgt fail') .local pmc ops, cpast, cpost ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) cpast = node[0] cpost = self.'post_regex'(cpast) .local pmc name $P0 = node.'name'() name = self.'as_post'($P0, 'rtype'=>'*') .local string rxname rxname = self.'unique'('rxcap_') .local pmc caplabel, donelabel $S0 = concat rxname, '_fail' caplabel = self.'post_new'('Label', 'result'=>$S0) $S0 = concat rxname, '_done' donelabel = self.'post_new'('Label', 'result'=>$S0) ops.'push_pirop'('inline', name, 'inline'=>' # rx subcapture %0') ops.'push_pirop'('set_addr', '$I10', caplabel) self.'!cursorop'(ops, '!mark_push', 0, 0, pos, '$I10') ops.'push'(cpost) ops.'push_pirop'('set_addr', '$I10', caplabel) self.'!cursorop'(ops, '!mark_peek', 2, '$I12', '$I11', '$I10') self.'!cursorop'(ops, '!cursor_pos', 0, '$I11') self.'!cursorop'(ops, '!cursor_start', 1, '$P10') ops.'push_pirop'('callmethod', '"!cursor_pass"', '$P10', pos, '""') ops.'push'(name) self.'!cursorop'(ops, '!mark_push', 0, 0, CURSOR_FAIL, 0, '$P10') ops.'push_pirop'('callmethod', '"!cursor_names"', '$P10', name) ops.'push_pirop'('goto', donelabel) ops.'push'(caplabel) ops.'push_pirop'('goto', fail) ops.'push'(donelabel) .return (ops) .end =item subrule(PAST::Regex node) Perform a subrule call. =cut .sub 'subrule' :method :multi(_, ['PAST';'Regex']) .param pmc node .local pmc cur, pos, fail, ops (cur, pos, fail) = self.'!rxregs'('cur pos fail') ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) .local pmc name $P0 = node.'name'() name = self.'as_post'($P0, 'rtype'=>'*') .local pmc cpost, posargs, namedargs, subpost (cpost, posargs, namedargs) = self.'post_children'(node, 'signature'=>'v:') subpost = shift posargs .local pmc negate .local string testop negate = node.'negate'() testop = self.'??!!'(negate, 'if', 'unless') .local pmc subtype, backtrack subtype = node.'subtype'() backtrack = node.'backtrack'() ops.'push_pirop'('inline', subpost, subtype, negate, 'inline'=>" # rx subrule %0 subtype=%1 negate=%2") self.'!cursorop'(ops, '!cursor_pos', 0, pos) ops.'push'(cpost) ops.'push_pirop'('callmethod', subpost, cur, posargs :flat, namedargs :flat, 'result'=>'$P10') ops.'push_pirop'(testop, '$P10', fail) if subtype == 'zerowidth' goto done if backtrack != 'r' goto subrule_backtrack if subtype == 'method' goto subrule_pos self.'!cursorop'(ops, '!mark_push', 0, 0, CURSOR_FAIL, 0, '$P10') goto subrule_named subrule_backtrack: .local string rxname .local pmc backlabel, passlabel rxname = self.'unique'('rxsubrule') $S0 = concat rxname, '_back' backlabel = self.'post_new'('Label', 'result'=>$S0) $S0 = concat rxname, '_pass' passlabel = self.'post_new'('Label', 'result'=>$S0) ops.'push_pirop'('goto', passlabel) ops.'push'(backlabel) ops.'push_pirop'('callmethod', '"!cursor_next"', '$P10', 'result'=>'$P10') ops.'push_pirop'(testop, '$P10', fail) ops.'push'(passlabel) ops.'push_pirop'('set_addr', '$I10', backlabel) self.'!cursorop'(ops, '!mark_push', 0, 0, pos, '$I10', '$P10') if subtype == 'method' goto subrule_pos subrule_named: ops.'push'(name) ops.'push_pirop'('callmethod', '"!cursor_names"', '$P10', name) subrule_pos: ops.'push_pirop'('callmethod', '"pos"', '$P10', 'result'=>pos) done: .return (ops) .end =item post_new(type, args :slurpy, options :slurpy :named) Helper method to create a new POST node of C. =cut .sub 'post_new' :method .param string type .param pmc args :slurpy .param pmc options :slurpy :named $P0 = get_hll_global ['POST'], type .tailcall $P0.'new'(args :flat, options :flat :named) .end =item ??!!(test, trueval, falseval) Helper method to perform ternary operation -- returns C if C is true, C otherwise. =cut .sub '??!!' :method .param pmc test .param pmc trueval .param pmc falseval if test goto true .return (falseval) true: .return (trueval) .end =back =head1 AUTHOR Patrick Michaud is the author and maintainer. =head1 COPYRIGHT Copyright (C) 2009, The Perl Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: =head1 AUTHOR Patrick Michaud is the author and maintainer. =head1 COPYRIGHT Copyright (C) 2009, The Perl Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: PCCMETHOD.pm000644000765000765 3705112171255036 17366 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/Pmc2c# Copyright (C) 2004-2012, Parrot Foundation. package Parrot::Pmc2c::PCCMETHOD; use strict; use warnings; use Carp qw(longmess croak); use Parrot::Pmc2c::PCCMETHOD_BITS; use Parrot::Pmc2c::UtilFunctions qw( trim ); =head1 NAME Parrot::Pmc2c::PCCMETHOD - Parses and preps PMC PCCMETHOD called from F =head1 SYNOPSIS use Parrot::Pmc2c::PCCMETHOD; =head1 DESCRIPTION Parrot::Pmc2c::PCCMETHOD - Parses and preps PMC PCCMETHOD called from F =cut =head1 FUNCTIONS =head2 Publicly Available Methods =head3 C B Parse and Build PMC PCCMETHODS. B =over 4 =item * C =item * C Current Method Object =item * C Current Method Body =back =head3 C B Parse and Build a PCCINVOKE Call. B =over 4 =item * C =item * C Current Method Object =item * C Current Method Body =back =cut use constant REGNO_INT => 0; use constant REGNO_NUM => 1; use constant REGNO_STR => 2; use constant REGNO_PMC => 3; =head3 regtype to argtype conversion hash =cut our $reg_type_info = { # s is string, ss is short string, at is arg type +(REGNO_INT) => { s => "INTVAL", ss => "INT", pcc => 'I', at => PARROT_ARG_INTVAL}, +(REGNO_NUM) => { s => "FLOATVAL", ss => "NUM", pcc => "N", at => PARROT_ARG_FLOATVAL, }, +(REGNO_STR) => { s => "STRING*", ss => "STR", pcc => "S", at => PARROT_ARG_STRING, }, +(REGNO_PMC) => { s => "PMC*", ss => "PMC", pcc => "P", at => PARROT_ARG_PMC, }, }; =head3 C builds and returs an adverb hash from an adverb string such as ":optional :opt_flag :slurpy" { optional =>1, opt_flag =>1, slurpy =>1, } =cut sub parse_adverb_attributes { my $adverb_string = shift; my %result; if ( defined $adverb_string ) { ++$result{$1} while $adverb_string =~ /:(\S+)/g; } return \%result; } sub convert_type_string_to_reg_type { local ($_) = @_; return REGNO_INT if /INTVAL|int/i; return REGNO_NUM if /FLOATVAL|double/i; return REGNO_STR if /STRING/i; return REGNO_PMC if /PMC/i; croak "$_ not recognized as INTVAL, FLOATVAL, STRING, or PMC"; } sub gen_arg_pcc_sig { my ($param) = @_; return 'Ip' if exists $param->{attrs}{opt_flag}; my $sig = $reg_type_info->{ $param->{type} }->{pcc}; $sig .= 'c' if exists $param->{attrs}{constant}; $sig .= 'f' if exists $param->{attrs}{flatten}; $sig .= 'i' if exists $param->{attrs}{invocant}; $sig .= 'l' if exists $param->{attrs}{lookahead}; $sig .= 'n' if (exists $param->{attrs}{name} || exists $param->{attrs}{named}); $sig .= 'o' if exists $param->{attrs}{optional}; $sig .= 'p' if exists $param->{attrs}{opt_flag}; $sig .= 's' if exists $param->{attrs}{slurpy}; return $sig; } =head3 C Rewrites the method body performing the various macro substitutions for RETURNs. =cut sub rewrite_RETURNs { my ( $method, $pmc ) = @_; my $method_name = $method->name; my $body = $method->body; my $wb = $method->attrs->{manual_wb} ? '' : 'PARROT_GC_WRITE_BARRIER(interp, _self);'; my $signature_re = qr/ (RETURN #method name \s* #optional whitespace \( ([^\(]*) \) #returns ( stuff ... ) ;?) #optional semicolon /sx; croak "return not allowed in pccmethods, use RETURN instead $body" if $body and $body =~ m/\breturn\b.*?;\z/s; while ($body) { my $matched; if ($body) { $matched = $body->find($signature_re); last unless $matched; } $matched =~ /$signature_re/; my ( $match, $returns ) = ( $1, $2 ); my $e = Parrot::Pmc2c::Emitter->new( $pmc->filename(".c") ); if ($returns eq 'void') { $e->emit( <<"END" ); { /*BEGIN RETURN $returns */ $wb return; /*END RETURN $returns */ } END $matched->replace( $match, $e ); next; } my $goto_string = "goto ${method_name}_returns;"; my ( $returns_signature, $returns_varargs ) = process_pccmethod_args( parse_p_args_string($returns), 'return' ); if ($returns_signature) { $e->emit( <<"END" ); { /*BEGIN RETURN $returns */ END $e->emit( <<"END" ); Parrot_pcc_set_call_from_c_args(interp, _call_object, "$returns_signature", $returns_varargs); $wb return; /*END RETURN $returns */ } END } else { # if ($returns_signature) $e->emit( <<"END" ); { /*BEGIN RETURN $returns */ $wb return; } /*END RETURN $returns */ END } $matched->replace( $match, $e ); } } sub parse_p_args_string { my ($parameters) = @_; my $linear_args = []; for my $x ( split /,/, $parameters ) { #change 'PMC * foo' to 'PMC *foo' $x =~ s/\*\s+/\*/ if ($x =~ /\s\*+\s/); #change 'PMC* foo' to 'PMC *foo' $x =~ s/(\*+)\s+/ $1/ if ($x =~ /^\w+\*/); my ( $type, $name, $rest ) = split /\s+/, trim($x), 3; die "invalid PCC arg '$x': did you forget to specify a type?\n" unless defined $name; if ($name =~ /\**([a-zA-Z_]\w*)/) { $name = $1; } my $arg = { type => convert_type_string_to_reg_type($type), name => $name, attrs => parse_adverb_attributes($rest) }; push @$linear_args, $arg; } $linear_args; } sub is_named { my ($arg) = @_; while ( my ( $k, $v ) = each( %{ $arg->{attrs} } ) ) { return ( 1, $1 ) if $k =~ /named\((.*)\)/; } return ( 0, '' ); } sub process_pccmethod_args { my ( $linear_args, $arg_type ) = @_; my $args = [ [], [], [], [] ]; # actual INT, FLOAT, STRING, PMC my $signature = ""; my @vararg_list = (); my $varargs = ""; my $declarations = ""; for my $arg (@$linear_args) { my ( $named, $named_name ) = is_named($arg); my $type = $arg->{type}; my $name = $arg->{name}; if ($named) { my $tis = $reg_type_info->{+(REGNO_STR)}{s}; #reg_type_info string my $dummy_name = "_param_name_str_". $named_name; $dummy_name =~ s/"//g; my $argn = { type => +(REGNO_STR), name => $named_name, }; $arg->{named_arg} = $argn; $arg->{named_name} = $named_name; push @{ $args->[ +(REGNO_STR) ] }, $argn; $signature .= 'Sn'; $declarations .= "$tis $dummy_name = CONST_STRING_GEN(interp, $named_name);\n"; push @vararg_list, "&$dummy_name"; } push @{ $args->[ $type ] }, $arg; $signature .= gen_arg_pcc_sig($arg); if ( $arg_type eq 'arg' ) { my $tis = $reg_type_info->{$type}{"s"}; #reg_type_info string $declarations .= "$tis $name;\n" unless $arg->{already_declared}; push @vararg_list, "&$name"; } elsif ( $arg_type eq 'return' ) { my $typenamestr = $reg_type_info->{$type}{s}; push @vararg_list, "($typenamestr)$name"; } } $varargs = join ", ", @vararg_list; return ( $signature, $varargs, $declarations ); } =head3 C rewrite_pccmethod($method, $pmc); =cut sub rewrite_pccmethod { my ( $method, $pmc ) = @_; my $e = Parrot::Pmc2c::Emitter->new( $pmc->filename(".c") ); my $e_post = Parrot::Pmc2c::Emitter->new( $pmc->filename(".c") ); # parse pccmethod parameters, then unshift the PMC arg for the invocant my $linear_args = parse_p_args_string( $method->parameters ); unshift @$linear_args, { type => convert_type_string_to_reg_type('PMC'), name => '_self', attrs => parse_adverb_attributes(':invocant'), already_declared => 1, }; # The invocant is already passed in the C signature, why pass it again? my ( $params_signature, $params_varargs, $params_declarations ) = process_pccmethod_args( $linear_args, 'arg' ); my $wb = $method->attrs->{manual_wb} ? '' : 'PARROT_GC_WRITE_BARRIER(interp, _self);'; rewrite_RETURNs( $method, $pmc ); rewrite_pccinvoke( $method, $pmc ); $e->emit( <<"END"); PMC * const _ctx = CURRENT_CONTEXT(interp); PMC * const _call_object = Parrot_pcc_get_signature(interp, _ctx); { /* BEGIN PARMS SCOPE */ END $e->emit(<<"END"); $params_declarations END if ($params_signature) { $e->emit( <<"END"); Parrot_pcc_fill_params_from_c_args(interp, _call_object, "$params_signature", $params_varargs); END } $e->emit( <<'END' ); { /* BEGIN PMETHOD BODY */ END $e_post->emit( <<"END"); } /* END PMETHOD BODY */ $wb } /* END PARAMS SCOPE */ return; END $method->return_type('void'); $method->parameters(''); my $e_body = Parrot::Pmc2c::Emitter->new( $pmc->filename ); $e_body->emit($e); $e_body->emit( $method->body ); $e_body->emit($e_post); $method->body($e_body); $method->{PCCMETHOD} = 1; return 1; } sub rewrite_pccinvoke { my ( $method, $pmc ) = @_; my $body = $method->body; my $signature_re = qr{ ( ( \( ([^\(]*) \) # results \s* # optional whitespace = # results equals PCCINVOKE invocation \s* # optional whitespace )? # results are optional \b # exclude Parrot_pcc_invoke_method_from_c_args when lacking optional capture PCCINVOKE # method name \s* # optional whitespace \( ([^\(]*) \) # parameters ;? # optional semicolon ) }sx; while ($body) { my $matched; if ($body) { $matched = $body->find($signature_re); last unless $matched; } $matched =~ /$signature_re/; my ( $match, $result_clause, $results, $parameters ) = ( $1, $2, $3, $4 ); my ($out_vars, $out_types) = process_pccmethod_results( $results ); my ($fixed_params, $in_types, $in_vars) = process_pccmethod_parameters( $parameters ); my $signature = $in_types . '->' . $out_types; # I know this is ugly.... my $vars = ''; if ($in_vars) { $vars .= $in_vars; $vars .= ', ' if $out_vars; } $vars .= $out_vars; my $e = Parrot::Pmc2c::Emitter->new( $pmc->filename ); $e->emit(qq|Parrot_pcc_invoke_method_from_c_args($fixed_params, "$signature", $vars);\n|); $matched->replace( $match, $e ); } return 1; } sub process_pccmethod_results { my $results = shift; return ('', '') unless $results; my @params = split /,\s*/, $results; my (@out_vars, @out_types); for my $param (@params) { my ($type, @names) = process_parameter($param); push @out_types, $type; push @out_vars, map { "&$_" } @names; } my $out_types = join '', @out_types; my $out_vars = join ', ', @out_vars; return ($out_vars, $out_types); } sub process_pccmethod_parameters { my $parameters = shift; my ($interp, $pmc, $method, @params) = split /,\s*/, $parameters; $method = 'CONST_STRING_GEN(interp, ' . $method . ')'; my $fixed_params = join ', ', $interp, $pmc, $method; my (@in_types, @in_vars); for my $param (@params) { # @var is an array because named parameters are two variables my ($type, @var) = process_parameter($param); push @in_types, $type; push @in_vars, @var; } my $in_types = join '', @in_types; my $in_vars = join ', ', @in_vars; return ($fixed_params, $in_types, $in_vars); } sub process_parameter { my $param = shift; my $param_re = qr{ (STRING\s\*|INTVAL|FLOATVAL|PMC\s\*) # type \s* # optional whitespace (\w+) # name \s* # optional whitespace (.*)? # adverbs }sx; my ($type, $name, $adverbs) = $param =~ /$param_re/; # the first letter of the type is the type in the signature $type = substr $type, 0, 1; my $adverb_re = qr{ : # leading colon (\w+) # name (?: # optional argument \(" (\w+) "\) ) \s* }sx; my %allowed_adverbs = ( named => 'n', flatten => 'f', slurpy => 's', optional => 'o', opt_flag => 'p', ); my @arg_names = ($name); while (my ($name, $argument) = $adverbs =~ /$adverb_re/g) { next unless my $type_mod = $allowed_adverbs{$name}; $type .= $type_mod; next unless $type eq 'named'; push @arg_names, qq|CONST_STRING_GEN(interp, "$argument")|; } return ($type, @arg_names); } =head3 C B Parse and Build PMC multiple dispatch subs. B =over 4 =item * C =item * C Current Method Object =item * C Current Method Body =back =cut sub rewrite_multi_sub { my ( $method, $pmc ) = @_; my @param_types = (); my @new_params = (); # Fixup the parameters, standardizing PMC types and extracting type names # for the multi name. for my $param ( split /,/, $method->parameters ) { my ( $type, $name, $rest ) = split /\s+/, &Parrot::Pmc2c::PCCMETHOD::trim($param), 3; die "Invalid MULTI parameter '$param': missing type or name\n" unless defined $name; die "Invalid MULTI parameter '$param': attributes not allowed on multis\n" if defined $rest; # Clean any '*' out of the name or type. if ($name =~ /[\**]?(\"?\w+\"?)/) { $name = $1; } $type =~ s/\*+//; # Capture the actual type for the sub name push @param_types, $type; # Pass standard parameter types unmodified. # All other param types are rewritten as PMCs. if ($type eq 'STRING' or $type eq 'PMC' or $type eq 'INTVAL') { push @new_params, $param; } elsif ($type eq 'FLOATVAL') { push @new_params, $param; } else { push @new_params, "PMC *$name"; } } $method->parameters(join (",", @new_params)); $method->{MULTI_sig} = [@param_types]; $method->{MULTI_full_sig} = join(',', @param_types); $method->{MULTI} = 1; return 1; } sub mangle_name { my ( $method ) = @_; $method->symbol( $method->name ); $method->name( $method->type eq Parrot::Pmc2c::Method::MULTI() ? (join '_', 'multi', $method->name, @{ $method->{MULTI_sig} }) : "nci_@{[$method->name]}" ); } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: foo-02.t000644000765000765 54312101554067 15420 0ustar00brucebruce000000000000parrot-5.9.0/t/dynpmc#!./parrot # Copyright (C) 2011, Parrot Foundation. .sub main :main .include 'test_more.pir' plan(1) loadlib $P1, 'foo_group' sweep 1 $P2 = getprop $P1, '_type' $S0 = $P2 is($S0, 'PMC', 'ParrotLibrary props survive GC') .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: 030-option_or_data.t000644000765000765 400611533177644 20436 0ustar00brucebruce000000000000parrot-5.9.0/t/configure#! perl # Copyright (C) 2007, Parrot Foundation. # 030-option_or_data.t use strict; use warnings; use Test::More tests => 6; use Carp; use lib qw( lib t/configure/testlib ); use Parrot::Configure; use Parrot::Configure::Options qw( process_options ); use Parrot::Configure::Test qw( test_step_thru_runstep); use Parrot::Configure::Step::List qw( get_steps_list ); use IO::CaptureOutput qw | capture |; $| = 1; is( $|, 1, "output autoflush is set" ); my $testopt = q{bindir}; my $testoptval = q{mybindir}; my $localargv = []; my ($args, $step_list_ref) = process_options( { mode => q{configure}, argv => $localargv, } ); ok( defined $args, "process_options returned successfully" ); my $conf = Parrot::Configure->new; ok( defined $conf, "Parrot::Configure->new() returned okay" ); my $step = q{init::foobar}; my $description = 'Determining if your computer does foobar'; $conf->add_steps($step); $conf->options->set( %{$args} ); { my $rv; my $stdout; capture ( sub {$rv = $conf->runsteps}, \$stdout ); like( $stdout, qr/$description/s, "Got message expected upon running $step" ); ok( !defined( $conf->option_or_data($testopt) ), "option_or_data returned undef; neither option nor data had been defined" ); } pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME 030-option_or_data.t - test C =head1 SYNOPSIS % prove t/configure/030-option_or_data.t =head1 DESCRIPTION The files in this directory test functionality used by F. This file tests C in the case where no value for the tested option has been set on the command line but where no value for the tested option has been located internally by a configuration step. =head1 AUTHOR James E Keenan =head1 SEE ALSO Parrot::Configure, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: README.pod000644000765000765 41512101554067 16017 0ustar00brucebruce000000000000parrot-5.9.0/t/archive# Copyright (C) 2001-2012, Parrot Foundation. =pod =head1 NAME t/archive/README.pod - Readme file for the 't/archive/' directory. =head1 DESCRIPTION This directory holds parrot_test_run.tar.gz. =head1 COPYRIGHT Copyright (C) 2001-2012, Parrot Foundation. =cut multidispatch.t000644000765000765 6232211715102036 16613 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc#! perl # Copyright (C) 2001-2010, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Test::Util 'create_tempfile'; use Parrot::Test tests => 47; =head1 NAME t/pmc/mmd.t - Multi-Method Dispatch =head1 SYNOPSIS % prove t/pmc/multidispatch.t =head1 DESCRIPTION Tests the multi-method dispatch. =cut pir_output_is( <<'CODE', <<'OUTPUT', 'Integer_divide_Integer 10 / 3 = 1003', todo => 'TT #452' ); .sub 'test' :main .local pmc divide divide = get_global "Integer_divide_Integer" add_multi "divide", "Integer,Integer,Integer", divide $P0 = new ['Integer'] $P1 = new ['Integer'] $P2 = new ['Integer'] $P1 = 10 $P2 = 3 $P0 = $P1 / $P2 print $P0 print "\n" .end .sub Integer_divide_Integer .param pmc left .param pmc right .param pmc lhs $I0 = left $I1 = right $I2 = $I0/$I1 # don't call divide Integer/Integer here lhs = $I2 # ' lhs += 1000 # prove that this function has been called .return(lhs) .end CODE 1003 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "1+1=3", todo => 'TT #452' ); .sub _main :main .local pmc add add = get_global "add" add_multi "add", "Integer,Integer,Integer", add $P0 = new ['Integer'] $P1 = new ['Integer'] $P2 = new ['Integer'] $P1 = 1 $P2 = 1 $P0 = $P1 + $P2 print $P0 print "\n" .end .sub add .param pmc left .param pmc right .param pmc lhs $I0 = left $I1 = right $I2 = $I0 + $I1 inc $I2 lhs = $I2 .return (lhs) .end CODE 3 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "PASM divide - override builtin 10 / 3 = 42", todo => 'TT #452' ); .sub _main :main .local pmc divide divide = get_global "Integer_divide_Integer" add_multi "divide", "Integer,Integer,Integer", divide $P0 = new ['Integer'] $P1 = new ['Integer'] $P2 = new ['Integer'] $P1 = 10 $P2 = 3 $P0 = $P1 / $P2 print $P0 print "\n" .end .sub Integer_divide_Integer .param pmc left .param pmc right .param pmc lhs lhs = 42 .return(lhs) .end CODE 42 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "INTVAL return numeq", todo => 'TT #452' ); .sub _main :main .local pmc comp comp = get_global "Float_cmp_Integer" add_multi "cmp", "Float,Integer", comp $P1 = new ['Float'] $P2 = new ['Integer'] $P1 = 47.11 $P2 = 47 $I0 = cmp $P1, $P2 # XXX cmp calls cmp_num print $I0 print "\n" .end .sub Float_cmp_Integer .param pmc left .param pmc right .begin_return .set_return -42 .end_return .end CODE -42 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "find_multi" ); .sub _main :main .local pmc comp comp = get_global "Float_cmp_Integer" add_multi "cmp_num", "Float,Integer", comp $P0 = find_multi "cmp_num", "Float,Integer" if_null $P0, nok print "ok 1\n" ne_addr $P0, comp, nok print "ok 2\n" end nok: print "not ok\n" .end .sub Float_cmp_Integer .param pmc left .param pmc right .begin_return .set_return -42 .end_return .end CODE ok 1 ok 2 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "find_multi - invoke it" ); .sub _main :main .local pmc comp comp = get_global "Float_cmp_Integer" add_multi "cmp_num", "Float,Integer", comp $P0 = find_multi "cmp_num", "Float,Integer" if_null $P0, nok print "ok 1\n" ne_addr $P0, comp, nok print "ok 2\n" $P1 = new ['Float'] $P2 = new ['Integer'] $P1 = 47.11 $P2 = 47 $I0 = $P0($P1, $P2) print $I0 print "\n" end nok: print "not ok\n" .end .sub Float_cmp_Integer .param pmc left .param pmc right .begin_return .set_return -42 .end_return .end CODE ok 1 ok 2 -42 OUTPUT my ($TEMP, $temp_pir) = create_tempfile( SUFFIX => '.pir', UNLINK => 1 ); print $TEMP <<'EOF'; .sub Integer_divide_Integer .param pmc left .param pmc right .param pmc lhs lhs = 42 .return(lhs) .end EOF close $TEMP; pir_output_is( <<"CODE", <<'OUTPUT', "PASM MMD divide - loaded sub", todo => 'TT #452' ); .sub _main :main .local pmc divide load_bytecode "$temp_pir" divide = get_global "Integer_divide_Integer" add_multi "divide", "Integer,Integer,Integer", divide \$P0 = new ['Integer'] \$P1 = new ['Integer'] \$P2 = new ['Integer'] \$P1 = 10 \$P2 = 3 \$P0 = \$P1 / \$P2 say \$P0 .end CODE 42 OUTPUT pir_output_is( <<'CODE', <<'OUT', "first dynamic MMD call" ); .sub main :main .local pmc F, B, f, b, m, s newclass F, "Foo" f = new ['Foo'] newclass B, "Bar" b = new ['Bar'] # create a multi the hard way ## m = new MultiSub ## s = get_global "Foo", "foo" ## push m, s ## s = get_global "Bar", "foo" ## push m, s ## set_global "foo", m print "calling foo(f, b)\n" foo(f, b) print "calling foo(b, f)\n" foo(b, f) .end .sub foo :multi(Foo, Bar) .param pmc x .param pmc y print " Foo::foo\n" .end .sub foo :multi(Bar, Foo) .param pmc x .param pmc y print " Bar::foo\n" .end CODE calling foo(f, b) Foo::foo calling foo(b, f) Bar::foo OUT pir_output_is( <<'CODE', <<'OUT', "MMD second arg int/float dispatch" ); .sub foo :multi(_, Integer) .param pmc first .param pmc second print "(_, Int) method: " print first print ', ' print second print "\n" .end .sub foo :multi(_, Float) .param pmc first .param pmc second print "(_, Float) method: " print first print ', ' print second print "\n" .end .sub main :main $P0 = new ['Float'] $P0 = 9.5 foo(1, $P0) $P1 = new ['Integer'] $P1 = 3 foo(1, $P1) .end CODE (_, Float) method: 1, 9.5 (_, Int) method: 1, 3 OUT pir_error_output_like( <<'CODE', <<'OUT', "MMD single method, dispatch failure" ); ## Compare this to the previous example. .sub foo :multi(_, Float) .param pmc first .param pmc second print "(_, Float) method: " print first print ', ' print second print "\n" .end .sub main :main $P0 = new ['Float'] $P0 = 9.5 foo(1, $P0) $P1 = new ['Integer'] $P1 = 3 foo(1, $P1) .end CODE /\A\(_, Float\) method: 1, 9\.5 No applicable candidates/ OUT pir_output_is( <<'CODE', <<'OUT', "MMD on argument count" ); .sub main :main p("ok 1\n") p("-twice", "ok 2\n") .end .sub p :multi(string) .param string s print s .end .sub p :multi(string, string) .param string opt .param string s if opt != '-twice' goto no_twice print s print s .return() no_twice: print s .end CODE ok 1 ok 2 ok 2 OUT pir_output_is( <<'CODE', <<'OUT', "MMD on native types" ); .sub main :main p("ok 1\n") p(42) .end .sub p :multi(string) .param string s print s .end .sub p :multi(int) .param int i print i print "\n" .end CODE ok 1 42 OUT pir_output_is( <<'CODE', <<'OUT', 'MMD on PMC types' ); .sub 'test' :main $P0 = new ['String'] $P0 = "ok 1\n" p($P0) .local pmc pstring pstring = subclass 'String', 'PString' $P1 = new ['PString'] $P1 = "ok 2\n" p($P1) $P0 = subclass 'PString', "Xstring" $P0 = new ['Xstring'] $P0 = "ok 3\n" $P1 = subclass 'String', "Ystring" $P1 = new ['Ystring'] $P1 = "ok 4\n" p($P0) p($P1) .end .sub p :multi(PString) .param pmc p print "PSt " print p .end .sub p :multi(String) .param pmc p print "String " print p .end CODE String ok 1 PSt ok 2 PSt ok 3 String ok 4 OUT pir_output_is( <<'CODE', <<'OUT', 'MMD on PMC types quoted' ); .sub main :main $P0 = new ['String'] $P0 = "ok 1\n" p($P0) .local pmc pstring pstring = subclass 'String', 'PString' $P1 = new ['PString'] $P1 = "ok 2\n" p($P1) $P0 = subclass "PString", "Xstring" $P0 = new ['Xstring'] $P0 = "ok 3\n" $P1 = subclass "String", "Ystring" $P1 = new ['Ystring'] $P1 = "ok 4\n" p($P0) p($P1) .end .sub p :multi("String") .param pmc p print "String " print p .end .sub p :multi("PString") .param pmc p print "PSt " print p .end CODE String ok 1 PSt ok 2 PSt ok 3 String ok 4 OUT pir_error_output_like( <<'CODE', <<'OUT', 'MMD on PMC types, invalid' ); .sub main :main $P0 = new ['String'] $P0 = "ok 1\n" p($P0) .local pmc pstring pstring = subclass 'String', 'PString' $P1 = new ['PString'] $P1 = "ok 2\n" p($P1) $P0 = subclass "PString", "Xstring" $P0 = new ['Xstring'] $P0 = "ok 3\n" $P1 = subclass "String", "Ystring" $P1 = new ['Ystring'] $P1 = "ok 4\n" p($P0) p($P1) $P0 = new ['Integer'] p($P0) .end .sub p :multi(String) .param pmc p print "String " print p .end .sub p :multi(PString) .param pmc p print "PSt " print p .end CODE /String ok 1 PSt ok 2 PSt ok 3 String ok 4 No applicable candidates/ OUT pir_output_is( <<'CODE', <<'OUT', 'MMD on PMC types 3' ); .sub main :main $P0 = new ['String'] $P0 = "ok 1\n" p($P0) .local pmc pstring pstring = subclass 'String', 'PString' $P1 = new ['PString'] $P1 = "ok 2\n" p($P1) $P0 = subclass "PString", "Xstring" $P0 = new ['Xstring'] $P0 = "ok 3\n" $P1 = subclass "String", "Ystring" $P1 = new ['Ystring'] $P1 = "ok 4\n" p($P0) p($P1) .local pmc pint pint = subclass 'Integer', 'PInt' $P0 = new ['PInt'] $P0 = 42 p($P0) .end .sub p :multi(String) .param pmc p print "String " print p .end .sub p :multi(PString) .param pmc p print "PSt " print p .end .sub p :multi(Integer) .param pmc p print "Intege " print p print "\n" .end CODE String ok 1 PSt ok 2 PSt ok 3 String ok 4 Intege 42 OUT pir_output_is( <<'CODE', <<'OUT', 'MMD on PMC types, global namespace' ); .sub main :main $P0 = new ['String'] $P0 = "ok 1\n" p($P0) .local pmc pstring pstring = subclass 'String', 'PString' $P1 = new ['PString'] $P1 = "ok 2\n" p($P1) $P0 = subclass "PString", "Xstring" $P0 = new ['Xstring'] $P0 = "ok 3\n" $P1 = subclass "String", "Ystring" $P1 = new ['Ystring'] $P1 = "ok 4\n" p($P0) p($P1) .end .sub p :multi(String) .param pmc p print "String " print p .end .sub p :multi(PString) .param pmc p print "PSt " print p .end CODE String ok 1 PSt ok 2 PSt ok 3 String ok 4 OUT pir_output_is( <<'CODE', <<'OUT', 'MMD on PMC types, package namespace' ); .namespace ["Some"] .sub main :main $P0 = new ['String'] $P0 = "ok 1\n" p($P0) .local pmc pstring pstring = subclass 'String', 'PString' $P1 = new ['PString'] $P1 = "ok 2\n" p($P1) $P0 = subclass "PString", "Xstring" $P0 = new ['Xstring'] $P0 = "ok 3\n" $P1 = subclass "String", "Ystring" $P1 = new ['Ystring'] $P1 = "ok 4\n" p($P0) p($P1) .end .sub p :multi(String) .param pmc p print "String " print p .end .sub p :multi(PString) .param pmc p print "PSt " print p .end CODE String ok 1 PSt ok 2 PSt ok 3 String ok 4 OUT pir_output_is( <<'CODE', <<'OUT', "MMD on PMC types - Any", todo => 'GH #328' ); .sub main :main $P0 = new ['String'] $P0 = "ok 1\n" $P1 = new ['PerlInt'] $P1 = "ok 2\n" p($P0) p($P1) $P0 = new ['PerlInt'] $P0 = 42 p($P0) $P0 = new ['PerlInt'] $P0 = 43 q($P0) .end .namespace [] .sub p :multi(String) .param pmc p print "String " print p .end .sub p :multi(PString) .param pmc p print "PSt " print p .end .sub p :multi(_) .param pmc p print "Any " print p print "\n" .end .sub q :multi(pmc) .param pmc p print "Any " print p print "\n" .end CODE String ok 1 PSt ok 2 Any 42 Any 43 OUT pir_output_is( <<'CODE', <<'OUTPUT', "add as function - Int, Float" ); .sub main :main .local pmc d, l, r, a d = new ['Integer'] l = new ['Integer'] r = new ['Float'] l = 3 r = 39.42 a = get_root_global ["MULTI"], "add" d = a(l, r, d) print d print "\n" end .end CODE 42.42 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "add as method" ); .sub main :main .local pmc d, l, r l = new ['Integer'] r = new ['Integer'] l = 3 r = 39 d = l."add"(r, d) print d print "\n" end .end CODE 42 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "add as method - inherited", todo => 'GH #328' ); .sub main :main .local pmc d, l, r .local pmc pint pint = subclass 'Integer', 'PInt' l = new ['PInt'] r = new ['PInt'] l = 3 r = 39 d = l."add"(r, d) print d print "\n" .end CODE 42 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "add as method - Int, Float" ); .sub main :main .local pmc d, l, r l = new ['Integer'] r = new ['Float'] l = 3 r = 39.42 d = l."add"(r, d) print d print "\n" end .end CODE 42.42 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "bound add method" ); .sub main :main .local pmc d, l, r, m d = new ['Integer'] l = new ['Integer'] r = new ['Float'] l = 3 r = 39.42 m = get_global ['scalar'], "add" d = m(r, l, d) print d print "\n" r = new ['Integer'] r = 39 m = get_global ['Integer'], "add" d = m(r, l, d) print d print "\n" end .end CODE 42.42 42 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "Integer subclasses" ); .sub main :main .local pmc d, l, r, cl cl = subclass "Integer", "AInt" d = new ['AInt'] l = new ['AInt'] r = new ['AInt'] l = 4 r = 38 print l print "\n" print r print "\n" # dispatches to Parrot_Integer_add_Integer add d, l, r print d print "\n" add l, r print l print "\n" .end CODE 4 38 42 42 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "Integer subclasses, add" ); .sub main :main $P0 = subclass "Integer", "AInt" $P0 = new ['AInt'] $P1 = new ['Integer'] set $P0, 6 set $P1, 2 $P2 = add $P0, $P1 print $P2 print "\n" .end .namespace ["AInt"] .sub add :multi(AInt, Integer, PMC) .param pmc l .param pmc r .param pmc d print l print r print "\n" d = new ['Integer'] d = 2 .return(d) .end CODE 62 2 OUTPUT ($TEMP, $temp_pir) = create_tempfile( SUFFIX => '.pir', UNLINK => 1 ); print $TEMP <<'EOF'; .namespace ["AInt"] .sub add :multi(AInt, Integer, PMC) .param pmc l .param pmc r .param pmc d print l print r print "\n" d = new ['Integer'] d = 2 .return(d) .end EOF close $TEMP; pir_output_is( <<"CODE", <<'OUTPUT', "override builtin add" ); .sub main :main load_bytecode "$temp_pir" \$P0 = subclass "Integer", "AInt" \$P0 = new ['AInt'] \$P1 = new ['Integer'] set \$P0, 6 set \$P1, 2 \$P2 = add \$P0, \$P1 say \$P2 .end CODE 62 2 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "mmd bug reported by Jeff" ); .namespace ['Foo'] .sub bar :method :multi(Foo, string) .param string arg print "string\n" .end .sub bar :method :multi(Foo, pmc) .param pmc arg print "PMC\n" .end .sub bar :method :multi(Foo) print "nothing\n" .end .namespace [] .sub main :main newclass $P0, 'Foo' $P0 = new ['Foo'] $P0.'bar'('Bar!') $P1 = new ['String'] $P1 = "Bar!" $P0.'bar'($P1) $P0.'bar'() .end CODE string PMC nothing OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "use a core func for an object"); .sub main :main .local pmc d, l, r, cl cl = newclass "AInt" addattribute cl, ".i" d = new ['AInt'] l = new ['AInt'] r = new ['AInt'] .local pmc func .local string typ func = find_multi "add", "Float,Float,PMC" $S0 = typeof l typ = $S0 . "," typ .= $S0 typ .= "," typ .= $S0 add_multi "add", typ, func l = 4 r = 38 print l print "\n" print r print "\n" add d, l, r print d print "\n" .end .namespace ["AInt"] .sub init :vtable :method $P0 = new ['Integer'] setattribute self, ".i", $P0 .end .sub set_integer_native :vtable :method .param int i $P0 = getattribute self, ".i" $P0 = i .end .sub set_number_native :vtable :method .param num f $P0 = getattribute self, ".i" $P0 = f .end .sub get_string :vtable :method $P0 = getattribute self, ".i" $S0 = $P0 .return ($S0) .end .sub get_number :vtable :method $P0 = getattribute self, ".i" $N0 = $P0 .return ($N0) .end CODE 4 38 42 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "multisub vs find_name" ); .sub main :main $P0 = find_name "foo" $S0 = typeof $P0 print $S0 print "\n" .end .sub foo :method :multi(string) .param pmc x print " foo\n" .end .sub foo :method :multi(pmc) .param pmc x print " foo\n" .end CODE MultiSub OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "multisub w void" ); .sub main :main foo('xx') foo() foo('xx') .end .sub foo :multi(string) .param pmc x print "foo string\n" .end .sub foo :multi() print "foo\n" .end CODE foo string foo foo string OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "multisub w/o .HLL" ); .sub main :main $P0 = new ['Integer'] $P0 = 3 $P9 = 'foo'($P0) $P0 = new ['ResizablePMCArray'] push $P0, 4 $P1 = new ['String'] $P1 = 'hello' $P9 = 'foo'($P0, $P1) .end .sub 'foo' :multi(Integer) print "foo(Integer)\n" .return (0) .end .sub 'foo' :multi(ResizablePMCArray, _) print "foo(ResizablePMCArray,_)\n" .return (0) .end CODE foo(Integer) foo(ResizablePMCArray,_) OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "multisub w/ .HLL, rt #39161" ); .HLL 'Perl6' .sub main :main $P0 = new ['Integer'] $P0 = 3 $P9 = 'foo'($P0) $P0 = new ['ResizablePMCArray'] push $P0, 4 $P1 = new ['String'] $P1 = 'hello' $P9 = 'foo'($P0, $P1) .end .sub 'foo' :multi(Integer) print "foo(Integer)\n" .return (0) .end .sub 'foo' :multi(ResizablePMCArray, _) print "foo(ResizablePMCArray,_)\n" .return (0) .end CODE foo(Integer) foo(ResizablePMCArray,_) OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "multisub w/ flatten" ); # see also 'rt #39173 .sub main :main .local pmc int_pmc int_pmc = new ['Integer'] int_pmc = 3 .local pmc args args = new ['ResizablePMCArray'] push args, int_pmc 'foo'( args :flat ) .local pmc string_pmc string_pmc = new ['String'] string_pmc = 'hello' args = new ['ResizablePMCArray'] push args, string_pmc 'foo'( args :flat ) end .end .sub 'foo' :multi(Integer) print "foo(Integer)\n" .end .sub 'foo' :multi(String) print "foo(String)\n" .end CODE foo(Integer) foo(String) OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "keyed class name and multi" ); .sub main :main .local pmc class newclass class, [ 'Some'; 'Class' ] .local pmc instance instance = new [ 'Some'; 'Class' ] .local string name name = typeof instance print "Type: " print name print "\n" end .end CODE Type: Some;Class OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "keyed class name and multi" ); .sub main :main .local pmc class newclass class, [ 'Some'; 'Class' ] .local pmc instance instance = new [ 'Some'; 'Class' ] foo( instance ) end .end .sub 'foo' :multi( [ 'Some'; 'Class' ]) print "Called multi for class\n" .end .sub 'foo' :multi(_) print "Called wrong multi\n" .end CODE Called multi for class OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "unicode sub names and multi" ); .sub utf8:"\u7777" :multi(string) .param pmc arg print 'String:' say arg .end .sub utf8:"\u7777" :multi(int) .param pmc arg print 'Int:' say arg .end .sub main :main utf8:"\u7777"('what') utf8:"\u7777"(23) .end CODE String:what Int:23 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "autoboxing on multis" ); .sub box_me_up :multi(string) .param string first .param pmc second .local string promoted_type promoted_type = typeof second print "BMU autobox type: " print promoted_type print "\n" .end .sub box_me_up :multi() print "BMU no autobox, so sad\n" .end .sub box_me_up :multi(int, int) print "BMU inty, so bad\n" .end .sub main :main box_me_up( 'foo', 'bar' ) .end CODE BMU autobox type: String OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', '_ matches native types' ); .sub main :main .local pmc asub asub = get_global 'main' foo('world', asub) # should call :multi(_, Sub) .end .sub foo :multi(_, Sub) .param pmc x .param pmc y print x print " " say ":multi(_, Sub)" .end .sub foo :multi(Integer, Sub) .param int x .param pmc y print x print " " say ":multi(int, Sub)" .end CODE world :multi(_, Sub) OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', 'type mix with _' ); .sub main :main $P0 = new ['Integer'] $P0 = 3 'foo'($P0) 'foo'(2) 'foo'("1") $P0 = new ['String'] $P0 = "0" 'foo'($P0) $P0 = new ['Hash'] 'foo'($P0) .end .sub 'foo' :multi(Integer) .param pmc i print "foo(Integer)\n" .end .sub 'foo' :multi(_) .param pmc i print "foo(_)\n" .end .sub 'foo' :multi(int) .param int i print "foo(int)\n" .end .sub 'foo' :multi(String) .param pmc i print "foo(String)\n" .end .sub 'foo' :multi(string) .param string i print "foo(string)\n" .end CODE foo(Integer) foo(int) foo(string) foo(String) foo(_) OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', ':multi with :outer' ); .sub main :main new $P0, ['String'] assign $P0, 'arg0' new $P1, ['String'] assign $P1, 'arg1' $P99 = "foo"($P0) $P99 = "foo"($P0, $P1) $P99 = "bar"($P0) $P99 = "bar"($P0, $P1) .end .sub "foo" :multi(_) .param pmc x print "foo(_) : " say x .return (x) .end .sub "foo" :multi(_,_) .param pmc x .param pmc y print "foo(_,_): " print x print " " say y .return (y) .end .sub "bar" :outer("main") :multi(_) .param pmc x print "bar(_) : " say x .return (x) .end .sub "bar" :outer("main") :multi(_,_) .param pmc x .param pmc y print "bar(_,_): " print x print " " say y .return (y) .end CODE foo(_) : arg0 foo(_,_): arg0 arg1 bar(_) : arg0 bar(_,_): arg0 arg1 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "multi-dispatch on PMCNULL" ); .sub main :main null $P0 foo($P0) .end .sub foo :multi(String) say "string" .end .sub foo :multi(_) say "any" .end CODE any OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "multi-dispatch with :optional" ); .sub 'main' :main foo('Hello') foo('Goodbye', 2) foo(1) foo(100, 200) .end .sub foo :multi(string) .param string s .param int i :optional .param int have_i :opt_flag say s unless have_i goto done say i done: .end .sub foo :multi(int) .param int x .param int i :optional .param int have_i :opt_flag say x unless have_i goto done say i done: .end CODE Hello Goodbye 2 1 100 200 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', '.autoboxed MMD with :optional' ); .sub 'main' :main foo('Hello') foo('Goodbye', 2) foo(1) foo(100, 200) foo(77.7) foo(77.7, 88.8) .end .sub foo :multi(String) .param pmc s .param pmc i :optional .param int have_i :opt_flag say s unless have_i goto done say i done: .end .sub foo :multi(Integer) .param pmc x .param pmc i :optional .param int have_i :opt_flag say x unless have_i goto done say i done: .end .sub foo :multi(Float) .param pmc x .param pmc i :optional .param int have_i :opt_flag say x unless have_i goto done say i done: .end CODE Hello Goodbye 2 1 100 200 77.7 77.7 88.8 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', 'more .autoboxed MMD with :optional' ); .sub 'main' :main foo('Hello', 'Hi') foo('Goodbye', 'Ta ta', 2) foo(1, 2) foo(100, 200, 400) foo(77.7, 88.8) foo(77.7, 88.8, 99.9) .end .sub foo :multi(String, String) .param pmc x .param pmc y .param pmc i :optional .param int have_i :opt_flag print x print y unless have_i goto done print i done: say '' .end .sub foo :multi(Integer, Integer) .param pmc x .param pmc y .param pmc i :optional .param int have_i :opt_flag print x print y unless have_i goto done print i done: say '' .end .sub foo :multi(Float, Float) .param pmc x .param pmc y .param pmc i :optional .param int have_i :opt_flag print x print y unless have_i goto done print i done: say '' .end CODE HelloHi GoodbyeTa ta2 12 100200400 77.788.8 77.788.899.9 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', 'Integer subclass and MMD - TT #784' ); .sub main :main .local pmc int_c int_c = get_class "Integer" .local pmc sub_c sub_c = subclass int_c, "MyInt" $P1 = new 'Integer' $P1 = 4 $P1 -= 3 say $P1 $P1 = new 'MyInt' $P1 = 4 $P1 -= 3 say $P1 .end CODE 1 1 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', 'int autoboxes to scalar - TT #1133' ); .sub 'foo' :multi(['scalar']) .param pmc x say "Scalar!" .end .sub 'foo' :multi() .param pmc x $I0 = isa x, 'scalar' print "Scalar? " say $I0 .end .sub 'main' :main 'foo'(1) $P0 = box 1 'foo'($P0) .end CODE Scalar! Scalar! OUTPUT # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: perldoc.pm000644000765000765 771612224663742 16737 0ustar00brucebruce000000000000parrot-5.9.0/config/auto# Copyright (C) 2001-2013, Parrot Foundation. =head1 NAME config/auto/perldoc - Check whether perldoc works =head1 DESCRIPTION Determines whether F exists on the system and, if so, which version of F it is. More specifically, we look for the F associated with the instance of F with which F was invoked. =cut package auto::perldoc; use strict; use warnings; use File::Temp qw (tempfile ); use File::Spec qw (catfile ); use base qw(Parrot::Configure::Step); use Parrot::Configure::Utils ':auto'; sub _init { my $self = shift; my %data; $data{description} = q{Is perldoc installed}; $data{result} = q{}; return \%data; } sub runstep { my ( $self, $conf ) = @_; my $cmd = File::Spec->catfile($conf->data->get('scriptdirexp_provisional'), q{perldoc}); my ( $fh, $filename ) = tempfile( UNLINK => 1 ); # try to execute 'perldoc perldoc' || 'perldoc Pod::Perldoc' to # read the documentation of perldoc my $content = capture_output("$cmd -ud $filename perldoc") || capture_output("$cmd -ud $filename Pod::Perldoc") || undef; return 1 unless defined( $self->_initial_content_check($conf, $content) ); my $version = $self->_analyze_perldoc($cmd, $filename, $content); _handle_version($conf, $version, $cmd); my $TEMP_pod_build = <<'E_NOTE'; # the following part of the Makefile was built by 'config/auto/perldoc.pm' E_NOTE opendir my $OPS, 'src/ops' or die "opendir ops: $!"; my @ops = sort grep { !/^\./ && /\.ops$/ } readdir $OPS; closedir $OPS; my $TEMP_pod = join q{ } => map { my $t = $_; $t =~ s/\.ops$/.pod/; "ops/$t" } @ops; my $new_perldoc = $conf->data->get('new_perldoc'); foreach my $ops (@ops) { my $pod = $ops; $pod =~ s/\.ops$/.pod/; if ( $new_perldoc ) { $TEMP_pod_build .= <<"END"; ops/$pod: ../src/ops/$ops \t\$(PERLDOC) -ud ops/$pod ../src/ops/$ops \t\$(CHMOD) 0644 ops/$pod \t\$(ADDGENERATED) "docs/\$\@" "[doc]" END } else { $TEMP_pod_build .= <<"END"; ops/$pod: ../src/ops/$ops \t\$(PERLDOC) -u ../ops/$ops > ops/$pod \t\$(CHMOD) 0644 ../ops/$pod \t\$(ADDGENERATED) "docs/\$\@" "[doc]" END } } $conf->data->set( TEMP_pod => $TEMP_pod, TEMP_pod_build => $TEMP_pod_build, ); return 1; } sub _initial_content_check { my $self = shift; my ($conf, $content) = @_; if (! defined $content) { $conf->data->set( has_perldoc => 0, new_perldoc => 0, perldoc => 'echo', TEMP_pod => '', TEMP_pod_build => '', ); $self->set_result('no'); return; } else { return 1; } } sub _analyze_perldoc { my $self = shift; my ($cmd, $tmpfile, $content) = @_; my $version; if ( $content =~ m/^Unknown option:/ ) { $content = capture_output("$cmd perldoc") || ''; if ($content =~ m/perldoc/) { $version = $self->_handle_old_perldoc(); } else { $version = $self->_handle_no_perldoc(); } } elsif ( open my $FH, '<', $tmpfile ) { local $/; $content = <$FH>; close $FH; $version = 2; $self->set_result('yes'); } else { $version = $self->_handle_no_perldoc(); } unlink $tmpfile; return $version; } sub _handle_old_perldoc { my $self = shift; $self->set_result('yes, old version'); return 1; } sub _handle_no_perldoc { my $self = shift; $self->set_result('failed'); return 0; } sub _handle_version { my ($conf, $version, $cmd) = @_; $conf->data->set( has_perldoc => $version != 0 ? 1 : 0, new_perldoc => $version == 2 ? 1 : 0 ); $conf->data->set( perldoc => $cmd ) if $version; return 1; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: chXX_hlls.pod000644000765000765 2655111533177634 20136 0ustar00brucebruce000000000000parrot-5.9.0/docs/book/draft=pod =head1 HLLs and Interoperation Z =head2 Parrot HLL Environment In the earliest days Parrot was designed to be the single-purpose backend for the Perl 6 language. It quickly blossomed beyond that, and now has a much grander purpose: to host all dynamic languages, and to host them together on a single platform. If we look back through the history of dynamic programming languages, they've had a more difficult time interoperating with each other then compiled languages have because compiled languages operate at the same machine-code level and typically can make use of the same application binary interface (ABI). With the right compiler settings, programs written in Visual Basic can interoperate with programs written in C N, which can call functions written in C++, in Ada, Fortran, Pascal and so on. To try to mix two common dynamic languages, like Perl and Python, or Ruby and PHP, you would need to write some kind of custom "glue" function to try to include an interpreter object from one language as a library for another language, and then write code to try and get the parser for one to interact nicely with the parser for the other. It's a nightmare, frankly, and you don't see it happen too often. In Parrot, the situation is different because high level languages (HLL) are almost all written with the PCT tools, and are compiled to the same PIR and PBC code. Once compiled into PBC, a library written in any HLL language can be loaded and called by any other HLL N. A language can have a syntax to include code snippets from other languages inline in the same file. We can write a binding for a popular library such as opengl or xlib once, and include that library into any language that needs it. Compare this to the current situation where a library like Gtk2 needs to have bindings for every language that wants to use it. In short, Parrot should make interoperation easier for everybody. This chapter is going to talk about HLLs, the way they operate, and the way they interoperate on Parrot. =head2 HLLs on Parrot =head2 Working with HLLs =head3 Fakecutables It's possible to turn compilers created with PCT into stand-alone executables that run without the Parrot executable. To do this, the compiler bytecode is linked together with a small driver program in C and the Parrot library, C X. These programs have been given a special name by the Parrot development community: I X. They're called fake because the PBC is not converted to native machine code like in a normal binary executable file, but instead is left in original PBC format. =head3 Compiler Objects The C opcode has two forms that are used with HLL compilers. The first form stores an object as a compiler object to be retrieved later, and the second form retrieves a stored compiler object for a given language. The exact type of compiler object stored with C can vary for each different language implementation, although most of the languages using PCT will have a common form. If a compiler object is in register C<$P0>, it can be stored using the following C syntax: =begin PIR_FRAGMENT compreg 'MyCompiler', $P0 =end PIR_FRAGMENT There are two built-in compiler objects: One for PIR and one for PASM. These two don't need to be stored first, they can simply be retrieved and used. The PIR and PASM compiler objects are Sub PMCs that take a single string argument and return an array PMC containing a list of all the compiled subroutines from the string. Other compiler objects might be different entirely, and may need to be used in different ways. A common convention is for a compiler to be an object with a C method. This is done with PCT-based compilers and for languages who use a stateful compiler. Compiler objects allow programs in Parrot to compile arbitrary code strings at runtime and execute them. This ability, to dynamically compile code that is represented in a string variable at runtime, is of fundamental importance to many modern dynamic languages. Here's an example using the PIR compiler: =begin PIR_FRAGMENT .local string code code = "..." $P0 = compreg 'PIR' # Get the compiler object $P1 = $P0(code) # Compile the string variable "code" =end PIR_FRAGMENT The returned value from invoking the compiler object is an array of PMCs that contains the various executable subroutines from the compiled source. Here's a more verbose example of this: =begin PIR_FRAGMENT $P0 = compreg 'PIR' $S0 = <<"END_OF_CODE" .sub 'hello' say 'hello world!' .end .sub 'goodbye' say 'goodbye world!' .end END_OF_CODE $P1 = $P0($S0) $P2 = $P1[0] # The sub "hello" $P3 = $P1[0] # The sub "goodbye" $P2() # "hello world!" $P3() # "goodbye world!" =end PIR_FRAGMENT Here's an example of a Read-Eval-Print-Loop (REPL) in PIR: =begin PIR .sub main $P0 = getinterp $P0 = $P0.'stdin_handle'() $P1 = compreg 'PIR' loop_top: $S0 = $P0.'readline'() $S0 = ".sub '' :anon\n" . $S0 $S0 = $S0 . "\n.end\n" $P2 = $P1($S0) $P2() goto loop_top .end =end PIR The exact list of HLL packages installed on your system may vary. Some language compiler packages will exist as part of the Parrot source code repository, but many will be developed and maintained separately. In any case, these compilers will typically need to be loaded into your program first, before a compiler object for them can be retrieved and used. =head2 HLL Namespaces Let's take a closer look at namespaces then we have in previous chapters. Namespaces, as we mentioned before can be nested to an arbitrary depth starting with the root namespace. In practice, the root namespace is not used often, and is typically left for use by the Parrot internals. Directly beneath the root namespace are the X HLL Namespaces, named after the HLLs that the application software is written in. HLL namespaces are all lower-case, such as "perl6", or "cardinal", or "pynie". By sticking to this convention, multiple HLL compilers can operate on Parrot simultaneously while staying completely oblivious to each other. =head2 HLL Mapping HLL mapping enables Parrot to use a custom data type for internal operations instead of using the normal built-in types. Mappings can be created with the C<"hll_map"> method of the interpreter PMC. =begin PIR_FRAGMENT $P0 = newclass "MyNewClass" # New type $P1 = get_class "ResizablePMCArray" # Built-in type $P2 = getinterp $P2.'hll_map'($P1, $P0) =end PIR_FRAGMENT With the mapping in place, anywhere that Parrot would have used a ResizablePMCArray it now uses a MyNewClass object instead. Here's one example of this: =begin PIR .sub 'MyTestSub' .param pmc arglist :slurpy # A MyNewClass array of args .return(arglist) .end =end PIR =head2 Interoperability Guidelines =head3 Libraries and APIs As a thought experiment, imagine a library written in Common Lisp that uses Common Lisp data types. We like this library, so we want to include it in our Ruby project and call the functions from Ruby. Immediately we might think about writing a wrapper to convert parameters from Ruby types into Common Lisp types, and then to convert the Common Lisp return values back into Ruby types. This seems sane, and it would probably even work well. Now, expand this to all the languages on Parrot. We would need wrappers or converters to allow every pair of languages to communicate, which requires C libraries to make it work! As the number of languages hosted on the platform increases, this clearly becomes an untenable solution. So, what do we do? How do we make very different languages like Common Lisp, Ruby, Scheme, PHP, Perl and Python to interoperate with each other at the data level? There are two ways: =over 4 =item * VTable Functions VTable functions are the standard interface for PMC data types, and all PMCs have them. If the PMCs were written properly to satisfy this interface all the necessary information from those PMCs. Operate on the PMCs at the VTable level, and we can safely ignore the implementation details of them. =item * Class Methods If a library returns data in a particular format, the library reuser should know, understand, and make use of that format. Classes written in other languages will have a whole set of documented methods to be interfaced with and the reuser of those classes should use those methods. This only works, of course, in HLLs that allow object orientation and classes and methods, so for languages that don't have this the vtable interface should be used instead. =back =head3 Mixing and Matching Datatypes =head2 Linking and Embedding Not strictly a topic about HLLs and their interoperation, but it's important for us to also mention another interesting aspect of Parrot: Linking and embedding. We've touched on one related topic above, that of creating the compiler fakecutables. The fakecutables contain a link to C, which contains all the necessary guts of Parrot. When the fakecutable is executed, a small driver program loads the PBC data into libparrot through its API functions. The Parrot executable is just one small example of how Parrot's functionality can be implemented, and we will talk about a few other ways here too. =head3 Embedding Parrot C is a library that can be statically or dynamically linked to any other executable program that wants to use it. This linking process is known as I, and is a great way to interoperate =head3 Creating and Interoperating Interpreters Parrot's executable, which is the interface which most users are going to be familiar with, uses a single interpreter structure to perform a single execution task. However, this isn't the only supported structural model that Parrot supports. In fact, the interpreter structure is not a singleton, and multiple interpreters can be created by a single program. This allows separate tasks to be run in separate environments, which can be very helpful if we are writing programs and libraries in multiple languages. Interpreters can communicate and share data between each other, and can run independently from others in the same process. =head3 Small, Toy, and Domain-Specific Languages How many programs are out there with some sort of scripting capability? You can probably name a few off the top of your head with at least some amount of scripting or text-based commands. In developing programs like this, typically it's necessary to write a custom parser for the input commands, and a custom execution engine to make the instructions do what they are intended to do. Instead of doing all this, why not embed an instance of Parrot in the program, and let Parrot handle the parsing and executing details? Small scripting components which are not useful in a general sense like most programming languages, and are typically limited to use in very specific environments (such as within a single program) are called I (DSL). DSLs are a very popular topic because a DSL allows developers to create a custom language that makes dealing with a given problem space or data set very easy. Parrot and its suite of compiler tools in turn make creating the DSLs very easy. It's all about ease of use. =head3 Parrot API =cut # Local variables: # c-file-style: "parrot" # End: # vim: expandtab shiftwidth=4: HTMLPage.pm000644000765000765 605311715102033 17312 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/Docs# Copyright (C) 2004-2011, Parrot Foundation. =head1 NAME Parrot::Docs::HTMLPage - HTML Documentation Page =head1 DESCRIPTION C gives Parrot documentation pages the Parrot house-style. This just provides C and C class methods for now, to prevent code being duplicated in C and C. =head2 Class Methods =over =cut package Parrot::Docs::HTMLPage; use strict; use warnings; =item C Returns the page header with the specified title and navigation bar. C<$resources> should be the relative path from the page to F, the image and CSS file directory. =cut sub header { my $self = shift; # Default values to keep warnings quiet in tests. my $title = shift || 'Untitled'; my $navigation = shift || ''; my $resources = shift || ''; my $version = shift || ''; my $breadcrumb = $navigation; $breadcrumb .= " » " if $navigation; $breadcrumb .= $title; <<"HEADER"; Parrot $version - $title FOOTER return $footer; } =back =cut 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: imcc.in000644000765000765 7411567202625 21674 0ustar00brucebruce000000000000parrot-5.9.0/t/tools/dev/headerizer/testlib%top{ /* HEADERIZER HFILE: none */ /* HEADERIZER STOP */ } abc_statement000644000765000765 232011533177634 22030 0ustar00brucebruce000000000000parrot-5.9.0/examples/languages/abc/t# if statement 1;if(1)2;3 1\n2\n3\n if with a true condition 1;if(0)2;3 1\n3\n if with a false condition 1;if(1<2)2;3 1\n2\n3\n if with a relational operator 1;if(3+4<8*2-10)2;3 1\n3\n if with < 1;if(3+4<8*2-9)2;3 1\n3\n if with < 1;if(3+4<8*2+10)2;3 1\n2\n3\n if with < 1;if(3+4<=8*2-10)2;3 1\n3\n if with <= 1;if(3+4<=8*2-9)2;3 1\n2\n3\n if with <= 1;if(3+4<=8*2+10)2;3 1\n2\n3\n if with <= 1;if(3+4==8*2-10)2;3 1\n3\n if with == 1;if(3+4==8*2-9)2;3 1\n2\n3\n if with == 1;if(3+4==8*2+10)2;3 1\n3\n if with == 1;if(3+4!=8*2-10)2;3 1\n2\n3\n if with != 1;if(3+4!=8*2-9)2;3 1\n3\n if with != 1;if(3+4!=8*2+10)2;3 1\n2\n3\n if with != 1;if(3+4>=8*2-10)2;3 1\n2\n3\n if with >= 1;if(3+4>=8*2-9)2;3 1\n2\n3\n if with >= 1;if(3+4>=8*2+10)2;3 1\n3\n if with >= 1;if(3+4>8*2-10)2;3 1\n2\n3\n if with > 1;if(3+4>8*2-9)2;3 1\n3\n if with > 1;if(3+4>8*2+10)2;3 1\n3\n if with > # for statement for(i=0;i<2;i++)i 0\n1\n simple for for(i=0;i<2;i++){i} 0\n1\n simple for with compound statement # while statement while(i<5)i++; 0\n1\n2\n3\n4\n simple while while(i<5){i++;} 0\n1\n2\n3\n4\n simple while with compound # compound statement { 1+2; 1*2; 1%2 } 3\n2\n1\n compound statement Git.pm000644000765000765 136112101554067 15611 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot# Copyright (C) 2012, Parrot Foundation. =head1 NAME Parrot::Git - Detect run-time Git support in a portable way =head1 SYNOPSIS use Parrot::Git qw/has_git/; if (has_git()){ # git magic } else { # so sad, no git } =head1 DESCRIPTION See if there is a Git binary available. =cut package Parrot::Git; use strict; use warnings; use lib qw( lib ); use base 'Exporter'; our @EXPORT_OK = qw/has_git/; sub has_git { my $to_dev_null = $^O =~ /Win/ ? "1> NUL 2>&1" : ">/dev/null 2>&1"; my $has_git = system("git --version $to_dev_null") == 0 ? 1 : 0 ; return $has_git; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: Button.pir000644000765000765 1144011533177636 21614 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library/SDL =head1 NAME SDL::Button - A multi state SDL Button =head1 SYNOPSIS # the image to use for the button $P0 = new 'String' $P0 = "filename/to/image.png" # create the button button = new ['SDL'; 'Button'], $P0 # set the position button.'xpos'( 10 ) button.'ypos'( 10 ) # set the number of states button.'states'( 2 ) # activate the second status (first is 0) button = 1 # draw the button button."draw"( screen ) =head1 DESCRIPTION A button uses an image containing several images representing different states of a button. You can change the button status at any time, the button will then be drawn differently. Please have a look at F for an example. =head1 METHODS An SDL::Button object has the following methods: =over 4 =cut .namespace ['SDL'; 'Button'] .sub __onload :load .local pmc class class = get_class ['SDL'; 'Button'] if_null class, define_class .return() define_class: newclass class, ['SDL'; 'Button'] addattribute class, 'image' addattribute class, 'status' addattribute class, 'states' addattribute class, 'rect' addattribute class, 'clicked' addattribute class, 'actions' .end =item button = new ID, name =cut .sub init_pmc :vtable :method .param pmc name $P0 = new ['SDL'; 'Image'], name setattribute self, 'image', $P0 $P0 = new 'Integer' $P0 = 0 setattribute self, 'status', $P0 $P0 = new 'Integer' $P0 = 1 setattribute self, 'states', $P0 $P0 = new ['SDL'; 'Rect'] setattribute self, 'rect', $P0 $P0 = new 'Integer' $P0 = 0 setattribute self, 'clicked', $P0 $P0 = new 'ResizablePMCArray' setattribute self, 'actions', $P0 .end =item set_integer_native =cut .sub set_integer_native :vtable :method .param int val $P0 = getattribute self, 'status' $P0 = val .end =item get_integer =cut .sub get_integer :vtable :method $P0 = getattribute self, 'status' $I0 = $P0 .return( $I0 ) .end =item states( count ) =cut .sub states :method .param int count $P0 = getattribute self, 'states' $P0 = count .end =item pos( x, y ) =cut .sub pos :method .param int x .param int y $P0 = getattribute self, 'rect' $P0.'x'( x ) $P0.'y'( y ) .end =item size( width, height ) =cut .sub size :method .param int w .param int h $P0 = getattribute self, 'rect' $P0.'width'( w ) $P0.'height'( h ) .end =item draw( screen ) =cut .sub draw :method .param pmc screen .local pmc image .local int status .local int states .local pmc drect .local pmc srect .local pmc clicked image = getattribute self, 'image' $P0 = getattribute self, 'status' status = $P0 $P0 = getattribute self, 'states' states = $P0 drect = getattribute self, 'rect' clicked = getattribute self, 'clicked' srect = new ['SDL'; 'Rect'] $I1 = drect.'height'() srect.'height'( $I1 ) $I1 = drect.'width'() srect.'width'( $I1 ) cmod $I0, status, states $I0 *= $I1 srect.'x'( $I0 ) $I1 = drect.'height'() $I0 = clicked $I0 *= $I1 srect.'y'( $I0 ) screen.'blit'( image, srect, drect ) screen.'update_rect'( drect ) .end =item click( x, y ) =cut .sub click :method .param int x .param int y .param int b .param pmc arg .local pmc rect .local pmc clicked rect = getattribute self, 'rect' clicked = getattribute self, 'clicked' $I0 = rect.'x'() if x < $I0 goto OUT $I1 = rect.'width'() $I0 += $I1 if x >= $I0 goto OUT $I0 = rect.'y'() if y < $I0 goto OUT $I1 = rect.'height'() $I0 += $I1 if y >= $I0 goto OUT $I0 = clicked if $I0 goto RAISE clicked = 1 branch OK RAISE: if b == 1 goto END self."raise"( arg ) clicked = 0 branch OK OUT: $I0 = clicked unless $I0 goto END clicked = 0 OK: .return( 1 ) END: .return( 0 ) .end =item raise( arg ) =cut .sub raise :method .param pmc arg .local int status .local pmc action $P0 = getattribute self, 'status' status = $P0 action = getattribute self, 'actions' $P0 = action[status] $P0( arg ) .end =item setAction( status, callback ) =cut .sub setAction :method .param int status .param pmc cb .local pmc action action = getattribute self, 'actions' action[status] = cb .end =back =head1 AUTHOR Jens Rieks Eparrot at jensbeimsurfen dot deE is the author and maintainer. Please send patches and suggestions to the Perl 6 Internals mailing list. =head1 COPYRIGHT Copyright (C) 2004-2008, Parrot Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: pdd21_namespaces.pod000644000765000765 4663412101554066 20245 0ustar00brucebruce000000000000parrot-5.9.0/docs/pdds# Copyright (C) 2005-2010, Parrot Foundation. =head1 PDD 21: Namespaces =head2 Abstract Description and implementation of Parrot namespaces. =head2 Description =over 4 =item - Namespaces should be stored under first-level namespaces corresponding to the HLL language name =item - Namespaces should be hierarchical =item - The C opcode takes a multidimensional hash key or an array of name strings =item - Namespaces follow the semantics of the HLL in which they're defined =item - exports follow the semantics of the library's language =item - Two interfaces: typed and untyped =back =head2 Definitions =head3 "HLL" A High Level Language, such as Perl, Python, or Tcl, in contrast to PIR, which is a low-level language. =head3 "current namespace" The I at runtime is the namespace associated with the currently executing subroutine. PASM assigns each subroutine a namespace when compilation of the subroutine begins. Don't change the associated namespace of a subroutine unless you're prepared for weird consequences. (PASM also has its own separate concept of current namespace which is used to initialize the runtime current namespace as well as determine where to store compiled symbols.) =head2 Implementation =head3 Namespace Indexing Syntax Namespaces are denoted in Parrot as simple strings, multidimensional hash keys, or arrays of name strings. A namespace may appear in Parrot source code as the string C<"a"> or the key C<["a"]>. A nested namespace "b" inside the namespace "a" will appear as the key C<["a"; "b"]>. There is no limit to namespace nesting. =head3 Naming Conventions Parrot's target languages have a wide variety of namespace models. By implementing an API and standard conventions, it should be possible to allow interoperability while still allowing each one to choose the best internal representation. =over 4 =item True Root Namespace The true root namespace is hidden from common usage, but it is available via the C opcode. For example: $P0 = get_root_namespace This root namespace stringifies to the empty string. =item HLL Root Namespaces Each HLL must store public items in a namespace named with the lowercased name of the HLL. This is the HLL root namespace. For instance, Tcl's user-created namespaces should live in the C namespace. This eliminates any accidental collisions between languages. An HLL root namespace must be stored at the first level in Parrot's namespace hierarchy. These top-level namespaces should also be specified in a standard unicode encoding. The reasons for these restrictions is to allow compilers to remain completely ignorant of each other. Parrot internals are stored in the default HLL root namespace C. =item HLL Implementation Namespaces Each HLL must store implementation internals (private items) in an HLL root namespace named with an underscore and the lowercased name of the HLL. For instance, Tcl's implementation internals should live in the C<_tcl> namespace. =item HLL User-Created Namespaces Each HLL must store all user-created namespaces under the HLL root namespace. It is suggested that HLLs use hierarchical namespaces to practical extent. A single flat namespace can be made to work, but it complicates symbol exportation. =back =head3 Namespace PMC API Most languages leave their symbols plain, which makes lookups quite straightforward. Others use sigils or other mangling techniques, complicating the problem of interoperability. Parrot namespaces assist with interoperability by providing two interface subsets: the I and the I. =head4 Untyped Interface Each HLL may, when working with its own namespace objects, use the I, which allows direct naming in the native style of the namespace's HLL. This interface consists of the standard Parrot hash interface, with all its keys, values, lookups, deletions, etc. Just treat the namespace like a hash. (It probably is one, really, deep down.) The untyped interface also has one method: =over 4 =item C =begin PIR_FRAGMENT $P1 = $P2.'get_name'() =end PIR_FRAGMENT Gets the name of the namespace $P2 as an array of strings. For example, if $P2 is a Perl 5 namespace "Some::Module", within the Perl 5 HLL, then get_name() on $P2 returns an array of "perl5", "Some", "Module". It returns the literal namespace names as the HLL stored them, without filtering for name mangling. NOTE: Due to aliasing, this value may be wrong -- i.e. it may disagree with the namespace name with which you found the namespace in the first place. =back =head4 Typed Interface When a given namespace's HLL is either different from the current HLL or unknown, an HLL should generally use only the language-agnostic namespace interface. This interface isolates HLLs from each others' naming quirks. It consists of C, C, and C methods, for values of "foo" including "sub" (something executable), "namespace" (something in which to find more names), and "var" (anything). NOTE: The job of the typed interface is to bridge I differences, and I naming differences. Therefore: 1) It does not enforce, nor even notice, the interface requirements of "sub" or "namespace": e.g. execution of C does I automatically guarantee that $P0 is an invokable subroutine; and 2) it does not prevent overwriting one type with another. =over 4 =item C =begin PIR_FRAGMENT $P1.'add_namespace'($S2, $P3) =end PIR_FRAGMENT Store $P3 as a namespace under the namespace $P1, with the name of $S2. =item C =begin PIR_FRAGMENT $P1.'add_sub'($S2, $P3) =end PIR_FRAGMENT Store $P3 as a subroutine with the name of $S2 in the namespace $P1. =item C =begin PIR_FRAGMENT $P1.'add_var'($S2, $P3) =end PIR_FRAGMENT Store $P3 as a variable with the name of $S2 in the namespace $P1. IMPLEMENTATION NOTE: Perl namespace implementations may choose to implement add_var() by checking which parts of the variable interface are implemented by $P0 (scalar, array, and/or hash) so it can decide on an appropriate sigil. =item C, C, C =begin PIR_FRAGMENT $P1.'del_namespace'($S2) $P1.'del_sub'($S2) $P1.'del_var'($S2) =end PIR_FRAGMENT Delete the sub, namespace, or variable named $S2 from the namespace $P1. =item C, C, C =begin PIR_FRAGMENT $P1 = $P2.'find_namespace'($S3) $P1 = $P2.'find_sub'($S3) $P1 = $P2.'find_var'($S3) =end PIR_FRAGMENT Find the sub, namespace, or variable named $S3 in the namespace $P2. IMPLEMENTATION NOTE: Perl namespace implementations should implement find_var() to check all variable sigils, but the order is not to be counted on by users. If you're planning to let Python code see your module, you should avoid exporting both C and C. (Well, you might want to consider not exporting variables at all, but that's a style issue.) =item C =begin PIR_FRAGMENT $P1.'export_to'($P2, $P3) =end PIR_FRAGMENT Export items from the namespace $P1 into the namespace $P2. The items to export are named in $P3, which may be an array of strings, a hash, or null. If $P3 is an array of strings, interpretation of items in an array follows the conventions of the source (exporting) namespace. If $P3 is a hash, the keys correspond to the names in the source namespace, and the values correspond to the names in the destination namespace. If a hash value is null or an empty string, the name in the hash key is used. A null $P3 requests the 'default' set of items. Any other type passed into $P3 throws an exception. The base Parrot namespace export_to() function interprets item names as literals -- no wildcards or other special meaning. There is no default list of items to export, so $P3 of null and $P3 of an empty array have the same behavior. NOTE: Exportation may entail non-obvious, odd, or even mischievous behavior. For example, Perl's pragmata are implemented as exports, and they don't actually export anything. IMPLEMENTATION EXAMPLES: Suppose a Perl program were to import some Tcl module with an import pattern of "c*" -- something that might be expressed in Perl 6 as C. This operation would import all the commands that start with 'c' from the given Tcl namespace into the current Perl namespace. This is so because, regardless of whether 'c*' is a Perl 6 style export pattern, it I a valid Tcl export pattern. {XXX - The ':' for HLL is just proposed. This example will need to be updated later.} IMPLEMENTATION NOTE: Most namespace C implementations will restrict themselves to using the typed interface on the target namespace. However, they may also decide to check the type of the target namespace and, if it turns out to be of a compatible type, to use same-language shortcuts. DESIGN TODO: Figure out a good convention for a default export list in the base namespace PMC. Maybe a standard method "expand_export_list()"? =back =head3 Compiler PMC API =head4 Methods =over 4 =item C =begin PIR_FRAGMENT $P1 = $P2.'parse_name'($S3) =end PIR_FRAGMENT Parse the name in $S3 using the rules specific to the compiler $P2, and return an array of individual name elements. For example, a Java compiler would turn 'C' to C<['a','b','c']>, while a Perl compiler would turn 'C' into the same result. Meanwhile, due to Perl's sigil rules, 'C<$a::b::c>' would become C<['a','b','$c']>. =item C =begin PIR_FRAGMENT $P1 = $P2.'get_namespace'($P3) =end PIR_FRAGMENT Ask the compiler $P2 to find its namespace which is named by the elements of the array in $P3. If $P3 is a null PMC or an empty array, C retrieves the base namespace for the HLL. It returns a namespace PMC on success and a null PMC on failure. This method allows other HLLs to know one name (the HLL) and then work with that HLL's modules without having to know the name it chose for its namespace tree. (If you really want to know the name, the get_name() method should work on the returned namespace PMC.) Note that this method is basically a convenience and/or performance hack, as it does the equivalent of C followed by zero or more calls to .get_namespace(). However, any compiler is free to cheat if it doesn't get caught, e.g. to use the untyped namespace interface if the language doesn't mangle namespace names. =item C =begin PIR_FRAGMENT $P1.'load_library'($P2, $P3) =end PIR_FRAGMENT Ask this compiler to load a library/module named by the elements of the array in $P2, with optional control information in $P3. For example, Perl 5's module named "Some::Module" should be loaded using (in pseudo Perl 6): C. The meaning of $P3 is compiler-specific. The only universal legal value is Null, which requests a "normal" load. The meaning of "normal" varies, but the ideal would be to perform only the minimal actions required. On failure, an exception is thrown. =back =head3 Subroutine PMC API Some information must be available about subroutines to implement the correct behavior about namespaces. =head4 Methods =over 4 =item C =begin PIR_FRAGMENT $P1 = $P2.'get_namespace'() =end PIR_FRAGMENT Retrieve the namespace $P1 where the subroutine $P2 was defined. (As opposed to the namespace(s) that it may have been exported to.) =back =head3 Namespace Opcodes The namespace opcodes all have 3 variants: one that operates from the currently selected namespace (i.e. the namespace of the currently executing subroutine), one that operates from the HLL root namespace (identified by "hll" in the opcode name), and one that operates from the true root namespace (identified by "root" in the name). =over 4 =item C =begin PIR_FRAGMENT_INVALID set_namespace ['key'], $P1 set_hll_namespace ['key'], $P1 set_root_namespace ['key'], $P1 =end PIR_FRAGMENT_INVALID Add the namespace PMC $P1 under the name denoted by a multidimensional hash key. =begin PIR_FRAGMENT_INVALID set_namespace $P1, $P2 set_hll_namespace $P1, $P2 set_root_namespace $P1, $P2 =end PIR_FRAGMENT_INVALID Add the namespace PMC $P2 under the name denoted by an array of name strings $P1. =item C =begin PIR_FRAGMENT $P1 = get_namespace $P1 = get_hll_namespace $P1 = get_root_namespace =end PIR_FRAGMENT Retrieve the current namespace, the HLL root namespace, or the true root namespace and store it in $P1. =begin PIR_FRAGMENT_INVALID $P1 = get_namespace [key] $P1 = get_hll_namespace [key] $P1 = get_root_namespace [key] =end PIR_FRAGMENT_INVALID Retrieve the namespace denoted by a multidimensional hash key and store it in C<$P1>. =begin PIR_FRAGMENT $P1 = get_namespace $P2 $P1 = get_hll_namespace $P2 $P1 = get_root_namespace $P2 =end PIR_FRAGMENT Retrieve the namespace denoted by the array of names $P2 and store it in C<$P1>. Thus, to get the "Foo::Bar" namespace from the top-level of the HLL if the name was known at compile time, you could retrieve the namespace with a key: =begin PIR_FRAGMENT $P0 = get_hll_namespace ["Foo"; "Bar"] =end PIR_FRAGMENT If the name was not known at compile time, you would retrieve the namespace with an array instead: =begin PIR_FRAGMENT $P1 = split "::", "Foo::Bar" $P0 = get_hll_namespace $P1 =end PIR_FRAGMENT =item C =begin PIR_FRAGMENT_INVALID $P1 = make_namespace [key] $P1 = make_hll_namespace [key] $P1 = make_root_namespace [key] =end PIR_FRAGMENT_INVALID Create and retrieve the namespace denoted by a multidimensional hash key and store it in C<$P1>. If the namespace already exists, only retrieve it. =begin PIR_FRAGMENT_INVALID $P1 = make_namespace $P2 $P1 = make_hll_namespace $P2 $P1 = make_root_namespace $P2 =end PIR_FRAGMENT_INVALID Create and retrieve the namespace denoted by the array of names $P2 and store it in C<$P1>. If the namespace already exists, only retrieve it. =item C =begin PIR_FRAGMENT $P1 = get_global $S2 $P1 = get_hll_global $S2 $P1 = get_root_global $S2 =end PIR_FRAGMENT Retrieve the symbol named $S2 in the current namespace, HLL root namespace, or true root namespace. =begin PIR_FRAGMENT .local pmc key $P1 = get_global [key], $S2 $P1 = get_hll_global [key], $S2 $P1 = get_root_global [key], $S2 =end PIR_FRAGMENT Retrieve the symbol named $S2 by a multidimensional hash key relative to the current namespace, HLL root namespace, or true root namespace. =begin PIR_FRAGMENT $P1 = get_global $P2, $S3 $P1 = get_hll_global $P2, $S3 $P1 = get_root_global $P2, $S3 =end PIR_FRAGMENT Retrieve the symbol named $S3 by the array of names $P2 relative to the current namespace, HLL root namespace, or true root namespace. =item C =begin PIR_FRAGMENT set_global $S1, $P2 set_hll_global $S1, $P2 set_root_global $S1, $P2 =end PIR_FRAGMENT Store $P2 as the symbol named $S1 in the current namespace, HLL root namespace, or true root namespace. =begin PIR_FRAGMENT .local pmc key set_global [key], $S1, $P2 set_hll_global [key], $S1, $P2 set_root_global [key], $S1, $P2 =end PIR_FRAGMENT Store $P2 as the symbol named $S1 by a multidimensional hash key, relative to the current namespace, HLL root namespace, or true root namespace. If the given namespace does not exist it is created. =begin PIR_FRAGMENT set_global $P1, $S2, $P3 set_hll_global $P1, $S2, $P3 set_root_global $P1, $S2, $P3 =end PIR_FRAGMENT Store $P3 as the symbol named $S2 by the array of names $P1, relative to the current namespace, HLL root namespace, or true root namespace. If the given namespace does not exist it is created. =back =head3 HLL Namespace Mapping In order to make this work, Parrot must somehow figure out what type of namespace PMC to create. =head4 Default Namespace The default namespace PMC will implement Parrot's current behavior. =head4 Compile-time Creation This Perl: #!/usr/bin/perl package Foo; $x = 5; should map roughly to this PIR: =begin PIR_INVALID .HLL "Perl5" .loadlib "perl5_group" .namespace [ "Foo" ] .sub main :main $P0 = new 'PerlInt' $P0 = 5 set_global "$x", $P0 .end =end PIR_INVALID In this case, the C
sub would be tied to Perl 5 by the C<.HLL> directive, so a Perl 5 namespace would be created. =head4 Run-time Creation Consider the following Perl 5 program: #!/usr/bin/perl $a = 'x'; ${"Foo::$a"} = 5; The C namespace is created at run-time (without any optimizations). In these cases, Parrot should create the namespace based on the HLL of the PIR subroutine that calls the store function. =begin PIR_INVALID .HLL "Perl5" .loadlib "perl5_group" .sub main :main # $a = 'x'; $P0 = new 'PerlString' $P0 = "x" set_global "$a", $P0 # ${"Foo::$a"} = 5; $P1 = new 'PerlString' $P1 = "Foo::" $P1 .= $P0 $S0 = $P1 $P2 = split "::", $S0 $S0 = pop $P2 $S0 = "$" . $S0 $P3 = new 'PerlInt' $P3 = 5 set_global $P2, $S0, $P3 .end =end PIR_INVALID In this case, C should see that it was called from "main", which is in a Perl 5 namespace, so it will create the "Foo" namespace as a Perl 5 namespace. =head2 Language Notes =head3 Perl 6 =head4 Sigils Perl 6 may wish to be able to access the namespace as a hash with sigils. That is certainly possible, even with subroutines and methods. It's not important that a HLL use the typed namespace API, it is only important that it provides it for others to use. So Perl 6 may implement C and C VTABLE slots that allow the namespace PMC to be used as a hash. The C method would, in this case, append a "&" sigil to the front of the sub/method name and search in the internal hash. =head3 Python =head4 Importing from Python Since functions and variables overlap in Python's namespaces, when exporting to another HLL's namespace, the Python namespace PMC's C method should use introspection to determine whether C should be added using C or C. C<$I0 = does $P0, "Sub"> may be enough to decide correctly. =head4 Subroutines and Namespaces Since Python's subroutines and namespaces are just variables (the namespace collides there), the Python PMC's C method may return subroutines as variables. =head3 Examples =head4 Aliasing Perl: #!/usr/bin/perl6 sub foo {...} %Foo::{"&bar"} = &foo; PIR: =begin PIR .sub main :main $P0 = get_global "&foo" $P1 = get_namespace ["Foo"] # A smart perl6 compiler would emit this, # because it knows that Foo is a perl6 namespace: $P1["&bar"] = $P0 # But a naive perl6 compiler would emit this: $P1.'add_sub'("bar", $P0) .end .sub foo #... .end =end PIR =head4 Cross-language Exportation Perl 5: #!/usr/bin/perl use tcl:Some::Module 'w*'; # XXX - ':' after HLL may change in Perl 6 write("this is a tcl command"); PIR (without error checking): =begin PIR .sub main :main .local pmc tcl .local pmc ns tcl = compreg "tcl" ns = new 'Array' ns = 2 ns[0] = "Some" ns[1] = "Module" null $P0 tcl.'load_library'(ns, $P0) $P0 = tcl.'get_namespace'(ns) $P1 = get_namespace $P0.'export_to'($P1, 'w*') "write"("this is a tcl command") .end =end PIR =head2 References None. =cut __END__ Local Variables: fill-column:78 End: vim: expandtab shiftwidth=4: stress_stringsu.pir000644000765000765 200212101554066 22433 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks# Copyright (C) 2010-2012, Parrot Foundation. =head1 NAME examples/benchmarks/stress_stringsu.pir - GC unicode strings stress-testing =head1 SYNOPSIS % time ./parrot examples/benchmarks/stress_stringsu.pir =head1 DESCRIPTION Create encoded strings, running through the imcc optimizer, which reencodes the strings. Some of the strings are long-lived, most of them are short lived. Main purpose - test encoding issues and imcc performance. [GH #873] =cut .sub 'main' :main .local pmc rsa # array of long lived strings. .local pmc args .local int i rsa = new ['ResizableStringArray'] args = new ['ResizablePMCArray'] i = 0 push args, i loop: $S0 = utf8:"\x{a2}" args[0] = i sprintf $S1, "%d", args $S2 = concat $S0, $S1 $I0 = i % 10 # every 10th string is longlived if $I0 goto inc_i push rsa, $S2 inc_i: inc i if i < 10000000 goto loop .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: Rules.mak000644000765000765 106312101554067 16374 0ustar00brucebruce000000000000parrot-5.9.0/ext/winxed# Build winxed snapshot. $(WINXED_LANG): ext/winxed/compiler.pir $(PARROT) $(MKPATH) runtime/parrot/languages/winxed $(PARROT) -o $@ ext/winxed/compiler.pir @$(ADDGENERATED) "$@" "[winxed]" winxed.pbc: ext/winxed/driver.pir $(PARROT) $(PARROT) -o $@ ext/winxed/driver.pir $(WINXED) : winxed.pbc $(PBC_TO_EXE) $(WINXED_LANG) $(PBC_TO_EXE) winxed.pbc $(INSTALLABLEWINXED) : winxed.pbc src/install_config$(O) $(PBC_TO_EXE) $(PBC_TO_EXE) winxed.pbc --install @$(ADDGENERATED) "$@" "[main]" bin # Local variables: # mode: makefile # End: # vim: ft=make: pcc_methods.pod000644000765000765 1021712101554066 17234 0ustar00brucebruce000000000000parrot-5.9.0/docs/dev# Copyright (C) 2007-2012, Parrot Foundation. =head1 NAME docs/dev/pcc_methods.pod - Parrot Calling Conventions in C =head1 DESCRIPTION This document address issues relating to C and the Parrot Calling Conventions. =head1 OVERVIEW A C is a PMC method that follows the Parrot Calling Conventions (a.k.a. PCC). This allows PIR code to call PMC methods using slurpy, named, and other types of arguments as specified in I. This offers flexibility not found in a PMC C or a vtable function using C calling conventions. C is used to call a method using the Parrot Calling Conventions. It uses the standard C/C approach that the C opcode would. You can use C in any PMC method (including vtable methods), even if they are not C's. You can call methods that are not implemented with C, too. =head1 SYNTAX =head2 C To declare that a method in a PMC should take arguments using the Parrot Calling Conventions, prefix its name with the keyword C. The PCC parameter list is put where you would normally put the C parameter list. Do not specify a return type for C's; the true signature of the return is specified inside the method using C, described below. PCCMETHOD PlayRandomSong() { ... } PCCMETHOD PlaySong(STRING *artist, STRING *title) { ... } For full details of the parameter list syntax, see L. =head2 C To return arguments using the Parrot Calling Conventions, which you should do if you have implemented a C (unless it returns no arguments, of course), use the C keyword. This takes a signature as specified in the L section. RETURN(PMC *status, INTVAL count); =head2 C To call a method on an object using the Parrot Calling Conventions, use C. It takes 3 arguments, followed by the signature of the call and the arguments as specified in the L section. The first three arguments, in order, are: =over 4 =item * The current interpreter; use C in a PMC. =item * The object to call the method on. Use the C macro for the current PMC. =item * The double-quoted name of the method to call. =back Any return arguments appear, with the return signature, to the left of the call and in parentheses. For example: PCCINVOKE(interp, monkey, "eat", PMC* banana); (PMC *pooh) = PCCINVOKE(interp, monkey, "excrete"); (PMC *status, INTVAL count) = PCCINVOKE(interp, player, "PlaySong", artist, title); PCCINVOKE(interp, SELF, value :named("key") :optional) =head2 Parameter List Syntax The syntax for a PCC parameter list is a comma separated list of zero or more parameters. Each parameter takes the form: { INTVAL | NUMVAL | STRING* | PMC* } NAME [ ADVERBS ] That is, a register type, followed by a name, optionally followed by one or more flags specified as adverbs. The list of supported adverbs is listed in F, the calling conventions design document. Note that unlike PIR, single quotes I be used to quote values in C-based PCC calls. Also note that in line with the Parrot code standards, you should put the pointer symbol next to the variable, PMC *param :optional # Good not next to the type. PMC* param :optional # Bad =head1 OTHER CONSIDERATIONS =head2 Performance When a C or vtable function is called, C is used to map the arguments held in the current C into the C calling conventions. That is, you still end up involving the Parrot Calling Conventions anyway, so there is no reason to expect a C to be any slower. It may well be faster. It's probably best to just not care. :-) It is clearly true that C is going to be more costly than an invocation of a C function from another C function, if you do the call directly at the C level. However, if you do that, you are ignoring any method overrides if you have been subclassed and you wouldn't want to do that now, would you? =cut __END__ Local Variables: fill-column:78 End: vim: expandtab shiftwidth=4: instructions.c000644000765000765 3623211716253435 20366 0ustar00brucebruce000000000000parrot-5.9.0/compilers/imcc/* * Copyright (C) 2002-2010, Parrot Foundation. */ #include #include #define _PARSER #include "imc.h" #include "pbc.h" #include "optimizer.h" #include "pmc/pmc_callcontext.h" #include "parrot/oplib/core_ops.h" /* =head1 NAME compilers/imcc/instructions.c =head1 DESCRIPTION When generating the code, the instructions of the program are stored in an array. After the register allocation is resolved, the instructions array is flushed. These functions operate over this array and its contents. =head2 Functions =over 4 =cut */ /* HEADERIZER HFILE: compilers/imcc/instructions.h */ /* HEADERIZER BEGIN: static */ /* HEADERIZER END: static */ static const char types[] = "INPS"; /* =item C Creates a new instruction =cut */ PARROT_MALLOC PARROT_CANNOT_RETURN_NULL Instruction * _mk_instruction(ARGIN(const char *op), ARGIN(const char *fmt), int n, ARGIN(SymReg * const *r), int flags) { ASSERT_ARGS(_mk_instruction) const size_t reg_space = (n > 1) ? (sizeof (SymReg *) * (n - 1)) : 0; Instruction * const ins = (Instruction*)mem_sys_allocate_zeroed(sizeof (Instruction) + reg_space); int i; ins->opname = mem_sys_strdup(op); ins->format = mem_sys_strdup(fmt); ins->symreg_count = n; for (i = 0; i < n; i++) ins->symregs[i] = r[i]; ins->flags = flags; ins->op = NULL; return ins; } /* =item C next two functions are called very often, says gprof they should be fast =cut */ int instruction_reads(ARGIN(const Instruction *ins), ARGIN(const SymReg *r)) { ASSERT_ARGS(instruction_reads) int f, i; op_lib_t *core_ops = PARROT_GET_CORE_OPLIB(NULL); if (ins->op && ins->op->lib == core_ops) { if (OP_INFO_OPNUM(ins->op) == PARROT_OP_set_args_pc || OP_INFO_OPNUM(ins->op) == PARROT_OP_set_returns_pc) { for (i = ins->symreg_count - 1; i >= 0; --i) if (r == ins->symregs[i]) return 1; return 0; } else if (OP_INFO_OPNUM(ins->op) == PARROT_OP_get_params_pc || OP_INFO_OPNUM(ins->op) == PARROT_OP_get_results_pc) { return 0; } } f = ins->flags; for (i = ins->symreg_count - 1; i >= 0; --i) { if (f & (1 << i)) { const SymReg * const ri = ins->symregs[i]; if (ri == r) return 1; /* this additional test for _kc ops seems to slow * down instruction_reads by a huge amount compared to the * _writes below */ if (ri->set == 'K') { const SymReg *key; for (key = ri->nextkey; key; key = key->nextkey) if (key->reg == r) return 1; } } } /* a sub call reads the previous args */ if (ins->type & ITPCCSUB) { while (ins && ins->op != &core_ops->op_info_table[PARROT_OP_set_args_pc]) ins = ins->prev; if (!ins) return 0; for (i = ins->symreg_count - 1; i >= 0; --i) { if (ins->symregs[i] == r) return 1; } } return 0; } /* =item C Determines whether the instruction C writes to the SymReg C. Returns 1 if it does, 0 if not. =cut */ int instruction_writes(ARGIN(const Instruction *ins), ARGIN(const SymReg *r)) { ASSERT_ARGS(instruction_writes) const int f = ins->flags; int j; op_lib_t *core_ops = PARROT_GET_CORE_OPLIB(NULL); /* a get_results opcode occurs after the actual sub call */ if (ins->op == &core_ops->op_info_table[PARROT_OP_get_results_pc]) { int i; /* but only if it isn't the get_results opcode of * an ExceptionHandler, which doesn't have * a call next */ if (ins->prev && (ins->prev->type & ITPCCSUB)) return 0; for (i = ins->symreg_count - 1; i >= 0; --i) { if (ins->symregs[i] == r) return 1; } return 0; } else if (ins->type & ITPCCSUB) { int i; ins = ins->prev; /* can't used pcc_sub->ret due to bug #38406 * it seems that all sub SymRegs are shared * and point to the most recent pcc_sub * structure */ while (ins && ins->op != &core_ops->op_info_table[PARROT_OP_get_results_pc]) ins = ins->next; if (!ins) return 0; for (i = ins->symreg_count - 1; i >= 0; --i) { if (ins->symregs[i] == r) return 1; } return 0; } if (ins->op == &core_ops->op_info_table[PARROT_OP_get_params_pc]) { int i; for (i = ins->symreg_count - 1; i >= 0; --i) { if (ins->symregs[i] == r) return 1; } return 0; } else if (ins->op == &core_ops->op_info_table[PARROT_OP_set_args_pc] || ins->op == &core_ops->op_info_table[PARROT_OP_set_returns_pc]) { return 0; } for (j = 0; j < ins->symreg_count; j++) if (f & (1 << (16 + j))) if (ins->symregs[j] == r) return 1; return 0; } /* =item C Get the register number of an address which is a branch target =cut */ int get_branch_regno(ARGIN(const Instruction *ins)) { ASSERT_ARGS(get_branch_regno) int j; for (j = ins->opsize - 2; j >= 0 && ins->symregs[j] ; --j) if (ins->type & (1 << j)) return j; return -1; } /* =item C Get the register corresponding to an address which is a branch target =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL SymReg * get_branch_reg(ARGIN(const Instruction *ins)) { ASSERT_ARGS(get_branch_reg) const int r = get_branch_regno(ins); if (r >= 0) return ins->symregs[r]; return NULL; } /* some useful instruction routines */ /* =item C Delete instruction ins. It's up to the caller to actually free the memory of ins, if appropriate. The instruction following ins is returned. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL Instruction * _delete_ins(ARGMOD(IMC_Unit *unit), ARGIN(Instruction *ins)) { ASSERT_ARGS(_delete_ins) Instruction * const next = ins->next; Instruction * const prev = ins->prev; if (prev) prev->next = next; else unit->instructions = next; if (next) next->prev = prev; else unit->last_ins = prev; return next; } /* =item C Delete instruction ins, and then free it. The instruction following ins is returned. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL Instruction * delete_ins(ARGMOD(IMC_Unit *unit), ARGMOD(Instruction *ins)) { ASSERT_ARGS(delete_ins) Instruction * next = _delete_ins(unit, ins); free_ins(ins); return next; } /* =item C Insert Instruction C in the execution flow after Instruction C. =cut */ void insert_ins(ARGMOD(IMC_Unit *unit), ARGMOD_NULLOK(Instruction *ins), ARGMOD(Instruction *tmp)) { ASSERT_ARGS(insert_ins) if (!ins) { Instruction * const next = unit->instructions; unit->instructions = tmp; tmp->next = next; if (next) { next->prev = tmp; tmp->line = next->line; } else { unit->last_ins = tmp; } } else { Instruction * const next = ins->next; ins->next = tmp; tmp->prev = ins; tmp->next = next; if (next) next->prev = tmp; else unit->last_ins = tmp; if (!tmp->line) tmp->line = ins->line; } } /* =item C Insert Instruction C into the execution flow before Instruction C. =cut */ void prepend_ins(ARGMOD(IMC_Unit *unit), ARGMOD_NULLOK(Instruction *ins), ARGMOD(Instruction *tmp)) { ASSERT_ARGS(prepend_ins) if (!ins) { Instruction * const next = unit->instructions; unit->instructions = tmp; tmp->next = next; next->prev = tmp; tmp->line = next->line; } else { Instruction * const prev = ins->prev; ins->prev = tmp; tmp->next = ins; tmp->prev = prev; if (prev) prev->next = tmp; if (!tmp->line) tmp->line = ins->line; } } /* =item C Substitute Instruction C for Instruction C. Free C if C is true. =cut */ void subst_ins(ARGMOD(IMC_Unit *unit), ARGMOD(Instruction *ins), ARGMOD(Instruction *tmp), int needs_freeing) { ASSERT_ARGS(subst_ins) Instruction * const prev = ins->prev; if (prev) prev->next = tmp; else unit->instructions = tmp; tmp->prev = prev; tmp->next = ins->next; if (ins->next) ins->next->prev = tmp; else unit->last_ins = tmp; if (tmp->line == 0) tmp->line = ins->line; if (needs_freeing) free_ins(ins); } /* =item C Move instruction ins from its current position to the position following instruction to. Returns the instruction following the initial position of ins. =cut */ PARROT_CAN_RETURN_NULL Instruction * move_ins(ARGMOD(IMC_Unit *unit), ARGMOD(Instruction *ins), ARGMOD(Instruction *to)) { ASSERT_ARGS(move_ins) Instruction * const next = _delete_ins(unit, ins); insert_ins(unit, to, ins); return next; } /* =item C Emit a single instruction into the current unit buffer. =cut */ PARROT_CAN_RETURN_NULL Instruction * emitb(ARGMOD(imc_info_t * imcc), ARGMOD_NULLOK(IMC_Unit *unit), ARGIN_NULLOK(Instruction *i)) { ASSERT_ARGS(emitb) if (!unit || !i) return NULL; if (!unit->instructions) unit->last_ins = unit->instructions = i; else { unit->last_ins->next = i; i->prev = unit->last_ins; unit->last_ins = i; } /* lexer is in next line already */ i->line = imcc->line; return i; } /* =item C Free the Instruction structure ins. =cut */ void free_ins(ARGMOD(Instruction *ins)) { ASSERT_ARGS(free_ins) mem_sys_free(ins->format); mem_sys_free(ins->opname); mem_sys_free(ins); } /* =item C Print details of instruction ins in file fd. =cut */ #define REGB_SIZE 256 PARROT_IGNORABLE_RESULT int ins_print(ARGMOD(imc_info_t * imcc), PIOHANDLE io, ARGIN(const Instruction *ins)) { ASSERT_ARGS(ins_print) char regb[IMCC_MAX_FIX_REGS][REGB_SIZE]; /* only long key constants can overflow */ char *regstr[IMCC_MAX_FIX_REGS]; int i; int len; /* comments, labels and such */ if (!ins->symregs[0] || !strchr(ins->format, '%')) return Parrot_io_pprintf(imcc->interp, io, "%s", ins->format); for (i = 0; i < ins->symreg_count; i++) { const SymReg *p = ins->symregs[i]; if (!p) continue; if (p->type & VT_CONSTP) p = p->reg; if (p->color >= 0 && REG_NEEDS_ALLOC(p)) { snprintf(regb[i], REGB_SIZE, "%c%d", p->set, (int)p->color); regstr[i] = regb[i]; } else if (p->type & VTREGKEY) { const SymReg *k = p; *regb[i] = '\0'; while ((k = k->nextkey) != NULL) { const size_t used = strlen(regb[i]); if (k->reg && k->reg->color >= 0) snprintf(regb[i]+used, REGB_SIZE - used, "%c%d", k->reg->set, (int)k->reg->color); else strncat(regb[i], k->name, REGB_SIZE - used - 1); if (k->nextkey) strncat(regb[i], ";", REGB_SIZE - strlen(regb[i]) - 1); } regstr[i] = regb[i]; } else if (p->type == VTCONST && p->set == 'S' && *p->name != '"' && *p->name != '\'') { /* unquoted string const */ snprintf(regb[i], REGB_SIZE, "\"%s\"", p->name); regstr[i] = regb[i]; } else regstr[i] = p->name; } switch (ins->opsize-1) { case -1: /* labels */ case 1: len = Parrot_io_pprintf(imcc->interp, io, ins->format, regstr[0]); break; case 2: len = Parrot_io_pprintf(imcc->interp, io, ins->format, regstr[0], regstr[1]); break; case 3: len = Parrot_io_pprintf(imcc->interp, io, ins->format, regstr[0], regstr[1], regstr[2]); break; case 4: len = Parrot_io_pprintf(imcc->interp, io, ins->format, regstr[0], regstr[1], regstr[2], regstr[3]); break; case 5: len = Parrot_io_pprintf(imcc->interp, io, ins->format, regstr[0], regstr[1], regstr[2], regstr[3], regstr[4]); break; case 6: len = Parrot_io_pprintf(imcc->interp, io, ins->format, regstr[0], regstr[1], regstr[2], regstr[3], regstr[4], regstr[5]); break; default: Parrot_io_eprintf(imcc->interp, "unhandled: opsize (%d), op %s, fmt %s\n", ins->opsize, ins->opname, ins->format); exit(EXIT_FAILURE); break; } return len; } /* for debug */ static PIOHANDLE output; /* =item C Opens the emitter function C of the given C. Passes the C to the open function. =cut */ void emit_open(ARGMOD(imc_info_t * imcc)) { ASSERT_ARGS(emit_open) imcc->dont_optimize = 0; e_pbc_open(imcc); } /* =item C Flushes the emitter by emitting all the instructions in the current IMC_Unit C. =cut */ void emit_flush(ARGMOD(imc_info_t * imcc), ARGIN_NULLOK(void *param), ARGIN(IMC_Unit *unit)) { ASSERT_ARGS(emit_flush) Instruction *ins; e_pbc_new_sub(imcc, param, unit); for (ins = unit->instructions; ins; ins = ins->next) { IMCC_debug(imcc, DEBUG_IMC, "emit %d\n", ins); e_pbc_emit(imcc, param, unit, ins); } e_pbc_end_sub(imcc, param, unit); } /* =item C Closes the given emitter. =cut */ void emit_close(ARGMOD(imc_info_t *imcc), ARGIN_NULLOK(void *param)) { ASSERT_ARGS(emit_close) e_pbc_close(imcc, param); } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ Test.pir000644000765000765 2031112101554067 23125 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library/Test/Builder =head1 NAME Test::Builder::Test - base class for all Test::Builder test objects =head1 SYNOPSIS See L. You probably don't need to use this directly. =head1 DESCRIPTION This PIR program is a base class for all Test::Builder test objects. =head1 METHODS This class provides the following methods: =over 4 =cut .namespace [ 'Test'; 'Builder'; 'Test' ] .sub _initialize :load .local pmc tbtb_class newclass tbtb_class, [ 'Test'; 'Builder'; 'Test'; 'Base' ] addattribute tbtb_class, 'passed' addattribute tbtb_class, 'number' addattribute tbtb_class, 'diagnostic' addattribute tbtb_class, 'description' addattribute tbtb_class, 'skip' addattribute tbtb_class, 'todo' .local pmc tbtp_class subclass tbtp_class, tbtb_class, ['Test'; 'Builder'; 'Test'; 'Pass'] .local pmc tbtf_class subclass tbtf_class, tbtb_class, ['Test'; 'Builder'; 'Test'; 'Fail'] .local pmc tbtwr_class subclass tbtwr_class, tbtb_class, ['Test'; 'Builder'; 'Test'; 'WithReason'] addattribute tbtwr_class, 'reason' .local pmc tbts_class subclass tbts_class, tbtwr_class, ['Test'; 'Builder'; 'Test'; 'Skip'] .local pmc tbtt_class subclass tbtt_class, tbtwr_class, ['Test'; 'Builder'; 'Test'; 'TODO'] .end =item C Creates and returns a new test object, based on the arguments in the C hash. Yes, this is a facade factory. The arguments are: =over 4 =item C The number of the test. This is important. =item C An integer representing whether the test passed or failed. =item C An integer representing whether the test is a skip test. =item C The string reason why this is a skip or TODO test. =item C An integer representing whether the test is a TODO test. =item C The string description of this test. =back The returned object is a subclass of Test::Builder::Test. =cut .sub create .param pmc args .local pmc test .local int type_flag CHECK_TODO: type_flag = args['todo'] unless type_flag goto CHECK_SKIP test = new ['Test'; 'Builder'; 'Test'; 'TODO'], args .return( test ) CHECK_SKIP: type_flag = args['skip'] unless type_flag goto CHECK_PASS test = new ['Test'; 'Builder'; 'Test'; 'Skip'], args .return( test ) CHECK_PASS: type_flag = args['passed'] unless type_flag goto CHECK_FAIL test = new ['Test'; 'Builder'; 'Test'; 'Pass'], args .return( test ) CHECK_FAIL: test = new ['Test'; 'Builder'; 'Test'; 'Fail'], args .return( test ) .end =item C Returns a C containing information about this test -- mostly the information you pass to C. =item C Returns the TAP-compatible string representation of this test. =cut .namespace [ 'Test'; 'Builder'; 'Test'; 'Base' ] .sub init_pmc :vtable :method .param pmc args .local pmc passed .local pmc number .local pmc diagnostic .local pmc description passed = args['passed'] setattribute self, "passed", passed number = args['number'] unless null number goto SET_NUMBER number = new 'Integer' number = 0 SET_NUMBER: setattribute self, "number", number diagnostic = args['diagnostic'] unless null diagnostic goto SET_DIAGNOSTIC diagnostic = new 'String' set diagnostic, '???' SET_DIAGNOSTIC: setattribute self, "diagnostic", diagnostic description = args['description'] unless null description goto SET_DESCRIPTION description = new 'String' set description, '' SET_DESCRIPTION: setattribute self, "description", description .end .sub passed :method .local pmc passed getattribute passed, self, "passed" .return( passed ) .end .sub number :method .local pmc number getattribute number, self, "number" .return( number ) .end .sub diagnostic :method .local pmc diagnostic getattribute diagnostic, self, "diagnostic" .return( diagnostic ) .end .sub description :method .local pmc description getattribute description, self, "description" .return( description ) .end .sub status :method .local pmc passed .local pmc description .local pmc status passed = self.'passed'() description = self.'description'() status = new 'Hash' set status['passed'], passed set status['description'], description .end .sub report :method .local pmc passed .local pmc number .local pmc description .local string report .local string number_string .local string desc_string passed = self.'passed'() number = self.'number'() description = self.'description'() report = '' number_string = number desc_string = description if passed goto PASSED set report, 'not ' PASSED: report = concat report, 'ok ' report = concat report, number_string unless desc_string goto REPORT report = concat report, ' - ' report = concat report, desc_string REPORT: .return( report ) .end # no code here .namespace [ 'Test'; 'Builder'; 'Test'; 'Pass' ] # no code here either .namespace [ 'Test'; 'Builder'; 'Test'; 'Fail' ] .namespace [ 'Test'; 'Builder'; 'Test'; 'WithReason' ] .sub init_pmc :vtable :method .param pmc args .local pmc reason reason = new 'String' set reason, '' .local int is_defined is_defined = exists args['reason'] unless is_defined goto SET_ATTRIBUTE reason = args['reason'] SET_ATTRIBUTE: setattribute self, "reason", reason .end .sub reason :method .local pmc reason getattribute reason, self, "reason" .return( reason ) .end .sub status :method .local pmc reason .local pmc status .local pmc parent_status parent_status = get_hll_global ['Test'; 'Builder'; 'Test'; 'WithReason'], 'status' status = parent_status() reason = self.'reason'() set status['reason'], reason .return( status ) .end .namespace [ 'Test'; 'Builder'; 'Test'; 'Skip' ] .sub report :method .local pmc reason .local pmc number .local string report .local string number_string .local string reason_string number = self.'number'() reason = self.'reason'() report = 'ok ' number_string = number reason_string = reason report = concat report, number_string report = concat report, ' #skip ' report = concat report, reason_string .return( report ) .end .sub status :method .local pmc status .local pmc parent_status parent_status = get_hll_global ['Test'; 'Builder'; 'Test'; 'WithReason'], 'status' status = parent_status() set status['skip'], 1 .return( status ) .end .namespace [ 'Test'; 'Builder'; 'Test'; 'TODO' ] .sub report :method .local pmc passed .local pmc reason .local pmc number .local string report passed = self.'passed'() number = self.'number'() report = '' if passed goto PASSED report = 'not ' PASSED: report = concat report, 'ok ' $S0 = number report = concat report, $S0 report = concat report, ' # TODO ' $S0 = self.'reason'() report = concat report, $S0 if passed goto REPORT # Build long explanation why report .= "\n\tFailed (TODO) test '" $S0 = self.'description'() report .= $S0 report .= "'" REPORT: .return( report ) .end .sub status :method .local pmc passed .local pmc status .local pmc parent_status parent_status = get_hll_global ['Test'; 'Builder'; 'Test'; 'WithReason'], 'status' status = parent_status() passed = self.'passed'() set status['TODO'], 1 set status['passed'], 1 set status['really_passed'], 1 .return( status ) .end =back =head1 AUTHOR Written and maintained by chromatic, C<< chromatic at wgz dot org >>, based on the Perl 6 port he wrote, based on the original Perl 5 version he wrote with ideas from Michael G. Schwern. Please send patches, feedback, and suggestions to the Perl 6 internals mailing list. =head1 COPYRIGHT Copyright (C) 2005-2010, Parrot Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: parrot.pod000644000765000765 1507712101554066 17302 0ustar00brucebruce000000000000parrot-5.9.0/docs/binaries# Copyright (C) 2011-2012, Parrot Foundation. =pod =head1 NAME parrot - Parrot Virtual Machine =head1 SYNOPSIS B [-options] [arguments ...] =head1 DESCRIPTION Parrot is a virtual machine designed to efficiently compile and execute bytecode for dynamic languages. Parrot currently hosts a variety of language implementations in various stages of completion, including Tcl, Javascript, Ruby, Lua, Scheme, PHP, Python, Perl 6, APL, and a .NET bytecode translator. Parrot is not about parrots, but we are rather fond of them, for obvious reasons. =head1 OPTIONS =over 4 =item B<-h> =item B<--help> Print the option summary on the command line. =item B<-V> =item B<--version> Print version information and exit. =item B<-I> =item B<--include> Add C to the include search path. =item B<-L> =item B<--library> Add C to the library search path. =item B<--hash-seed> [hexnum] Sets the hash seed to the specified value. This option is useful for debugging intermittent failures, but should I be used in production. For more information about this option, I F, F, F, and F. =back =over 11 =item B<-X> =item B<--dynext> Add C to the dynamic extension search path. =back =head2 Run core options These options select the runcore, which is useful for performance tuning and debugging. For more information about these options, I the "About runcores" section in F. =over 4 =item B<-R> =item B<--runcore> [CORE] Select the runcore. The following cores are available in Parrot, but not all may be available on your system: slow, bounds bounds checking core (default) fast bare-bones core without bounds-checking or context-updating subprof subroutine-level profiler (see POD in 'src/runcore/subprof.c') trace bounds checking core with trace info (see 'parrot --help-debug') profiling see 'docs/dev/profilling.pod' gcdebug performs a full GC run before every op dispatch (good for debugging GC problems) =item B<-p> =item B<--profile> Run with the slow core and print an execution profile. =item B<-t> =item B<--trace> Run with the slow core and print trace information to B. I C for available flag bits. =back =head2 VM options =over 4 =item B<-D> =item B<--parrot-debug>[=HEXFLAGS] Turn on interpreter debug flag. I C for available flag bits. =item B<--help-debug> Print the summary of debugging and tracing flag bits. =item B<-w> =item B<--warnings> Turn on warnings. I C for available flag bits. =item B<-G> =item B<--no-gc> Turn off GC. This may prove useful for finding GC-related bugs. =over 11 =item Note: Do not use this option for longer running programs: since memory is no longer recycled, it may quickly become exhausted. =back =item B<-g> =item B<--gc> [GC-type] =back =head3 GC MS2 options =over 4 =item B<--gc-dynamic-threshold>=percentage Maximum memory wasted by GC =item B<--gc-min-threshold>=Kb =back =head3 GC GMS options =over 4 =item B<--gc-nursery-size>=percent of system Size of gen0 (default 2) =item B<--gc-debug> Turn on GC (Garbage Collection) debugging. This imposes some stress on the GC subsystem and can considerably slow down execution. =item B<--leak-test|--destroy-at-end> Free all memory of the last interpreter. This is useful when running leak checkers. =item B<-.> =item B<--wait> Read a keystroke before starting. This is useful when you want to attach a debugger on platforms such as Windows. =item B<--runtime-prefix> Print the runtime prefix path and exit. =item --numthreads Overrides the automatically detected number of CPU cores to set the number of OS threads. Minimum number: 2 =back =head2 Compiler options =over 4 =item B<-E> =item B<--pre-process-only> Preprocess source file (expand macros) and print result to C: $> parrot -E t/op/macro_10.pasm $> parrot -E t/op/macro_10.pasm | parrot -- - =item B<-o> =item B<--output>=FILE Act like an assembler, but do not execute the code, unless the B<-r> is supplied as well. If 'outputfile' ends with F<.pbc>, 'parrot' will write a PBC file. If it ends with F<.pasm>, 'parrot' will output a PASM file, even from PASM input. =item B<--output-pbc> Act like an assembler, but always output bytecode, even if the output file does not end in F<.pbc> =item B<-a> =item B<--pasm> Assume PASM input on C. =item B<-c> =item B<--pbc> Assume PBC file on C and execute it. NOTE: If whitespace separates the B<-d> switch from the argument, the argument I start with a number, I, a decimal digit. =item B<-r> =item B<--run-pbc> Only useful after C<-o> or C<--output-pbc>. Execute the program from the compiled in-memory image. If two C<-r> options are supplied, the F<.pbc> file is read from disc and executed. This is needed, primarily, for tests. =item B<-y> =item B<--yydebug> Turn on yydebug in F/F. =back =head2 If the file ends in F<.pbc> it will be interpreted immediately. If the file ends in F<.pasm>, then it is parsed as PASM code. Otherwise, it is parsed as PIR code. In both cases, it will then be executed, unless the C<-o> flag was supplied. If the C is a single dash, input from C is read. =head2 [arguments ...] Optional arguments passed to the running program as ARGV. The program is assumed to know what to do with the arguments. =head1 ENVIRONMENT =over 4 =item PARROT_RUNTIME If this environment variable is set, parrot will use this path as its runtime prefix instead of the compiled-in path. This is useful if you want to execute a version of parrot different from the one on the "compiled-in" path. =item PARROT_GC_DEBUG Turn on the I<--gc-debug> flag. =back =head1 SEE ALSO 'docs/running.pod' Additional information on command line options. http://www.parrot.org/ The official Parrot web site. http://docs.parrot.org/ Parrot's official documentation site. http://parrot.github.com/ An alternative documentation site. =head1 REPORTING BUGS For information on how to submit a bug report, I F. =head1 AUTHORS Parrot is a product of the contributions of a great many people. For a list of most of these people, I F. =head1 COPYRIGHT Copyright (C) 2001-2012, Parrot Foundation. =cut fallback.h000644000765000765 515112101554067 20632 0ustar00brucebruce000000000000parrot-5.9.0/include/parrot/atomic/* atomic/fallback.h * Copyright (C) 2006, Parrot Foundation. * Overview: * This header provides an implementation of atomic * operations in terms of threading primitives. * Data Structure and Algorithms: * History: * Notes: * References: */ #ifndef PARROT_ATOMIC_FALLBACK_H_GUARD #define PARROT_ATOMIC_FALLBACK_H_GUARD typedef struct Parrot_atomic_pointer { void *val; Parrot_mutex lock; } Parrot_atomic_pointer; typedef struct Parrot_atomic_integer { INTVAL val; Parrot_mutex lock; } Parrot_atomic_integer; # define PARROT_ATOMIC_PTR_GET(result, a) \ do { \ LOCK((a).lock); \ (result) = (a).val; \ UNLOCK((a).lock); \ } while (0) # define PARROT_ATOMIC_INT_GET(result, a) \ do { \ LOCK((a).lock); \ (result) = (a).val; \ UNLOCK((a).lock); \ } while (0) # define PARROT_ATOMIC_PTR_SET(a, b) \ do { \ LOCK((a).lock); \ (a).val = (b); \ UNLOCK((a).lock); \ } while (0) # define PARROT_ATOMIC_INT_SET(a, b) \ do { \ LOCK((a).lock); \ (a).val = (b); \ UNLOCK((a).lock); \ } while (0) # define PARROT_ATOMIC_INT_INC(result, a) \ do { \ LOCK((a).lock); \ (result) = ++(a).val; \ UNLOCK((a).lock); \ } while (0) # define PARROT_ATOMIC_INT_DEC(result, a) \ do { \ LOCK((a).lock); \ (result) = --(a).val; \ UNLOCK((a).lock); \ } while (0) # define PARROT_ATOMIC_PTR_CAS(result, a, expect, update) \ do { \ LOCK((a).lock); \ if ((a).val == (expect)) { \ (a).val = (update); \ (result) = 1; \ } \ else { \ (result) = 0; \ } \ UNLOCK((a).lock); \ } while (0) # define PARROT_ATOMIC_INT_CAS(result, a, expect, update) \ do { \ LOCK((a).lock); \ if ((a).val == (expect)) { \ (a).val = (update); \ (result) = 1; \ } \ else { \ (result) = 0; \ } \ UNLOCK((a).lock); \ } while (0) # define PARROT_ATOMIC_PTR_INIT(a) \ do { \ MUTEX_INIT((a).lock); \ } while (0) # define PARROT_ATOMIC_PTR_DESTROY(a) \ do { \ MUTEX_DESTROY((a).lock); \ } while (0) # define PARROT_ATOMIC_INT_INIT(a) \ do { \ MUTEX_INIT((a).lock); \ } while (0) # define PARROT_ATOMIC_INT_DESTROY(a) \ do { \ MUTEX_DESTROY((a).lock); \ } while (0) #endif /* PARROT_ATOMIC_FALLBACK_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ segments.c000644000765000765 17006012101554067 17114 0ustar00brucebruce000000000000parrot-5.9.0/src/packfile/* Copyright (C) 2011-2012, Parrot Foundation. =head1 NAME src/packfile/segments.c - Segment Handling Routines =head1 DESCRIPTION Functions in this file represent behaviors for different PackFile segments. =cut */ /* HEADERIZER HFILE: include/parrot/packfile.h */ #include "parrot/parrot.h" #include "pf_private.h" #include "pmc/pmc_parrotlibrary.h" #include "segments.str" /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void byte_code_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*self); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PackFile_Segment * byte_code_new(PARROT_INTERP) __attribute__nonnull__(1); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static opcode_t * byte_code_pack(PARROT_INTERP, ARGMOD(PackFile_Segment *self), ARGOUT(opcode_t *cursor)) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*self) FUNC_MODIFIES(*cursor); PARROT_WARN_UNUSED_RESULT PARROT_PURE_FUNCTION static size_t byte_code_packed_size(PARROT_INTERP, ARGMOD(PackFile_Segment *self)) __attribute__nonnull__(2) FUNC_MODIFIES(*self); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static const opcode_t * byte_code_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *self), ARGIN(const opcode_t *cursor)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*self); static void const_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*self); PARROT_MALLOC PARROT_CANNOT_RETURN_NULL static PackFile_Segment * const_new(PARROT_INTERP) __attribute__nonnull__(1); static void default_destroy(PARROT_INTERP, ARGFREE_NOTNULL(PackFile_Segment *self)) __attribute__nonnull__(1) __attribute__nonnull__(2); static void default_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static opcode_t * default_pack( ARGIN(const PackFile_Segment *self), ARGOUT(opcode_t *dest)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); PARROT_PURE_FUNCTION PARROT_WARN_UNUSED_RESULT static size_t default_packed_size(ARGIN(const PackFile_Segment *self)) __attribute__nonnull__(1); PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static const opcode_t * default_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *self), ARGIN(const opcode_t *cursor)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*self); static void directory_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*self); static void directory_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PackFile_Segment * directory_new(PARROT_INTERP) __attribute__nonnull__(1); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static opcode_t * directory_pack(PARROT_INTERP, ARGMOD(PackFile_Segment *self), ARGOUT(opcode_t *cursor)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*self) FUNC_MODIFIES(*cursor); PARROT_WARN_UNUSED_RESULT static size_t directory_packed_size(PARROT_INTERP, ARGMOD(PackFile_Segment *self)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*self); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static const opcode_t * directory_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *segp), ARGIN(const opcode_t *cursor)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*segp); static void make_code_pointers(ARGMOD(PackFile_Segment *seg)) __attribute__nonnull__(1) FUNC_MODIFIES(*seg); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PMC * PackFile_Constant_unpack_pmc(PARROT_INTERP, ARGIN(PackFile_ConstTable *constt), ARGIN(const opcode_t **cursor)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3); static void pf_debug_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*self); static void pf_debug_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PackFile_Segment * pf_debug_new(PARROT_INTERP) __attribute__nonnull__(1); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static opcode_t * pf_debug_pack(PARROT_INTERP, ARGMOD(PackFile_Segment *self), ARGOUT(opcode_t *cursor)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*self) FUNC_MODIFIES(*cursor); static size_t pf_debug_packed_size(PARROT_INTERP, ARGMOD(PackFile_Segment *self)) __attribute__nonnull__(2) FUNC_MODIFIES(*self); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static const opcode_t * pf_debug_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *self), ARGIN(const opcode_t *cursor)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*self); static void segment_init( ARGOUT(PackFile_Segment *self), ARGIN(PackFile *pf), ARGIN(STRING *name)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*self); static void sort_segs(ARGMOD(PackFile_Directory *dir)) __attribute__nonnull__(1) FUNC_MODIFIES(*dir); #define ASSERT_ARGS_byte_code_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self)) #define ASSERT_ARGS_byte_code_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_byte_code_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(self) \ , PARROT_ASSERT_ARG(cursor)) #define ASSERT_ARGS_byte_code_packed_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(self)) #define ASSERT_ARGS_byte_code_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self) \ , PARROT_ASSERT_ARG(cursor)) #define ASSERT_ARGS_const_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self)) #define ASSERT_ARGS_const_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_default_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self)) #define ASSERT_ARGS_default_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self)) #define ASSERT_ARGS_default_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(self) \ , PARROT_ASSERT_ARG(dest)) #define ASSERT_ARGS_default_packed_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(self)) #define ASSERT_ARGS_default_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self) \ , PARROT_ASSERT_ARG(cursor)) #define ASSERT_ARGS_directory_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self)) #define ASSERT_ARGS_directory_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self)) #define ASSERT_ARGS_directory_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_directory_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self) \ , PARROT_ASSERT_ARG(cursor)) #define ASSERT_ARGS_directory_packed_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self)) #define ASSERT_ARGS_directory_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(segp) \ , PARROT_ASSERT_ARG(cursor)) #define ASSERT_ARGS_make_code_pointers __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(seg)) #define ASSERT_ARGS_PackFile_Constant_unpack_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(constt) \ , PARROT_ASSERT_ARG(cursor)) #define ASSERT_ARGS_pf_debug_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self)) #define ASSERT_ARGS_pf_debug_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self)) #define ASSERT_ARGS_pf_debug_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_pf_debug_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self) \ , PARROT_ASSERT_ARG(cursor)) #define ASSERT_ARGS_pf_debug_packed_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(self)) #define ASSERT_ARGS_pf_debug_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self) \ , PARROT_ASSERT_ARG(cursor)) #define ASSERT_ARGS_segment_init __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(self) \ , PARROT_ASSERT_ARG(pf) \ , PARROT_ASSERT_ARG(name)) #define ASSERT_ARGS_sort_segs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dir)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =head2 PackFile ConstTable Structure Functions =over 4 =item C Clear the C C. =cut */ PARROT_EXPORT void PackFile_ConstTable_clear(PARROT_INTERP, ARGMOD(PackFile_ConstTable *self)) { ASSERT_ARGS(PackFile_ConstTable_clear) if (self->num.constants) { mem_gc_free(interp, self->num.constants); self->num.constants = NULL; } if (self->str.constants) { mem_gc_free(interp, self->str.constants); self->str.constants = NULL; } if (self->pmc.constants) { mem_gc_free(interp, self->pmc.constants); self->pmc.constants = NULL; } if (self->string_hash) { Parrot_hash_destroy(interp, self->string_hash); self->string_hash = NULL; } if (self->tag_map) { mem_gc_free(interp, self->tag_map); self->ntags = 0; } return; } /* =item C Unpacks a PackFile ConstTable from a block of memory. The format is: opcode_t const_count * constants Returns cursor if everything is OK, else zero (0). =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL const opcode_t * PackFile_ConstTable_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *seg), ARGIN(const opcode_t *cursor)) { ASSERT_ARGS(PackFile_ConstTable_unpack) STRING * const sub_str = CONST_STRING(interp, "Sub"); PackFile_ConstTable * const self = (PackFile_ConstTable *)seg; PackFile * const pf = seg->pf; opcode_t i; PackFile_ConstTable_clear(interp, self); self->num.const_count = PF_fetch_opcode(pf, &cursor); self->str.const_count = PF_fetch_opcode(pf, &cursor); self->pmc.const_count = PF_fetch_opcode(pf, &cursor); if (self->num.const_count) { self->num.constants = mem_gc_allocate_n_zeroed_typed(interp, self->num.const_count, FLOATVAL); if (!self->num.constants) goto err; } if (self->str.const_count) { self->str.constants = mem_gc_allocate_n_zeroed_typed(interp, self->str.const_count, STRING *); if (!self->str.constants) goto err; } if (self->pmc.const_count) { self->pmc.constants = mem_gc_allocate_n_zeroed_typed(interp, self->pmc.const_count, PMC *); if (!self->pmc.constants) goto err; } for (i = 0; i < self->num.const_count; i++) self->num.constants[i] = PF_fetch_number(pf, &cursor); for (i = 0; i < self->str.const_count; i++) self->str.constants[i] = PF_fetch_string(interp, pf, &cursor); for (i = 0; i < self->pmc.const_count; i++) self->pmc.constants[i] = PackFile_Constant_unpack_pmc(interp, self, &cursor); for (i = 0; i < self->pmc.const_count; i++) { /* XXX unpack returned the lists of all objects in the object graph * must dereference the first object into the constant slot */ PMC * const pmc = self->pmc.constants[i] = VTABLE_get_pmc_keyed_int(interp, self->pmc.constants[i], 0); PObj_is_shared_SET(pmc); /* packfile constants will be shared among threads */ /* magically place subs into namespace stashes * XXX make this explicit with :load subs in PBC */ if (VTABLE_isa(interp, pmc, sub_str)) Parrot_ns_store_sub(interp, pmc); } self->ntags = PF_fetch_opcode(pf, &cursor); self->tag_map = mem_gc_allocate_n_zeroed_typed(interp, self->ntags, PackFile_ConstTagPair); for (i = 0; i < self->ntags; i++) { self->tag_map[i].tag_idx = PF_fetch_opcode(pf, &cursor); self->tag_map[i].const_idx = PF_fetch_opcode(pf, &cursor); } return cursor; err: Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ALLOCATION_ERROR, "PackFile_ConstTable_unpack: Could not allocate memory for array!\n"); } /* =item C Returns a new C segment. =cut */ PARROT_MALLOC PARROT_CANNOT_RETURN_NULL static PackFile_Segment * const_new(PARROT_INTERP) { ASSERT_ARGS(const_new) PackFile_ConstTable * const const_table = mem_gc_allocate_zeroed_typed(interp, PackFile_ConstTable); return (PackFile_Segment *)const_table; } /* =item C Destroys the C C. =cut */ static void const_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self)) { ASSERT_ARGS(const_destroy) PackFile_ConstTable * const ct = (PackFile_ConstTable *)self; PackFile_ConstTable_clear(interp, ct); } /* =item C Unpacks a constant PMC. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PMC * PackFile_Constant_unpack_pmc(PARROT_INTERP, ARGIN(PackFile_ConstTable *constt), ARGIN(const opcode_t **cursor)) { ASSERT_ARGS(PackFile_Constant_unpack_pmc) PackFile * const pf = constt->base.pf; PMC *pmc; /* thawing the PMC needs the real packfile in place */ PackFile_ByteCode * const cs_save = interp->code; interp->code = pf->cur_cs; pmc = Parrot_thaw_pbc(interp, constt, cursor); /* restore code */ interp->code = cs_save; return pmc; } /* =item C Creates a new annotations segment structure. =cut */ PARROT_EXPORT PARROT_CANNOT_RETURN_NULL PackFile_Segment * PackFile_Annotations_new(PARROT_INTERP) { ASSERT_ARGS(PackFile_Annotations_new) /* Allocate annotations structure; create it all zeroed, and we will * allocate memory for each of the arrays on demand. */ PackFile_Annotations * const seg = mem_gc_allocate_zeroed_typed(interp, PackFile_Annotations); return (PackFile_Segment *) seg; } /* =item C Frees all memory associated with an annotations segment. =cut */ void PackFile_Annotations_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *seg)) { ASSERT_ARGS(PackFile_Annotations_destroy) PackFile_Annotations * const self = (PackFile_Annotations *)seg; /* Free any keys. */ if (self->keys) mem_gc_free(interp, self->keys); self->keys = NULL; } /* =item C Computes the number of opcode_ts needed to store the passed annotations segment. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_PURE_FUNCTION size_t PackFile_Annotations_packed_size(SHIM_INTERP, ARGMOD(PackFile_Segment *seg)) { ASSERT_ARGS(PackFile_Annotations_packed_size) const PackFile_Annotations * const self = (PackFile_Annotations *)seg; return 1 + self->num_keys * 4; /* keys and key count */ } /* =item C Packs this segment into bytecode. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL opcode_t * PackFile_Annotations_pack(SHIM_INTERP, ARGIN(PackFile_Segment *seg), ARGOUT(opcode_t *cursor)) { ASSERT_ARGS(PackFile_Annotations_pack) const PackFile_Annotations * const self = (PackFile_Annotations *)seg; INTVAL i; /* Write key count and any keys. */ *cursor++ = self->num_keys; for (i = 0; i < self->num_keys; ++i) { const PackFile_Annotations_Key * const key = self->keys + i; *cursor++ = key->name; *cursor++ = key->type; *cursor++ = key->start; *cursor++ = key->len; } return cursor; } /* =item C Unpacks this segment from the bytecode. =cut */ PARROT_CANNOT_RETURN_NULL const opcode_t * PackFile_Annotations_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *seg), ARGIN(const opcode_t *cursor)) { ASSERT_ARGS(PackFile_Annotations_unpack) PackFile_Annotations * const self = (PackFile_Annotations *)seg; PackFile_ByteCode *code; STRING *code_name; INTVAL i, str_len; /* Unpack keys. */ self->num_keys = PF_fetch_opcode(seg->pf, &cursor); self->keys = mem_gc_allocate_n_zeroed_typed(interp, self->num_keys, PackFile_Annotations_Key); for (i = 0; i < self->num_keys; ++i) { PackFile_Annotations_Key * const key = self->keys + i; key->name = PF_fetch_opcode(seg->pf, &cursor); key->type = (pf_ann_key_type_t)PF_fetch_opcode(seg->pf, &cursor); key->start = PF_fetch_opcode(seg->pf, &cursor); key->len = PF_fetch_opcode(seg->pf, &cursor); } /* Need to associate this segment with the applicable code segment. */ str_len = Parrot_str_length(interp, self->base.name); code_name = STRING_substr(interp, self->base.name, 0, str_len - 4); code = (PackFile_ByteCode *)PackFile_find_segment(interp, self->base.dir, code_name, 0); if (!code || code->base.type != PF_BYTEC_SEG) { Parrot_ex_throw_from_c_args(interp, NULL, 1, "Code '%s' not found for annotations segment '%s'\n", code_name, self->base.name); } self->code = code; code->annotations = self; return cursor; } /* =item C Produces a dump of the annotations segment. =cut */ void PackFile_Annotations_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *seg)) { ASSERT_ARGS(PackFile_Annotations_dump) const PackFile_Annotations * const self = (const PackFile_Annotations *)seg; INTVAL i; size_t j; default_dump_header(interp, (const PackFile_Segment *)self); /* Dump keys. */ Parrot_io_printf(interp, "\n [\n"); for (i = 0; i < self->num_keys; ++i) { const PackFile_Annotations_Key * const key = &self->keys[i]; const size_t key_end = key->start + key->len; Parrot_io_printf(interp, " #%d\n [\n", i); Parrot_io_printf(interp, " NAME => %Ss\n", self->code->const_table->str.constants[key->name]); Parrot_io_printf(interp, " TYPE => %s\n", key->type == PF_ANNOTATION_KEY_TYPE_INT ? "integer" : key->type == PF_ANNOTATION_KEY_TYPE_STR ? "string" : key->type == PF_ANNOTATION_KEY_TYPE_PMC ? "pmc" : ""); for (j = key->start; j < key_end; j++) { Parrot_io_printf(interp, " [\n", i); Parrot_io_printf(interp, " BYTECODE_OFFSET => %d\n", self->base.data[j * 2 + ANN_ENTRY_OFF]); Parrot_io_printf(interp, " VALUE => %d\n", self->base.data[j * 2 + ANN_ENTRY_VAL]); Parrot_io_printf(interp, " ],\n"); } Parrot_io_printf(interp, " ],\n"); } Parrot_io_printf(interp, " ],\n"); Parrot_io_printf(interp, "],\n"); } /* =item C Registers the C/C/... functions for a packfile type. =cut */ PARROT_EXPORT void PackFile_funcs_register(SHIM_INTERP, ARGMOD(PackFile *pf), UINTVAL type, const PackFile_funcs funcs) { ASSERT_ARGS(PackFile_funcs_register) pf->PackFuncs[type] = funcs; } /* =item C Unpacks a PackFile given a cursor into PBC. This is the default unpack. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static const opcode_t * default_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *self), ARGIN(const opcode_t *cursor)) { ASSERT_ARGS(default_unpack) DECL_CONST_CAST_OF(opcode_t); self->op_count = PF_fetch_opcode(self->pf, &cursor); self->itype = PF_fetch_opcode(self->pf, &cursor); self->id = PF_fetch_opcode(self->pf, &cursor); self->size = PF_fetch_opcode(self->pf, &cursor); if (self->size == 0) return cursor; /* if the packfile is mmap()ed just point to it if we don't * need any fetch transforms */ if (self->pf->is_mmap_ped && !self->pf->need_endianize && !self->pf->need_wordsize) { self->data = PARROT_const_cast(opcode_t *, cursor); cursor += self->size; return cursor; } /* else allocate mem */ self->data = mem_gc_allocate_n_typed(interp, self->size, opcode_t); if (!self->data) { Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ALLOCATION_ERROR, "PackFile_unpack: Unable to allocate data memory!\n"); } if (!self->pf->need_endianize && !self->pf->need_wordsize) { memcpy(self->data, cursor, self->size * sizeof (opcode_t)); cursor += self->size; } else { int i; for (i = 0; i < (int)self->size; i++) self->data[i] = PF_fetch_opcode(self->pf, &cursor); } return cursor; } /* =item C Dumps the header of a given PackFile_Segment. =cut */ void default_dump_header(PARROT_INTERP, ARGIN(const PackFile_Segment *self)) { ASSERT_ARGS(default_dump_header) Parrot_io_printf(interp, "%Ss => [ # offs 0x%x(%d)", self->name, (int)self->file_offset, (int)self->file_offset); Parrot_io_printf(interp, " = op_count %d, itype %d, id %d, size %d, ...", (int)self->op_count, (int)self->itype, (int)self->id, (int)self->size); } /* =item C Dumps a PackFile_Segment. =cut */ static void default_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self)) { ASSERT_ARGS(default_dump) size_t i = self->data ? 0: self->file_offset + SEGMENT_HEADER_SIZE; default_dump_header(interp, self); if (i % 8) Parrot_io_printf(interp, "\n %04x: ", (int) i); for (; i < (self->data ? self->size : self->file_offset + self->op_count); ++i) { if (i % 8 == 0) Parrot_io_printf(interp, "\n %04x: ", (int) i); Parrot_io_printf(interp, "%08lx ", (unsigned long) (self->data ? self->data[i] : self->pf->src[i])); } Parrot_io_printf(interp, "\n]\n"); } /* =item C Registers a PackFile's functions; called from within C. =cut */ void pf_register_standard_funcs(PARROT_INTERP, ARGMOD(PackFile *pf)) { ASSERT_ARGS(pf_register_standard_funcs) static const PackFile_funcs dirf = { directory_new, directory_destroy, directory_packed_size, directory_pack, directory_unpack, directory_dump }; static const PackFile_funcs defaultf = { PackFile_Segment_new, (PackFile_Segment_destroy_func_t) NULL, (PackFile_Segment_packed_size_func_t) NULL, (PackFile_Segment_pack_func_t) NULL, (PackFile_Segment_unpack_func_t) NULL, default_dump }; static const PackFile_funcs constf = { const_new, const_destroy, PackFile_ConstTable_pack_size, PackFile_ConstTable_pack, PackFile_ConstTable_unpack, default_dump }; static const PackFile_funcs bytef = { byte_code_new, byte_code_destroy, byte_code_packed_size, byte_code_pack, byte_code_unpack, default_dump }; static const PackFile_funcs debugf = { pf_debug_new, pf_debug_destroy, pf_debug_packed_size, pf_debug_pack, pf_debug_unpack, pf_debug_dump }; static const PackFile_funcs annotationf = { PackFile_Annotations_new, PackFile_Annotations_destroy, PackFile_Annotations_packed_size, PackFile_Annotations_pack, PackFile_Annotations_unpack, PackFile_Annotations_dump }; PackFile_funcs_register(interp, pf, PF_DIR_SEG, dirf); PackFile_funcs_register(interp, pf, PF_UNKNOWN_SEG, defaultf); PackFile_funcs_register(interp, pf, PF_CONST_SEG, constf); PackFile_funcs_register(interp, pf, PF_BYTEC_SEG, bytef); PackFile_funcs_register(interp, pf, PF_DEBUG_SEG, debugf); PackFile_funcs_register(interp, pf, PF_ANNOTATIONS_SEG, annotationf); return; } /* =item C Creates a new segment in the given PackFile_Directory of the given C with the given C. If C is true, adds the segment to the directory. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PackFile_Segment * PackFile_Segment_new_seg(PARROT_INTERP, ARGMOD(PackFile_Directory *dir), UINTVAL type, ARGIN(STRING *name), int add) { ASSERT_ARGS(PackFile_Segment_new_seg) PackFile * const pf = dir->base.pf; const PackFile_Segment_new_func_t f = pf->PackFuncs[type].new_seg; PackFile_Segment * const seg = (f)(interp); segment_init(seg, pf, name); seg->type = type; if (add) PackFile_add_segment(interp, dir, seg); return seg; } /* =item C Destroys the given PackFile_Segment. =cut */ PARROT_EXPORT void PackFile_Segment_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self)) { ASSERT_ARGS(PackFile_Segment_destroy) const PackFile_Segment_destroy_func_t f = self->pf->PackFuncs[self->type].destroy; if (f) (f)(interp, self); /* destroy self after specific */ default_destroy(interp, self); } /* =item C Returns the size of the given segment, when packed, taking into account padding and alignment. =cut */ PARROT_EXPORT size_t PackFile_Segment_packed_size(PARROT_INTERP, ARGIN(PackFile_Segment *self)) { ASSERT_ARGS(PackFile_Segment_packed_size) size_t size = default_packed_size(self); const size_t align = 16 / sizeof (opcode_t); PackFile_Segment_packed_size_func_t f = self->pf->PackFuncs[self->type].packed_size; if (f) size += (f)(interp, self); /* pad/align it */ if (align && size % align) size += (align - size % align); return size; } /* =item C Packs a PackFile_Segment, returning a cursor to the start of the results. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL opcode_t * PackFile_Segment_pack(PARROT_INTERP, ARGIN(PackFile_Segment *self), ARGIN(opcode_t *cursor)) { ASSERT_ARGS(PackFile_Segment_pack) /*const size_t align = 16 / sizeof (opcode_t);*/ PackFile_Segment_pack_func_t f = self->pf->PackFuncs[self->type].pack; opcode_t * old_cursor; /* Used for filling padding with 0 */ cursor = default_pack(self, cursor); if (f) cursor = (f)(interp, self, cursor); old_cursor = cursor; ALIGN_16(self->pf, cursor); /* fill padding with zeros */ while (old_cursor != cursor) *old_cursor++ = 0; /*if (align && (cursor - self->pf->src) % align) cursor += align - (cursor - self->pf->src) % align;*/ return cursor; } /* =item C Unpacks a PackFile_Segment, returning a cursor to the results on success and NULL otherwise. All all these functions call the related C function. If a special is defined this gets called after. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL const opcode_t * PackFile_Segment_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *self), ARGIN(const opcode_t *cursor)) { ASSERT_ARGS(PackFile_Segment_unpack) PackFile_Segment_unpack_func_t f = self->pf->PackFuncs[self->type].unpack; int offs; cursor = default_unpack(interp, self, cursor); if (!cursor) return NULL; if (f) { cursor = (f)(interp, self, cursor); if (!cursor) return NULL; } offs = OFFS(self->pf, cursor); offs += PAD_16_B(offs); cursor = self->pf->src + offs/(sizeof (opcode_t)); return cursor; } /* =item C Dumps the segment C. =cut */ PARROT_EXPORT void PackFile_Segment_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self)) { ASSERT_ARGS(PackFile_Segment_dump) self->pf->PackFuncs[self->type].dump(interp, self); } /* =back =head2 Standard Directory Functions =over 4 =item C Returns a new C cast as a C. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PackFile_Segment * directory_new(PARROT_INTERP) { ASSERT_ARGS(directory_new) return (PackFile_Segment *)mem_gc_allocate_zeroed_typed(interp, PackFile_Directory); } /* =item C Dumps the directory C. =cut */ static void directory_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self)) { ASSERT_ARGS(directory_dump) const PackFile_Directory * const dir = (const PackFile_Directory *) self; size_t i; default_dump_header(interp, self); Parrot_io_printf(interp, "\n\t# %d segments\n", dir->num_segments); for (i = 0; i < dir->num_segments; ++i) { const PackFile_Segment * const seg = dir->segments[i]; Parrot_io_printf(interp, "\ttype %d\t%Ss\t", (int)seg->type, seg->name); Parrot_io_printf(interp, " offs 0x%x(0x%x)\top_count %d\n", (int)seg->file_offset, (int)seg->file_offset * sizeof (opcode_t), (int)seg->op_count); } Parrot_io_printf(interp, "]\n"); for (i = 0; i < dir->num_segments; ++i) PackFile_Segment_dump(interp, dir->segments[i]); } /* =item C Unpacks the directory from the provided cursor. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static const opcode_t * directory_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *segp), ARGIN(const opcode_t *cursor)) { ASSERT_ARGS(directory_unpack) PackFile_Directory * const dir = (PackFile_Directory *)segp; PackFile * const pf = dir->base.pf; const opcode_t *pos; size_t i; int offs; PARROT_ASSERT(pf); dir->num_segments = PF_fetch_opcode(pf, &cursor); dir->segments = mem_gc_allocate_n_zeroed_typed(interp, dir->num_segments, PackFile_Segment *); for (i = 0; i < dir->num_segments; ++i) { PackFile_Segment *seg; STRING *name; size_t opcode; /* get type */ UINTVAL type = PF_fetch_opcode(pf, &cursor); if (type >= PF_MAX_SEG) type = PF_UNKNOWN_SEG; /* get name */ name = PF_fetch_string(interp, pf, &cursor); /* create it */ seg = PackFile_Segment_new_seg(interp, dir, type, name, 0); seg->file_offset = PF_fetch_opcode(pf, &cursor); seg->op_count = PF_fetch_opcode(pf, &cursor); if (pf->need_wordsize) { #if OPCODE_T_SIZE == 8 if (pf->header->wordsize == 4) pos = pf->src + seg->file_offset / 2; #else if (pf->header->wordsize == 8) pos = pf->src + seg->file_offset * 2; #endif else { fprintf(stderr, "directory_unpack failed: invalid wordsize %d\n", (int)pf->header->wordsize); return NULL; } } else pos = pf->src + seg->file_offset; opcode = PF_fetch_opcode(pf, &pos); if (seg->op_count != opcode) { Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE, "%Ss: Size in directory %d doesn't match size %d " "at offset 0x%x\n", seg->name, (int)seg->op_count, (int)opcode, (int)seg->file_offset); } if (i) { PackFile_Segment *last = dir->segments[i - 1]; if (last->file_offset + last->op_count != seg->file_offset) fprintf(stderr, "section: sections are not back to back\n"); } make_code_pointers(seg); /* store the segment */ dir->segments[i] = seg; seg->dir = dir; } offs = OFFS(pf, cursor); offs += PAD_16_B(offs); cursor = pf->src + offs/(sizeof (opcode_t)); /* and now unpack contents of dir */ for (i = 0; cursor && i < dir->num_segments; ++i) { const opcode_t * const csave = cursor; /* check len again */ const size_t tmp = PF_fetch_opcode(pf, &cursor); /* keep gcc -O silent */ size_t delta = 0; cursor = csave; pos = PackFile_Segment_unpack(interp, dir->segments[i], cursor); if (!pos) { Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE, "PackFile_unpack segment '%Ss' failed\n", dir->segments[i]->name); } /* FIXME bug on 64bit reading 32bit lurking here! TT #254 */ if (pf->need_wordsize) { #if OPCODE_T_SIZE == 8 if (pf->header->wordsize == 4) delta = (pos - cursor) * 2; #else if (pf->header->wordsize == 8) delta = (pos - cursor) / 2; #endif } else delta = pos - cursor; if ((size_t)delta != tmp || dir->segments[i]->op_count != tmp) Parrot_io_eprintf(interp, "PackFile_unpack segment '%Ss' directory length %d " "length in file %d needed %d for unpack\n", dir->segments[i]->name, (int)dir->segments[i]->op_count, (int)tmp, (int)delta); cursor = pos; } return cursor; } /* =item C Destroys the directory. =cut */ static void directory_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self)) { ASSERT_ARGS(directory_destroy) PackFile_Directory * const dir = (PackFile_Directory *)self; size_t i; for (i = 0; i < dir->num_segments; ++i) { PackFile_Segment * const segment = dir->segments[i]; /* Prevent repeated destruction */ dir->segments[i] = NULL; if (segment && segment != self) PackFile_Segment_destroy(interp, segment); } if (dir->segments) { mem_gc_free(interp, dir->segments); dir->segments = NULL; dir->num_segments = 0; } } /* =item C Sorts the segments in C. =cut */ static void sort_segs(ARGMOD(PackFile_Directory *dir)) { ASSERT_ARGS(sort_segs) const size_t num_segs = dir->num_segments; PackFile_Segment *seg = dir->segments[0]; if (seg->type != PF_BYTEC_SEG) { size_t i; for (i = 1; i < num_segs; ++i) { PackFile_Segment * const s2 = dir->segments[i]; if (s2->type == PF_BYTEC_SEG) { dir->segments[0] = s2; dir->segments[i] = seg; break; } } } /* XXX * Temporary? hack to put ConstantTable in front of other segments. * This is useful for Annotations because we ensure that constants used * for keys already available during unpack. */ seg = dir->segments[1]; if (seg->type != PF_CONST_SEG) { size_t i; for (i = 3; i < num_segs; ++i) { PackFile_Segment * const s2 = dir->segments[i]; if (s2->type == PF_CONST_SEG) { dir->segments[2] = s2; dir->segments[i] = seg; break; } } } } /* =item C Returns the size of the directory minus the value returned by C. =cut */ PARROT_WARN_UNUSED_RESULT static size_t directory_packed_size(PARROT_INTERP, ARGMOD(PackFile_Segment *self)) { ASSERT_ARGS(directory_packed_size) PackFile_Directory * const dir = (PackFile_Directory *)self; const size_t align = 16 / sizeof (opcode_t); size_t size, i; /* need bytecode, fixup, other segs ... */ sort_segs(dir); /* number of segments + default, we need it for the offsets */ size = 1 + default_packed_size(self); for (i = 0; i < dir->num_segments; ++i) { /* type, offset, size */ size += 3; size += PF_size_string(dir->segments[i]->name); } /* pad/align it */ if (align && size % align) size += (align - size % align); for (i = 0; i < dir->num_segments; ++i) { size_t seg_size; dir->segments[i]->file_offset = size + self->file_offset; seg_size = PackFile_Segment_packed_size(interp, dir->segments[i]); dir->segments[i]->op_count = seg_size; size += seg_size; } self->op_count = size; /* subtract default, it is added in PackFile_Segment_packed_size */ return size - default_packed_size(self); } /* =item C Packs the directory C, using the given cursor. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static opcode_t * directory_pack(PARROT_INTERP, ARGMOD(PackFile_Segment *self), ARGOUT(opcode_t *cursor)) { ASSERT_ARGS(directory_pack) PackFile_Directory * const dir = (PackFile_Directory *)self; const size_t num_segs = dir->num_segments; /*const size_t align = 16/sizeof (opcode_t);*/ size_t i; PackFile * const pf = self->pf; opcode_t * old_cursor; /* Used for filling padding with 0 */ *cursor++ = num_segs; for (i = 0; i < num_segs; i++) { const PackFile_Segment * const seg = dir->segments[i]; *cursor++ = seg->type; cursor = PF_store_string(cursor, seg->name); *cursor++ = seg->file_offset; *cursor++ = seg->op_count; } old_cursor = cursor; ALIGN_16(pf, cursor); /* fill padding with zeros */ while (old_cursor != cursor) *old_cursor++ = 0; /*if (align && (cursor - self->pf->src) % align) cursor += align - (cursor - self->pf->src) % align;*/ /* now pack all segments into new format */ for (i = 0; i < dir->num_segments; ++i) { PackFile_Segment * const seg = dir->segments[i]; cursor = PackFile_Segment_pack(interp, seg, cursor); } return cursor; } /* =back =head2 C Functions =over 4 =item C Initializes the segment C with the provided PackFile and the given name. Note that this duplicates the given name. =cut */ static void segment_init(ARGOUT(PackFile_Segment *self), ARGIN(PackFile *pf), ARGIN(STRING *name)) { ASSERT_ARGS(segment_init) self->pf = pf; self->type = PF_UNKNOWN_SEG; self->file_offset = 0; self->op_count = 0; self->itype = 0; self->size = 0; self->data = NULL; self->id = 0; self->name = name; } /* =item C Creates a new default section. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PackFile_Segment * PackFile_Segment_new(PARROT_INTERP) { ASSERT_ARGS(PackFile_Segment_new) PackFile_Segment * const seg = mem_gc_allocate_zeroed_typed(interp, PackFile_Segment); return seg; } /* =back =head2 Default Function Implementations The default functions are called before the segment specific functions and can read a block of C data. =over 4 =item C The default destroy function. Destroys a PackFile_Segment. =cut */ static void default_destroy(PARROT_INTERP, ARGFREE_NOTNULL(PackFile_Segment *self)) { ASSERT_ARGS(default_destroy) if (!self->pf->is_mmap_ped && self->data) { mem_gc_free(interp, self->data); self->data = NULL; } mem_gc_free(interp, self); } /* =item C Returns the default size of the segment C. =cut */ PARROT_PURE_FUNCTION PARROT_WARN_UNUSED_RESULT static size_t default_packed_size(ARGIN(const PackFile_Segment *self)) { ASSERT_ARGS(default_packed_size) return SEGMENT_HEADER_SIZE + self->size; } /* =item C Performs the default pack. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static opcode_t * default_pack(ARGIN(const PackFile_Segment *self), ARGOUT(opcode_t *dest)) { ASSERT_ARGS(default_pack) *dest++ = self->op_count; *dest++ = self->itype; *dest++ = self->id; *dest++ = self->size; if (self->size) STRUCT_COPY_N(dest, self->data, self->size); return dest + self->size; } /* =back =head2 ByteCode =over 4 =item C Destroys the C segment C. =cut */ static void byte_code_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self)) { ASSERT_ARGS(byte_code_destroy) PackFile_ByteCode * const byte_code = (PackFile_ByteCode *)self; if (byte_code->op_func_table) mem_gc_free(interp, byte_code->op_func_table); if (byte_code->op_info_table) mem_gc_free(interp, byte_code->op_info_table); if (byte_code->op_mapping.libs) { const opcode_t n_libs = byte_code->op_mapping.n_libs; opcode_t i; for (i = 0; i < n_libs; i++) { mem_gc_free(interp, byte_code->op_mapping.libs[i].table_ops); mem_gc_free(interp, byte_code->op_mapping.libs[i].lib_ops); } mem_gc_free(interp, byte_code->op_mapping.libs); } if (byte_code->libdeps) mem_gc_free(interp, byte_code->libdeps); if (byte_code->annotations) PackFile_Annotations_destroy(interp, (PackFile_Segment *)byte_code->annotations); byte_code->annotations = NULL; byte_code->const_table = NULL; byte_code->debugs = NULL; byte_code->op_func_table = NULL; byte_code->op_info_table = NULL; byte_code->op_mapping.libs = NULL; byte_code->libdeps = NULL; } /* =item C Creates a new C segment. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PackFile_Segment * byte_code_new(PARROT_INTERP) { ASSERT_ARGS(byte_code_new) PackFile_ByteCode * const byte_code = mem_gc_allocate_zeroed_typed(interp, PackFile_ByteCode); byte_code->main_sub = -1; return (PackFile_Segment *) byte_code; } /* =item C Computes the size in multiples of C required to store the passed C. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_PURE_FUNCTION static size_t byte_code_packed_size(SHIM_INTERP, ARGMOD(PackFile_Segment *self)) { ASSERT_ARGS(byte_code_packed_size) PackFile_ByteCode * const byte_code = (PackFile_ByteCode *)self; size_t size; int i; unsigned int u; size = 4; /* main_sub + op_count + n_libs + n_libdeps*/ for (u = 0; u < byte_code->n_libdeps; u++) size += PF_size_string(byte_code->libdeps[u]); for (i = 0; i < byte_code->op_mapping.n_libs; i++) { PackFile_ByteCode_OpMappingEntry * const entry = &byte_code->op_mapping.libs[i]; /* dynoplib data */ size += PF_size_cstring(entry->lib->name); size += 2; /* bc_major + bc_minor */ /* op entries */ size += 1; /* n_ops */ size += entry->n_ops * 2; /* lib_ops and table_ops */ } return size; } /* =item C Stores the passed C segment in bytecode. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static opcode_t * byte_code_pack(SHIM_INTERP, ARGMOD(PackFile_Segment *self), ARGOUT(opcode_t *cursor)) { ASSERT_ARGS(byte_code_pack) const PackFile_ByteCode * const byte_code = (PackFile_ByteCode *)self; int i; unsigned int u; *cursor++ = byte_code->main_sub; *cursor++ = byte_code->n_libdeps; *cursor++ = byte_code->op_count; *cursor++ = byte_code->op_mapping.n_libs; for (u = 0; u < byte_code->n_libdeps; u++) cursor = PF_store_string(cursor, byte_code->libdeps[u]); for (i = 0; i < byte_code->op_mapping.n_libs; i++) { int j; PackFile_ByteCode_OpMappingEntry * const entry = &byte_code->op_mapping.libs[i]; /* dynoplib data */ cursor = PF_store_cstring(cursor, entry->lib->name); *cursor++ = entry->lib->bc_major_version; *cursor++ = entry->lib->bc_minor_version; /* op entries */ *cursor++ = entry->n_ops; for (j = 0; j < entry->n_ops; j++) { *cursor++ = entry->table_ops[j]; *cursor++ = entry->lib_ops[j]; } } return cursor; } /* =item C Unpacks a bytecode segment into the passed C. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static const opcode_t * byte_code_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *self), ARGIN(const opcode_t *cursor)) { ASSERT_ARGS(byte_code_unpack) PackFile_ByteCode * const byte_code = (PackFile_ByteCode *)self; int i; unsigned int u; size_t total_ops = 0; byte_code->main_sub = PF_fetch_opcode(self->pf, &cursor); byte_code->n_libdeps = PF_fetch_opcode(self->pf, &cursor); byte_code->libdeps = mem_gc_allocate_n_zeroed_typed(interp, byte_code->n_libdeps, STRING *); byte_code->op_count = PF_fetch_opcode(self->pf, &cursor); byte_code->op_func_table = mem_gc_allocate_n_zeroed_typed(interp, byte_code->op_count, op_func_t); byte_code->op_info_table = mem_gc_allocate_n_zeroed_typed(interp, byte_code->op_count, op_info_t *); byte_code->op_mapping.n_libs = PF_fetch_opcode(self->pf, &cursor); byte_code->op_mapping.libs = mem_gc_allocate_n_zeroed_typed(interp, byte_code->op_mapping.n_libs, PackFile_ByteCode_OpMappingEntry); for (u = 0; u < byte_code->n_libdeps; u++) { STRING * const libname = PF_fetch_string(interp, self->pf, &cursor); PMC * const lib_pmc = Parrot_dyn_load_lib(interp, libname, NULL); byte_code->libdeps[u] = libname; UNUSED(lib_pmc); } for (i = 0; i < byte_code->op_mapping.n_libs; i++) { PackFile_ByteCode_OpMappingEntry * const entry = &byte_code->op_mapping.libs[i]; /* dynoplib data */ { char * const lib_name = PF_fetch_cstring(interp, self->pf, &cursor); const opcode_t bc_major = PF_fetch_opcode(self->pf, &cursor); const opcode_t bc_minor = PF_fetch_opcode(self->pf, &cursor); /* XXX * broken encapsulation => should make this data easier to access somehow */ if (STREQ(lib_name, PARROT_CORE_OPLIB_NAME)) { entry->lib = PARROT_CORE_OPLIB_INIT(interp, 1); } else { PMC * const lib_pmc = Parrot_dyn_load_lib(interp, Parrot_str_new(interp, lib_name, 0), NULL); typedef op_lib_t *(*oplib_init_t)(PARROT_INTERP, long init); void *oplib_init; oplib_init_t fn; if (!VTABLE_get_bool(interp, lib_pmc)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR, "Could not load oplib `%s'", lib_name); GETATTR_ParrotLibrary_oplib_init(interp, lib_pmc, oplib_init); fn = (oplib_init_t)D2FPTR(oplib_init); entry->lib = fn(interp, 1); } mem_gc_free(interp, lib_name); if (entry->lib->bc_major_version != bc_major || entry->lib->bc_minor_version != bc_minor) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR, "Incompatible versions of `%s' bytecode, possibly due to " "loading bytecode generated by an old version of Parrot. " "Found %d.%d but loaded %d.%d", entry->lib->name, bc_major, bc_minor, entry->lib->bc_major_version, entry->lib->bc_minor_version); } /* op entries */ { int j; total_ops += entry->n_ops = PF_fetch_opcode(self->pf, &cursor); entry->table_ops = mem_gc_allocate_n_zeroed_typed(interp, entry->n_ops, opcode_t); entry->lib_ops = mem_gc_allocate_n_zeroed_typed(interp, entry->n_ops, opcode_t); for (j = 0; j < entry->n_ops; j++) { opcode_t idx = PF_fetch_opcode(self->pf, &cursor); opcode_t op = PF_fetch_opcode(self->pf, &cursor); if (0 > op || op >= entry->lib->op_count) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE, "opcode index out of bounds on library `%s'. Found %d, expected 0 to %d.", entry->lib->name, op, entry->lib->op_count - 1); if (0 > idx || (size_t)idx >= byte_code->op_count) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE, "op table index out of bounds for entry from library `%s'." " Found %d, expected 0 to %d", entry->lib->name, idx, byte_code->op_count - 1); if (byte_code->op_func_table[idx]) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE, "duplicate entries in optable"); entry->table_ops[j] = idx; entry->lib_ops[j] = op; byte_code->op_func_table[idx] = entry->lib->op_func_table[op]; byte_code->op_info_table[idx] = &entry->lib->op_info_table[op]; } } } if (total_ops != byte_code->op_count) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE, "wrong number of ops decoded for optable. Decoded %d, but expected %d", total_ops, byte_code->op_count); return cursor; } /* =back =head2 Debug Info =over 4 =item C Destroys the C segment C. =cut */ static void pf_debug_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self)) { ASSERT_ARGS(pf_debug_destroy) PackFile_Debug * const debug = (PackFile_Debug *) self; /* Free mappings pointer array. */ mem_gc_free(interp, debug->mappings); debug->mappings = NULL; debug->num_mappings = 0; } /* =item C Creates and returns a new C segment. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PackFile_Segment * pf_debug_new(PARROT_INTERP) { ASSERT_ARGS(pf_debug_new) PackFile_Debug * const debug = mem_gc_allocate_zeroed_typed(interp, PackFile_Debug); /* don't create initial mappings here; they'll get overwritten later */ return (PackFile_Segment *)debug; } /* =item C Returns the size of the C segment's filename in C units. =cut */ static size_t pf_debug_packed_size(SHIM_INTERP, ARGMOD(PackFile_Segment *self)) { ASSERT_ARGS(pf_debug_packed_size) PackFile_Debug * const debug = (PackFile_Debug *)self; return (debug->num_mappings*2) + 1; } /* =item C Packs the debug segment, using the given cursor. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static opcode_t * pf_debug_pack(PARROT_INTERP, ARGMOD(PackFile_Segment *self), ARGOUT(opcode_t *cursor)) { ASSERT_ARGS(pf_debug_pack) PackFile_Debug * const debug = (PackFile_Debug *)self; const int n = debug->num_mappings; int i; if (n > 0 && debug->mappings == NULL) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE, "No mappings but non zero num mappings(%I)", n); /* Store number of mappings. */ *cursor++ = n; /* Now store each mapping. */ for (i = 0; i < n; ++i) { /* Bytecode offset and filename. */ *cursor++ = debug->mappings[i].offset; *cursor++ = debug->mappings[i].filename; } return cursor; } /* =item C Unpacks a debug segment into a PackFile_Debug structure, given the cursor. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static const opcode_t * pf_debug_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *self), ARGIN(const opcode_t *cursor)) { ASSERT_ARGS(pf_debug_unpack) PackFile_Debug * const debug = (PackFile_Debug *)self; PackFile_ByteCode *code; int i; /* For some reason, we store the source file name in the segment name. So we can't find the bytecode seg without knowing the filename. But with the new scheme we can have many file names. For now, just base this on the name of the debug segment. */ STRING *code_name; size_t str_len; /* Number of mappings. */ debug->num_mappings = PF_fetch_opcode(self->pf, &cursor); /* Allocate space for mappings vector. */ debug->mappings = mem_gc_allocate_n_zeroed_typed(interp, debug->num_mappings, PackFile_DebugFilenameMapping); /* Read in each mapping. */ for (i = 0; i < debug->num_mappings; ++i) { /* Get offset and filename type. */ debug->mappings[i].offset = PF_fetch_opcode(self->pf, &cursor); debug->mappings[i].filename = PF_fetch_opcode(self->pf, &cursor); } /* find seg e.g. CODE_DB => CODE and attach it */ str_len = Parrot_str_length(interp, debug->base.name); code_name = STRING_substr(interp, debug->base.name, 0, str_len - 3); code = (PackFile_ByteCode *)PackFile_find_segment(interp, self->dir, code_name, 0); if (!code || code->base.type != PF_BYTEC_SEG) { Parrot_ex_throw_from_c_args(interp, NULL, 1, "Code '%Ss' not found for debug segment '%Ss'\n", code_name, self->name); } code->debugs = debug; debug->code = code; return cursor; } /* =item C Dumps a debug segment to a human readable form. =cut */ static void pf_debug_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self)) { ASSERT_ARGS(pf_debug_dump) const PackFile_Debug * const debug = (const PackFile_Debug *)self; opcode_t i; default_dump_header(interp, self); Parrot_io_printf(interp, "\n mappings => [\n"); for (i = 0; i < debug->num_mappings; ++i) { Parrot_io_printf(interp, " #%d\n [\n", i); Parrot_io_printf(interp, " OFFSET => %d,\n", debug->mappings[i].offset); Parrot_io_printf(interp, " FILENAME => %Ss\n", debug->code->const_table->str.constants[debug->mappings[i].filename]); Parrot_io_printf(interp, " ],\n"); } Parrot_io_printf(interp, " ]\n"); } /* =item C Makes compact/shorthand pointers. The first segments read are the default segments. =cut */ static void make_code_pointers(ARGMOD(PackFile_Segment *seg)) { ASSERT_ARGS(make_code_pointers) PackFile * const pf = seg->pf; switch (seg->type) { case PF_BYTEC_SEG: if (!pf->cur_cs) pf->cur_cs = (PackFile_ByteCode *)seg; break; case PF_CONST_SEG: if (!pf->cur_cs->const_table) { pf->cur_cs->const_table = (PackFile_ConstTable *)seg; pf->cur_cs->const_table->code = pf->cur_cs; } break; case PF_UNKNOWN_SEG: break; case PF_DEBUG_SEG: pf->cur_cs->debugs = (PackFile_Debug *)seg; pf->cur_cs->debugs->code = pf->cur_cs; break; default: break; } } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ pdd10_embedding.pod000644000765000765 3647612101554066 20045 0ustar00brucebruce000000000000parrot-5.9.0/docs/pdds# Copyright (C) 2001-2012, Parrot Foundation. =head1 PDD 10: Embedding =head2 Abstract Parrot, more precisely libparrot, can be embedded into applications to provide a dynamic language runtime. A perfect example of this embedding is in the Parrot executable, which is a thin wrapper around libparrot. Version 1 =head2 Description =head3 Difference Between Embedding and Extending Embedding and Extending (PDD 11) are similar concepts. In both, we write code that interfaces with libparrot. In an embedding situation we write an application which loads and calls libparrot. In an extending situation, libparrot loads and calls your module. Extending gives libparrot more features, and allows your code to execute from inside libparrot. From that location, the extending application has full access to the available power and features of libparrot. This includes knowledge about internal structure definitions, and internal-only functions and subsystems. Because extending code is so closely tied to the internals of libparrot, it will be more affected by changes in libparrot itself. Also, the stability of extending code is tied to the stability of libparrot: If either crashes, the other will likely crash with it. Embedding, on the other hand, has much more limited access to libparrot. All embedding applications must use the official embedding API, which is limited and abstracted by design. Embedding applications must treat all pointers and structures returned from the API as being opaque. This abstraction buys stability. Changes to the internals of libparrot are unlikely to cause changes in embedding code. If libparrot crashes or suffers an unrecoverable error, it can return control to the embedding application more gracefully. =head3 The Embedding API The Embedding API is a special set of functions found in the C directory. These functions may not be used internally by libparrot, embedding applications may not use any other functions. Breaking either of these rules can have serious implications for application stability. Prior to the implementation of the new API, when libparrot had an unhandled exception it would call the C C library function to close the application. This is undesirable because embedding applications want the ability to handle errors and recover from problems in libparrot. The new API provides error handling capabilities for cases of unhandled exceptions, including both expected EXCEPT_exit and other types of error-related exceptions. The embedding API also makes sure certain details are in place, including stack markers for the GC. Calling into libparrot without setting a valid stack marker could cause serious (and difficult to diagnose) errors. The embedding API provides relatively limited interaction with libparrot, at least from the point of view of an internals developer or an extension developer. There are many reasons for this. First and foremost, the full power of libparrot is almost always available through the runcore. If you want to do something with Parrot, it is almost always easier and preferred to write your code in a language which targets Parrot, compile it down to bytecode, and load that bytecode into Parrot to execute. Almost all applications of libparrot will involve bytecode execution at some level, and this is where most operations become possible. The API also provides a powerful abstraction layer between the libparrot internals developers and the embedding application developers. The API is sufficiently abstracted and detached enough that even large changes to the internals of libparrot are unlikely to require any changes in the embedding application. For instance, libparrot could completely change its entire object model implementation and not cause a change to the API at all. While limited, the API is not static. If embedders need new features or functionality, those can usually be added with relative ease. =head2 Using the Embedding API The embedding API follows certain guidelines that should be understood by users, and followed by developers: =over 4 =item * The embed API operates mostly on the 4 core Parrot data types: Parrot_PMC, Parrot_String, Parrot_Int, and Parrot_Float. The first two of these are pointers and should be treated as opaque. =item * Where possible and reasonable, functions should take Parrot_Strings instead of raw C C or C types. Functions do exist to easily convert between C types and Parrot_String. =item * PMCs are the primary data item. Anything more complicated than an integer or string will be passed as a PMC. Some integers and strings will be wrapped up in a PMC and passed. =item * The number of API functions will stay relatively small. The purpose of the API is not to provide the most efficient use of libparrot, but instead the most general, stable and abstracted one. =item * Calls into libparrot carry a performance overhead because we have to do error handling, stack manipulation, data marshaling, etc. It is best to do less work through the API, and more work through bytecode and the runcore. =item * The embed API uses a single header file: L. Embedding applications should use only this header file and no other header files from Parrot. Embedding applications should NOT use L, or any other files. =item * libparrot does little to no signal handling. Those are typically the responsibility of the embedder. =item * File descriptors and resource handles are typically owned by whoever opens them first. If the embedding application tells libparrot to open a file with a FileHandle PMC, libparrot will keep and manage that file descriptor. Functionality may be provided to import and export sharable resources like these. =item * Resources such as allocated memory are managed by whoever creates them. If the embedding application allocates a structure and passes it in to libparrot, the embedding application is in charge of managing and freeing that structure. If libparrot allocates data, it will be in charge of managing and freeing it. In many cases, data passed to or from libparrot through the API will be copied to a new memory buffer. =item * libparrot will not output error information to C unless specifically requested to. Instead, libparrot will gather all error information and make it available to the user through function calls. =item * API calls should be nestable. Unhandled exceptions or other error conditions should cause a jump back to the inner-most API call. The interpreter should be able to recover from errors in inner-most frames and continue executing. I =back =head2 Implementation The embedding API has two goals: To allow access to libparrot as a dynamic language runtime and bytecode interpreter, and to encapsulate implementation details internal to libparrot from the embedding application. There are several guidelines for the embedding API implementation that developers of it should follow: =over 4 =item * It should never be possible to crash or corrupt the interpreter when following the interface as documented. The interpreter should be able to be used and reused until it is explicitly destroyed. The interpreter should be reusable after it deals with an unhandled exception, including EXCEPT_exit exceptions. =item * It should never be possible for libparrot to crash, corrupt, or forcibly exit the embedding application. Also, libparrot should never use resources which haven't been assigned to it, such as standard IO handles C, C, and C. =item * Each API function should have a single purpose, and should avoid duplication of functionality as much as possible. A course-grained API is preferable to a fine-grained one, even if some performance must be sacrificed. =item * names must be consistent in the API documentation and the examples. All API functions are named C. =item * The return value of every API function should be an integer value. The return value should be 1 on success, and 0 on failure. No other results should be returned. The marker C is special and is used to denote API functions. This macro sets the function up to be exported from the shared library and may also provide some hints to the compiler. All API functions return a Parrot_Int to signal status. =back =head3 Working with Interpreters It is the external code's duty to create, manage, and destroy interpreters. C returns an opaque pointer to a new interpreter, with some options set in it. The definition of C is as follows: Parrot_Int Parrot_api_make_interpreter(Parrot_PMC parent, Parrot_Int flags, Parrot_Init_Args *args, Parrot_PMC * interp); A common usage pattern for making an interpreter is: Parrot_PMC interp = NULL; Parrot_Init_Args *args = NULL; GET_INIT_ARGS(args); if (!Parrot_api_make_interpreter(NULL, 0, args, &interp)) { fprintf(stderr, "Could not create interpreter"); exit(EXIT_FAILURE); } C can be NULL for the I interpreter created, or where the interpreter does not have a logical parent. If a parent is provided, the new interpreter will have a child/parent relationship with the parent interp. The C parameter contains a bit-wise combination of certain startup flags that govern interpreter creation. It is safe to set this to 0 unless special needs require it to be otherwise. The C parameter is a structure containing a series of options that must be set on the interpreter during initialization. These options, many of which deal with the memory subsystem and other deep internals can typically be ignored. C can be C if no special options need to be set. The new interpreter PMC is returned in the last parameter. C destroys an interpreter and frees its resources. Parrot_Int Parrot_api_destroy_interpreter(Parrot_Interp); It is a good idea to destroy child interpreters before destroying their parents. =head3 Working with Source Code and PBC Files libparrot natively executes .pbc bytecode files. These are manipulated in Parrot through a PMC interface. PBC PMCs can be obtained in a number of ways: they can be returned from a compiler, they can be loaded from PBC, or they can be constructed on the fly. I Once a PBC PMC is obtained, several things can be done with it: It can be loaded into libparrot as a library and individual calls can be made into it. It can also be executed directly as an application, which will trigger the C<:main> function, if any. The PMC can also be written out to a .pbc file for later use. Currently there are two functions to get a bytecode PMC. Parrot_api_load_bytecode_file(interp, filename, *pbc) Parrot_api_load_bytecode_bytes(interp, bytecode, size, *pbc) The first function loads bytecode from a file. The second loads bytecode in from an in-memory byte array. Both return a bytecode PMC. That PMC can be passed as an argument to any of the following functions: Parrot_api_ready_bytecode(interp, pbc, *main_sub) Parrot_api_run_bytecode(interp, pbc, args) Parrot_api_disassemble_bytecode(interp, pbc, outfilename, opts) C loads the bytecode into memory and returns a reference to the C<:main> Sub PMC, if any. It does not automatically execute the bytecode. C loads bytecode and automatically executes C<:main> with the given arguments, and sets these arguments in the IGLOBALS array for later access. C is used primarily by the pbc_disassemble frontend. =head3 Settings and Configuration The interpreter is configured in many ways. When the interpreter is created there is a structure C that we can use to optionally change some of the low-level internal options of the interpreter. Thereafter, we can set configurations using the Config Hash or a series of API calls. The Configuration hash is a hash of named settings that can be set in the interpreter. The primary purpose of this is to help set information such as standard search paths. The configuration hash will also be available from the interpreter's IGLOBALS array, and may be used by various tools and utilities to inform certain decisions. To set a configuration hash, call Parrot_api_set_configuration_hash This function is only really intended to be called once per interpreter. It is possible to set a new configuration hash at any time, but settings from the old hash will not be removed first. Currently, the configuration hash is set as a global, and any interpreter created after a config hash is set will automatically inherit the last set configuration hash. Setting a new config hash on a child interpreter does not affect any existing interpreters. In addition to the configuration hash, library search paths can be appended to through the following functions: Parrot_api_add_library_search_path Parrot_api_add_include_search_path Parrot_api_add_dynext_search_path or hooked via a custom defined: #ifdef PARROT_PLATFORM_LIB_PATH_INIT_HOOK PARROT_PLATFORM_LIB_PATH_INIT_HOOK(interp, lib_paths); #endif The search paths are accessible via vtable calls to indexed string arrays from the ParrotInterpreter array, at the index C. See F resp. F for the indices. For example in pir: .local pmc interp getinterp interp .local pmc lib_paths lib_paths = interp[.IGLOBALS_LIB_PATHS] .local pmc include_path include_path = lib_paths[.PARROT_LIB_PATH_INCLUDE] .local pmc library_path library_path = lib_paths[.PARROT_LIB_PATH_LIBRARY] .local pmc dynext_path dynext_path = lib_paths[.PARROT_LIB_PATH_DYNEXT] .local pmc lang_path lang_path = lib_paths[.PARROT_LIB_PATH_LANG] =head3 Strings and PMCs Embedding API functions which perform general operations on any PMC are named C and are located in the file C. Functions which perform general operations on a Parrot String are named C and are located in the file C. PMC functions are general and explicitly limited. The API does not, and does not want to, provide complete access to the entire suite of internal operations and VTABLEs. The API does not provide convenience methods to do all operations in a single call. Some common operations may take multiple API calls to perform. String operations are broken down into two types: The first are the set of functions used to marshal between C-level strings and Parrot Strings. Import functions take a C string (char* or wchar_t*), and copy their contents into a new String buffer. Export functions perform the opposite operation: The internal buffer is copied to a freshly allocated memory block and returned. When you are done with the string, there is an associated free function to deallocate that memory. The second type of string API functions are functions to perform operations on strings. These could be operations such as string analysis or string manipulation. =head2 References =cut __END__ Local Variables: fill-column:78 End: vim: expandtab shiftwidth=4: pdds.json000644000765000765 47511631440401 16355 0ustar00brucebruce000000000000parrot-5.9.0/docs/index{ "page" : "pdds", "content" : [ { "source" : [ "docs/pdds/*.pod", "docs/pdds/draft/*.pod" ], "resource" : [ "docs/pdds/*.png" ], "title" : "Design Documents" } ], "title" : "Parrot Design Documents (PDDs)" } hacking_tips.pod000644000765000765 1001412101554066 20272 0ustar00brucebruce000000000000parrot-5.9.0/docs/project# Copyright (C) 2011, Parrot Foundation. =head1 NAME docs/project/hacking_tips.pod - A Collection of Useful Tips for Parrot Hacking =head1 DESCRIPTION Parrot is a complex project that can fail in mysterious and spectacular ways and has a tendency to exhibit surprising performance bottlenecks. When that happens, you have the exciting job of figuring out what's wrong and how to fix it. This document exists to provide a repository of knowledge and techniques to make that job easier. =head2 Debugging Parrot (external tools) =head3 gdb gdb should be a familiar tool, but many developers only use a small subset of its capabilities. This section covers some of its lesser known features that may come in handy while debugging Parrot. Note that this is not intended to be an exhaustive resource. If your favorite technique is missing, please add it. =head4 Conditional Breakpoints gdb's breakpoints are great for inspecting the state of a running (or recently crashed) program, but sometimes the function or line you want to break on will be entered many times before it becomes interesting. gdb allows breakpoints to be tied to conditions like so: (gdb) br Parrot_FixedPMCArray_elements if _self == 0 Breakpoint 1 at 0xb7e69830: file ./src/pmc/fixedpmcarray.c, line 163. =head4 Pretty-Printing A very nice feature implemented by Nolan Lum as a Google Code-In project is gdb pretty-printing support for Parrot's STRING and PMC structs. This makes those structs much more discoverable. Instead of seeing this: $1 = {flags = 512, vtable = 0x8096388, data = 0x80b64a4, _metadata = 0x0} when debugging a PMC or STRING, you'll see this: Note that you'll need gdb 7.1 or later for this to work. =head4 Links L =head3 Reducing Nondeterminism When trying to chase down GC bugs, reproducibility is often a major barrier. These tools and techniques reduce randomness in a running interpreter and may make garbage collection bugs (and other memory-sensitive problems) easier to isolate. =head4 ASLR and VDSO Disabling address space layout and VDSO can make a program run less randomly. Be careful with this, though. Disabling ASLR also makes certain kinds of attacks easier to perform. Don't do this on a production system, and be sure to reenable these settings once you're done debugging. sudo sh -c "echo 0 > /proc/sys/kernel/randomize_va_space" sudo sh -c "echo 0 > /proc/sys/vm/vdso_enabled" =head4 Hash Seed Randomization Parrot's hashing algorithms use a randomized hash seed. This makes execution of PIR code less vulnerable to an algorithmic complexity attack based on the performance of our hashing algorithm, but also means that iteration through an unordered hash won't always happen in the same order. If your bug fails intermittently, try passing several different hash seeds to the parrot executable until you find one that triggers the bug: parrot --hash-seed=0x1234 ./perl6.pbc foo.p6 =head2 Debugging Parrot (internal tools) When it crashes, Parrot makes an effort to provide a PIR-level backtrace in addition the typical C-level backtrace. This may not be entirely useful because libparrot gets its debugging information from imcc, but there's potential for it to help. TODO: parrot_debugger =head2 Profiling (external tools) TODO: valgrind (memgrind, callgrind) =head2 Profiling (internal tools) TODO: profiling runcore =head2 Misc When hacking on the Configure system, it's helpful to be able to run a single step instead of having to go through the whole process. tools/dev/reconfigure.pl exists for that purpose: perl tools/dev/reconfigure.pl --step=gen::makefile When hacking on Makefile template files such as F, please: =over 4 =item * Pay attention to situations where F rules require hard-tabs rather than wordspaces. =item * Make sure you test your code revisions with both F and, on multi-core machines, F (where C 1>). =back =cut __END__ Local Variables: fill-column:78 End: porting_intro.pod000644000765000765 1007612101554066 17066 0ustar00brucebruce000000000000parrot-5.9.0/docs# Copyright (C) 2001-2012, Parrot Foundation. =pod =head1 NAME docs/porting_intro.pod - Parrot Subsystem Porting Introduction =head1 DESCRIPTION This document is an introduction to porting the optional subsystems of Parrot onto a new architecture once the core successfully builds. It assumes passing familiarity with common VM techniques but relatively little knowledge of Parrot internals. For each feature, a brief description of its purpose, hints on helping to port it, and pointers to more information are included. =head1 THREADS =head2 What it is Parrot abstracts parallel streams of execution (threads) using a small set of concurrency primitives that operate on thread objects with distinct code paths and private data. Architecture-specific threading models are mapped onto to these primitives to provide Parrot threads with the most desirable features of native threads. Native thread support is very important to the adoption of Parrot. =head2 How to help At present Parrot has full native threads support, pthreads and windows threads. But running garbage collection together with allocation of memory in threaded code might lead to races or access violations, esp. on darwin, but also on linux. See L =head2 References =over 4 =item * F =item * F =item * F =item * F =item * F =back =head1 Signals =head2 What it is Parrot must be able to receive asynchronous imperative and advisory messages from the operating system and other local processes in a safe manner. Typically this is done by registering message-specific callback functions, to which the operating system transfers control when signals are generated. =head2 How to help UNIX-like systems usually employ the signal() function for this purpose; Windows achieves similar functionality with message queues. For now, Parrot assumes a mechanism like the former can be used. Currently the signal handler test suite only operates under Linux, though the mechanism itself is intended to work wherever Parrot does. Portable tests as well as fixes for failures thereof are greatly needed. =head2 References =over 4 =item * F =item * F =back =head1 DYNLOADING =head2 What it is Nearly all modern operating systems support runtime-specified importation of shared library object code, and Parrot must support this feature in order to use native libraries without relying on the system linker. Notable APIs for this mechanism include C on common *NIXes and LoadLibrary on Win32. =head2 How to help If not already supported, research the dynamic library loading API for your platform and implement it in the platform-specific sources. Since Parrot substantially abstracts the dynload mechanism, adding support for a new platform should not require diving far into Parrot internals. =head2 References =over 4 =item * F =back =head1 Memory protection =head2 What it is An ever-increasing number of operating systems support the enforcement of executable/non-executable flags on memory regions to prevent the improper execution of erroneous or malicious instructions. When applied by default to regions that rarely need to contain executable code, this is a useful security measure. However, since Parrot (specifically, the JIT subsystem) generates and executes native instructions in such regions, it must be able to safely circumvent these protections. =head2 How to help Determine what level of support for execute protection your architecture/OS combination has, and how to selectively disable it. Documentation for features like PaX (Linux) and W^X (OpenBSD) are the best place to look for this information. The platform-specific source files implement memory allocation wrappers that hide these details, so wading deep into Parrot is probably not a prerequisite for this task. =head1 REFERENCES =over 4 =item * F =back =cut manifest.t000644000765000765 156311533177644 16273 0ustar00brucebruce000000000000parrot-5.9.0/t/distro#! perl # Copyright (C) 2001-2006, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use ExtUtils::Manifest; =head1 NAME t/distro/manifest.t - check sanity of the MANIFEST file =head1 SYNOPSIS % prove t/distro/manifest.t =head1 DESCRIPTION Checks that the distribution and the MANIFEST file agree. =cut ok( -e $ExtUtils::Manifest::MANIFEST, 'MANIFEST exists' ); ok( -e $ExtUtils::Manifest::MANIFEST . '.SKIP', 'MANIFEST.SKIP exists' ); diag "this may take a while..."; $ExtUtils::Manifest::Quiet = 1; my @missing = ExtUtils::Manifest::manicheck(); ok( !@missing, 'manicheck()' ) or diag("Missing files:\n\t@missing"); # remember to change the number of tests :-) BEGIN { plan tests => 3; } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: TclLibrary.pir000644000765000765 2574111533177636 21777 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library# Copyright (C) 2008, Parrot Foundation. # vkon =head1 TITLE TclLibrary.pir - NCI interface to Tcl language (http://www.tcl.tk) =head1 DESCRIPTION This module implements Tcl/Tk interface for Parrot. =head1 TODO =over 2 =item Tcl_GetStringFromObj - check its declaration and usage func = dlfunc libtcl, "Tcl_GetStringFromObj", "tpp" # should be "tp3" =back =cut .include "hllmacros.pir" .include "datatypes.pasm" .namespace ['TclLibrary'] # derived from tcl.h: .const int TCL_OK = 0 .const int TCL_ERROR = 1 .const int TCL_RETURN = 2 .const int TCL_BREAK = 3 .const int TCL_CONTINUE = 4 # DEBUG .const int debug_objresult = 1 # .sub eval :method .param string str .local string res, error .local pmc f_evalex, f_getobjresult, f_getstringresult, f_resetresult f_resetresult = get_global '_tcl_resetresult' f_evalex = get_global '_tcl_evalex' f_getobjresult = get_global '_tcl_getobjresult' f_getstringresult = get_global '_tcl_getstringresult' .local pmc interp interp = getattribute self,'interp' f_resetresult(interp) .local int rc rc = f_evalex(interp,str,-1,0) # interp, string, length or -1, flags # check if the result is TCL_OK(=0) if rc==TCL_OK goto eval_ok res = f_getstringresult(interp,0) error = "error during Tcl_EvalEx: " . res die error eval_ok: # get the result (list result, etc - TBD) .IfElse(debug_objresult==1,{ .local pmc obj obj = f_getobjresult(interp,0) .local pmc tcl_obj_decl tcl_obj_decl = get_global '_tcl_obj_decl' # retrieve tcl_obj structure assign obj, tcl_obj_decl # ... and use it res = _pmc_from_tclobj(interp,obj) },{ res = f_getstringresult(interp,0) }) .return(res) .end # Constructor for the interpreter object. # optional parameter - path to the tcl shared library. .sub init :method :vtable .param string libname :optional .param int has_libname :opt_flag # get interpreter, store it globally .local pmc interp, f_createinterp, f_tclinit .local pmc libtcl libtcl = get_global '_libtcl' # if _libtcl not defined yet, then we're starting first time, so need # to call _tcl_load_lib unless_null libtcl, libtcl_loaded if has_libname goto with_libname '_tcl_load_lib'() goto with_libname_e with_libname: '_tcl_load_lib'(libname) with_libname_e: libtcl = get_global '_libtcl' libtcl_loaded: f_createinterp = dlfunc libtcl, "Tcl_CreateInterp", "p" interp = f_createinterp() unless_null interp, ok_interp die "NO interp\n" ok_interp: setattribute self,'interp', interp f_tclinit = dlfunc libtcl, "Tcl_Init", "vp" f_tclinit(interp) .end =over 4 =item _init Performs the initialization of Tcl bridge, namely instantiates TclLibrary class =cut .sub _init :load :init .local pmc tclclass tclclass = newclass ['TclLibrary'] addattribute tclclass, 'interp' .end =item _init_tclobj - creates a helper for Tcl_Obj struct # do the tcl.h adaptations =cut .sub _init_tclobj # "declare" a helper for Tcl_Obj structure # here is the definition of the Tcl_Obj struct # typedef struct Tcl_Obj { # int refCount; // When 0 the object will be freed. # char *bytes; // points to the first byte of the obj string representation... # int length; // number of bytes at *bytes, not incl.the term.null. # Tcl_ObjType *typePtr; // obj type. if NULL - no int.rep. # union { /* The internal representation: */ # long longValue; /* - an long integer value */ # double doubleValue; /* - a double-precision floating value */ # VOID *otherValuePtr; /* - another, type-specific value */ # Tcl_WideInt wideValue; /* - a long long value */ # struct { /* - internal rep as two pointers */ # VOID *ptr1; # VOID *ptr2; # } twoPtrValue; # struct { /* - internal rep as a wide int, tightly # * packed fields */ # VOID *ptr; /* Pointer to digits */ # unsigned long value;/* Alloc, used, and signum packed into a # * single word */ # } ptrAndLongRep; # } internalRep; # } Tcl_Obj; .local pmc tcl_obj_struct, tcl_obj_decl tcl_obj_decl = new 'ResizablePMCArray' push tcl_obj_decl, .DATATYPE_INT push tcl_obj_decl, 0 push tcl_obj_decl, 0 push tcl_obj_decl, .DATATYPE_CSTR push tcl_obj_decl, 0 push tcl_obj_decl, 0 push tcl_obj_decl, .DATATYPE_INT push tcl_obj_decl, 0 push tcl_obj_decl, 0 push tcl_obj_decl, .DATATYPE_INT push tcl_obj_decl, 0 push tcl_obj_decl, 0 # following items are for union, let it be 2 longs, which eventually # could be transformed to the required type push tcl_obj_decl, .DATATYPE_LONG push tcl_obj_decl, 2 push tcl_obj_decl, 0 # union TBD tcl_obj_struct = new 'UnManagedStruct', tcl_obj_decl set_global '_tcl_obj_decl', tcl_obj_decl # XXXXXXXXX <---------- .end # find proper shared library and use it. .sub _tcl_load_lib .param string libname :optional .param int has_libname :opt_flag # load shared library .local pmc libnames libnames = new 'ResizableStringArray' unless has_libname goto standard_names push libnames, libname say libname goto standard_names_e standard_names: push libnames, 'tcl85' push libnames, 'tcl84' push libnames, 'libtcl8.5' push libnames, 'libtcl8.4' push libnames, 'libtcl8.5.so' push libnames, 'libtcl8.4.so' standard_names_e: .local pmc libtcl libtcl = _load_lib_with_fallbacks('tcl', libnames) set_global '_libtcl', libtcl # initialize Tcl library .local pmc func_findexec func_findexec = dlfunc libtcl, "Tcl_FindExecutable", "vp" func_findexec(0) # few more functions, store them globally .local pmc func # need: Tcl_ResetResult, Tcl_EvalEx, Tcl_GetStringResult, etc func = dlfunc libtcl, "Tcl_ResetResult", "vp" set_global '_tcl_resetresult', func func = dlfunc libtcl, "Tcl_EvalEx", "iptii" set_global '_tcl_evalex', func func = dlfunc libtcl, "Tcl_GetStringFromObj", "tpp" # should be "tp3" set_global '_tcl_getstringfromobj', func func = dlfunc libtcl, "Tcl_GetStringResult", "tp" set_global '_tcl_getstringresult', func func = dlfunc libtcl, "Tcl_ListObjGetElements", "vippp" # should be "vip3p" set_global '_tcl_listobjgetelements', func func = dlfunc libtcl, "Tcl_GetObjResult", "pp" set_global '_tcl_getobjresult', func func = dlfunc libtcl, "Tcl_GetObjType", "it" set_global '_tcl_getobjtype', func '_init_tclobj'() .end # #static SV * #SvFromTclObj(pTHX_ Tcl_Obj *objPtr) =item pmc _pmc_from_tclobj(pmc interp, pmc tclobj) This is a (static) function that will convert Tcl object to pmc =cut .sub _pmc_from_tclobj .param pmc interp .param pmc tclobj # check what type this tcl obj is say "enter pmc_from_tclobj" # check what tclobj actually is (null, integer, list, etc) # ---> these lines will be factored out into some init stage! .... .local int tclBooleanTypePtr .local int tclByteArrayTypePtr .local int tclDoubleTypePtr .local int tclIntTypePtr .local int tclListTypePtr .local int tclStringTypePtr .local int tclWideIntTypePtr .local pmc f_getobjtype f_getobjtype = get_global '_tcl_getobjtype' tclBooleanTypePtr = f_getobjtype("boolean") tclByteArrayTypePtr = f_getobjtype("bytearray") tclDoubleTypePtr = f_getobjtype("double") tclIntTypePtr = f_getobjtype("int") tclListTypePtr = f_getobjtype("list") tclStringTypePtr = f_getobjtype("string") tclWideIntTypePtr = f_getobjtype("wideInt") # ..... <---- (see above) #.local pmc tcl_obj_struct #tcl_obj_struct = get_global '_tcl_obj_struct' if tclobj!=0 goto not_null # null say "NULL???" goto EOJ not_null: .local int obj_type obj_type = tclobj[3] if obj_type==0 goto EOJ # if obj_type is null, there's no internal rep if obj_type!=tclBooleanTypePtr goto m00 say "implement tclBooleanTypePtr!" goto EOJ m00: if obj_type!=tclByteArrayTypePtr goto m01 say "implement tclByteArrayTypePtr" goto EOJ m01: if obj_type!=tclDoubleTypePtr goto m02 #sv = newSViv(objPtr->internalRep.doubleValue); say "implement tclDoubleTypePtr" goto EOJ m02: if obj_type!=tclIntTypePtr goto m03 #sv = newSViv(objPtr->internalRep.longValue); .local int ires ires = tclobj[4] say ires .return(ires) m03: if obj_type!=tclListTypePtr goto m04 .local int objc .local pmc objv # pointer which will hold array of tcl_obj's # Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv); # if (objc) { .... } .local pmc f_listobjgetelements f_listobjgetelements = get_global '_tcl_listobjgetelements' #f_listobjgetelements.(0, tclobj, objc, objv) say "implement tclListTypePtr" goto EOJ m04: if obj_type!=tclStringTypePtr goto m05 say "implement tclStringTypePtr" goto EOJ m05: print "implement TCL obj_type " say obj_type EOJ: .local string str .local pmc f_getstr f_getstr = get_global '_tcl_getstringfromobj' str = f_getstr(tclobj, 0) .return(str) .end .sub MainLoop :method say "MainLoop" # TO BE FIXED self.'eval'(<<'EOS') while {[winfo exists .]} { update } EOS # .local pmc libtcl, f_mainloop # libtcl = get_global '_libtcl' # f_mainloop = dlfunc libtcl, "Tk_MainLoop", "v" # f_mainloop() say "MainLoop-e!" .end =item _load_lib_with_fallbacks(string friendly_name, pmc fallback_list) This function is more generally useful than just for this module -- it implements the search for a particular library that may appear under any of several different filenames. The C should be a simple array of strings, each naming one of the possible filenames, I the trailing shared library extension (e.g. C<.dll> or C<.so>). The C is only used to fill in the error message in case no match can be found on the system. BORROWED from OpenGL.pir - keep an eye on it (e.g. if it will be organized elsewhere - reuse it from there) =cut .sub _load_lib_with_fallbacks .param string friendly_name .param pmc fallback_list .local pmc list_iter list_iter = iter fallback_list .local string libname .local pmc library iter_loop: unless list_iter goto failed libname = shift list_iter library = loadlib libname unless library goto iter_loop loaded: print "tcl lib is " say libname .return (library) failed: .local string message message = 'Could not find a suitable ' message .= friendly_name message .= ' shared library!' die message .end =back =head1 SEE ALSO http://www.tcl.tk =head1 AUTHORS TBD =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: utf8_base64.pir000644000765000765 210312101554066 20535 0ustar00brucebruce000000000000parrot-5.9.0/examples/library#!./parrot # Copyright (C) 2012, Parrot Foundation. =head1 NAME examples/mime_base64/utf_base64.pir - Conformant MIME::Base64 utf8 handling =head1 SYNOPSIS % ./parrot examples/mime_base64/utf_base64.pir =head1 DESCRIPTION Compare conformant coreutils C and F against ours. See L =cut .sub main :main load_bytecode 'MIME/Base64.pbc' .local pmc enc_sub enc_sub = get_global [ "MIME"; "Base64" ], 'encode_base64' .local string result_encode # GH 814 result_encode = enc_sub(utf8:"\x{a2}") say "encode: utf8:\"\\x{a2}\"" say "expected: wqI=" print "result: " say result_encode # GH 813 result_encode = enc_sub(utf8:"\x{203e}") say "encode: utf8:\"\\x{203e}\"" say "expected: 4oC+" print "result: " say result_encode .end =head1 AUTHOR ronaldxs =head1 SEE ALSO F, =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: TODO000644000765000765 55511533177633 16140 0ustar00brucebruce000000000000parrot-5.9.0/compilers/opscSimple todo. Required for initial self-hosting: * NONE! We are selfhosted now! Required for full implementation: * Handling #line directives. * A LOT OF DOCUMENTATION. * Add tests for Trans::C independent from 06-emitter.t * Add tests for dynamic mode of Emitter. Nice to have: * Profiling and performance tuning of ops parsing (we need pmichaud). rx_modifiers000644000765000765 1512311533177643 22260 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/pge/perl6regex## modifiers :i bcd abcdef y ignorecase (:i) :i bcd aBcdef y ignorecase (:i) :i bcd abCdef y ignorecase (:i) :i bcd abcDef y ignorecase (:i) :i bcd abc-ef n ignorecase (:i) :ignorecase bcd abcdef y ignorecase (:ignorecase) :ignorecase bcd aBCDef y ignorecase (:ignorecase) :ignorecase bcd abc-ef n ignorecase (:ignorecase) # todo :pugs :i(0) bcd abcdef y ignorecase, repetition (:i(0)) :i(0) bcd abCdef n ignorecase, repetition (:i(0)) # todo :pugs :i(1) bcd abcdef y ignorecase, repetition (:i(1)) # todo :pugs :i(1) bcd abCdef y ignorecase, repetition (:i(1)) :i(1) bcd aBxDef n ignorecase, repetition (:i(1)) # todo :pugs :0i bcd abcdef y ignorecase, repetition (:0i) :0i bcd abCdef n ignorecase, repetition (:0i) # todo :pugs :1i bcd abcdef y ignorecase, repetition (:1i) # todo :pugs :1i bcd abCdef y ignorecase, repetition (:1i) # todo :pugs :1i bcd aBCDef y ignorecase, repetition (:1i) :1i bcd aBxDef n ignorecase, repetition (:1i) ab [:i cd ] ef abcdef y ignorecase, lexical (:i) ab [:i cd ] ef abCdef y ignorecase, lexical (:i) ab [:i cd ] ef abcDef y ignorecase, lexical (:i) ab [:i cd ] ef abCDef y ignorecase, lexical (:i) ab [:i cd ] ef aBCDef n ignorecase, lexical (:i) ab [:i cd ] ef abCDEf n ignorecase, lexical (:i) :i ab [:i cd ] ef abCDef y ignorecase, lexical (:i) :i ab [:i cd ] ef AbCDeF y ignorecase, lexical (:i) :i ab [:i cd ] ef AbcdeF y ignorecase, lexical (:i) # todo :pugs :i a [:i(0) b [:i(1) c [:0i d [:1i e [:i(0) f ] ] ] ] ] AbCdEf y ignorecase, lexical (:i) # todo :pugs :i aa [:i(0) bb [:i(1) cc [:0i dd [:1i ee [:i(0) ff ] ] ] ] ] AabbCcddEeff y ignorecase, lexical (:i) :i a [:i(0) b [:i(1) c [:0i d [:1i e [:i(0) f ] ] ] ] ] AbCdEF n ignorecase, lexical (:i) :i aa [:i(0) bb [:i(1) cc [:0i dd [:1i ee [:i(0) ff ] ] ] ] ] AabbCcddEeFf n ignorecase, lexical (:i) # todo :pugs :i ab [:i(0) cd ] ef AbcdeF y ignorecase, lexical repetition (:i) # todo :pugs :pge :i ab [:!i cd ] ef AbcdeF y ignorecase, lexical repetition (:i) # todo :pugs :i ab [:0i cd ] ef AbcdeF y ignorecase, lexical repetition (:i) # todo :pugs :0i ab [:1i cd ] ef abCDef y ignorecase, lexical repetition (:i) :0i ab [:1i cd ] ef AbCDeF n ignorecase, lexical repetition (:i) :0i ab [:1i cd ] ef AbcdeF n ignorecase, lexical repetition (:i) # todo :pugs :0i ab [:i(0) cd ] ef abcdef y ignorecase, lexical repetition (:i) :0i ab [:1i cd ] ef AbcdeF n ignorecase, lexical repetition (:i) # todo :pugs :i(1) ab [:1i cd ] ef AbCdeF y ignorecase, lexical repetition (:i) # todo :pugs :i(1) ab [:i(0) cd ] ef AbcdeF y ignorecase, lexical repetition (:i) :i(1) ab [:i(0) cd ] ef AbcDeF n ignorecase, lexical repetition (:i) # todo :pugs :i(2) ab [:i(999) cd ] ef ABCDEF y ignorecase, lexical repetition (:i) # todo :pugs :1i ab [:i(1) cd ] ef ABCDEF y ignorecase, lexical repetition (:i) :0i ab [:1i cd ] ef abcDeF n ignorecase, lexical repetition (:i) # todo :pugs :2i ab [:999i cd ] ef ABCDEF y ignorecase, lexical repetition (:i) ab [:ignorecase cd ] ef abCDef y ignorecase, lexical (:ignorecase) ab [:ignorecase cd ] ef aBCDef n ignorecase, lexical (:ignorecase) # todo :pugs :1ignorecase ab [:ignorecase(1) cd ] ef ABCDEF y ignorecase, lexical repetition (:ignorecase) # todo :pugs :s bcd a bcdef y sigspace (:s) # todo :pugs :s bcd a bcd ef y sigspace (:s) :s bcd abcdef n sigspace (:s) :s bcd abcd ef n sigspace (:s) :s bcd ab cdef n sigspace (:s) # todo :pugs :s b c d a b c d ef y sigspace (:s) # todo :pugs :s b c d a b c def y sigspace (:s) :s b c d ab c d ef n sigspace (:s) :s b c d a bcdef n sigspace (:s) :s b c d abcdef n sigspace (:s) # todo :pugs :sigspace bcd a bcdef y sigspace (:sigspace) # todo :pugs :sigspace bcd a bcd ef y sigspace (:sigspace) :sigspace bcd abcdef n sigspace (:sigspace) # todo :pugs :sigspace b c d a b c d ef y sigspace (:sigspace) # todo :pugs :sigspace b c d a b c def y sigspace (:sigspace) :sigspace b c d ab c d ef n sigspace (:sigspace) # todo :pugs :s(1) b c [:s(0) d e f ] a b c def y sigspace, lexical repetition (:s) # todo :pugs :pge :s b c [:!s d e f ] a b c def y sigspace, lexical repetition (:s) :s(0) b c [:s(1) d e f ] a b c def n sigspace, lexical repetition (:s) # todo :pge :!s b c [:s d e f ] a b c def n sigspace, lexical repetition (:s) :s(0) b c [:s(0) d e f ] a b c def n sigspace, lexical repetition (:s) # todo :pge :!s b c [:!s d e f ] a b c def n sigspace, lexical repetition (:s) # todo :pugs :s ab ab y sigspace, trailing ws foo\s*'-'?\s*bar foo\t \n-\n\t bar y basic match foo\s*'-'?\s*bar foo - bar y basic match foo\s+'-'?\s*bar foo bar y basic match \s+ \s* foo\s+'-'?\s*bar foo -bar y basic match \s+ \s* foo\s*'-'?\s+bar foo- bar y basic match \s* \s+ foo '-'? bar foo-bar y basic match \s* \s* foo '-'? bar foobar y basic match foo '-'? bar foo - bar n basic non-match # todo :pugs :s foo '-'? bar foo\n \t- \t\t\nbar y basic ws match # todo :pugs :s foo '-'? bar foo - bar y basic ws match # todo :pugs :s foo '-'? bar foo bar y basic ws match \s+ \s* # todo :pugs :s foo '-'? bar foo -bar y basic ws match \s+ \s* # todo :pugs :s foo '-'? bar foo- bar y basic ws match \s* \s+ # todo :pugs :s foo '-'? bar foo-bar y basic ws match \s* \s* :s foo '-'? bar foobar n basic ws non-match :s()foo '-'? bar foo - bar n basic ws match # todo :pugs :pge :s[]foo '-'? bar foo - bar y basic ws match # todo :pugs :sfoo '-'? bar foo - bar y basic ws match with boundary modifier separation # todo :pugs :s::foo '-'? bar foo - bar y basic ws match with backtrack no-op modifier separation :s::(\w+) ':=' (\S+) dog := spot /mob 0: / sigspace and capture together :s::(\w+) ':=' (\S+) dog := spot /mob 1: / sigspace and capture together # todo :pugs :pge :perl5 \A.*? bcd\Q$\E..\z a bcd$ef y perl5 syntax (:perl5) # todo :pugs :x(6) \d 123456 y repetition (:x) # todo :pugs :x(3) \d 123456 y repetition (:x) # todo :pugs :x(0) \d 123456 y repetition (:x) # todo :pugs :nth(3) a \d a1a2a3 y nth occurrence (:nth) # todo :pge :nth(4) a \d a1a2a3 n nth occurrence (:nth) # todo :pge :nth(0) a \d a1a2a3 n nth occurrence (:nth) :s^[\d+ ]* abc 11 12 13 abc y before closing bracket ## vim: noexpandtab tabstop=4 shiftwidth=4 hpux.pm000644000765000765 64711533177634 17371 0ustar00brucebruce000000000000parrot-5.9.0/config/init/hints# Copyright (C) 2005, Parrot Foundation. package init::hints::hpux; use strict; use warnings; sub runstep { my ( $self, $conf ) = @_; my $libs = $conf->data->get('libs'); if ( $libs !~ /-lpthread\b/ ) { $libs .= ' -lpthread'; } $conf->data->set( libs => $libs ); } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: debugger.pod000644000765000765 2240111533177634 15762 0ustar00brucebruce000000000000parrot-5.9.0/docs# Copyright (C) 2001-2009, Parrot Foundation. =head1 NAME docs/debugger.pod - The Parrot Debugger =head1 ABSTRACT This document describes F, the Parrot Debugger. =head1 DESCRIPTION Starting from version 0.0.6 Parrot has its own debugger, which is modeled after Perl's one. Its name is F, and is an interactive environment that let you step through bytecode, set breakpoints, evaluate assembly instructions and peek at the interpreter status. A good (well, at least some) knowledge of the Parrot internals is obviously required to read this document. Some familiarity with debugging principles is also mandatory beyond this point. =head1 BUILDING parrot_debugger The debugger is built along with Parrot when you run 'make', but if you want to build *only* the debugger, then you can run: make parrot_debugger Which will create a new parrot_debugger executable in the same directory as the parrot executable. =head1 THE DEBUGGER SHELL To start the debugger type: parrot_debugger file.pbc That is, F takes exactly one argument, which is the Parrot file that you're going to debug. This file may be Parrot bytecode (*.pbc), PASM source code (*.pasm) or PIR (*.pir). F will automatically load and disassemble the bytecode file for you. Note that you can't pass command line arguments to your program when you invoke the debugger. See the C command below for this. After the version banner, you'll see the friendly debugger prompt: (pdb) F is ready to receive commands and give output. To list the available commands type 'h'. To quit the debugger type 'q'. As with the Perl debugger, whenever it halts and shows you a line of code, it is always the line it's I to execute, not the one that it has just executed. =head1 DEBUGGER COMMANDS Always remember that you can enter 'h' to get a list of commands (this document may be outdated in respect to the actual debugger, so let it speak for itself). Most commands can be shortened to their first letter. When available, this is signaled by the letter in parentheses after the command name Thus, C means that the command can be given as 'help' or just 'h'. On the other hand, C can only be given as 'load', verbatim. Debugger commands are case sensitive (LOAD is not a valid command) but Parrot register names are not. A blank line always repeats the last command entered. Also note that at this point in its development, F has very poor error checking on commands and their arguments, so type carefully or something bad will happen. Feel free to report bugs, or better yet patch the source code (see L below). =over 4 =item assign Assign to a Parrot register. For example: (pdb) a I0 42 I0 = 42 (pdb) a N1 3.14 N1 = 3.14 The first command sets I0 to 42 and the second sets N1 to 3.14. Register names are not case sensitive, so you can use either i0 or I0 . =item disassemble Disassemble a loaded bytecode file. This will turn a file loaded with C into proper Parrot assembler. =item load Load a source code (assembler) file. The syntax is: load FILE =item list (l) List the source code. The syntax is: list [FROM] [NUM] Both arguments are optional. By default C is from where the last list command ended (or the first line if this is the first invocation) and C is 10. That is, it lists the source code ten lines at a time. Note that the disassembled source code is not the same as the original source code: labels take the names C and opcodes are fully qualified (eg. C instead of just C). See also C. Example: # lists the first three source code lines (pdb) l 1 3 1 set_i_ic I1,0 2 L3: print_sc "fact of " 3 print_i I1 =item run (r) Run (or restart) the program. The syntax is: run [ARGUMENTS] Any arguments you give are passed as command line arguments to the program (ie. they populate P0). After the program has ended, you can run it again with this command. See also the C command. Example: (pdb) r Restarting fact of 0 is: 1 fact of 1 is: 1 fact of 2 is: 2 fact of 3 is: 6 fact of 4 is: 24 fact of 5 is: 120 fact of 6 is: 720 Program exited. =item break (b) Add a breakpoint. The syntax is: b LINE [if CONDITION] If you want a conditional breakpoint you should first specify the register that is involved in the condition (at least one must be), the comparison and then the third argument can be either another register or a constant, which must be of the same type as the first register specified. The command returns a number which is the breakpoint identifier. You should note this number for the C command (see below). Example: # sets a breakpoint on line 10 (will be breakpoint 0) (pdb) b 10 Breakpoint 0 at line 10 # another breakpoint on line 11 (will be breakpoint 1) (pdb) b 11 Breakpoint 1 at line 11 # break at line 4 if I16 is less than or equal to 123456 (pdb) b 4 if I16 <= 123456 Breakpoint 2 at line 4 # break at line 4 if N27 is greater than 5.23 (pdb) b 5 if N27 > 5.23 Breakpoint 3 at line 5 # break at line 4 if S2 is equal to S13 (pdb) b 6 if S2 == S13 Breakpoint 4 at line 6 # break at line 4 if S5 is equal to "stop" (pdb) b 7 if S2 == "stop" Breakpoint 5 at line 7 =item watch (w) Add a watchpoint. The syntax is: w CONDITION The condition has the same format as in C =item delete (d) Delete a breakpoint. The syntax is: d NUM The C argument is the breakpoint number (from 0 to N) as emitted by the C command. It is NOT the line that has the breakpoint. Example: # delete the first breakpoint (was on line 10, see example above) (pdb) d 0 =item disable Disable a breakpoint. The syntax is the same as for the C command. Disabled breakpoints can be re-enabled with C. =item enable Re-enable a disabled breakpoint. The syntax is: enable [NUM] where C is the number of the breakpoint. =item continue (c) Continue the program execution. The syntax of this command is: continue [NUM] Without arguments, the command just runs the source code until a breakpoint is found (or until the end of the program). If you specify a number, it will skip the next C breakpoints it encounters. When the program has ended, continue will do nothing. Use C to execute it again. =item next (n) Run the next instruction. The syntax is: next [NUM] C defaults to 1, but you can give a number of instructions to execute before stopping again. =item eval (e) The eval command is currently unimplemeneted. Run an instruction. The syntax is: eval INSTRUCTION Example: (pdb) e set I0, 42 (pdb) e print I0 42 (pdb) p i I0 = 42 I1 = 0 ... =item trace (t) Trace the next instruction. The syntax is: trace [NUM] It executes the next C instructions (default is 1) just as C does, but printing additional trace information. This is the same as the information you get when running Parrot with the C<-t> option. Example: # executes 2 instructions and trace them (pdb) t 2 PC=0; OP=67 (set_i_ic); ARGS=(I1=0, 0) PC=3; OP=24 (print_sc); ARGS=("fact of ") fact of 3 print_i I1 =item print (p) Print the interpreter registers. Register names are not case sensitive. The syntax is: print VALUE C may be: =over 4 =item A register name: C Prints out the single register specified. =item A register type: C, C, C, or C

Prints out all registers of the given type =item An aggregate key: C Looks up the given (integer- or string-valued) key in a PMC register. =back For PMC registers, the command will print the number, the class of the PMC (in square brackets) and its string representation (when available). It prints for uninitialized PMC registers. Examples: # prints the content of I2 (pdb) p i2 I2 = 0 # prints the content of P0 (pdb) p P0 P0 = [ResizablePMCArray] # prints the content of all string registers (pdb) p s S0 = Just S1 = Another S2 = Parrot S3 = Hacker =item info Print interpreter information. Example: (pdb) info Total memory allocated = 81936 GC mark runs = 6 GC collect runs = 0 Active PMCs = 8197 Active buffers = 7 Total PMCs = 21840 Total buffers = 48 Header allocations since last collect = 0 Memory allocations since last collect = 2 =item quit (q) Exit the debugger. =item help (h) Prints information about debugger commands. The syntax is: help [COMMAND] If C is omitted, prints a list of the available commands. =back =head1 FILES =over 4 =item src/parrot_debugger.c This is the file that will produce the executable. Nothing fancy here, it mostly consists of the C

function. =item src/debug.c Most of the debugger is implemented here. You may want to start from the C function and go down from there for the real meat. =item src/embed.c C, the function which launches the debugger, is implemented here. =item include/parrot/debugger.h This defines all the PDB structures, which hold data used by the debugger. =back =head1 HISTORY =over 4 =item Version 1.0 First version (SVN debug.c revision 1.24), authored by Aldo Calpini =back sizes.pm000644000765000765 1670312101554066 16450 0ustar00brucebruce000000000000parrot-5.9.0/config/auto# Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME config/auto/sizes.pm - Various Sizes =head1 DESCRIPTION Determines the sizes of various types. =cut package auto::sizes; use strict; use warnings; use base qw(Parrot::Configure::Step); use Parrot::Configure::Utils ':auto'; sub _init { my $self = shift; my %data; $data{description} = q{Determine some sizes}; $data{result} = q{}; return \%data; } sub runstep { my ( $self, $conf ) = @_; my %types = ( intval => $conf->data->get('iv'), numval => $conf->data->get('nv'), opcode => $conf->data->get('opcode_t'), short => 'short', int => 'int', long => 'long', longlong => 'long long', ptr => 'void *', float => 'float', double => 'double', longdouble => 'long double', ); my @std_ints = ( 'short', 'int', 'long', 'long long' ); my @std_floats = ( 'float', 'double', 'long double' ); my @extra_ints = ( '__int16', '__int32', '__int64' ); my $sizes = _get_sizes($conf, values %types, @extra_ints); $conf->data->set( HAS_LONGLONG => $sizes->{'long long'} ? 1 : 0 ); _handle_ptrcast( $conf, \%types, $sizes, [ @std_ints, @extra_ints ]); for ( keys %types ) { $conf->data->set( $_.'size' => $sizes->{$types{$_}} ); } _set_intval_range($conf); _set_floatval_range($conf); # not as portable as possible, but should cover common architectures # extend list of types as necessary _set_fixed($conf, $sizes, 'int', 2, [ 'short', 'int', '__int16' ]); _set_fixed($conf, $sizes, 'int', 4, [ 'int', 'long', '__int32' ]); _handle_int64($conf, $sizes, [ 'long', 'long long', '__int64' ]); _set_fixed($conf, $sizes, 'float', 4, [ 'float', 'double' ]); _set_fixed($conf, $sizes, 'float', 8, [ 'double', 'long double' ]); _set_huge($conf, $sizes, 'int', [ reverse(@std_ints), reverse(@extra_ints), $types{intval} ] ); _set_huge($conf, $sizes, 'float', [ reverse(@std_floats), $types{numval} ] ); return 1; } #################### INTERNAL SUBROUTINES #################### sub test_size { my ($conf, $type) = @_; $conf->data->set( TEMP_type => $type ); $conf->cc_gen('config/auto/sizes/test_c.in'); eval { $conf->cc_build() }; my $ret = $@ ? 0 : eval $conf->cc_run(); $conf->cc_clean(); return $ret; } sub _get_sizes { my $conf = shift; my %sizes = map { $_ => 0 } @_; for my $size (keys %sizes) { $sizes{$size} = test_size($conf, $size); } return \%sizes; } sub _find_type_eq { my ($sizesref, $size, $checklist) = @_; for ( @$checklist ) { return $_ if $sizesref->{$_} == $size; } } sub _find_type_max { my ($sizesref, $checklist) = @_; my $size = 0; my $type; for ( @$checklist ) { if ( $sizesref->{$_} > $size ) { $type = $_; $size = $sizesref->{$_}; } } return $type; } sub _find_type_min { my ($sizesref, $checklist) = @_; my $size = 1024; # magic number greater than size of any scalar C type my $type; for ( @$checklist ) { if ( $sizesref->{$_} < $size ) { $type = $_; $size = $sizesref->{$_}; } } return $type; } sub _find_type_min_ge { my ($sizesref, $size, $checklist) = @_; my @reduced_checklist = grep { $sizesref->{$_} >= $size } @$checklist; return _find_type_min($sizesref, \@reduced_checklist); } sub _set_fixed { my ($conf, $sizesref, $kind, $size, $checklist) = @_; my $type = _find_type_eq($sizesref, $size, $checklist); my $name = $kind.$size.'_t'; if ( defined $type ) { $conf->data->set( $name => $type ); return 1; } else { $conf->data->set( $name => $checklist->[0] ); print <{$type}; $conf->data->set( 'huge'.$kind.'val' => $type, 'huge'.$kind.'valsize' => $size ); } sub _set_intval_range { my $conf = shift; my $ivmin; my $ivmax; my $iv = $conf->data->get('iv'); if ( ( $iv eq 'short' ) || ( $iv eq 'short int' ) ) { $ivmin = 'SHRT_MIN'; $ivmax = 'SHRT_MAX'; } elsif ( $iv eq 'int' ) { $ivmin = 'INT_MIN'; $ivmax = 'INT_MAX'; } elsif ( ( $iv eq 'long' ) || ( $iv eq 'long int' ) ) { $ivmin = 'LONG_MIN'; $ivmax = 'LONG_MAX'; } elsif ( ( $iv eq 'long long' ) || ( $iv eq 'long long int' ) ) { # The assumption is that a compiler that have the long long type # also provides its limit macros. $ivmin = 'LLONG_MIN'; $ivmax = 'LLONG_MAX'; } else { my $size = $conf->data->get('intvalsize'); my $n = 8 * $size; $ivmin = -2 ** ($n - 1); $ivmax = 2 ** ($n - 1) - 1; print <data->set( intvalmin => $ivmin ); $conf->data->set( intvalmax => $ivmax ); } sub _set_floatval_range { my $conf = shift; my $nvmin; my $nvmax; my $nv = $conf->data->get('nv'); if ( $nv eq 'float') { $nvmin = 'FLT_MIN'; $nvmax = 'FLT_MAX'; } elsif ( $nv eq 'double' ) { $nvmin = 'DBL_MIN'; $nvmax = 'DBL_MAX'; } elsif ( $nv eq 'long double' ) { $nvmin = 'LDBL_MIN'; $nvmax = 'LDBL_MAX'; } else { print <data->set( floatvalmin => $nvmin ); $conf->data->set( floatvalmax => $nvmax ); } sub _handle_ptrcast { my ($conf, $typesref, $sizesref, $checklist) = @_; my $intvalsize = $sizesref->{$typesref->{'intval'}}; my $ptrsize = $sizesref->{$typesref->{'ptr'}}; my $intptr = _find_type_min_ge($sizesref, $ptrsize, $checklist); if ( defined $intptr ) { $conf->data->set( ptrcast => 'unsigned '.$intptr ); } else { die "Configure.pl: No int type of at least pointer size found.\n"; } return if $intvalsize >= $ptrsize; if ( $conf->options->get('intval') or $conf->options->get('ask') ) { print <{intval} = $intptr; $conf->data->set( iv => $intptr ); # FIXME: workaround for issue #705 $typesref->{opcode} = $intptr; $conf->data->set( opcode_t => $intptr ); } } sub _handle_int64 { my ($conf, $sizesref, $checklist) = @_; my $has_int64 = _set_fixed($conf, $sizesref, 'int', 8, $checklist); $conf->data->set( HAS_INT64 => $has_int64 ); if ( not $has_int64 ) { print <<'END'; 64-bit support disabled. END } } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: pge-hs.t000644000765000765 155011533177643 17107 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/pge#!./parrot # Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME t/library/pge-hs.t =head1 SYNOPSIS % prove t/library/pge-hs.t =head1 DESCRIPTION Grammar Engine Haskell Output tests =cut # 1 .sub main :main .include 'test_more.pir' plan(1) test_pge_hs_match() .end .sub test_pge_hs_match .local pmc match, add_rule .local string result load_bytecode "PGE.pbc" load_bytecode "PGE/Hs.pir" match = get_global ['PGE';'Hs'], "match" add_rule = get_global ['PGE';'Hs'], "add_rule" add_rule("foo", "s") result = match("test", "t(.)t") eq result, "PGE_Match 0 4 [PGE_Match 1 3 [] [(\"foo\", PGE_Match 2 3 [] [])]] []\n", OK ok(0, 'PGE::Hs match') .return() OK: ok(1, 'PGE::Hs match') .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: auto.pm000644000765000765 202112101554066 17600 0ustar00brucebruce000000000000parrot-5.9.0/config/auto/cpu/ppc# Copyright (C) 2001-2013, Parrot Foundation. =head1 NAME config/auto/cpu/ppc/auto.pm =head1 DESCRIPTION Test =cut package auto::cpu::ppc::auto; use strict; use warnings; sub runstep { my ( $self, $conf ) = @_; my @files = qw( test_gcc_cmpset_c.in ); for my $f (@files) { $conf->debug(" $f "); my ($suffix) = $f =~ /test_(\w+)/; $f = "config/auto/cpu/ppc/$f"; $conf->cc_gen($f); eval { $conf->cc_build("-DPARROT_CONFIG_TEST") }; if ($@) { $conf->debug(" $@ "); } else { if ( $conf->cc_run() =~ /ok/ ) { $conf->data->set( "ppc_has_$suffix" => '1', "HAS_PPC_$suffix" => '1', ); $conf->debug(" (\U$suffix) "); $conf->add_to_generated( $f, "[]" ); } } $conf->cc_clean(); } } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: C.pm000644000765000765 1614311567202623 17573 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/Docs/Section# Copyright (C) 2004-2009, Parrot Foundation. =head1 NAME Parrot::Docs::Section::C - C source code documentation section =head1 SYNOPSIS use Parrot::Docs::Section::C; =head1 DESCRIPTION A documentation section describing all the C source code in Parrot. =head2 Class Methods =over =cut package Parrot::Docs::Section::C; use strict; use warnings; use base qw( Parrot::Docs::Section ); use Parrot::Distribution; =item C Returns a C header files documentation item. =cut sub c_header_item { my $self = shift; return $self->c_item( shift, 'headers' => [@_] ); } =item C Returns a C source files documentation item. =cut sub c_source_item { my $self = shift; return $self->c_item( shift, 'sources' => [@_] ); } =item C Returns a new C source and header file documentation item. =cut sub c_pair_item { my $self = shift; return $self->c_item( shift, 'pairs' => [@_] ); } =item C Returns a new C source and/or header files documentation item. Recognized keys for C<%contents> are C, C, C and C. =cut sub c_item { my $self = shift; my $text = shift; my %contents = @_; my @contents = (); my $dist = Parrot::Distribution->new; if ( exists $contents{'pairs'} ) { foreach my $name ( @{ $contents{'pairs'} } ) { push @contents, $dist->relative_path( $dist->c_source_file_with_name($name) ), $dist->relative_path( $dist->c_header_file_with_name($name) ); } } if ( exists $contents{'sources'} ) { foreach my $name ( @{ $contents{'sources'} } ) { push @contents, $dist->relative_path( $dist->c_source_file_with_name($name) ); } } if ( exists $contents{'headers'} ) { foreach my $name ( @{ $contents{'headers'} } ) { push @contents, $dist->relative_path( $dist->c_header_file_with_name($name) ); } } if ( exists $contents{'contents'} ) { push @contents, @{ $contents{'contents'} }; } return $self->new_item( $text, grep { defined } @contents ); } =item C Returns a new section. =cut sub new { my $self = shift; return $self->SUPER::new( 'C', 'c.html', '', $self->new_group( 'General', '', $self->c_header_item( '', 'parrot' ), $self->c_pair_item( '', 'warnings' ), $self->c_pair_item( '', 'longopt' ), ), $self->new_group( 'Interpreter', '', $self->c_pair_item( '', 'embed' ), $self->c_pair_item( '', 'global_setup' ), $self->c_item( 'Parrot Interpreter: Callback Function Handling; Creation and Destruction; Misc functions; Run Ops and Methods.', 'pairs' => ['interpreter'], 'sources' => [ 'inter_cb', 'inter_create', 'inter_misc' ], 'headers' => ['interp_guts'] ), $self->c_pair_item( '', 'exit' ), ), $self->new_group( 'Registers and Stacks', '', $self->c_item( '', 'pairs' => ['register'], ), $self->c_item( '', 'pairs' => ['stacks'], ), $self->c_header_item( '', 'enums' ), ), $self->new_group( 'Ops', '', $self->c_pair_item( '', 'runops_cores' ), $self->c_header_item( '', 'op' ), $self->c_header_item( '', 'oplib' ), ), $self->new_group( 'Bytecode', '', $self->c_item( 'Parrot Packfile API and utilities.', 'contents' => ['src/packfile'], ), $self->c_source_item( '', 'byteorder' ), ), $self->new_group( 'Data Types', '', $self->c_pair_item( '', 'datatypes' ), $self->c_pair_item( '', 'hash' ), $self->c_pair_item( '', 'list' ), ), $self->new_group( 'PMCs', '', $self->c_pair_item( '', 'pmc' ), $self->c_header_item( '', 'vtables' ), $self->c_pair_item( '', 'key' ), $self->c_pair_item( '', 'sub' ), $self->c_header_item( '', 'pobj' ), $self->c_pair_item( '', 'pmc_freeze' ), ), $self->new_group( 'Objects', '', $self->c_pair_item( '', 'oo' ), ), $self->new_group( 'Strings', '', $self->c_item( '', 'sources' => [ 'string/api' ], 'headers' => [ 'string', 'string_funcs' ] ), $self->c_item( 'String encodings', 'contents' => ['src/string/encoding'] ), $self->c_item( 'Miscellaneous, sprintf and utility functions.', 'pairs' => ['misc'], 'sources' => [ 'spf_render', 'spf_vtable', 'utils' ] ), ), $self->new_group( 'Multi-methods', '', $self->c_pair_item( '', 'multidispatch' ), ), $self->new_group( 'Extensions', '', $self->c_pair_item( '', 'extend' ), ), $self->new_group( 'JIT', '', $self->c_item( 'Parrot\'s JIT subsystem, with support for stabs files.', 'pairs' => ['jit'], 'sources' => [ 'jit_debug', 'jit_debug_xcoff' ] ), ), $self->new_group( 'Exec', '', $self->c_item( 'Parrot\'s native executable subsystem.', 'pairs' => [ 'exec', 'exec_save' ], 'sources' => ['exec_start'] ), ), $self->new_group( 'IO', '', $self->c_item( 'Parrot\'s layer-based I/O subsystem.', 'headers' => ['io'], 'contents' => ['src/io'] ), ), $self->new_group( 'Threads', '', $self->c_pair_item( '', 'thread' ), $self->c_header_item( '', 'thr_pthread' ), ), $self->new_group( 'Exceptions', '', $self->c_pair_item( '', 'exceptions' ) ), $self->new_group( 'Memory', '', $self->c_pair_item( '', 'memory' ), $self->c_source_item( '', 'malloc' ), $self->c_source_item( '', 'malloc-trace' ), $self->c_source_item( '', 'mark_sweep' ), ), $self->new_group( 'Garbage Collection', '', $self->c_item( 'Parrot\'s garbage collection subsystem.', 'contents' => ['src/gc'] ), ), $self->new_group( 'Debugging', '', $self->c_item( '', 'pairs' => ['debug'], 'sources' => ['parrot_debugger'] ), $self->c_source_item( '', 'pbc_disassemble' ), $self->c_pair_item( '', 'trace' ), $self->c_source_item( '', 'test_main' ), ), ); } =back =cut 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: packfileopmap.t000644000765000765 713011656271051 16540 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc#!./parrot # Copyright (C) 2010, Parrot Foundation. =head1 NAME t/pmc/packfileopmap.t - test the PackfileOpMap PMC =head1 SYNOPSIS % make test_prep % prove t/pmc/packfileopmap.t =head1 DESCRIPTION Tests the PackfileOpMap PMC. =cut # Having some known data would be helpful, here. For now, just make sure # the values returned from get_type look right, and that the corresponding # fetches for the found types don't crash. .include 't/pmc/testlib/packfile_common.pir' .sub 'main' :main .include 'test_more.pir' 'sanity'() 'basic'() 'load_lib'() 'reverse_mapping'() 'done_testing'() .end # sanity check we have a PackfilOpMap .sub 'sanity' .local pmc opmap opmap = new ['PackfileOpMap'] isa_ok(opmap, "PackfileOpMap", "PackfileOpMap is a PackfileOpMap") .end .sub 'basic' .local pmc opmap opmap = new ['PackfileOpMap'] push_eh fake_op_eh $I0 = opmap['THIS IS NOT A REAL OP'] ok(0, "opmap throws an exception for invalid op names") goto done_with_fake_op fake_op_eh: ok(1, "opmap throws an exception for invalid op names") done_with_fake_op: pop_eh push_eh short_op_eh $I0 = opmap['say'] ok(0, "opmap does not attempt to map short op names") goto done_with_short_op short_op_eh: ok(1, "opmap does not attempt to map short op names") done_with_short_op: pop_eh $I0 = opmap['say_sc'] # First mapped op should be 0 is($I0, 0, "First mapped op is 0") $I1 = opmap['say_sc'] is($I0, $I1, "opmap always return same value for a given op") $I0 = opmap['returncc'] is($I0, 1, "Second mapped op is 1") $I0 = opmap['issame_i_p_p'] $I0 = opmap['cmp_i_i_i'] is($I0, 3, "Forth mapped op is 3") $I0 = opmap is($I0, 4, "opmap correctly reports the number of mapped ops") $P0 = opmap['say_sc'] $S0 = $P0 is($S0, 'say_sc', 'opmap returns the correct named op') push_eh invalid_op_name $P0 = opmap['speak_ne'] ok(0, 'opmap throws an exception on invalid op name') invalid_op_name: ok(1, 'caught invalid op name') pop_eh .local pmc oplibs oplibs = opmap.'oplibs'() $I0 = isa oplibs, 'Hash' ok($I0, 'oplibs gave a hash') $P0 = oplibs['core_ops'] $I0 = defined $P0 ok($I0, 'oplib contains core_ops') .end .sub 'load_lib' .local pmc opmap opmap = new ['PackfileOpMap'] ($I0) = opmap.'load_lib'('core_ops') ok(1, "load_lib works with 'core_ops'") ($I0) = opmap.'load_lib'('core_ops') ok(1, "load_lib works with 'core_ops' a second time") $I0 = opmap['say_sc'] # First mapped op should be 0 is($I0, 0, "Can map say_sc from core_ops") # After make corevm dynoplib isn't built yet. # Catch exception and ignore rest of tests. push_eh no_math_ops $P0 = loadlib 'math_ops' ($I0) = opmap.'load_lib'('math_ops') ok(1, "load_lib works with 'math_ops'") $I0 = opmap['cmod_i_i_i'] is($I0, 1, "Can map cmod_i_i_i from math_ops") .return () no_math_ops: pop_eh skip(2, 'No math_ops library') .return () .end .sub 'reverse_mapping' .local pmc opmap opmap = new ['PackfileOpMap'] # Map few ops. $I0 = opmap['say_sc'] $I1 = opmap['returncc'] $I2 = opmap['issame_i_p_p'] $I3 = opmap['cmp_i_i_i'] $S0 = opmap[$I0] is( $S0, "say_sc", "say_sc") $S0 = opmap[$I1] is( $S0, "returncc", "returncc") $S0 = opmap[$I2] is( $S0, "issame_i_p_p", "issame_i_p_p") $S0 = opmap[$I3] is( $S0, "cmp_i_i_i", "cmp_i_i_i") .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: 028-option_or_data.t000644000765000765 424611533177643 20452 0ustar00brucebruce000000000000parrot-5.9.0/t/configure#! perl # Copyright (C) 2007, Parrot Foundation. # 028-option_or_data.t use strict; use warnings; use Test::More tests => 12; use Carp; use lib qw( lib ); use lib qw( config ); use init::defaults; use init::install; use Parrot::Configure; use Parrot::Configure::Options qw( process_options ); use Parrot::Configure::Test qw( test_step_thru_runstep); use Parrot::Configure::Step::List qw( get_steps_list ); $| = 1; is( $|, 1, "output autoflush is set" ); my $testopt = q{bindir}; my $testoptval = q{mybindir}; my $localargv = []; my ($args, $step_list_ref) = process_options( { mode => q{configure}, argv => $localargv, } ); ok( defined $args, "process_options returned successfully" ); my $conf = Parrot::Configure->new; test_step_thru_runstep( $conf, q{init::defaults}, $args ); my ( $task, $step_name, $step, $ret ); my $pkg = q{init::install}; $conf->add_steps($pkg); $conf->options->set( %{$args} ); $task = $conf->steps->[1]; $step_name = $task->step; $step = $step_name->new(); ok( defined $step, "$step_name constructor returned defined value" ); isa_ok( $step, $step_name ); ok( $step->description(), "$step_name has description" ); $ret = $step->runstep($conf); ok( defined $ret, "$step_name runstep() returned defined value" ); my $val = $conf->option_or_data($testopt); is( $val, $conf->data->get($testopt), 'option_or_data() returned expected value when no option provided' ); pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME 028-option_or_data.t - test C =head1 SYNOPSIS % prove t/configure/028-option_or_data.t =head1 DESCRIPTION The files in this directory test functionality used by F. This file tests C in the case where no value for the tested option has been set on the command line but a value for the tested option has been located internally by a configuration step. =head1 AUTHOR James E Keenan =head1 SEE ALSO Parrot::Configure, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: cpu.pm000644000765000765 173411533177633 16071 0ustar00brucebruce000000000000parrot-5.9.0/config/auto# Copyright (C) 2001-2006, Parrot Foundation. =head1 NAME config/auto/cpu.pm - CPU specific Files =head1 DESCRIPTION Runs C in F if it exists. =cut package auto::cpu; use strict; use warnings; use base qw(Parrot::Configure::Step); use Carp; sub _init { my $self = shift; my %data; $data{description} = q{Generate CPU specific stuff}; $data{result} = q{}; return \%data; } sub runstep { my ( $self, $conf ) = @_; $conf->data->add( ' ', TEMP_atomic_o => '' ); # assure a default my $hints = "auto::cpu::" . $conf->data->get('cpuarch') . "::auto"; $conf->debug("\t(cpu hints = '$hints') "); eval "use $hints"; unless ($@) { $hints->runstep( $conf, @_ ); } else { $conf->debug("(no cpu specific hints)"); } return 1; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: exporter.pmc000644000765000765 2315212171255037 16456 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2007-2009, Parrot Foundation. =head1 NAME src/pmc/exporter.pmc - Export globals from one namespace to another =head1 SYNOPSIS You can use Exporter in PIR to import subs from a library. At its simplest: .sub main :main load_bytecode 'Test/More.pir' .local pmc exporter, src_ns, dest_ns src_ns = get_namespace [ 'Test'; 'More' ] exporter = new 'Exporter' exporter.'import'( src_ns :named('source') 'plan ok' :named('globals') ) plan(1) ok(1, 'exporter has imported the requested functions') .end You can also specify the exporter attributes before making the import call, for example to import into the alternate namespace 'Foo' you could use the following code: src_ns = get_namespace [ 'Test'; 'More' ] dest_ns = get_namespace [ 'Foo' ] exporter.'source'(src_ns) exporter.'destination'(dest_ns) exporter.'import'('plan ok' :named('globals')) You can even import subroutines under different names if globals is a hash: globals = new 'Hash' globals['plan'] = 'steps' globals['ok'] = 'passed' exporter.'import'(globals :named('globals')) steps(1) passed(1) =head1 DESCRIPTION Exports globals from one namespace to another. Exporter always uses the typed namespace interface, as outlined in F. Exporter is not derived from any other PMC, and does not provide any vtable interface--its interface consists solely of methods, not vtable functions. =head2 Structure The Exporter PMC structure (C) consists of three items: =over 4 =item C The source namespace -- a NameSpace PMC. A Null PMC is allocated during initialization. =item C The destination namespace -- a NameSpace PMC. A PMC representing the current namespace is allocated upon initialization. =item C The globals to export -- a PMC that implements a hash, an array, a String containing a list of space-separated subroutine names or Null. A Null PMC is allocated during initialization. =cut */ /* =back =head2 Functions =over 4 =cut */ /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* HEADERIZER END: static */ pmclass Exporter auto_attrs { ATTR PMC *ns_src; ATTR PMC *ns_dest; ATTR PMC *globals; /* =item C Initializes an Exporter PMC. =cut */ VTABLE void init() { /* Set up the object. */ SET_ATTR_ns_src(INTERP, SELF, PMCNULL); SET_ATTR_ns_dest(INTERP, SELF, Parrot_pcc_get_namespace(INTERP, CURRENT_CONTEXT(INTERP))); SET_ATTR_globals(INTERP, SELF, PMCNULL); /* Set flags for custom GC mark and destroy. */ PObj_custom_mark_SET(SELF); } /* =item C Mark referenced strings and PMCs in the structure as live. =cut */ VTABLE void mark() { PMC *ns_src; PMC *ns_dest; PMC *globals; GET_ATTR_ns_src(INTERP, SELF, ns_src); GET_ATTR_ns_dest(INTERP, SELF, ns_dest); GET_ATTR_globals(INTERP, SELF, globals); Parrot_gc_mark_PMC_alive(INTERP, ns_src); Parrot_gc_mark_PMC_alive(INTERP, ns_dest); Parrot_gc_mark_PMC_alive(INTERP, globals); } /* =back =head2 Methods =over 4 =item C Accessor for the source NameSpace object (C.) Sets the value if C is passed, otherwise returns the value. Throws an exception if a non-NameSpace PMC is passed. =cut */ METHOD source(PMC *src :optional, int got_src :opt_flag) { if (got_src) { if (src->vtable->base_type != enum_class_NameSpace) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "source must be a NameSpace PMC"); SET_ATTR_ns_src(INTERP, SELF, src); } else { PMC *tmp_ns_src; GET_ATTR_ns_src(INTERP, SELF, tmp_ns_src); RETURN(PMC *tmp_ns_src); } } /* =item C Accessor for the destination NameSpace object (C.) Sets the value if C is passed, otherwise returns the value. Throws an exception if a non-NameSpace PMC is passed. =cut */ METHOD destination(PMC *dest :optional, int got_dest :opt_flag) { if (got_dest) { if (dest->vtable->base_type != enum_class_NameSpace) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "destination must be a NameSpace PMC"); SET_ATTR_ns_dest(INTERP, SELF, dest); } else { PMC *tmp_ns_dest; GET_ATTR_ns_dest(INTERP, SELF, tmp_ns_dest); RETURN(PMC *tmp_ns_dest); } } /* =item C Accessor for the globals to export (C.) Sets the value if C is passed, otherwise returns the value. If C is a String, it is split on ascii whitespace, and each array member is added as a hash key. If C implements the array interface, each member is added as a hash key. if C implements the hash interface, it is assigned to Exporter's C attribute. Throws an exception if an unknown PMC type is passed. =cut */ METHOD globals(PMC *glb :optional, int got_glb :opt_flag) { STRING * const s_str = CONST_STRING(INTERP, "String"); STRING * const s_arr = CONST_STRING(INTERP, "array"); STRING * const s_hash = CONST_STRING(INTERP, "hash"); STRING * const s_space = CONST_STRING(INTERP, " "); if (got_glb) { STRING * const s_empty = CONST_STRING(INTERP, ""); PMC *temp_globals = Parrot_pmc_new(INTERP, enum_class_Hash); if (PMC_IS_NULL(glb)) { temp_globals = PMCNULL; } else if (VTABLE_isa(INTERP, glb, s_str) || (VTABLE_does(INTERP, glb, s_arr))) { PMC *glb_array; INTVAL n, i; if (VTABLE_isa(INTERP, glb, s_str)) glb_array = Parrot_str_split(INTERP, s_space, VTABLE_get_string(INTERP, glb)); else glb_array = glb; n = VTABLE_elements(INTERP, glb_array); if (n == 0) temp_globals = PMCNULL; for (i = 0; i < n; ++i) { STRING * const item = VTABLE_get_string_keyed_int(INTERP, glb_array, i); VTABLE_set_string_keyed_str(INTERP, temp_globals, item, s_empty); } } else if (VTABLE_does(INTERP, glb, s_hash)) { if (VTABLE_elements(INTERP, glb) == 0) temp_globals = PMCNULL; else temp_globals = glb; } else { Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "Invalid type %d in globals()", glb->vtable->base_type); } SET_ATTR_globals(INTERP, SELF, temp_globals); } else { PMC *tmp_globals; GET_ATTR_globals(INTERP, SELF, tmp_globals); if (PMC_IS_NULL(tmp_globals)) { RETURN(PMC *PMCNULL); } else RETURN(PMC *tmp_globals); } } /* =item C Import C from the C namespace to the C namespace. If C, C, or C are passed, they override the current value. C follows the semantics of the C method of the C PMC. in particular, if a NULL value is passed for C, the default set of items will be imported. Throws an exception upon error. =cut */ METHOD import(PMC *dest :optional :named("destination"), int got_dest :opt_flag, PMC *src :optional :named("source"), int got_src :opt_flag, PMC *globals :optional :named("globals"), int got_globals :opt_flag) { PMC *ns_src, *ns_dest, *ns_globals; if (got_src) PCCINVOKE(INTERP, SELF, "source", PMC *src); if (got_dest) PCCINVOKE(INTERP, SELF, "destination", PMC *dest); if (got_globals) PCCINVOKE(INTERP, SELF, "globals", PMC *globals); GET_ATTR_ns_src(INTERP, SELF, ns_src); if (PMC_IS_NULL(ns_src)) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "source namespace not set"); GET_ATTR_ns_dest(INTERP, SELF, ns_dest); /* This condition must never happen, destination is set during init and * attempts to change it with wrong values are rejected. * Even if it gets changed for unexpected reasons, "export_to" will * catch the problem. */ PARROT_ASSERT(!PMC_IS_NULL(ns_dest)); GET_ATTR_globals(INTERP, SELF, ns_globals); PCCINVOKE(INTERP, ns_src, "export_to", PMC *ns_dest, PMC *ns_globals); } } /* end pmclass Exporter */ /* =back =head1 STABILITY Unstable. This PMC is under active development; major portions of the interface have not yet been completed. =head1 SEE ALSO F, F. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ stringu.t000644000765000765 5615112101554067 15303 0ustar00brucebruce000000000000parrot-5.9.0/t/op#!perl # Copyright (C) 2001-2012, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Test tests => 48; use Parrot::Config; =head1 NAME t/op/stringu.t - Unicode String Test =head1 SYNOPSIS % prove t/op/stringu.t =head1 DESCRIPTION Tests Parrot unicode string system. =cut pir_output_is(<<'CODE',<<'OUTPUT', 'non-ascii immc optimizer GH#837'); .sub main $S1 = utf8:"\x{a2}" say $S1 concat $S1, unicode:"\x{a2}", unicode:"\x{a2}" say $S1 concat $S2, unicode:"\x{a2}", "c" say $S2 concat $S3, unicode:"\x{62}", unicode:"\x{62}" say $S3 .end CODE ¢ ¢¢ ¢c bb OUTPUT pir_output_is( <<'CODE', < " say $I0 $S0 = hash[str0] $S1 = hash[str1] $I0 = iseq $S0, $S1 #print "iseq hash[str0], hash[str1] => " say $I0 say $S0 say $S1 .end CODE 1 1 hello hello OUTPUT pir_output_is( <<'CODE', <<'OUT', 'numification of unicode strings to int' ); .sub main :main $S0 = "140" $I0 = $S0 say $I0 $I0 = find_encoding 'ucs2' $S0 = trans_encoding $S0, $I0 $I0 = $S0 say $I0 .end CODE 140 140 OUT pir_output_is( <<'CODE', <<'OUT', 'numification of unicode strings to float' ); .sub main :main $S0 = "140" $N0 = $S0 say $N0 $I0 = find_encoding 'ucs2' $S0 = trans_encoding $S0, $I0 $N0 = $S0 say $N0 .end CODE 140 140 OUT pir_output_is( <<'CODE', <<'OUT', 'numification of unicode strings float mixed' ); .sub main :main $S0 = utf8:"140 r\x{e9}sum\x{e9}s" $N0 = $S0 say $N0 $I0 = find_encoding 'ucs2' $S0 = trans_encoding $S0, $I0 $N0 = $S0 say $N0 .end CODE 140 140 OUT pir_output_is( <<'CODE', <<'OUT', 'concatenation of utf8 and iso-8859-1 (TT #752)' ); .sub 'main' :main $S1 = chr 0xe5 $S2 = chr 0x263b $S0 = utf8:"\u00e5\u263b" $S3 = concat $S1, $S2 if $S0 == $S3 goto equal_1 print "not " equal_1: say "equal" $S0 = utf8:"\u263b\u00e5" $S3 = concat $S2, $S1 if $S0 == $S3 goto equal_2 print "not " equal_2: say "equal" .end CODE equal equal OUT pir_output_is( <<'CODE', <<'OUT', 'concatenation of utf8 and ucs4' ); .sub 'main' :main $S1 = utf8:"\u263a" $S2 = ucs4:"\u263b" $S0 = utf8:"\u263a\u263b" $S3 = concat $S1, $S2 if $S0 == $S3 goto equal_1 print "not " equal_1: say "equal" $S0 = utf8:"\u263b\u263a" $S3 = concat $S2, $S1 if $S0 == $S3 goto equal_2 print "not " equal_2: say "equal" .end CODE equal equal OUT pir_output_is( <<'CODE', <<'OUT', 'join mixed encodings' ); .sub 'main' :main new $P0, 'ResizablePMCArray' push $P0, ascii:"a" push $P0, utf8:"\x{e1}" # a acute push $P0, iso-8859-1:"\x{e1}" # a acute join $S0, "", $P0 $I0 = length $S0 say $I0 .end CODE 3 OUT pir_output_is( <<'CODE', <<'OUT', 'illegal utf8 chars' ); .sub 'main' :main # malformed strings 'test_chars'(binary:"\x41\x80\x41") 'test_chars'(binary:"\x41\xBF\x41") 'test_chars'(binary:"\x41\xC1\xBF") 'test_chars'(binary:"\x41\xC2\x41") 'test_chars'(binary:"\x41\xF5\xA1\xA2\xA3") 'test_chars'(binary:"\x41\xFE\x41") # unaligned end 'test_chars'(binary:"\xC2") 'test_chars'(binary:"\xF4") 'test_chars'(binary:"\xE1\x80") 'test_chars'(binary:"\xF2\xAB") 'test_chars'(binary:"\xF1\x80\x80") # overlong forms 'test_chars'(binary:"\xE0\x9F\xBF") # 0x07FF 'test_chars'(binary:"\xF0\x8F\xBF\xBD") # 0xFFFD # invalid chars 'test_chars'(binary:"\xED\xA0\x80") # 0xD800 'test_chars'(binary:"\xED\xBF\xBF") # 0xDFFF 'test_chars'(binary:"\xEF\xB7\x90") # 0xFDD0 'test_chars'(binary:"\xEF\xB7\xAF") # 0xFDEF 'test_chars'(binary:"\xEF\xBF\xBE") # 0xFFFE 'test_chars'(binary:"\xEF\xBF\xBF") # 0xFFFF 'test_chars'(binary:"\xF0\x9F\xBF\xBE") # 0x1FFFE 'test_chars'(binary:"\xF4\x8F\xBF\xBF") # 0x10FFFF 'test_chars'(binary:"\xF4\x90\x80\x80") # 0x110000 .end .sub 'test_chars' .param string chars .local pmc eh, ex, bb bb = new 'ByteBuffer' bb = chars eh = new 'ExceptionHandler' set_label eh, handler push_eh eh chars = bb.'get_string'('utf8') say 'valid' goto end handler: .local pmc ex .get_results (ex) $S0 = ex['message'] print $S0 end: pop_eh .end CODE Malformed UTF-8 string Malformed UTF-8 string Malformed UTF-8 string Malformed UTF-8 string Malformed UTF-8 string Malformed UTF-8 string Unaligned end in UTF-8 string Unaligned end in UTF-8 string Unaligned end in UTF-8 string Unaligned end in UTF-8 string Unaligned end in UTF-8 string Overlong form in UTF-8 string Overlong form in UTF-8 string Invalid character in UTF-8 string Invalid character in UTF-8 string Invalid character in UTF-8 string Invalid character in UTF-8 string Invalid character in UTF-8 string Invalid character in UTF-8 string Invalid character in UTF-8 string Invalid character in UTF-8 string Invalid character in UTF-8 string OUT pir_output_is( <<'CODE', <<'OUT', 'valid utf8 chars' ); .sub 'main' :main 'test_chars'(binary:"\xC2\x80") 'test_chars'(binary:"\xE0\xA0\x80") 'test_chars'(binary:"\xED\x9F\xBF") 'test_chars'(binary:"\xEE\x80\x80") 'test_chars'(binary:"\xEF\xB7\x8F") 'test_chars'(binary:"\xEF\xB7\xB0") 'test_chars'(binary:"\xEF\xBF\xBD") 'test_chars'(binary:"\xF0\x90\x80\x80") 'test_chars'(binary:"\xF0\x9F\xBF\xBD") 'test_chars'(binary:"\xF0\xA0\x80\x80") 'test_chars'(binary:"\xF4\x8F\xBF\xBD") .end .sub 'test_chars' .param string chars .local pmc bb bb = new 'ByteBuffer' bb = chars chars = bb.'get_string'('utf8') $I0 = ord chars $P0 = new 'FixedIntegerArray', 1 $P0[0] = $I0 $S0 = sprintf '0x%X', $P0 say $S0 .end CODE 0x80 0x800 0xD7FF 0xE000 0xFDCF 0xFDF0 0xFFFD 0x10000 0x1FFFD 0x20000 0x10FFFD OUT sub units_to_code { my $bytes_per_unit = shift; my $pack_format = $bytes_per_unit == 2 ? 'S*' : 'L*'; my $code = ''; for my $unit (@_) { my $str = pack($pack_format, @$unit); $str =~ s/./sprintf("\\x%02X", ord($&))/egs; $code .= qq{ 'test_chars'(binary:"$str")\n}; } return $code; } my $code = qq{ 'test_chars'(binary:"\\x41\\x42\\x43")\n}; $code .= units_to_code( 2, [ 0xD800 ], [ 0xDFFF ], [ 0xD800, 0x0041 ], [ 0xD900, 0xDAFF ], [ 0xDBFF, 0xD800 ], [ 0xDC00, 0xD8FF ], [ 0xDDFF, 0xDE00 ], [ 0xDFFF, 0x0041 ], [ 0xFDD0 ], [ 0xFDEF ], [ 0xFFFE ], [ 0xFFFF ], [ 0xD83F, 0xDFFF ], [ 0xDBFF, 0xDFFE ], ); pir_output_is( <?@ABCDEFGHIJKLMNOPQRXP  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPmath.c000644000765000765 251411567202624 17530 0ustar00brucebruce000000000000parrot-5.9.0/src/platform/cygwin/* * Copyright (C) 2006-2009, Parrot Foundation. */ /* =head1 NAME src/platform/cygwin/math.c =head1 DESCRIPTION math stuff =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" /* * force atan2() to use fast IEEE behavior */ #include #ifndef __STRICT_ANSI__ _LIB_VERSION_TYPE _LIB_VERSION = _IEEE_; #else _LIB_VERSION_TYPE _LIB_VERSION = _POSIX_; #endif /* HEADERIZER HFILE: none */ #if DOUBLE_SIZE == 2 * INT_SIZE /* =item C return true if the Numval has a negative sign. This is mostly for handling the -0.0 case. =cut */ extern int Parrot_signbit(double x) { union { double d; int i[2]; } u; u.d = x; # if PARROT_BIGENDIAN return u.i[0] < 0; # else return u.i[1] < 0; # endif } #endif #if NUMVAL_SIZE == 12 && DOUBLE_SIZE == 3 * INT_SIZE && PARROT_LITTLE_ENDIAN /* =item C Same as Parrot_signbit for long double. Return true if the Numval has a negative sign. This is mostly for handling the -0.0 case. =cut */ int Parrot_signbit_l(long double x) { union { long double d; int i[3]; } u; u.d = x; return u.i[2] < 0; } #endif /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ pmc_freeze.pod000644000765000765 1570312101554066 17070 0ustar00brucebruce000000000000parrot-5.9.0/docs/dev# Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME docs/dev/pmc_freeze.pod - Freeze/Thaw Design Notes =head1 DESCRIPTION This document describes freeze/thaw internals version 0.1. Please note: This is not the final implementation. =head1 OVERVIEW Freezing or serializing arbitrary PMCs is an interesting problem. Aggregates can hold other aggregates and can be deeply nested, so so a recursive approach could easily blow the stack, especially on embedded systems. Also, aggregates can be self-referential -- they can hold pointers to themselves -- so that working on such structures could create infinite loops. =head1 COVERAGE Although the file is named F it ultimately will deal with every kind of operation that deeply traverses an arbitrary data structures. For example: =over 4 =item freeze Called from user code to serialize the state of a PMC into some (possibly binary) representation held in a STRING. =item freeze_at_destruct A variant of C, possibly called from an exception handler or on resource shortage before interpreter shutdown, to save some data before dying. It must not consume any additional resources. =item thaw The opposite of C: reconstruct all PMCs to generate an identical copy of the original frozen PMC. As with C, can be called from user code. =item dclone Deeply clone an aggregate. C is basically the same as C. =item dump, pretty_print Create a visual representation of an aggregate. =item destruction ordering Find the logical dependencies of a collection of PMCs, so that they can be destroyed in an appropriate order. This is also called on interpreter shutdown. =item mark Mark all objects as being live by calling B called from GC. While the functionality is the same, it will not be implemented on top of this general scheme for performance reasons. This leads to some code duplication, but GC is run permanently and deserves all the speed it can get. =back =head1 Description The basic scheme of operation looks like this: info = init() push todo_list, pmc while (todo_list) current = shift todo_list current->visit(info) done. =head2 The visit_info structure This structure holds all necessary information and function pointers specific to the desired functionality. It gets passed on to all vtable functions and callback functions. =head2 Working loop =over 4 =item todo list A B called B holds items still to be worked on. This method is slower and consumes more resources, but doesn't interfere with GC runs and is thread-safe. =back =head2 Putting items on the todo list This is done by a callback function inside the B structure called B. It gets called initially to put the first item on the list and is called thereafter from all PMCs for contained PMCs inside the B vtable function. =head2 The visit() vtable The general scheme above shows that this method is called for all items on the B. B has to call B for all contained PMCs, which then get visited until all is done. =head2 The visit_pmc_now() callback The basic operation is: (seen, id) = was_already_seen(pmc) do_specific_action(pmc, seen, id) if (!seen) pmc->visit_action() =head2 Avoiding duplicates As stated in the introduction structures can be self-referential, they can contain (at an arbitrary depth) PMCs, that were already processed. Just following these PMCs would lead to endless loops. So already B PMCs have to be remembered. =over 4 =item The B hash Using a B is one method to avoid duplicates. The B hash holds keys being the address of the PMC and values being a PMC B, which is unique for this PMC. While this is straight forward, it consumes 16 bytes per PMC (plus overhead, 32-bit system assumed). Hash lookups also take a considerable amount of time. =back =head2 The actual action So after all we finally arrived at the point to actually perform the desired functionality. First the PMC-specific part is done inside F then the specific vtable function B, B, whatever, is called, again via a function pointer called B. =head1 Freeze and thaw As stated PMCs are currently processed inside the core, PMC-specific parts are done by calling the PMCs vtable function. This parts could of course be moved to F too, so that it's simpler to override the functionality. =head2 Serializer interface During initialization the Bs B data pointer is filled with an object having B functions that remarkably look like a PMCs vtable. So Bvtable-Epush_integer> spits out an INTVAL to the frozen B, while B gets an INTVAL from the frozen stream. This simplifies final changes when B becomes just a PMC of some serializer class. There are currently two serializers: =over 4 =item Plain text This serializer is mainly intended for testing. Having a readable representation of the image simplifies debugging a lot. =item Parrot Byte Code We already have a platform-independent way of reading and writing opcodes, string, and number-constants. So this serializer uses functionality of the pack-file routines. The produced image isn't as dense as it could be though, because all data are aligned at B boundaries. =back =head2 Image data format PMC Bs ranging from 1 to N-PMCs are shifted left by two, so that the 2 lo bits can serve as flags: id + 0x1 ... PMC was seen id + 0x2 ... PMC has same type as previous PMC id + 0x3 ... escape flag A PMCs image generally looks like: The text representation of the array P0 = [P1=666, P2=777, P0] may look like: 0xdf4 30 3 0xdf8 33 666 0xdf2 777 0xdf5 0xdf4 ... PMC id (with "0x" in front for clarity) 30 ... enum_class_ResizablePMCArray 3 ... elements count 0xdf8 ... id of first element 33 ... enum_class_Integer 666 ... value 0xdf2 ... id of second element, same type as prev element 777 ... value 0xdf5 ... id of array itself with lo bit set The escape flag marks places in the image, where additional data will follow. After the escape flag is an int defining the kind of the following data, passed on in B. During B the PMCs vtable is called again, to restore these data. So a PMCs B vtable has to check B if normal or extra data have to be shifted from the image. This is e.g. needed for PMC properties or arrays containing sparse holes, to set the array index of the following data. A Integer(666) with a property hash ("answer"=>42) thus looks like: 0xdfc 33 666 0xdff 2 0xdf4 32 1 answer 0xdf8 33 42 B<0xdff> is the escape mark for the PMC B<0xdfc> followed by the constant B. [ To be continued ] =head1 FILES F, F =head1 AUTHOR Leopold Toetsch C =cut # vim: expandtab shiftwidth=2 tw=70: RESPONSIBLE_PARTIES000644000765000765 1010412162603275 15430 0ustar00brucebruce000000000000parrot-5.9.0# Copyright (C) 2002-2013, Parrot Foundation. This is a list of project roles, with a partial list of the folks who have taken responsibility for them. This does not list all the people with commit access, just those who have a role they've taken responsibility for. This document is mostly for historic purposes, see CREDITS for the full details of all contributors. See docs/project/roles_responsibilities.pod for role definitions, and https://github.com/parrot/parrot/wiki/Languages for language authors/maintainers. Project Team ------------ Community Ambassador Jonathan "Duke" Leto Release Manager Bob Rogers Patrick Michaud Bernhard Schmalhofer Jerry Gay chromatic Will Coleda Andrew Whitworth Klaas-Jan Stol Francois Perrad Mark Glines Christoph Otto Jonathan "Duke" Leto Gerd Pokorra Michael Hind Tyler Curtis James E Keenan Kevin Polulak Alvis Yardley Reini Urban Bruce Gray Metacommitter Allison Randal Jerry Gay Will Coleda chromatic Jeff Horwitz Andrew Whitworth James E Keenan Jonathan "Duke" Leto Julian Albo Committers ---------- Core Developer Andrew Whitworth Reini Urban Bernhard Schmalhofer Kevin Tew Jonathan Worthington Bob Rogers Nuno Carvalho chromatic Allison Randal Christoph Otto Julian Albo Mark Glines Vasily Chekalkin Jonathan "Duke" Leto Alvis Yardley Brian Gernhardt Compiler Developer Patrick Michaud (PGE, PCT) Allison Randal (TGE) Platform Porter Allison Randal (Debian, Ubuntu) Francois Perrad (MinGW32) Reini Urban (cygwin) Will Coleda (MacPorts) Jerry Gay (Windows) Gerd Pokorra (Fedora) Patch Monster chromatic Reini Urban Jonathan Worthington Jerry Gay Will Coleda James E Keenan Francois Perrad Christoph Otto Julian Albo Mark Glines Jonthan "Duke" Leto Contributors ------------ Cage Cleaner James E Keenan Jerry Gay chromatic Andy Lester Francois Perrad Mark Glines Bruce Gray Michael Hind Alvis Yardley General Contributor See CREDITS 81_continuation.pir000644000765000765 203112101554066 21724 0ustar00brucebruce000000000000parrot-5.9.0/examples/tutorial# Copyright (C) 2007-2012, Parrot Foundation. =pod =head1 DESCRIPTION A tutorial lesson about Parrot's continuations. =head1 CONTINUATIONS Continuations are tricky and amazing things. Parrot uses continuations for all sorts of things internally and you can use them too if you want. A continuation is like a snapshot of the current execution environment. If you invoke a continuation like a subroutine, it returns you to the point where you created the continuation. Also, you can set the address in the continuation to any label, so you can return to any arbitrary point in your code that you want by invoking it. =cut .sub main :main .local pmc cont cont = new ['Continuation'] set_addr cont, continued test_call(4, cont) say "should never be printed" continued: say "continuation called" .end .sub test_call .param pmc argument .param pmc cont print "got argument: " say argument cont() .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: pdd_format.t000644000765000765 354411567202625 17252 0ustar00brucebruce000000000000parrot-5.9.0/t/codingstd#! perl # Copyright (C) 2001-2011, Parrot Foundation. use strict; use warnings; use Test::More tests => 1; use Carp; use Tie::File; my @pdddirs = qw( ./docs/pdds ./docs/pdds/draft ); my @pddfiles = (); foreach my $dir (@pdddirs) { die "Directory '$dir' is not found, or not a directory" if not -d $dir; my @pdds = glob "$dir/pdd*.pod" or warn "No PDD files found in directory '$dir'"; push @pddfiles, @pdds; } my @diagnostics = (); foreach my $pdd (@pddfiles) { my $diag = check_pdd_formatting($pdd); if ( $diag ) { push @diagnostics, $diag; } } for my $msg (@diagnostics) { diag($msg); } cmp_ok( scalar(@diagnostics), '==', 0, 'PDDs are formatted correctly' ); sub check_pdd_formatting { my $pdd = shift; my $diag = q{}; my @toolong = (); my @sections_needed = qw( Abstract Description Implementation References ); my %sections_seen; my @lines; tie @lines, 'Tie::File', $pdd or croak "Unable to tie to $pdd: $!"; for (my $i=0; $i<=$#lines; $i++) { if ( ( length( $lines[$i] ) > 78 ) and ( $lines[$i] !~ m/^(?:F|L)<| 78 chars: @toolong\n}; } foreach my $need (@sections_needed) { if ( ! $sections_seen{$need} ) { $diag .= qq{$pdd lacks 'head2' $need section\n}; } } return $diag; } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: tail.t000644000765000765 1651312101554067 17642 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/imcc/syn#!perl # Copyright (C) 2005-2007, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Config; use Parrot::Test tests => 7; ############################## # Parrot Calling Conventions: Tail call optimization. pir_output_is( <<'CODE', <<'OUT', "tail call optimization, final position" ); .sub _main :main $P1 = new 'Integer' $P1 = 20 $P2 = new 'Integer' $P2 = 3 .const 'Sub' f = "_floor" .const 'Sub' c = "_funcall" set_args "0,0,0", f, $P1, $P2 invokecc c get_results "0,0", $P3, $P4 print "_floor returned " print 2 # TODO argcP print " values, " print $P3 print " and " print $P4 print ".\n" .const 'Sub' s = "_fib_step" set_args "0,0,0", s, $P1, $P2 invokecc c get_results "0,0,0", $P3, $P4, $P5 print "_fib_step returned " print 3 # TODO argcP print " values, " print $P3 print ", " print $P4 print ", and " print $P5 print ".\n" .end .sub _funcall .local pmc function .local pmc argv get_params "0,0x20", function, argv print "[doing _funcall]\n" $I33 = defined function if $I33 goto doit bad_func: print "_funcall: Bad function.\n" exit 0 doit: set_args "0x20", argv tailcall function .end ## Return quotient and remainder as two integers. .sub _floor .local pmc arg1 .local pmc arg2 get_params "0,0", arg1, arg2 $P1 = new 'Integer' $P1 = arg1 / arg2 ## truncate. $I1 = $P1 $P1 = $I1 $P2 = new 'Integer' $P2 = arg1 % arg2 set_returns "0,0", $P1, $P2 returncc .end ## Return the sum and the two arguments as three integers. .sub _fib_step .local pmc arg1 .local pmc arg2 get_params "0,0", arg1, arg2 $P1 = new 'Integer' $P1 = arg1 + arg2 set_returns "0,0,0", $P1, arg1, arg2 returncc .end CODE [doing _funcall] _floor returned 2 values, 6 and 2. [doing _funcall] _fib_step returned 3 values, 23, 20, and 3. OUT pir_output_is( <<'CODE', <<'OUT', "tail call optimization, intermediate position" ); .sub _main :main $P1 = new 'Integer' $P1 = 20 $P2 = new 'Integer' $P2 = 3 .const 'Sub' f = "_floor" .const 'Sub' s = "_fib_step" ($P3, $P4) = _funcall(f, $P1, $P2) print "_floor returned " print 2 print " values, " print $P3 print " and " print $P4 print ".\n" ($P3, $P4, $P5) = _funcall(s, $P1, $P2) print "_fib_step returned " print 3 print " values, " print $P3 print ", " print $P4 print ", and " print $P5 print ".\n" .end .sub _funcall .param pmc function .param pmc argv :slurpy print "[doing _funcall]\n" $I33 = defined function unless $I33 goto bad_func doit: .tailcall function(argv :flat) bad_func: print "_funcall: Bad function.\n" exit 0 .end ## Return quotient and remainder as two integers. .sub _floor .param pmc arg1 .param pmc arg2 $P1 = new 'Integer' $P1 = arg1 / arg2 ## truncate. $I1 = $P1 $P1 = $I1 $P2 = new 'Integer' $P2 = arg1 % arg2 .return($P1, $P2) .end ## Return the sum and the two arguments as three integers. .sub _fib_step .param pmc arg1 .param pmc arg2 $P1 = new 'Integer' $P1 = arg1 + arg2 .return ($P1, arg1, arg2) .end CODE [doing _funcall] _floor returned 2 values, 6 and 2. [doing _funcall] _fib_step returned 3 values, 23, 20, and 3. OUT pir_output_is( <<'CODE', <<'OUT', "tail call optimization, implicit final return" ); .sub _main :main $P1 = new 'Integer' $P1 = 20 $P2 = new 'Integer' $P2 = 3 .const 'Sub' f = "_floor" .const 'Sub' s = "_fib_step" ($P3, $P4) = _funcall(f, $P1, $P2) print "_floor returned " print 2 print " values, " print $P3 print " and " print $P4 print ".\n" ($P3, $P4, $P5) = _funcall(s, $P1, $P2) print "_fib_step returned " print 3 print " values, " print $P3 print ", " print $P4 print ", and " print $P5 print ".\n" .end .sub _funcall .param pmc function .param pmc argv :slurpy print "[doing _funcall]\n" $I33 = defined function if $I33 goto doit bad_func: print "_funcall: Bad function.\n" exit 0 doit: .tailcall function(argv :flat) .end ## Return quotient and remainder as two integers. .sub _floor .param pmc arg1 .param pmc arg2 $P1 = new 'Integer' $P1 = arg1 / arg2 ## truncate. $I1 = $P1 $P1 = $I1 $P2 = new 'Integer' $P2 = arg1 % arg2 .return($P1, $P2) .end ## Return the sum and the two arguments as three integers. .sub _fib_step .param pmc arg1 .param pmc arg2 $P1 = new 'Integer' $P1 = arg1 + arg2 .begin_return .set_return $P1 .set_return arg1 .set_return arg2 .end_return .end CODE [doing _funcall] _floor returned 2 values, 6 and 2. [doing _funcall] _fib_step returned 3 values, 23, 20, and 3. OUT pir_output_is( <<'CODE', <<'OUT', ":flatten in .return" ); .sub _main :main $P1 = new 'Integer' $P1 = 20 $P2 = new 'Integer' $P2 = 3 .const 'Sub' s = "_fib_step" ($P3, $P4, $P5) = _funcall(s, $P1, $P2) print "_fib_step returned " print 3 print " values, " print $P3 print ", " print $P4 print ", and " print $P5 print ".\n" .end .sub _funcall .param pmc function .param pmc argv :slurpy $I33 = defined function unless $I33 goto bad_func doit: ($P35 :slurpy) = function(argv :flat) $I35 = $P35 print "[got " print $I35 print " results]\n" .return ($P35 :flat) bad_func: print "_funcall: Bad function.\n" exit 0 .end ## Return the sum and the two arguments as three integers. .sub _fib_step .param pmc arg1 .param pmc arg2 $P1 = new 'Integer' $P1 = arg1 + arg2 .return ($P1, arg1, arg2) .end CODE [got 3 results] _fib_step returned 3 values, 23, 20, and 3. OUT pir_output_is( <<'CODE', <<'OUT', "new tail call syntax" ); .sub main :main $S0 = foo() print $S0 .end .sub foo .tailcall bar() print "never\n" .end .sub bar .return ("ok\n") .end CODE ok OUT pir_output_is( <<'CODE', <<'OUT', "new tail method call syntax" ); .sub main :main .local pmc cl, o, n cl = newclass "Foo" addattribute cl, "n" o = new "Foo" n = new 'Integer' n = 2000 # beyond recursion limit of 1000 setattribute o, [ "Foo" ], "n", n o."go"() n = getattribute o, [ "Foo" ], "n" print n print "\n" .end .namespace ["Foo"] .sub go :method .local pmc n n = getattribute self, [ "Foo" ], "n" dec n unless n goto done .tailcall self."go"() done: .end CODE 0 OUT pir_output_is( <<'CODE', <<'OUTPUT', ".tailcall into an NCI" ); .sub main :main say "A" $P0 = 'Foo'("C") $S0 = typeof $P0 $P1 = $P0[0] $P1 = 'Bar'($P1, "F") say $P1 say "H" .end .sub 'Foo' .param string c say "B" $P0 = compreg "PIR" $S0 = <<'PIRSOURCE' .sub 'Baz' :main .param string f say f .return("G") .end .sub 'Fie' :init say "D" .end PIRSOURCE say c .tailcall $P0($S0) .end .sub 'Bar' .param pmc baz .param string f say "E" .tailcall baz(f) .end CODE A B C D E F G H OUTPUT # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: enums.h000644000765000765 602511567202623 16752 0ustar00brucebruce000000000000parrot-5.9.0/include/parrot/* enums.h * Copyright (C) 2001-2008, Parrot Foundation. * Overview: * enums shared by much of the stack-handling code * Data Structure and Algorithms: * History: * Notes: * References: */ #ifndef PARROT_ENUMS_H_GUARD #define PARROT_ENUMS_H_GUARD typedef enum { NO_STACK_ENTRY_TYPE = 0, STACK_ENTRY_MARK = 1, STACK_ENTRY_DESTINATION = 2, STACK_ENTRY_ACTION = 3, STACK_ENTRY_PMC = 4 } Stack_entry_type; typedef enum { NO_STACK_ENTRY_FLAGS = 0, STACK_ENTRY_CLEANUP_FLAG = 1 << 0 } Stack_entry_flags; typedef enum { NO_STACK_CHUNK_FLAGS = 0, STACK_CHUNK_COW_FLAG = 1 << 0 } Stack_chunk_flags; /* &gen_from_enum(iterator.pasm) */ typedef enum { ITERATE_FROM_START, ITERATE_FROM_START_KEYS, ITERATE_GET_NEXT, ITERATE_GET_PREV, ITERATE_FROM_END } Iterator_action_t; /* &end_gen */ /* &gen_from_enum(call_bits.pasm lib/Parrot/Pmc2c/PCCMETHOD_BITS.pm) */ typedef enum { /* 4 low bits are argument types */ PARROT_ARG_INTVAL = 0x0000, /* 0 */ PARROT_ARG_STRING = 0x0001, /* 1 */ PARROT_ARG_PMC = 0x0002, /* 2 */ PARROT_ARG_FLOATVAL = 0x0003, /* 3 */ PARROT_ARG_TYPE_MASK = 0x000f, /* argument meaning and conversion bits */ PARROT_ARG_CONSTANT = 0x0010, /* 16 */ /* bits a user has to define */ PARROT_ARG_FLATTEN = 0x0020, /* .flatten_arg */ PARROT_ARG_SLURPY_ARRAY = PARROT_ARG_FLATTEN, /* i.e. foldup */ /* unused - 0x040 */ PARROT_ARG_OPTIONAL = 0x0080, /* 128 */ PARROT_ARG_OPT_FLAG = 0x0100, /* 256 prev optional was set */ PARROT_ARG_NAME = 0x0200, /* 512 this String is an arg name */ PARROT_ARG_LOOKAHEAD = 0x0400, /* 1024 this is a lookahead argument */ PARROT_ARG_INVOCANT = 0x0800, /* 2048 this PMC is an invocant */ PARROT_ARG_CALL_SIG = 0x1000 /* more to come soon */ } Call_bits_enum_t; /* &end_gen */ #define PARROT_ARG_INTVAL_ISSET(o) ((o) & PARROT_ARG_INTVAL) #define PARROT_ARG_STRING_ISSET(o) ((o) & PARROT_ARG_STRING) #define PARROT_ARG_PMC_ISSET(o) ((o) & PARROT_ARG_PMC) #define PARROT_ARG_FLOATVAL_ISSET(o) ((o) & PARROT_ARG_FLOATVAL) #define PARROT_ARG_TYPE_MASK_MASK(o) ((o) & PARROT_ARG_TYPE_MASK) #define PARROT_ARG_TYPE(o) PARROT_ARG_TYPE_MASK_MASK(o) #define PARROT_ARG_CONSTANT_ISSET(o) ((o) & PARROT_ARG_CONSTANT) #define PARROT_ARG_FLATTEN_ISSET(o) ((o) & PARROT_ARG_FLATTEN) #define PARROT_ARG_SLURPY_ARRAY_ISSET(o) ((o) & PARROT_ARG_SLURPY_ARRAY) #define PARROT_ARG_OPTIONAL_ISSET(o) ((o) & PARROT_ARG_OPTIONAL) #define PARROT_ARG_OPT_FLAG_ISSET(o) ((o) & PARROT_ARG_OPT_FLAG) #define PARROT_ARG_NAME_ISSET(o) ((o) & PARROT_ARG_NAME) #define PARROT_ARG_INVOCANT_ISSET(o) ((o) & PARROT_ARG_INVOCANT) #endif /* PARROT_ENUMS_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ imclexer.c000644000765000765 53460412227371462 17457 0ustar00brucebruce000000000000parrot-5.9.0/compilers/imcc#line 2 "compilers/imcc/imclexer.c" #line 2 "compilers/imcc/imcc.l" /* ex: set ro ft=c: * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! * * This file is generated automatically by the Parrot build process * from the file compilers/imcc/imcc.l. * * Any changes made here will be lost! * */ /* HEADERIZER HFILE: none */ /* HEADERIZER STOP */ #ifndef __STDC_VERSION__ # define __STDC_VERSION__ 0 #endif #include "imc.h" #include "parser.h" #line 28 "compilers/imcc/imclexer.c" #define YY_INT_ALIGNED short int /* A lexical scanner generated by flex */ #define FLEX_SCANNER #define YY_FLEX_MAJOR_VERSION 2 #define YY_FLEX_MINOR_VERSION 5 #define YY_FLEX_SUBMINOR_VERSION 35 #if YY_FLEX_SUBMINOR_VERSION > 0 #define FLEX_BETA #endif /* First, we deal with platform-specific or compiler-specific issues. */ /* begin standard C headers. */ #include #include #include #include /* end standard C headers. */ /* flex integer type definitions */ #ifndef FLEXINT_H #define FLEXINT_H /* C99 systems have . Non-C99 systems may or may not. */ #if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L /* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, * if you want the limit (max/min) macros for int types. */ #ifndef __STDC_LIMIT_MACROS #define __STDC_LIMIT_MACROS 1 #endif #include typedef int8_t flex_int8_t; typedef uint8_t flex_uint8_t; typedef int16_t flex_int16_t; typedef uint16_t flex_uint16_t; typedef int32_t flex_int32_t; typedef uint32_t flex_uint32_t; #else typedef signed char flex_int8_t; typedef short int flex_int16_t; typedef int flex_int32_t; typedef unsigned char flex_uint8_t; typedef unsigned short int flex_uint16_t; typedef unsigned int flex_uint32_t; /* Limits of integral types. */ #ifndef INT8_MIN #define INT8_MIN (-128) #endif #ifndef INT16_MIN #define INT16_MIN (-32767-1) #endif #ifndef INT32_MIN #define INT32_MIN (-2147483647-1) #endif #ifndef INT8_MAX #define INT8_MAX (127) #endif #ifndef INT16_MAX #define INT16_MAX (32767) #endif #ifndef INT32_MAX #define INT32_MAX (2147483647) #endif #ifndef UINT8_MAX #define UINT8_MAX (255U) #endif #ifndef UINT16_MAX #define UINT16_MAX (65535U) #endif #ifndef UINT32_MAX #define UINT32_MAX (4294967295U) #endif #endif /* ! C99 */ #endif /* ! FLEXINT_H */ #ifdef __cplusplus /* The "const" storage-class-modifier is valid. */ #define YY_USE_CONST #else /* ! __cplusplus */ /* C99 requires __STDC__ to be defined as 1. */ #if defined (__STDC__) #define YY_USE_CONST #endif /* defined (__STDC__) */ #endif /* ! __cplusplus */ #ifdef YY_USE_CONST #define yyconst const #else #define yyconst #endif /* Returned upon end-of-file. */ #define YY_NULL 0 /* Promotes a possibly negative, possibly signed char to an unsigned * integer for use as an array index. If the signed char is negative, * we want to instead treat it as an 8-bit unsigned char, hence the * double cast. */ #define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c) /* An opaque pointer. */ #ifndef YY_TYPEDEF_YY_SCANNER_T #define YY_TYPEDEF_YY_SCANNER_T typedef void* yyscan_t; #endif /* For convenience, these vars (plus the bison vars far below) are macros in the reentrant scanner. */ #define yyin yyg->yyin_r #define yyout yyg->yyout_r #define yyextra yyg->yyextra_r #define yyleng yyg->yyleng_r #define yytext yyg->yytext_r #define yylineno (YY_CURRENT_BUFFER_LVALUE->yy_bs_lineno) #define yycolumn (YY_CURRENT_BUFFER_LVALUE->yy_bs_column) #define yy_flex_debug yyg->yy_flex_debug_r /* Enter a start condition. This macro really ought to take a parameter, * but we do it the disgusting crufty way forced on us by the ()-less * definition of BEGIN. */ #define BEGIN yyg->yy_start = 1 + 2 * /* Translate the current start state into a value that can be later handed * to BEGIN to return to the state. The YYSTATE alias is for lex * compatibility. */ #define YY_START ((yyg->yy_start - 1) / 2) #define YYSTATE YY_START /* Action number for EOF rule of a given start state. */ #define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1) /* Special action meaning "start processing a new file". */ #define YY_NEW_FILE yyrestart(yyin ,yyscanner ) #define YY_END_OF_BUFFER_CHAR 0 /* Size of default input buffer. */ #ifndef YY_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k. * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. * Ditto for the __ia64__ case accordingly. */ #define YY_BUF_SIZE 32768 #else #define YY_BUF_SIZE 16384 #endif /* __ia64__ */ #endif /* The state buf must be large enough to hold one state per character in the main buffer. */ #define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type)) #ifndef YY_TYPEDEF_YY_BUFFER_STATE #define YY_TYPEDEF_YY_BUFFER_STATE typedef struct yy_buffer_state *YY_BUFFER_STATE; #endif #define EOB_ACT_CONTINUE_SCAN 0 #define EOB_ACT_END_OF_FILE 1 #define EOB_ACT_LAST_MATCH 2 /* Note: We specifically omit the test for yy_rule_can_match_eol because it requires * access to the local variable yy_act. Since yyless() is a macro, it would break * existing scanners that call yyless() from OUTSIDE yylex. * One obvious solution it to make yy_act a global. I tried that, and saw * a 5% performance hit in a non-yylineno scanner, because yy_act is * normally declared as a register variable-- so it is not worth it. */ #define YY_LESS_LINENO(n) \ do { \ int yyl;\ for ( yyl = n; yyl < yyleng; ++yyl )\ if ( yytext[yyl] == '\n' )\ --yylineno;\ }while(0) /* Return all but the first "n" matched characters back to the input stream. */ #define yyless(n) \ do \ { \ /* Undo effects of setting up yytext. */ \ int yyless_macro_arg = (n); \ YY_LESS_LINENO(yyless_macro_arg);\ *yy_cp = yyg->yy_hold_char; \ YY_RESTORE_YY_MORE_OFFSET \ yyg->yy_c_buf_p = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \ YY_DO_BEFORE_ACTION; /* set up yytext again */ \ } \ while ( 0 ) #define unput(c) yyunput( c, yyg->yytext_ptr , yyscanner ) #ifndef YY_TYPEDEF_YY_SIZE_T #define YY_TYPEDEF_YY_SIZE_T typedef size_t yy_size_t; #endif #ifndef YY_STRUCT_YY_BUFFER_STATE #define YY_STRUCT_YY_BUFFER_STATE struct yy_buffer_state { FILE *yy_input_file; char *yy_ch_buf; /* input buffer */ char *yy_buf_pos; /* current position in input buffer */ /* Size of input buffer in bytes, not including room for EOB * characters. */ yy_size_t yy_buf_size; /* Number of characters read into yy_ch_buf, not including EOB * characters. */ int yy_n_chars; /* Whether we "own" the buffer - i.e., we know we created it, * and can realloc() it to grow it, and should free() it to * delete it. */ int yy_is_our_buffer; /* Whether this is an "interactive" input source; if so, and * if we're using stdio for input, then we want to use getc() * instead of fread(), to make sure we stop fetching input after * each newline. */ int yy_is_interactive; /* Whether we're considered to be at the beginning of a line. * If so, '^' rules will be active on the next match, otherwise * not. */ int yy_at_bol; int yy_bs_lineno; /**< The line count. */ int yy_bs_column; /**< The column count. */ /* Whether to try to fill the input buffer when we reach the * end of it. */ int yy_fill_buffer; int yy_buffer_status; #define YY_BUFFER_NEW 0 #define YY_BUFFER_NORMAL 1 /* When an EOF's been seen but there's still some text to process * then we mark the buffer as YY_EOF_PENDING, to indicate that we * shouldn't try reading from the input source any more. We might * still have a bunch of tokens to match, though, because of * possible backing-up. * * When we actually see the EOF, we change the status to "new" * (via yyrestart()), so that the user can continue scanning by * just pointing yyin at a new input file. */ #define YY_BUFFER_EOF_PENDING 2 }; #endif /* !YY_STRUCT_YY_BUFFER_STATE */ /* We provide macros for accessing buffer states in case in the * future we want to put the buffer states in a more general * "scanner state". * * Returns the top of the stack, or NULL. */ #define YY_CURRENT_BUFFER ( yyg->yy_buffer_stack \ ? yyg->yy_buffer_stack[yyg->yy_buffer_stack_top] \ : NULL) /* Same as previous macro, but useful when we know that the buffer stack is not * NULL or when we need an lvalue. For internal use only. */ #define YY_CURRENT_BUFFER_LVALUE yyg->yy_buffer_stack[yyg->yy_buffer_stack_top] void yyrestart (FILE *input_file ,yyscan_t yyscanner ); void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer ,yyscan_t yyscanner ); YY_BUFFER_STATE yy_create_buffer (FILE *file,int size ,yyscan_t yyscanner ); void yy_delete_buffer (YY_BUFFER_STATE b ,yyscan_t yyscanner ); void yy_flush_buffer (YY_BUFFER_STATE b ,yyscan_t yyscanner ); void yypush_buffer_state (YY_BUFFER_STATE new_buffer ,yyscan_t yyscanner ); void yypop_buffer_state (yyscan_t yyscanner ); static void yyensure_buffer_stack (yyscan_t yyscanner ); static void yy_load_buffer_state (yyscan_t yyscanner ); static void yy_init_buffer (YY_BUFFER_STATE b,FILE *file ,yyscan_t yyscanner ); #define YY_FLUSH_BUFFER yy_flush_buffer(YY_CURRENT_BUFFER ,yyscanner) YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size ,yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str ,yyscan_t yyscanner ); YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,int len ,yyscan_t yyscanner ); void *yyalloc (yy_size_t ,yyscan_t yyscanner ); void *yyrealloc (void *,yy_size_t ,yyscan_t yyscanner ); void yyfree (void * ,yyscan_t yyscanner ); #define yy_new_buffer yy_create_buffer #define yy_set_interactive(is_interactive) \ { \ if ( ! YY_CURRENT_BUFFER ){ \ yyensure_buffer_stack (yyscanner); \ YY_CURRENT_BUFFER_LVALUE = \ yy_create_buffer(yyin,YY_BUF_SIZE ,yyscanner); \ } \ YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \ } #define yy_set_bol(at_bol) \ { \ if ( ! YY_CURRENT_BUFFER ){\ yyensure_buffer_stack (yyscanner); \ YY_CURRENT_BUFFER_LVALUE = \ yy_create_buffer(yyin,YY_BUF_SIZE ,yyscanner); \ } \ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \ } #define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol) /* Begin user sect3 */ typedef unsigned char YY_CHAR; typedef int yy_state_type; #define yytext_ptr yytext_r static yy_state_type yy_get_previous_state (yyscan_t yyscanner ); static yy_state_type yy_try_NUL_trans (yy_state_type current_state ,yyscan_t yyscanner); static int yy_get_next_buffer (yyscan_t yyscanner ); static void yy_fatal_error (yyconst char msg[] ,yyscan_t yyscanner ); /* Done after the current pattern has been matched and before the * corresponding action - sets up yytext. */ #define YY_DO_BEFORE_ACTION \ yyg->yytext_ptr = yy_bp; \ yyleng = (size_t) (yy_cp - yy_bp); \ yyg->yy_hold_char = *yy_cp; \ *yy_cp = '\0'; \ yyg->yy_c_buf_p = yy_cp; #define YY_NUM_RULES 141 #define YY_END_OF_BUFFER 142 /* This struct is not used in this scanner, but its presence is necessary. */ struct yy_trans_info { flex_int32_t yy_verify; flex_int32_t yy_nxt; }; static yyconst flex_int16_t yy_accept[861] = { 0, 0, 1, 0, 1, 0, 1, 15, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 4, 1, 142, 129, 128, 9, 128, 129, 129, 10, 129, 129, 129, 129, 129, 129, 110, 129, 90, 129, 114, 114, 129, 82, 129, 84, 127, 127, 127, 127, 127, 127, 127, 127, 129, 129, 1, 1, 129, 128, 128, 129, 129, 129, 129, 1, 1, 129, 140, 135, 131, 135, 140, 140, 140, 140, 140, 114, 114, 140, 138, 138, 1, 1, 140, 15, 16, 15, 15, 15, 15, 15, 15, 15, 15, 15, 1, 1, 15, 141, 129, 7, 7, 129, 1, 5, 5, 5, 5, 5, 5, 5, 5, 5, 1, 6, 129, 8, 129, 129, 129, 129, 129, 114, 114, 129, 129, 1, 1, 129, 11, 129, 129, 129, 129, 129, 114, 114, 129, 129, 1, 1, 141, 2, 141, 141, 141, 141, 141, 114, 114, 141, 141, 1, 1, 4, 3, 141, 4, 4, 4, 4, 4, 4, 4, 4, 1, 1, 128, 0, 9, 87, 0, 118, 0, 125, 125, 125, 125, 125, 95, 79, 98, 0, 88, 93, 0, 114, 91, 92, 113, 104, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 96, 94, 113, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 76, 83, 86, 59, 85, 77, 109, 0, 127, 111, 126, 127, 69, 127, 127, 127, 127, 127, 99, 80, 100, 81, 1, 0, 13, 0, 86, 59, 0, 128, 112, 112, 112, 112, 0, 0, 0, 0, 1, 135, 131, 135, 0, 0, 0, 139, 139, 139, 138, 0, 136, 1, 1, 15, 16, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 1, 15, 7, 1, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 1, 0, 8, 0, 0, 0, 118, 0, 0, 0, 0, 114, 113, 113, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 11, 0, 0, 0, 118, 0, 0, 0, 0, 114, 113, 113, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 2, 0, 0, 0, 118, 0, 0, 0, 0, 114, 113, 113, 0, 0, 0, 0, 0, 0, 0, 1, 1, 4, 0, 3, 4, 0, 4, 4, 4, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 1, 1, 89, 121, 122, 124, 123, 0, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 97, 113, 116, 0, 113, 117, 115, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 102, 101, 78, 108, 0, 126, 127, 72, 127, 73, 74, 127, 127, 0, 112, 112, 0, 0, 132, 137, 134, 139, 139, 139, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 5, 5, 5, 5, 5, 5, 5, 5, 0, 113, 116, 0, 113, 117, 115, 0, 0, 0, 0, 113, 116, 0, 113, 117, 115, 0, 0, 0, 0, 113, 116, 0, 113, 117, 115, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 113, 63, 112, 112, 112, 112, 21, 112, 112, 112, 112, 18, 112, 112, 112, 112, 112, 112, 112, 112, 20, 112, 112, 0, 0, 0, 0, 0, 0, 0, 41, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, 0, 0, 119, 0, 0, 103, 0, 120, 0, 68, 71, 127, 127, 0, 134, 139, 139, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 5, 5, 5, 5, 0, 113, 0, 0, 119, 0, 0, 0, 0, 0, 120, 0, 0, 113, 0, 0, 119, 0, 0, 0, 0, 0, 120, 0, 0, 113, 0, 0, 119, 0, 0, 0, 0, 0, 120, 0, 4, 4, 4, 0, 4, 4, 4, 0, 4, 0, 4, 4, 112, 112, 24, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 39, 0, 54, 0, 35, 0, 0, 34, 33, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 127, 127, 12, 0, 130, 139, 14, 15, 112, 112, 65, 112, 112, 112, 112, 112, 112, 112, 112, 64, 106, 112, 67, 112, 112, 112, 112, 112, 112, 48, 0, 0, 0, 0, 0, 32, 58, 0, 0, 0, 40, 0, 0, 45, 0, 75, 70, 139, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 112, 50, 112, 112, 112, 112, 0, 0, 0, 0, 31, 0, 0, 0, 0, 55, 42, 133, 112, 112, 112, 112, 112, 112, 112, 112, 112, 107, 112, 53, 112, 112, 26, 19, 112, 112, 112, 0, 0, 0, 0, 43, 0, 0, 0, 17, 112, 112, 112, 23, 112, 112, 112, 112, 25, 112, 112, 112, 112, 52, 61, 0, 0, 60, 57, 56, 37, 112, 112, 112, 112, 30, 112, 112, 112, 62, 112, 49, 36, 0, 22, 112, 112, 28, 46, 112, 112, 51, 44, 112, 29, 47, 66, 105, 27, 0 } ; static yyconst flex_int32_t yy_ec[256] = { 0, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 1, 2, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 2, 5, 6, 7, 8, 9, 10, 11, 1, 1, 12, 13, 14, 15, 16, 17, 18, 19, 20, 20, 20, 20, 20, 20, 21, 21, 22, 1, 23, 24, 25, 1, 26, 27, 28, 27, 27, 29, 27, 30, 31, 32, 30, 30, 33, 30, 34, 35, 36, 30, 30, 37, 30, 30, 30, 30, 38, 30, 30, 1, 39, 1, 1, 40, 1, 41, 42, 43, 44, 45, 46, 47, 48, 49, 30, 30, 50, 51, 52, 53, 54, 30, 55, 56, 57, 58, 59, 30, 60, 61, 30, 1, 62, 1, 63, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 } ; static yyconst flex_int32_t yy_meta[64] = { 0, 1, 1, 2, 1, 1, 3, 1, 4, 1, 1, 1, 1, 1, 1, 5, 1, 1, 6, 6, 6, 6, 7, 1, 1, 1, 8, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 1, 11, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 1, 1 } ; static yyconst flex_int16_t yy_base[981] = { 0, 0, 62, 85, 67, 148, 68, 211, 72, 274, 63, 337, 71, 62, 109, 400, 75, 463, 101, 526, 102, 589, 110, 4146, 4147, 115, 4147, 119, 4121, 79, 4147, 108, 4120, 114, 4132, 641, 638, 4147, 648, 655, 109, 701, 729, 734, 637, 646, 653, 710, 744, 716, 774, 718, 719, 745, 720, 54, 631, 790, 795, 797, 753, 801, 794, 817, 778, 4119, 769, 805, 775, 4147, 821, 4147, 840, 717, 802, 4130, 829, 861, 0, 867, 4117, 722, 836, 873, 887, 849, 0, 4147, 4136, 855, 4127, 879, 883, 897, 892, 4114, 957, 861, 905, 4093, 4147, 903, 928, 968, 4113, 866, 0, 0, 925, 935, 957, 1005, 957, 4111, 1065, 936, 904, 813, 4147, 987, 997, 1001, 1011, 1034, 1126, 1056, 1005, 1186, 1042, 1057, 990, 4147, 1003, 1093, 1038, 1099, 1103, 1247, 1098, 1060, 1307, 1108, 1135, 1053, 4147, 1082, 1146, 1089, 1156, 1162, 1368, 1177, 1203, 1428, 1214, 1218, 4129, 4147, 4129, 1012, 933, 1220, 1224, 1488, 1218, 910, 1548, 1139, 1229, 1253, 1165, 4147, 4147, 996, 4147, 0, 0, 1275, 1283, 1307, 1315, 4147, 4147, 4147, 4120, 4147, 4147, 1319, 1329, 4147, 4147, 1323, 4147, 0, 4097, 4077, 4083, 852, 4075, 43, 4074, 1060, 4084, 4083, 1186, 4078, 723, 4081, 4072, 4096, 4147, 1335, 1116, 1380, 1254, 0, 4067, 4077, 4067, 1105, 1117, 1239, 43, 1200, 4063, 1212, 4074, 4057, 1253, 4147, 4147, 4147, 4147, 1189, 4091, 4090, 1283, 4105, 1396, 1351, 1368, 1370, 1397, 1441, 1446, 1447, 4147, 4147, 4147, 4147, 1359, 1231, 4147, 1283, 1378, 1419, 1421, 1277, 4057, 4057, 1312, 4065, 1406, 4051, 4048, 114, 1286, 1462, 4147, 1468, 4083, 1455, 0, 0, 4052, 4062, 1086, 4096, 1467, 1491, 1496, 0, 4147, 1056, 0, 0, 4090, 1492, 1518, 1500, 1548, 1441, 1561, 1524, 1594, 1142, 1640, 4094, 1358, 4041, 1579, 1375, 0, 1521, 0, 1565, 1651, 1598, 1655, 1462, 1613, 1570, 1686, 1167, 1732, 4092, 1405, 1499, 4147, 1511, 1655, 1679, 1588, 1598, 1684, 1686, 1705, 1747, 1769, 1781, 1674, 1800, 1804, 1824, 1758, 1870, 1600, 1708, 1717, 1626, 4147, 1695, 1777, 1851, 1713, 1749, 1771, 1775, 1828, 1885, 1907, 1919, 1793, 1938, 1942, 1962, 1830, 2008, 1834, 1756, 1856, 1802, 4147, 1826, 1858, 1896, 1904, 1909, 1913, 1964, 1951, 2023, 2045, 2057, 1974, 1981, 2069, 2100, 2034, 2146, 1915, 1984, 2032, 4093, 0, 4147, 1662, 1811, 4092, 4091, 1295, 4083, 2063, 2093, 2087, 2157, 1925, 2169, 2075, 2206, 2047, 2252, 1590, 1603, 1789, 1894, 2036, 2080, 2105, 2115, 2178, 0, 4060, 4040, 4044, 4040, 4037, 3937, 3912, 3905, 1308, 3887, 1906, 3893, 3879, 3869, 3851, 3826, 3815, 3825, 3817, 3810, 4147, 2185, 1955, 2146, 2197, 2161, 0, 3791, 3783, 3781, 3618, 2081, 3597, 3605, 3586, 3567, 3568, 3561, 3531, 3508, 3497, 3495, 3492, 3503, 3497, 3499, 1989, 3528, 4147, 4147, 3504, 4147, 2023, 2214, 2263, 2223, 2271, 2224, 2265, 2273, 2274, 2237, 3474, 3465, 3446, 3331, 4147, 2279, 0, 0, 3287, 3277, 2289, 2305, 1979, 2309, 2317, 2193, 2333, 2053, 3297, 2133, 3240, 2326, 2337, 2176, 2349, 2365, 2201, 2369, 2300, 2388, 2401, 2314, 2413, 2420, 2345, 2444, 2396, 2309, 2422, 2439, 2463, 2475, 2492, 2496, 2500, 2518, 2503, 2369, 2526, 2537, 2550, 2530, 2563, 2569, 2573, 2593, 2601, 2433, 2612, 2628, 2581, 2224, 2638, 2646, 2605, 2664, 2266, 1524, 2613, 2456, 2505, 0, 3233, 3224, 3191, 3184, 3195, 3194, 3181, 3169, 3165, 0, 3163, 3155, 3130, 3129, 2991, 2970, 2933, 2940, 0, 2919, 2908, 2893, 2893, 2852, 2860, 2847, 2836, 2837, 4147, 2845, 2836, 2839, 2829, 2840, 2832, 999, 2838, 2825, 2826, 2830, 4147, 2836, 2168, 4147, 0, 2866, 4147, 2388, 4147, 0, 2483, 2647, 2664, 2655, 2197, 0, 2825, 2829, 2609, 2655, 2412, 0, 0, 2862, 2462, 0, 0, 2280, 2669, 2676, 2709, 0, 2710, 2714, 2697, 2718, 2339, 2446, 2524, 2540, 2734, 2738, 2452, 2466, 2742, 2746, 2748, 2752, 2571, 2641, 2650, 2765, 2768, 2775, 2677, 2695, 2779, 2785, 2789, 2805, 2722, 2744, 2809, 2812, 2815, 2821, 2781, 2798, 2813, 2818, 2790, 2592, 2868, 2867, 1766, 2858, 2836, 2665, 2864, 2863, 2809, 2810, 0, 2804, 2792, 2804, 2789, 2768, 2767, 2740, 2736, 2727, 2719, 2719, 2687, 2672, 2698, 2680, 2675, 4147, 2662, 4147, 2634, 4147, 2619, 2590, 4147, 4147, 2555, 2557, 2559, 2537, 2540, 2527, 2523, 2488, 2448, 2453, 2430, 2833, 2835, 4147, 2842, 0, 2403, 4147, 2442, 2388, 2355, 0, 2352, 2336, 2322, 2314, 2290, 2287, 2226, 2206, 0, 2204, 2183, 0, 2165, 2140, 2128, 2086, 2061, 2055, 0, 2029, 2031, 2017, 2009, 2002, 4147, 4147, 1968, 1929, 1924, 4147, 1910, 1889, 4147, 1889, 2841, 2843, 2113, 1874, 2809, 1870, 1858, 1846, 1829, 1820, 1811, 1787, 1793, 1782, 1768, 1705, 0, 1691, 1665, 1646, 1636, 1632, 1619, 1612, 1573, 4147, 1559, 1568, 1537, 1524, 4147, 4147, 2288, 1506, 1505, 1495, 1482, 1475, 1464, 1455, 1438, 1430, 0, 1421, 0, 1393, 1400, 0, 0, 1368, 1370, 1352, 1347, 1334, 1277, 1226, 4147, 1214, 1202, 1193, 0, 1173, 1147, 1156, 0, 1129, 1119, 1081, 1073, 0, 1062, 1035, 1016, 978, 0, 4147, 966, 945, 4147, 4147, 4147, 4147, 933, 914, 910, 889, 0, 872, 863, 828, 0, 794, 0, 4147, 787, 0, 740, 707, 0, 624, 606, 89, 0, 4147, 84, 0, 0, 0, 0, 0, 4147, 2891, 2897, 2907, 2915, 2926, 2930, 2938, 2945, 2956, 2967, 2978, 2989, 2996, 3007, 3018, 3029, 3040, 3051, 3062, 3073, 3084, 3095, 3106, 3117, 3128, 3139, 3150, 3161, 3172, 3183, 3194, 3205, 3211, 3221, 3227, 3233, 3239, 3250, 3256, 3260, 3266, 3273, 3284, 3295, 3306, 3317, 3328, 3339, 3350, 3361, 3372, 3383, 3394, 3405, 3416, 3427, 3438, 3449, 3460, 3471, 3482, 3493, 3504, 3515, 3526, 3532, 3537, 3543, 3552, 3563, 3574, 3582, 3593, 3599, 3605, 3611, 3622, 3633, 3644, 3655, 3666, 3677, 3688, 3699, 3710, 3721, 3732, 3743, 3754, 3765, 3776, 3787, 3798, 3809, 3820, 3831, 3842, 3853, 3859, 3870, 3881, 3892, 3900, 3911, 3917, 3923, 3934, 3945, 3956, 3967, 3978, 3989, 4000, 4011, 4022, 4033, 4044, 4055, 4066, 4077 } ; static yyconst flex_int16_t yy_def[981] = { 0, 860, 1, 1, 3, 860, 5, 860, 7, 860, 9, 860, 11, 9, 9, 860, 15, 860, 17, 860, 19, 860, 21, 860, 860, 860, 860, 860, 860, 861, 860, 862, 860, 860, 863, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 864, 864, 864, 864, 864, 864, 864, 864, 860, 860, 860, 860, 865, 860, 860, 860, 39, 860, 860, 860, 860, 865, 860, 860, 860, 860, 861, 866, 863, 860, 867, 41, 860, 860, 868, 868, 860, 860, 865, 869, 860, 869, 870, 871, 869, 869, 869, 93, 869, 872, 869, 869, 869, 860, 860, 41, 860, 873, 860, 874, 874, 875, 874, 874, 874, 111, 874, 876, 874, 861, 877, 860, 877, 878, 879, 877, 877, 877, 124, 877, 880, 877, 877, 881, 860, 881, 882, 883, 881, 881, 881, 137, 881, 884, 881, 881, 885, 860, 885, 886, 887, 885, 885, 885, 150, 885, 888, 885, 885, 889, 860, 889, 890, 891, 889, 889, 889, 163, 889, 892, 889, 889, 860, 860, 860, 860, 861, 860, 861, 893, 893, 893, 893, 893, 860, 860, 860, 894, 860, 860, 860, 860, 860, 860, 860, 860, 895, 895, 895, 895, 895, 895, 895, 895, 895, 895, 895, 895, 895, 895, 895, 895, 860, 860, 860, 860, 860, 860, 896, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 873, 897, 860, 897, 897, 897, 897, 897, 897, 897, 897, 860, 860, 860, 860, 860, 898, 860, 898, 898, 898, 898, 860, 895, 895, 895, 895, 860, 860, 860, 860, 860, 860, 860, 860, 899, 899, 900, 901, 901, 901, 902, 860, 902, 860, 860, 903, 860, 904, 903, 904, 905, 903, 903, 903, 903, 903, 903, 903, 903, 903, 906, 903, 903, 903, 860, 860, 907, 908, 907, 907, 907, 907, 907, 907, 907, 907, 907, 907, 909, 907, 907, 910, 860, 910, 911, 911, 910, 911, 912, 912, 910, 910, 910, 910, 910, 910, 910, 910, 910, 913, 910, 910, 910, 914, 860, 914, 915, 915, 914, 915, 916, 916, 914, 914, 914, 914, 914, 914, 914, 914, 914, 917, 914, 914, 914, 918, 860, 918, 919, 919, 918, 919, 920, 920, 918, 918, 918, 918, 918, 918, 918, 918, 918, 921, 918, 918, 918, 922, 922, 860, 923, 923, 922, 923, 924, 924, 922, 922, 922, 922, 922, 922, 922, 922, 922, 925, 922, 922, 922, 860, 926, 926, 926, 926, 860, 927, 927, 927, 927, 927, 927, 927, 927, 927, 927, 927, 927, 927, 927, 927, 927, 927, 927, 927, 927, 927, 860, 860, 860, 860, 860, 860, 928, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 929, 930, 860, 860, 860, 860, 931, 932, 932, 932, 932, 932, 932, 932, 932, 933, 927, 927, 860, 934, 860, 934, 935, 936, 936, 936, 937, 937, 937, 937, 937, 937, 937, 938, 939, 940, 937, 941, 941, 941, 941, 941, 941, 941, 942, 943, 943, 943, 943, 943, 943, 943, 944, 945, 946, 947, 947, 947, 947, 947, 947, 947, 948, 949, 950, 951, 951, 951, 951, 951, 951, 951, 952, 953, 954, 955, 955, 955, 955, 955, 955, 955, 956, 957, 958, 860, 860, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 960, 860, 960, 961, 860, 962, 860, 962, 963, 963, 963, 963, 964, 965, 966, 966, 967, 967, 968, 967, 968, 969, 970, 967, 970, 967, 971, 971, 972, 971, 973, 973, 974, 974, 973, 974, 975, 975, 976, 976, 973, 976, 977, 977, 978, 978, 977, 978, 979, 979, 980, 980, 977, 980, 951, 951, 952, 952, 951, 952, 953, 953, 954, 954, 951, 954, 955, 955, 956, 956, 955, 956, 957, 957, 958, 958, 955, 958, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 963, 963, 860, 964, 966, 966, 860, 967, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 963, 963, 966, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 860, 860, 860, 860, 860, 860, 860, 860, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 860, 860, 860, 860, 860, 860, 860, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 959, 860, 860, 959, 959, 959, 959, 959, 959, 959, 959, 860, 959, 959, 959, 959, 959, 959, 0, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860 } ; static yyconst flex_int16_t yy_nxt[4211] = { 0, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 42, 42, 43, 44, 45, 46, 47, 47, 47, 47, 47, 47, 48, 47, 48, 47, 48, 48, 47, 24, 47, 47, 47, 47, 47, 47, 47, 49, 47, 50, 47, 47, 51, 47, 52, 47, 53, 47, 54, 47, 47, 47, 55, 56, 57, 105, 58, 105, 116, 66, 83, 67, 84, 115, 97, 115, 98, 128, 246, 129, 41, 42, 42, 42, 449, 174, 59, 60, 418, 61, 24, 68, 85, 419, 24, 24, 99, 24, 62, 450, 62, 63, 24, 141, 154, 142, 155, 64, 65, 24, 24, 105, 167, 105, 168, 116, 247, 169, 175, 169, 458, 169, 171, 169, 182, 459, 209, 41, 42, 42, 42, 170, 47, 210, 47, 170, 859, 47, 183, 47, 177, 47, 178, 47, 179, 180, 858, 24, 24, 69, 70, 71, 72, 69, 73, 69, 74, 69, 69, 75, 69, 76, 69, 76, 77, 69, 78, 79, 79, 79, 69, 80, 69, 69, 81, 81, 81, 81, 81, 81, 82, 81, 82, 81, 82, 82, 81, 69, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 69, 69, 86, 86, 87, 88, 86, 89, 86, 86, 86, 86, 90, 86, 91, 86, 91, 92, 86, 93, 94, 94, 94, 86, 95, 86, 86, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 86, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 86, 86, 24, 24, 100, 24, 24, 29, 24, 24, 24, 24, 34, 24, 62, 24, 62, 101, 24, 102, 103, 103, 103, 24, 65, 24, 24, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 24, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 24, 24, 106, 106, 107, 106, 106, 29, 106, 106, 106, 106, 108, 106, 109, 106, 109, 110, 106, 111, 112, 112, 112, 106, 113, 106, 106, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 106, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 106, 106, 117, 117, 118, 119, 117, 120, 117, 117, 117, 117, 121, 117, 122, 117, 122, 123, 117, 124, 125, 125, 125, 117, 126, 117, 117, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 117, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 117, 117, 130, 130, 131, 132, 130, 133, 130, 130, 130, 130, 134, 130, 135, 130, 135, 136, 130, 137, 138, 138, 138, 130, 139, 130, 130, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 130, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 130, 130, 143, 143, 144, 145, 143, 146, 143, 143, 143, 143, 147, 143, 148, 143, 148, 149, 143, 150, 151, 151, 151, 143, 152, 143, 143, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 143, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 143, 143, 156, 156, 157, 158, 156, 159, 156, 156, 156, 156, 160, 156, 161, 156, 161, 162, 156, 163, 164, 164, 164, 156, 165, 156, 156, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 156, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 156, 156, 185, 187, 248, 188, 188, 188, 188, 228, 229, 189, 857, 187, 186, 188, 188, 188, 188, 230, 231, 190, 191, 191, 191, 191, 232, 233, 192, 856, 193, 193, 193, 193, 193, 194, 193, 193, 193, 193, 193, 193, 193, 249, 193, 195, 196, 197, 193, 198, 193, 199, 193, 200, 201, 202, 203, 193, 204, 205, 206, 207, 193, 193, 193, 208, 211, 234, 188, 188, 188, 188, 174, 234, 235, 234, 234, 234, 212, 213, 235, 237, 235, 235, 235, 214, 235, 237, 215, 237, 237, 237, 212, 277, 211, 213, 188, 188, 188, 188, 855, 234, 234, 214, 257, 175, 257, 213, 235, 235, 215, 238, 238, 238, 238, 237, 237, 428, 239, 243, 266, 245, 266, 213, 216, 242, 217, 252, 253, 218, 429, 234, 219, 220, 221, 222, 223, 224, 235, 225, 226, 250, 227, 250, 854, 237, 250, 171, 250, 252, 253, 244, 257, 171, 257, 170, 266, 171, 266, 187, 170, 188, 188, 188, 188, 318, 319, 256, 216, 240, 254, 255, 267, 268, 269, 241, 262, 220, 221, 263, 264, 224, 853, 271, 226, 271, 227, 271, 271, 256, 860, 267, 268, 269, 187, 852, 188, 188, 188, 188, 235, 252, 253, 278, 278, 278, 278, 277, 193, 258, 284, 193, 298, 193, 298, 259, 260, 301, 272, 301, 261, 193, 193, 193, 279, 268, 280, 193, 191, 191, 191, 191, 211, 851, 188, 188, 188, 188, 279, 268, 280, 256, 415, 285, 287, 213, 288, 288, 288, 288, 289, 289, 289, 289, 416, 274, 298, 282, 298, 174, 275, 213, 290, 384, 288, 288, 288, 288, 850, 281, 191, 191, 191, 191, 291, 292, 281, 302, 849, 281, 184, 293, 400, 281, 294, 304, 391, 316, 291, 316, 848, 292, 175, 388, 281, 300, 300, 300, 300, 293, 305, 281, 306, 306, 306, 306, 294, 281, 281, 847, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 846, 281, 281, 307, 307, 307, 307, 297, 281, 281, 281, 845, 211, 302, 300, 300, 300, 300, 318, 319, 302, 340, 341, 302, 281, 213, 844, 302, 318, 321, 174, 322, 318, 325, 340, 341, 318, 319, 302, 843, 322, 213, 318, 319, 387, 302, 388, 281, 281, 308, 842, 306, 306, 306, 306, 326, 334, 327, 327, 327, 327, 309, 310, 175, 323, 318, 319, 698, 311, 340, 347, 312, 337, 318, 338, 309, 699, 344, 310, 389, 328, 328, 328, 328, 362, 363, 311, 337, 318, 338, 284, 340, 341, 312, 302, 302, 302, 302, 302, 841, 302, 302, 302, 302, 302, 302, 302, 302, 840, 302, 302, 356, 317, 362, 363, 315, 302, 302, 302, 317, 362, 369, 317, 285, 340, 343, 317, 344, 366, 235, 340, 341, 302, 421, 340, 341, 277, 317, 359, 340, 360, 422, 839, 348, 317, 349, 349, 349, 349, 350, 350, 350, 350, 838, 339, 302, 302, 318, 319, 837, 345, 339, 434, 434, 339, 359, 340, 360, 339, 403, 329, 404, 327, 327, 327, 327, 491, 362, 365, 339, 366, 492, 330, 331, 442, 443, 339, 362, 363, 332, 444, 836, 333, 362, 363, 405, 330, 405, 445, 331, 370, 458, 371, 371, 371, 371, 502, 332, 372, 372, 372, 372, 835, 367, 333, 317, 317, 318, 319, 317, 317, 317, 317, 317, 317, 317, 317, 317, 317, 834, 317, 317, 833, 361, 362, 363, 336, 317, 317, 317, 361, 461, 462, 361, 381, 362, 382, 361, 381, 362, 382, 832, 384, 317, 378, 425, 384, 426, 361, 403, 385, 403, 252, 253, 392, 361, 393, 393, 393, 393, 394, 394, 394, 394, 383, 831, 317, 317, 340, 341, 830, 383, 451, 169, 383, 169, 452, 458, 383, 829, 454, 351, 459, 349, 349, 349, 349, 170, 455, 383, 437, 437, 437, 352, 353, 460, 383, 257, 446, 257, 354, 828, 447, 355, 252, 253, 266, 352, 266, 234, 353, 406, 406, 406, 406, 448, 235, 391, 354, 407, 407, 407, 407, 237, 388, 355, 339, 339, 340, 341, 339, 339, 339, 339, 339, 339, 339, 339, 339, 339, 827, 339, 339, 408, 408, 408, 408, 358, 339, 339, 339, 409, 409, 409, 409, 191, 191, 191, 191, 191, 191, 191, 191, 211, 339, 188, 188, 188, 188, 553, 410, 433, 433, 433, 433, 421, 213, 234, 298, 250, 298, 250, 410, 475, 235, 554, 410, 339, 339, 362, 363, 237, 213, 170, 234, 301, 234, 301, 410, 252, 253, 235, 373, 235, 371, 371, 371, 371, 237, 826, 237, 435, 825, 435, 374, 375, 436, 436, 436, 436, 824, 376, 234, 234, 377, 316, 466, 316, 374, 235, 235, 375, 465, 465, 465, 465, 237, 237, 823, 376, 252, 253, 252, 253, 822, 467, 377, 361, 361, 362, 363, 361, 361, 361, 361, 361, 361, 361, 361, 361, 361, 821, 361, 361, 820, 468, 469, 234, 380, 361, 361, 361, 234, 234, 235, 442, 476, 486, 486, 235, 235, 237, 267, 268, 269, 361, 237, 237, 267, 268, 269, 479, 479, 479, 479, 478, 819, 473, 497, 497, 235, 818, 470, 278, 278, 278, 278, 277, 361, 361, 384, 279, 268, 280, 817, 472, 279, 268, 280, 471, 318, 319, 395, 816, 393, 393, 393, 393, 289, 289, 289, 289, 318, 319, 396, 397, 289, 289, 289, 289, 815, 398, 302, 814, 399, 184, 661, 484, 396, 813, 304, 397, 290, 658, 288, 288, 288, 288, 812, 398, 489, 489, 489, 484, 811, 292, 399, 383, 383, 810, 384, 383, 383, 383, 383, 383, 383, 383, 383, 383, 383, 292, 383, 383, 485, 485, 485, 485, 402, 383, 383, 383, 487, 809, 487, 484, 808, 488, 488, 488, 488, 307, 307, 307, 307, 383, 500, 500, 500, 318, 319, 484, 384, 211, 542, 300, 300, 300, 300, 318, 321, 318, 319, 403, 512, 404, 213, 807, 383, 383, 490, 490, 490, 490, 307, 307, 307, 307, 806, 490, 490, 490, 213, 805, 498, 495, 498, 340, 341, 499, 499, 499, 499, 490, 490, 490, 490, 490, 490, 281, 281, 495, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 281, 804, 281, 281, 318, 321, 803, 322, 297, 281, 281, 281, 387, 308, 388, 306, 306, 306, 306, 496, 496, 496, 496, 318, 319, 281, 310, 802, 318, 321, 495, 322, 801, 318, 325, 318, 325, 800, 505, 505, 323, 322, 310, 322, 340, 341, 495, 389, 281, 281, 501, 501, 501, 501, 318, 319, 337, 318, 338, 501, 501, 501, 340, 341, 323, 337, 318, 338, 799, 328, 328, 328, 328, 501, 501, 501, 501, 501, 501, 302, 302, 302, 302, 302, 798, 302, 302, 302, 302, 302, 302, 302, 302, 797, 302, 302, 318, 319, 340, 343, 315, 302, 302, 302, 359, 340, 360, 318, 319, 329, 510, 327, 327, 327, 327, 511, 661, 302, 318, 319, 340, 347, 331, 658, 340, 347, 340, 343, 344, 344, 318, 319, 344, 328, 328, 328, 328, 403, 331, 403, 302, 302, 340, 341, 503, 504, 504, 504, 504, 318, 319, 362, 363, 318, 319, 796, 503, 515, 515, 506, 503, 506, 345, 388, 507, 507, 507, 507, 508, 508, 508, 795, 503, 318, 319, 362, 363, 340, 341, 340, 341, 794, 520, 340, 341, 793, 522, 521, 509, 509, 509, 509, 350, 350, 350, 350, 389, 509, 509, 509, 340, 343, 792, 344, 359, 340, 360, 362, 365, 791, 366, 509, 509, 509, 509, 509, 509, 317, 317, 318, 319, 317, 317, 317, 317, 317, 317, 317, 317, 317, 317, 790, 317, 317, 340, 341, 345, 789, 336, 317, 317, 317, 405, 367, 405, 362, 365, 351, 366, 349, 349, 349, 349, 362, 363, 317, 340, 341, 362, 365, 353, 788, 362, 369, 362, 363, 787, 532, 340, 341, 366, 350, 350, 350, 350, 384, 353, 783, 317, 317, 781, 367, 513, 514, 514, 514, 514, 340, 341, 535, 535, 340, 341, 556, 513, 557, 780, 516, 513, 516, 362, 363, 517, 517, 517, 517, 518, 518, 518, 779, 513, 340, 341, 362, 369, 372, 372, 372, 372, 434, 434, 366, 778, 362, 363, 777, 519, 519, 519, 519, 362, 363, 381, 362, 382, 519, 519, 519, 525, 525, 526, 589, 526, 486, 486, 527, 527, 527, 527, 519, 519, 519, 519, 519, 519, 339, 339, 340, 341, 339, 339, 339, 339, 339, 339, 339, 339, 339, 339, 776, 339, 339, 362, 363, 590, 594, 358, 339, 339, 339, 381, 362, 382, 362, 363, 373, 530, 371, 371, 371, 371, 531, 775, 339, 362, 363, 774, 384, 375, 540, 406, 406, 406, 406, 541, 607, 362, 363, 595, 372, 372, 372, 372, 384, 375, 773, 339, 339, 362, 363, 523, 524, 524, 524, 524, 384, 772, 394, 394, 394, 394, 771, 523, 528, 528, 528, 523, 384, 608, 538, 538, 538, 770, 384, 407, 407, 407, 407, 523, 362, 363, 394, 394, 394, 394, 395, 769, 393, 393, 393, 393, 782, 533, 782, 529, 529, 529, 529, 397, 408, 408, 408, 408, 529, 529, 529, 571, 768, 533, 409, 409, 409, 409, 572, 397, 611, 573, 529, 529, 529, 529, 529, 529, 361, 361, 362, 363, 361, 361, 361, 361, 361, 361, 361, 361, 361, 361, 384, 361, 361, 436, 436, 436, 436, 380, 361, 361, 361, 612, 384, 589, 534, 534, 534, 534, 437, 437, 437, 536, 767, 536, 361, 533, 537, 537, 537, 537, 543, 766, 543, 497, 497, 544, 544, 544, 544, 707, 708, 533, 433, 433, 433, 433, 590, 361, 361, 384, 489, 489, 489, 410, 436, 436, 436, 436, 500, 500, 500, 234, 765, 539, 539, 539, 539, 384, 235, 410, 234, 234, 539, 539, 539, 237, 764, 235, 235, 252, 253, 535, 535, 763, 237, 237, 539, 539, 539, 539, 539, 539, 383, 383, 762, 384, 383, 383, 383, 383, 383, 383, 383, 383, 383, 383, 761, 383, 383, 657, 234, 658, 234, 402, 383, 383, 383, 235, 234, 235, 234, 234, 711, 712, 237, 235, 237, 235, 235, 782, 383, 782, 237, 600, 237, 237, 479, 479, 479, 479, 478, 604, 302, 604, 659, 591, 605, 605, 605, 605, 617, 318, 625, 383, 383, 596, 318, 319, 599, 622, 597, 598, 485, 485, 485, 485, 488, 488, 488, 488, 760, 505, 505, 484, 488, 488, 488, 488, 614, 759, 614, 318, 319, 615, 615, 615, 615, 318, 319, 484, 490, 490, 490, 490, 496, 496, 496, 496, 758, 490, 490, 490, 508, 508, 508, 495, 499, 499, 499, 499, 757, 340, 637, 490, 490, 490, 490, 490, 490, 634, 756, 495, 499, 499, 499, 499, 501, 501, 501, 501, 318, 319, 755, 594, 754, 501, 501, 501, 318, 621, 618, 622, 618, 318, 319, 619, 619, 619, 619, 501, 501, 501, 501, 501, 501, 318, 319, 607, 504, 504, 504, 504, 318, 319, 318, 627, 595, 628, 753, 503, 507, 507, 507, 507, 623, 362, 649, 507, 507, 507, 507, 340, 341, 646, 711, 503, 318, 319, 318, 621, 608, 630, 752, 630, 318, 319, 631, 631, 631, 631, 629, 509, 509, 509, 509, 340, 341, 611, 318, 627, 509, 509, 509, 544, 544, 544, 544, 340, 341, 749, 514, 514, 514, 514, 509, 509, 509, 509, 509, 509, 234, 513, 515, 515, 340, 341, 748, 235, 340, 341, 612, 747, 340, 341, 237, 340, 633, 513, 634, 517, 517, 517, 517, 517, 517, 517, 517, 518, 518, 518, 340, 341, 544, 544, 544, 544, 318, 625, 340, 639, 746, 640, 362, 363, 622, 519, 519, 519, 519, 362, 363, 635, 318, 625, 519, 519, 519, 525, 525, 642, 622, 642, 362, 363, 643, 643, 643, 643, 519, 519, 519, 519, 519, 519, 641, 362, 363, 524, 524, 524, 524, 362, 363, 340, 341, 362, 363, 745, 523, 744, 527, 527, 527, 527, 384, 743, 527, 527, 527, 527, 528, 528, 528, 742, 523, 362, 363, 658, 534, 534, 534, 534, 741, 362, 645, 740, 646, 739, 384, 533, 529, 529, 529, 529, 362, 651, 663, 652, 664, 529, 529, 529, 538, 538, 538, 533, 605, 605, 605, 605, 659, 384, 738, 529, 529, 529, 529, 529, 529, 647, 654, 384, 654, 340, 633, 655, 655, 655, 655, 384, 653, 665, 340, 637, 234, 537, 537, 537, 537, 737, 634, 235, 234, 537, 537, 537, 537, 384, 237, 235, 664, 234, 605, 605, 605, 605, 237, 736, 235, 340, 341, 539, 539, 539, 539, 237, 615, 615, 615, 615, 539, 539, 539, 615, 615, 615, 615, 340, 639, 318, 621, 735, 622, 665, 539, 539, 539, 539, 539, 539, 706, 302, 318, 319, 591, 705, 318, 319, 734, 617, 318, 621, 733, 622, 362, 363, 729, 619, 619, 619, 619, 619, 619, 619, 619, 623, 318, 627, 730, 628, 318, 627, 728, 628, 340, 341, 362, 645, 340, 341, 340, 633, 731, 634, 340, 633, 623, 634, 732, 631, 631, 631, 631, 631, 631, 631, 631, 340, 637, 727, 340, 639, 629, 640, 726, 634, 629, 340, 639, 725, 640, 362, 363, 362, 363, 724, 635, 362, 363, 723, 635, 362, 645, 657, 646, 658, 643, 643, 643, 643, 362, 651, 643, 643, 643, 643, 641, 362, 645, 722, 646, 362, 649, 641, 362, 649, 384, 362, 651, 646, 652, 384, 646, 362, 651, 721, 652, 647, 659, 720, 655, 655, 655, 655, 716, 655, 655, 655, 655, 663, 234, 664, 234, 647, 707, 253, 717, 235, 234, 235, 234, 784, 718, 653, 237, 235, 237, 235, 719, 653, 715, 714, 237, 785, 237, 713, 663, 384, 658, 786, 657, 384, 607, 710, 665, 709, 589, 704, 703, 750, 702, 701, 700, 697, 696, 695, 694, 693, 692, 691, 751, 173, 690, 173, 173, 173, 173, 173, 173, 173, 173, 173, 176, 689, 688, 176, 176, 184, 687, 184, 184, 184, 184, 184, 184, 184, 184, 184, 236, 236, 236, 236, 236, 236, 236, 236, 251, 251, 251, 251, 251, 251, 251, 251, 251, 251, 251, 270, 270, 270, 270, 273, 686, 273, 685, 273, 273, 273, 273, 276, 276, 276, 276, 276, 276, 276, 281, 684, 281, 281, 281, 281, 281, 281, 281, 281, 281, 283, 683, 283, 283, 283, 283, 283, 283, 283, 283, 283, 286, 682, 286, 286, 286, 286, 286, 286, 286, 286, 286, 296, 681, 296, 296, 296, 296, 296, 296, 296, 296, 296, 235, 235, 235, 235, 235, 235, 235, 302, 302, 680, 302, 302, 302, 302, 302, 302, 302, 302, 303, 303, 303, 303, 303, 303, 303, 303, 303, 303, 303, 314, 314, 679, 314, 314, 314, 314, 314, 314, 314, 314, 317, 317, 317, 317, 317, 317, 317, 317, 317, 317, 317, 320, 320, 320, 320, 320, 320, 320, 320, 320, 320, 320, 324, 324, 324, 324, 324, 324, 324, 324, 324, 324, 324, 335, 335, 335, 335, 335, 335, 335, 335, 335, 335, 335, 339, 339, 339, 339, 339, 339, 339, 339, 339, 339, 339, 342, 342, 342, 342, 342, 342, 342, 342, 342, 342, 342, 346, 346, 346, 346, 346, 346, 346, 346, 346, 346, 346, 357, 357, 357, 357, 357, 357, 357, 357, 357, 357, 357, 361, 361, 361, 361, 361, 361, 361, 361, 361, 361, 361, 364, 364, 364, 364, 364, 364, 364, 364, 364, 364, 364, 368, 368, 368, 368, 368, 368, 368, 368, 368, 368, 368, 379, 379, 379, 379, 379, 379, 379, 379, 379, 379, 379, 383, 678, 383, 383, 383, 383, 383, 383, 383, 383, 383, 386, 677, 386, 386, 386, 386, 386, 386, 386, 386, 386, 390, 676, 390, 390, 390, 390, 390, 390, 390, 390, 390, 401, 675, 401, 401, 401, 401, 401, 401, 401, 401, 401, 176, 674, 673, 176, 176, 184, 672, 184, 184, 184, 184, 184, 184, 184, 184, 184, 411, 671, 670, 411, 411, 411, 438, 669, 668, 438, 236, 236, 236, 236, 236, 236, 236, 236, 251, 251, 251, 251, 251, 251, 251, 251, 251, 251, 251, 477, 477, 477, 477, 477, 477, 480, 480, 480, 480, 481, 667, 481, 481, 481, 481, 276, 276, 276, 276, 276, 276, 276, 281, 666, 281, 281, 281, 281, 281, 281, 281, 281, 281, 283, 613, 283, 283, 283, 283, 283, 283, 283, 283, 283, 286, 607, 286, 286, 286, 286, 286, 286, 286, 286, 286, 296, 603, 296, 296, 296, 296, 296, 296, 296, 296, 296, 302, 302, 602, 302, 302, 302, 302, 302, 302, 302, 302, 303, 303, 303, 303, 303, 303, 303, 303, 303, 303, 303, 314, 314, 478, 314, 314, 314, 314, 314, 314, 314, 314, 317, 317, 317, 317, 317, 317, 317, 317, 317, 317, 317, 320, 320, 320, 320, 320, 320, 320, 320, 320, 320, 320, 324, 324, 324, 324, 324, 324, 324, 324, 324, 324, 324, 335, 335, 335, 335, 335, 335, 335, 335, 335, 335, 335, 339, 339, 339, 339, 339, 339, 339, 339, 339, 339, 339, 342, 342, 342, 342, 342, 342, 342, 342, 342, 342, 342, 346, 346, 346, 346, 346, 346, 346, 346, 346, 346, 346, 357, 357, 357, 357, 357, 357, 357, 357, 357, 357, 357, 361, 361, 361, 361, 361, 361, 361, 361, 361, 361, 361, 364, 364, 364, 364, 364, 364, 364, 364, 364, 364, 364, 368, 368, 368, 368, 368, 368, 368, 368, 368, 368, 368, 379, 379, 379, 379, 379, 379, 379, 379, 379, 379, 379, 383, 571, 383, 383, 383, 383, 383, 383, 383, 383, 383, 386, 556, 386, 386, 386, 386, 386, 386, 386, 386, 386, 390, 553, 390, 390, 390, 390, 390, 390, 390, 390, 390, 401, 592, 401, 401, 401, 401, 401, 401, 401, 401, 401, 176, 589, 587, 176, 176, 411, 586, 585, 411, 411, 411, 438, 584, 583, 438, 588, 582, 588, 588, 588, 588, 588, 588, 588, 588, 588, 591, 581, 591, 591, 591, 591, 591, 591, 591, 591, 591, 593, 580, 593, 593, 593, 593, 593, 593, 593, 593, 593, 236, 236, 236, 236, 236, 236, 236, 236, 251, 251, 251, 251, 251, 251, 251, 251, 251, 251, 251, 477, 477, 477, 477, 477, 477, 601, 579, 601, 601, 601, 601, 481, 578, 481, 481, 481, 481, 281, 577, 281, 281, 281, 281, 281, 281, 281, 281, 281, 606, 576, 606, 606, 606, 606, 606, 606, 606, 606, 606, 609, 575, 609, 609, 609, 609, 609, 609, 609, 609, 609, 610, 574, 610, 610, 610, 610, 610, 610, 610, 610, 610, 302, 302, 570, 302, 302, 302, 302, 302, 302, 302, 302, 616, 616, 616, 616, 616, 616, 616, 616, 616, 616, 616, 317, 317, 317, 317, 317, 317, 317, 317, 317, 317, 317, 620, 620, 620, 620, 620, 620, 620, 620, 620, 620, 620, 624, 624, 624, 624, 624, 624, 624, 624, 624, 624, 624, 626, 626, 626, 626, 626, 626, 626, 626, 626, 626, 626, 339, 339, 339, 339, 339, 339, 339, 339, 339, 339, 339, 632, 632, 632, 632, 632, 632, 632, 632, 632, 632, 632, 636, 636, 636, 636, 636, 636, 636, 636, 636, 636, 636, 638, 638, 638, 638, 638, 638, 638, 638, 638, 638, 638, 361, 361, 361, 361, 361, 361, 361, 361, 361, 361, 361, 644, 644, 644, 644, 644, 644, 644, 644, 644, 644, 644, 648, 648, 648, 648, 648, 648, 648, 648, 648, 648, 648, 650, 650, 650, 650, 650, 650, 650, 650, 650, 650, 650, 383, 569, 383, 383, 383, 383, 383, 383, 383, 383, 383, 656, 568, 656, 656, 656, 656, 656, 656, 656, 656, 656, 660, 567, 660, 660, 660, 660, 660, 660, 660, 660, 660, 662, 566, 662, 662, 662, 662, 662, 662, 662, 662, 662, 411, 565, 564, 411, 411, 411, 588, 563, 588, 588, 588, 588, 588, 588, 588, 588, 588, 591, 562, 591, 591, 591, 591, 591, 591, 591, 591, 591, 593, 561, 593, 593, 593, 593, 593, 593, 593, 593, 593, 236, 236, 236, 236, 236, 236, 236, 236, 251, 251, 251, 251, 251, 251, 251, 251, 251, 251, 251, 601, 560, 601, 601, 601, 601, 481, 559, 481, 481, 481, 481, 281, 558, 281, 281, 281, 281, 281, 281, 281, 281, 281, 606, 555, 606, 606, 606, 606, 606, 606, 606, 606, 606, 609, 552, 609, 609, 609, 609, 609, 609, 609, 609, 609, 610, 551, 610, 610, 610, 610, 610, 610, 610, 610, 610, 302, 302, 550, 302, 302, 302, 302, 302, 302, 302, 302, 616, 616, 616, 616, 616, 616, 616, 616, 616, 616, 616, 317, 317, 317, 317, 317, 317, 317, 317, 317, 317, 317, 620, 620, 620, 620, 620, 620, 620, 620, 620, 620, 620, 624, 624, 624, 624, 624, 624, 624, 624, 624, 624, 624, 626, 626, 626, 626, 626, 626, 626, 626, 626, 626, 626, 339, 339, 339, 339, 339, 339, 339, 339, 339, 339, 339, 632, 632, 632, 632, 632, 632, 632, 632, 632, 632, 632, 636, 636, 636, 636, 636, 636, 636, 636, 636, 636, 636, 638, 638, 638, 638, 638, 638, 638, 638, 638, 638, 638, 549, 548, 547, 546, 545, 388, 387, 384, 384, 464, 494, 493, 284, 464, 483, 482, 478, 452, 450, 426, 474, 416, 464, 277, 463, 457, 456, 453, 441, 440, 439, 432, 431, 430, 427, 424, 423, 420, 417, 414, 413, 412, 174, 385, 384, 313, 277, 299, 295, 284, 282, 265, 174, 265, 174, 181, 172, 860, 23, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860 } ; static yyconst flex_int16_t yy_chk[4211] = { 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 10, 2, 10, 13, 4, 6, 4, 6, 12, 8, 12, 8, 16, 55, 16, 13, 13, 13, 13, 222, 29, 2, 3, 199, 3, 3, 4, 6, 199, 3, 3, 8, 3, 3, 222, 3, 3, 3, 18, 20, 18, 20, 3, 3, 3, 3, 14, 22, 14, 22, 14, 55, 25, 29, 25, 265, 27, 27, 27, 33, 265, 40, 14, 14, 14, 14, 25, 3, 40, 3, 27, 854, 3, 33, 3, 31, 3, 31, 3, 31, 31, 851, 3, 3, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 35, 36, 56, 36, 36, 36, 36, 44, 44, 36, 850, 38, 35, 38, 38, 38, 38, 45, 45, 38, 39, 39, 39, 39, 46, 46, 39, 849, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 56, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 41, 47, 41, 41, 41, 41, 73, 49, 47, 51, 52, 54, 41, 41, 49, 47, 51, 52, 54, 41, 81, 49, 41, 51, 52, 54, 41, 81, 42, 41, 42, 42, 42, 42, 847, 48, 53, 41, 60, 73, 60, 42, 48, 53, 41, 48, 48, 48, 48, 48, 53, 206, 49, 52, 66, 54, 66, 42, 43, 51, 43, 68, 68, 43, 206, 50, 43, 43, 43, 43, 43, 43, 50, 43, 43, 57, 43, 57, 846, 50, 58, 58, 58, 59, 59, 53, 61, 61, 61, 57, 67, 67, 67, 62, 58, 62, 62, 62, 62, 117, 117, 68, 64, 50, 59, 59, 70, 70, 70, 50, 64, 64, 64, 64, 64, 64, 844, 74, 64, 74, 64, 74, 74, 59, 63, 72, 72, 72, 76, 841, 76, 76, 76, 76, 82, 85, 85, 82, 82, 82, 82, 82, 63, 63, 89, 63, 97, 63, 97, 63, 63, 105, 77, 105, 63, 63, 63, 63, 83, 83, 83, 63, 77, 77, 77, 77, 79, 839, 79, 79, 79, 79, 84, 84, 84, 85, 197, 89, 91, 79, 91, 91, 91, 91, 92, 92, 92, 92, 197, 77, 98, 98, 98, 116, 77, 79, 93, 165, 93, 93, 93, 93, 838, 94, 101, 101, 101, 101, 93, 93, 94, 108, 837, 94, 108, 93, 165, 94, 93, 108, 160, 115, 93, 115, 835, 93, 116, 160, 94, 102, 102, 102, 102, 93, 109, 94, 109, 109, 109, 109, 93, 96, 96, 834, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, 833, 96, 96, 110, 110, 110, 110, 96, 96, 96, 96, 832, 103, 112, 103, 103, 103, 103, 119, 119, 112, 130, 130, 112, 96, 103, 827, 112, 120, 120, 173, 120, 121, 121, 132, 132, 126, 126, 112, 826, 121, 103, 122, 122, 159, 112, 159, 96, 96, 111, 823, 111, 111, 111, 111, 122, 126, 122, 122, 122, 122, 111, 111, 173, 120, 123, 123, 581, 111, 134, 134, 111, 128, 128, 128, 111, 581, 134, 111, 159, 123, 123, 123, 123, 143, 143, 111, 129, 129, 129, 283, 139, 139, 111, 114, 114, 114, 114, 114, 822, 114, 114, 114, 114, 114, 114, 114, 114, 821, 114, 114, 139, 125, 145, 145, 114, 114, 114, 114, 125, 147, 147, 125, 283, 133, 133, 125, 133, 147, 276, 135, 135, 114, 201, 136, 136, 276, 125, 141, 141, 141, 201, 820, 135, 125, 135, 135, 135, 135, 136, 136, 136, 136, 818, 138, 114, 114, 124, 124, 817, 133, 138, 212, 212, 138, 142, 142, 142, 138, 167, 124, 167, 124, 124, 124, 124, 295, 146, 146, 138, 146, 295, 124, 124, 219, 219, 138, 148, 148, 124, 220, 816, 124, 149, 149, 170, 124, 170, 220, 124, 148, 313, 148, 148, 148, 148, 313, 124, 149, 149, 149, 149, 815, 146, 124, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 813, 127, 127, 812, 151, 152, 152, 127, 127, 127, 127, 151, 233, 233, 151, 154, 154, 154, 151, 155, 155, 155, 811, 161, 127, 152, 204, 162, 204, 151, 168, 168, 168, 251, 251, 161, 151, 161, 161, 161, 161, 162, 162, 162, 162, 164, 809, 127, 127, 137, 137, 808, 164, 223, 169, 164, 169, 223, 228, 164, 807, 225, 137, 228, 137, 137, 137, 137, 169, 225, 164, 214, 214, 214, 137, 137, 228, 164, 257, 221, 257, 137, 805, 221, 137, 253, 253, 266, 137, 266, 236, 137, 177, 177, 177, 177, 221, 236, 390, 137, 178, 178, 178, 178, 236, 390, 137, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 804, 140, 140, 179, 179, 179, 179, 140, 140, 140, 140, 180, 180, 180, 180, 187, 187, 187, 187, 191, 191, 191, 191, 188, 140, 188, 188, 188, 188, 420, 191, 211, 211, 211, 211, 260, 188, 239, 298, 250, 298, 250, 211, 260, 239, 420, 191, 140, 140, 150, 150, 239, 188, 250, 240, 301, 241, 301, 211, 254, 254, 240, 150, 241, 150, 150, 150, 150, 240, 803, 241, 213, 802, 213, 150, 150, 213, 213, 213, 213, 801, 150, 238, 242, 150, 316, 239, 316, 150, 238, 242, 150, 238, 238, 238, 238, 238, 242, 800, 150, 255, 255, 256, 256, 799, 241, 150, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 153, 796, 153, 153, 795, 242, 242, 243, 153, 153, 153, 153, 244, 245, 243, 262, 262, 291, 291, 244, 245, 243, 267, 267, 267, 153, 244, 245, 269, 269, 269, 271, 271, 271, 271, 271, 793, 256, 309, 309, 278, 791, 243, 278, 278, 278, 278, 278, 153, 153, 163, 279, 279, 279, 790, 245, 280, 280, 280, 244, 317, 317, 163, 789, 163, 163, 163, 163, 287, 287, 287, 287, 319, 319, 163, 163, 289, 289, 289, 289, 788, 163, 303, 787, 163, 303, 541, 289, 163, 786, 303, 163, 288, 541, 288, 288, 288, 288, 785, 163, 293, 293, 293, 289, 784, 288, 163, 166, 166, 783, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 288, 166, 166, 290, 290, 290, 290, 166, 166, 166, 166, 292, 779, 292, 290, 778, 292, 292, 292, 292, 305, 305, 305, 305, 166, 311, 311, 311, 322, 322, 290, 402, 300, 402, 300, 300, 300, 300, 323, 323, 336, 336, 403, 336, 403, 300, 777, 166, 166, 294, 294, 294, 294, 307, 307, 307, 307, 776, 294, 294, 294, 300, 774, 310, 307, 310, 339, 339, 310, 310, 310, 310, 294, 294, 294, 294, 294, 294, 296, 296, 307, 296, 296, 296, 296, 296, 296, 296, 296, 296, 296, 296, 773, 296, 296, 320, 320, 772, 320, 296, 296, 296, 296, 386, 306, 386, 306, 306, 306, 306, 308, 308, 308, 308, 330, 330, 296, 306, 771, 321, 321, 308, 321, 770, 324, 324, 325, 325, 769, 330, 330, 320, 324, 306, 325, 341, 341, 308, 386, 296, 296, 312, 312, 312, 312, 326, 326, 337, 337, 337, 312, 312, 312, 344, 344, 321, 338, 338, 338, 768, 326, 326, 326, 326, 312, 312, 312, 312, 312, 312, 314, 314, 314, 314, 314, 767, 314, 314, 314, 314, 314, 314, 314, 314, 765, 314, 314, 327, 327, 345, 345, 314, 314, 314, 314, 359, 359, 359, 334, 334, 327, 334, 327, 327, 327, 327, 334, 660, 314, 328, 328, 346, 346, 327, 660, 347, 347, 342, 342, 346, 342, 329, 329, 347, 328, 328, 328, 328, 404, 327, 404, 314, 314, 352, 352, 328, 329, 329, 329, 329, 331, 331, 361, 361, 332, 332, 764, 329, 352, 352, 331, 328, 331, 342, 387, 331, 331, 331, 331, 332, 332, 332, 763, 329, 333, 333, 363, 363, 348, 348, 356, 356, 762, 356, 358, 358, 761, 358, 356, 333, 333, 333, 333, 348, 348, 348, 348, 387, 333, 333, 333, 343, 343, 760, 343, 360, 360, 360, 364, 364, 759, 364, 333, 333, 333, 333, 333, 333, 335, 335, 335, 335, 335, 335, 335, 335, 335, 335, 335, 335, 335, 335, 758, 335, 335, 349, 349, 343, 757, 335, 335, 335, 335, 405, 364, 405, 365, 365, 349, 365, 349, 349, 349, 349, 366, 366, 335, 350, 350, 367, 367, 349, 756, 368, 368, 380, 380, 755, 380, 351, 351, 368, 350, 350, 350, 350, 396, 349, 753, 335, 335, 749, 365, 350, 351, 351, 351, 351, 353, 353, 396, 396, 354, 354, 422, 351, 422, 747, 353, 350, 353, 370, 370, 353, 353, 353, 353, 354, 354, 354, 746, 351, 355, 355, 369, 369, 370, 370, 370, 370, 434, 434, 369, 744, 374, 374, 743, 355, 355, 355, 355, 375, 375, 381, 381, 381, 355, 355, 355, 374, 374, 375, 458, 375, 486, 486, 375, 375, 375, 375, 355, 355, 355, 355, 355, 355, 357, 357, 357, 357, 357, 357, 357, 357, 357, 357, 357, 357, 357, 357, 742, 357, 357, 371, 371, 458, 464, 357, 357, 357, 357, 382, 382, 382, 378, 378, 371, 378, 371, 371, 371, 371, 378, 739, 357, 372, 372, 738, 400, 371, 400, 406, 406, 406, 406, 400, 491, 373, 373, 464, 372, 372, 372, 372, 392, 371, 737, 357, 357, 376, 376, 372, 373, 373, 373, 373, 398, 736, 392, 392, 392, 392, 735, 373, 376, 376, 376, 372, 394, 491, 398, 398, 398, 733, 393, 407, 407, 407, 407, 373, 377, 377, 394, 394, 394, 394, 393, 732, 393, 393, 393, 393, 752, 394, 752, 377, 377, 377, 377, 393, 408, 408, 408, 408, 377, 377, 377, 443, 731, 394, 409, 409, 409, 409, 443, 393, 493, 443, 377, 377, 377, 377, 377, 377, 379, 379, 379, 379, 379, 379, 379, 379, 379, 379, 379, 379, 379, 379, 395, 379, 379, 435, 435, 435, 435, 379, 379, 379, 379, 493, 397, 588, 395, 395, 395, 395, 437, 437, 437, 397, 730, 397, 379, 395, 397, 397, 397, 397, 410, 729, 410, 497, 497, 410, 410, 410, 410, 600, 600, 395, 433, 433, 433, 433, 588, 379, 379, 399, 489, 489, 489, 433, 436, 436, 436, 436, 500, 500, 500, 465, 728, 399, 399, 399, 399, 535, 465, 433, 467, 469, 399, 399, 399, 465, 726, 467, 469, 473, 473, 535, 535, 725, 467, 469, 399, 399, 399, 399, 399, 399, 401, 401, 723, 401, 401, 401, 401, 401, 401, 401, 401, 401, 401, 401, 722, 401, 401, 540, 466, 540, 470, 401, 401, 401, 401, 466, 468, 470, 471, 472, 613, 613, 466, 468, 470, 471, 472, 782, 401, 782, 468, 473, 471, 472, 479, 479, 479, 479, 479, 484, 502, 484, 540, 502, 484, 484, 484, 484, 502, 511, 511, 401, 401, 466, 505, 505, 472, 511, 468, 471, 485, 485, 485, 485, 487, 487, 487, 487, 721, 505, 505, 485, 488, 488, 488, 488, 495, 720, 495, 622, 622, 495, 495, 495, 495, 508, 508, 485, 490, 490, 490, 490, 496, 496, 496, 496, 719, 490, 490, 490, 508, 508, 508, 496, 498, 498, 498, 498, 718, 521, 521, 490, 490, 490, 490, 490, 490, 521, 717, 496, 499, 499, 499, 499, 501, 501, 501, 501, 503, 503, 716, 593, 714, 501, 501, 501, 510, 510, 503, 510, 503, 504, 504, 503, 503, 503, 503, 501, 501, 501, 501, 501, 501, 506, 506, 606, 504, 504, 504, 504, 507, 507, 512, 512, 593, 512, 713, 504, 506, 506, 506, 506, 510, 531, 531, 507, 507, 507, 507, 513, 513, 531, 712, 504, 509, 509, 623, 623, 606, 513, 710, 513, 628, 628, 513, 513, 513, 513, 512, 509, 509, 509, 509, 514, 514, 610, 629, 629, 509, 509, 509, 543, 543, 543, 543, 515, 515, 704, 514, 514, 514, 514, 509, 509, 509, 509, 509, 509, 596, 514, 515, 515, 516, 516, 703, 596, 517, 517, 610, 702, 518, 518, 596, 520, 520, 514, 520, 516, 516, 516, 516, 517, 517, 517, 517, 518, 518, 518, 519, 519, 544, 544, 544, 544, 624, 624, 522, 522, 701, 522, 525, 525, 624, 519, 519, 519, 519, 523, 523, 520, 625, 625, 519, 519, 519, 525, 525, 523, 625, 523, 524, 524, 523, 523, 523, 523, 519, 519, 519, 519, 519, 519, 522, 526, 526, 524, 524, 524, 524, 527, 527, 634, 634, 528, 528, 700, 524, 699, 526, 526, 526, 526, 534, 698, 527, 527, 527, 527, 528, 528, 528, 697, 524, 529, 529, 657, 534, 534, 534, 534, 696, 530, 530, 695, 530, 694, 538, 534, 529, 529, 529, 529, 532, 532, 542, 532, 542, 529, 529, 529, 538, 538, 538, 534, 604, 604, 604, 604, 657, 533, 691, 529, 529, 529, 529, 529, 529, 530, 533, 536, 533, 635, 635, 533, 533, 533, 533, 537, 532, 542, 636, 636, 597, 536, 536, 536, 536, 690, 636, 597, 599, 537, 537, 537, 537, 539, 597, 599, 663, 598, 605, 605, 605, 605, 599, 688, 598, 640, 640, 539, 539, 539, 539, 598, 614, 614, 614, 614, 539, 539, 539, 615, 615, 615, 615, 641, 641, 620, 620, 686, 620, 663, 539, 539, 539, 539, 539, 539, 599, 616, 618, 618, 616, 598, 619, 619, 684, 616, 621, 621, 683, 621, 646, 646, 681, 618, 618, 618, 618, 619, 619, 619, 619, 620, 626, 626, 682, 626, 627, 627, 680, 627, 630, 630, 647, 647, 631, 631, 632, 632, 682, 632, 633, 633, 621, 633, 682, 630, 630, 630, 630, 631, 631, 631, 631, 637, 637, 679, 638, 638, 626, 638, 678, 637, 627, 639, 639, 677, 639, 642, 642, 652, 652, 676, 632, 643, 643, 675, 633, 644, 644, 656, 644, 656, 642, 642, 642, 642, 653, 653, 643, 643, 643, 643, 638, 645, 645, 674, 645, 648, 648, 639, 649, 649, 654, 650, 650, 648, 650, 655, 649, 651, 651, 673, 651, 644, 656, 672, 654, 654, 654, 654, 670, 655, 655, 655, 655, 662, 705, 662, 706, 645, 708, 708, 670, 705, 750, 706, 751, 754, 670, 650, 705, 750, 706, 751, 671, 651, 669, 667, 750, 754, 751, 666, 665, 664, 661, 754, 659, 658, 609, 603, 662, 602, 591, 587, 585, 705, 584, 583, 582, 580, 579, 578, 577, 576, 575, 573, 706, 861, 572, 861, 861, 861, 861, 861, 861, 861, 861, 861, 862, 571, 570, 862, 862, 863, 569, 863, 863, 863, 863, 863, 863, 863, 863, 863, 864, 864, 864, 864, 864, 864, 864, 864, 865, 865, 865, 865, 865, 865, 865, 865, 865, 865, 865, 866, 866, 866, 866, 867, 568, 867, 567, 867, 867, 867, 867, 868, 868, 868, 868, 868, 868, 868, 869, 566, 869, 869, 869, 869, 869, 869, 869, 869, 869, 870, 565, 870, 870, 870, 870, 870, 870, 870, 870, 870, 871, 563, 871, 871, 871, 871, 871, 871, 871, 871, 871, 872, 562, 872, 872, 872, 872, 872, 872, 872, 872, 872, 873, 873, 873, 873, 873, 873, 873, 874, 874, 561, 874, 874, 874, 874, 874, 874, 874, 874, 875, 875, 875, 875, 875, 875, 875, 875, 875, 875, 875, 876, 876, 560, 876, 876, 876, 876, 876, 876, 876, 876, 877, 877, 877, 877, 877, 877, 877, 877, 877, 877, 877, 878, 878, 878, 878, 878, 878, 878, 878, 878, 878, 878, 879, 879, 879, 879, 879, 879, 879, 879, 879, 879, 879, 880, 880, 880, 880, 880, 880, 880, 880, 880, 880, 880, 881, 881, 881, 881, 881, 881, 881, 881, 881, 881, 881, 882, 882, 882, 882, 882, 882, 882, 882, 882, 882, 882, 883, 883, 883, 883, 883, 883, 883, 883, 883, 883, 883, 884, 884, 884, 884, 884, 884, 884, 884, 884, 884, 884, 885, 885, 885, 885, 885, 885, 885, 885, 885, 885, 885, 886, 886, 886, 886, 886, 886, 886, 886, 886, 886, 886, 887, 887, 887, 887, 887, 887, 887, 887, 887, 887, 887, 888, 888, 888, 888, 888, 888, 888, 888, 888, 888, 888, 889, 559, 889, 889, 889, 889, 889, 889, 889, 889, 889, 890, 558, 890, 890, 890, 890, 890, 890, 890, 890, 890, 891, 557, 891, 891, 891, 891, 891, 891, 891, 891, 891, 892, 556, 892, 892, 892, 892, 892, 892, 892, 892, 892, 893, 554, 553, 893, 893, 894, 552, 894, 894, 894, 894, 894, 894, 894, 894, 894, 895, 551, 550, 895, 895, 895, 896, 549, 548, 896, 897, 897, 897, 897, 897, 897, 897, 897, 898, 898, 898, 898, 898, 898, 898, 898, 898, 898, 898, 899, 899, 899, 899, 899, 899, 900, 900, 900, 900, 901, 547, 901, 901, 901, 901, 902, 902, 902, 902, 902, 902, 902, 903, 546, 903, 903, 903, 903, 903, 903, 903, 903, 903, 904, 494, 904, 904, 904, 904, 904, 904, 904, 904, 904, 905, 492, 905, 905, 905, 905, 905, 905, 905, 905, 905, 906, 483, 906, 906, 906, 906, 906, 906, 906, 906, 906, 907, 907, 482, 907, 907, 907, 907, 907, 907, 907, 907, 908, 908, 908, 908, 908, 908, 908, 908, 908, 908, 908, 909, 909, 477, 909, 909, 909, 909, 909, 909, 909, 909, 910, 910, 910, 910, 910, 910, 910, 910, 910, 910, 910, 911, 911, 911, 911, 911, 911, 911, 911, 911, 911, 911, 912, 912, 912, 912, 912, 912, 912, 912, 912, 912, 912, 913, 913, 913, 913, 913, 913, 913, 913, 913, 913, 913, 914, 914, 914, 914, 914, 914, 914, 914, 914, 914, 914, 915, 915, 915, 915, 915, 915, 915, 915, 915, 915, 915, 916, 916, 916, 916, 916, 916, 916, 916, 916, 916, 916, 917, 917, 917, 917, 917, 917, 917, 917, 917, 917, 917, 918, 918, 918, 918, 918, 918, 918, 918, 918, 918, 918, 919, 919, 919, 919, 919, 919, 919, 919, 919, 919, 919, 920, 920, 920, 920, 920, 920, 920, 920, 920, 920, 920, 921, 921, 921, 921, 921, 921, 921, 921, 921, 921, 921, 922, 476, 922, 922, 922, 922, 922, 922, 922, 922, 922, 923, 475, 923, 923, 923, 923, 923, 923, 923, 923, 923, 924, 474, 924, 924, 924, 924, 924, 924, 924, 924, 924, 925, 462, 925, 925, 925, 925, 925, 925, 925, 925, 925, 926, 459, 457, 926, 926, 927, 456, 455, 927, 927, 927, 928, 454, 453, 928, 929, 452, 929, 929, 929, 929, 929, 929, 929, 929, 929, 930, 451, 930, 930, 930, 930, 930, 930, 930, 930, 930, 931, 450, 931, 931, 931, 931, 931, 931, 931, 931, 931, 932, 932, 932, 932, 932, 932, 932, 932, 933, 933, 933, 933, 933, 933, 933, 933, 933, 933, 933, 934, 934, 934, 934, 934, 934, 935, 449, 935, 935, 935, 935, 936, 448, 936, 936, 936, 936, 937, 447, 937, 937, 937, 937, 937, 937, 937, 937, 937, 938, 446, 938, 938, 938, 938, 938, 938, 938, 938, 938, 939, 445, 939, 939, 939, 939, 939, 939, 939, 939, 939, 940, 444, 940, 940, 940, 940, 940, 940, 940, 940, 940, 941, 941, 442, 941, 941, 941, 941, 941, 941, 941, 941, 942, 942, 942, 942, 942, 942, 942, 942, 942, 942, 942, 943, 943, 943, 943, 943, 943, 943, 943, 943, 943, 943, 944, 944, 944, 944, 944, 944, 944, 944, 944, 944, 944, 945, 945, 945, 945, 945, 945, 945, 945, 945, 945, 945, 946, 946, 946, 946, 946, 946, 946, 946, 946, 946, 946, 947, 947, 947, 947, 947, 947, 947, 947, 947, 947, 947, 948, 948, 948, 948, 948, 948, 948, 948, 948, 948, 948, 949, 949, 949, 949, 949, 949, 949, 949, 949, 949, 949, 950, 950, 950, 950, 950, 950, 950, 950, 950, 950, 950, 951, 951, 951, 951, 951, 951, 951, 951, 951, 951, 951, 952, 952, 952, 952, 952, 952, 952, 952, 952, 952, 952, 953, 953, 953, 953, 953, 953, 953, 953, 953, 953, 953, 954, 954, 954, 954, 954, 954, 954, 954, 954, 954, 954, 955, 441, 955, 955, 955, 955, 955, 955, 955, 955, 955, 956, 440, 956, 956, 956, 956, 956, 956, 956, 956, 956, 957, 439, 957, 957, 957, 957, 957, 957, 957, 957, 957, 958, 431, 958, 958, 958, 958, 958, 958, 958, 958, 958, 959, 430, 429, 959, 959, 959, 960, 428, 960, 960, 960, 960, 960, 960, 960, 960, 960, 961, 427, 961, 961, 961, 961, 961, 961, 961, 961, 961, 962, 426, 962, 962, 962, 962, 962, 962, 962, 962, 962, 963, 963, 963, 963, 963, 963, 963, 963, 964, 964, 964, 964, 964, 964, 964, 964, 964, 964, 964, 965, 425, 965, 965, 965, 965, 966, 424, 966, 966, 966, 966, 967, 423, 967, 967, 967, 967, 967, 967, 967, 967, 967, 968, 421, 968, 968, 968, 968, 968, 968, 968, 968, 968, 969, 419, 969, 969, 969, 969, 969, 969, 969, 969, 969, 970, 418, 970, 970, 970, 970, 970, 970, 970, 970, 970, 971, 971, 417, 971, 971, 971, 971, 971, 971, 971, 971, 972, 972, 972, 972, 972, 972, 972, 972, 972, 972, 972, 973, 973, 973, 973, 973, 973, 973, 973, 973, 973, 973, 974, 974, 974, 974, 974, 974, 974, 974, 974, 974, 974, 975, 975, 975, 975, 975, 975, 975, 975, 975, 975, 975, 976, 976, 976, 976, 976, 976, 976, 976, 976, 976, 976, 977, 977, 977, 977, 977, 977, 977, 977, 977, 977, 977, 978, 978, 978, 978, 978, 978, 978, 978, 978, 978, 978, 979, 979, 979, 979, 979, 979, 979, 979, 979, 979, 979, 980, 980, 980, 980, 980, 980, 980, 980, 980, 980, 980, 416, 415, 414, 413, 412, 391, 389, 388, 383, 315, 299, 297, 286, 277, 275, 274, 270, 264, 263, 261, 259, 258, 237, 235, 234, 227, 226, 224, 218, 217, 216, 209, 208, 207, 205, 203, 202, 200, 198, 196, 195, 194, 184, 158, 156, 113, 104, 99, 95, 90, 88, 80, 75, 65, 34, 32, 28, 23, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860, 860 } ; /* Table of booleans, true if rule could match eol. */ static yyconst flex_int32_t yy_rule_can_match_eol[142] = { 0, 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, }; /* The intent behind this definition is that it'll catch * any uses of REJECT which flex missed. */ #define REJECT reject_used_but_not_detected #define yymore() yymore_used_but_not_detected #define YY_MORE_ADJ 0 #define YY_RESTORE_YY_MORE_OFFSET #line 1 "compilers/imcc/imcc.l" #line 26 "compilers/imcc/imcc.l" /* * imcc.l * * Intermediate Code Compiler for Parrot * * Copyright (C) 2002 Melvin Smith * Copyright (C) 2002-2008, Parrot Foundation. * * The tokenizer. * * */ /* static function declarations */ static void pop_parser_state(ARGMOD(imc_info_t *imcc), ARGMOD(void *yyscanner)); static struct macro_frame_t *new_frame(ARGMOD(imc_info_t *imcc)); static void define_macro(ARGMOD(imc_info_t *imcc), ARGIN(const char *name), ARGIN(const params_t *params), ARGIN(const char *expansion), int start_line); static macro_t *find_macro(ARGMOD(imc_info_t *imcc), ARGIN(const char *name)); static void scan_string(macro_frame_t *frame, ARGIN(const char *expansion), ARGMOD(void *yyscanner)); static void scan_file(ARGMOD(imc_info_t *imcc), ARGIN(struct macro_frame_t *frame), PIOHANDLE file, ARGMOD(void *yyscanner)); static int destroy_frame(macro_frame_t *frame, ARGMOD(void *yyscanner)); static int yylex_skip(YYSTYPE *valp, ARGMOD(imc_info_t *imcc), ARGIN(const char *skip), ARGMOD(void *yyscanner)); static int read_macro(YYSTYPE *valp, ARGMOD(imc_info_t *imcc), ARGMOD(void *yyscanner)); static int expand_macro(ARGMOD(imc_info_t *imcc), ARGIN(const char *name), ARGMOD(void *yyscanner)); static void include_file(ARGMOD(imc_info_t *imcc), ARGIN(STRING *file_name), ARGMOD(void *yyscanner)); static int handle_identifier(ARGMOD(imc_info_t *imcc), YYSTYPE *valp, ARGIN(const char *id)); #define YY_DECL int yylex(YYSTYPE *valp,yyscan_t yyscanner,ARGMOD(imc_info_t *imcc)) #define YYCHOP() (yytext[--yyleng] = '\0') #define SET_LINE_NUMBER (imcc->line = yylineno) #define DUP_AND_RET(valp, token) \ do { \ if (valp) (valp)->s = mem_sys_strndup(yytext, yyleng); \ return (token); \ } while (0) #define DUP_AND_RET_FREE(valp, token) \ do { \ if (valp) { \ mem_sys_free((valp)->s); \ (valp)->s = mem_sys_strndup(yytext, yyleng); \ return (token); \ } \ } while (0) #define YY_INPUT(buf, result, max_size) \ (result) = Parrot_io_internal_read((Interp *)yyextra->interp, (PIOHANDLE)yyin, (buf), (max_size)) #line 1799 "compilers/imcc/imclexer.c" #define INITIAL 0 #define emit 1 #define macro 2 #define pod 3 #define cmt1 4 #define cmt2 5 #define cmt3 6 #define cmt4 7 #define cmt5 8 #define heredoc1 9 #define heredoc2 10 #ifndef YY_NO_UNISTD_H /* Special case for "unistd.h", since it is non-ANSI. We include it way * down here because we want the user's section 1 to have been scanned first. * The user has a chance to override it with an option. */ #include #endif #ifndef YY_EXTRA_TYPE #define YY_EXTRA_TYPE void * #endif /* Holds the entire state of the reentrant scanner. */ struct yyguts_t { /* User-defined. Not touched by flex. */ YY_EXTRA_TYPE yyextra_r; /* The rest are the same as the globals declared in the non-reentrant scanner. */ FILE *yyin_r, *yyout_r; size_t yy_buffer_stack_top; /**< index of top of stack. */ size_t yy_buffer_stack_max; /**< capacity of stack. */ YY_BUFFER_STATE * yy_buffer_stack; /**< Stack as an array. */ char yy_hold_char; int yy_n_chars; int yyleng_r; char *yy_c_buf_p; int yy_init; int yy_start; int yy_did_buffer_switch_on_eof; int yy_start_stack_ptr; int yy_start_stack_depth; int *yy_start_stack; yy_state_type yy_last_accepting_state; char* yy_last_accepting_cpos; int yylineno_r; int yy_flex_debug_r; char *yytext_r; int yy_more_flag; int yy_more_len; }; /* end struct yyguts_t */ static int yy_init_globals (yyscan_t yyscanner ); int yylex_init (yyscan_t* scanner); int yylex_init_extra (YY_EXTRA_TYPE user_defined,yyscan_t* scanner); /* Accessor methods to globals. These are made visible to non-reentrant scanners for convenience. */ int yylex_destroy (yyscan_t yyscanner ); int yyget_debug (yyscan_t yyscanner ); void yyset_debug (int debug_flag ,yyscan_t yyscanner ); YY_EXTRA_TYPE yyget_extra (yyscan_t yyscanner ); void yyset_extra (YY_EXTRA_TYPE user_defined ,yyscan_t yyscanner ); FILE *yyget_in (yyscan_t yyscanner ); void yyset_in (FILE * in_str ,yyscan_t yyscanner ); FILE *yyget_out (yyscan_t yyscanner ); void yyset_out (FILE * out_str ,yyscan_t yyscanner ); int yyget_leng (yyscan_t yyscanner ); char *yyget_text (yyscan_t yyscanner ); int yyget_lineno (yyscan_t yyscanner ); void yyset_lineno (int line_number ,yyscan_t yyscanner ); int yyget_column (yyscan_t yyscanner ); void yyset_column (int column_no ,yyscan_t yyscanner ); /* Macros after this point can all be overridden by user definitions in * section 1. */ #ifndef YY_SKIP_YYWRAP #ifdef __cplusplus extern "C" int yywrap (yyscan_t yyscanner ); #else extern int yywrap (yyscan_t yyscanner ); #endif #endif static void yyunput (int c,char *buf_ptr ,yyscan_t yyscanner); #ifndef yytext_ptr static void yy_flex_strncpy (char *,yyconst char *,int ,yyscan_t yyscanner); #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen (yyconst char * ,yyscan_t yyscanner); #endif #ifndef YY_NO_INPUT #ifdef __cplusplus static int yyinput (yyscan_t yyscanner ); #else static int input (yyscan_t yyscanner ); #endif #endif static void yy_push_state (int new_state ,yyscan_t yyscanner); static void yy_pop_state (yyscan_t yyscanner ); static int yy_top_state (yyscan_t yyscanner ); /* Amount of stuff to slurp up with each read. */ #ifndef YY_READ_BUF_SIZE #ifdef __ia64__ /* On IA-64, the buffer size is 16k, not 8k */ #define YY_READ_BUF_SIZE 16384 #else #define YY_READ_BUF_SIZE 8192 #endif /* __ia64__ */ #endif /* Copy whatever the last rule matched to the standard output. */ #ifndef ECHO /* This used to be an fputs(), but since the string might contain NUL's, * we now use fwrite(). */ #define ECHO do { if (fwrite( yytext, yyleng, 1, yyout )) {} } while (0) #endif /* Gets input and stuffs it into "buf". number of characters read, or YY_NULL, * is returned in "result". */ #ifndef YY_INPUT #define YY_INPUT(buf,result,max_size) \ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \ { \ int c = '*'; \ size_t n; \ for ( n = 0; n < max_size && \ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \ buf[n] = (char) c; \ if ( c == '\n' ) \ buf[n++] = (char) c; \ if ( c == EOF && ferror( yyin ) ) \ YY_FATAL_ERROR( "input in flex scanner failed" ); \ result = n; \ } \ else \ { \ errno=0; \ while ( (result = fread(buf, 1, max_size, yyin))==0 && ferror(yyin)) \ { \ if( errno != EINTR) \ { \ YY_FATAL_ERROR( "input in flex scanner failed" ); \ break; \ } \ errno=0; \ clearerr(yyin); \ } \ }\ \ #endif /* No semi-colon after return; correct usage is to write "yyterminate();" - * we don't want an extra ';' after the "return" because that will cause * some compilers to complain about unreachable statements. */ #ifndef yyterminate #define yyterminate() return YY_NULL #endif /* Number of entries by which start-condition stack grows. */ #ifndef YY_START_STACK_INCR #define YY_START_STACK_INCR 25 #endif /* Report a fatal error. */ #ifndef YY_FATAL_ERROR #define YY_FATAL_ERROR(msg) yy_fatal_error( msg , yyscanner) #endif /* end tables serialization structures and prototypes */ /* Default declaration of generated scanner - a define so the user can * easily add parameters. */ #ifndef YY_DECL #define YY_DECL_IS_OURS 1 extern int yylex (yyscan_t yyscanner); #define YY_DECL int yylex (yyscan_t yyscanner) #endif /* !YY_DECL */ /* Code executed at the beginning of each rule, after yytext and yyleng * have been set up. */ #ifndef YY_USER_ACTION #define YY_USER_ACTION #endif /* Code executed at the end of each rule. */ #ifndef YY_BREAK #define YY_BREAK break; #endif #define YY_RULE_SETUP \ if ( yyleng > 0 ) \ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \ (yytext[yyleng - 1] == '\n'); \ YY_USER_ACTION /** The main scanner function which does all the work. */ YY_DECL { register yy_state_type yy_current_state; register char *yy_cp, *yy_bp; register int yy_act; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; #line 133 "compilers/imcc/imcc.l" /* for emacs "*/ if (imcc->expect_pasm == 1 && !imcc->in_pod) { imcc->expect_pasm = 2; BEGIN(emit); } if (imcc->frames->s.pasm_file && YYSTATE == INITIAL && !imcc->in_pod) { if (imcc->frames->s.pasm_file == 1) { BEGIN(emit); return EMIT; } return 0; } #line 2067 "compilers/imcc/imclexer.c" if ( !yyg->yy_init ) { yyg->yy_init = 1; #ifdef YY_USER_INIT YY_USER_INIT; #endif if ( ! yyg->yy_start ) yyg->yy_start = 1; /* first start state */ if ( ! yyin ) yyin = stdin; if ( ! yyout ) yyout = stdout; if ( ! YY_CURRENT_BUFFER ) { yyensure_buffer_stack (yyscanner); YY_CURRENT_BUFFER_LVALUE = yy_create_buffer(yyin,YY_BUF_SIZE ,yyscanner); } yy_load_buffer_state(yyscanner ); } while ( 1 ) /* loops until end-of-file is reached */ { yy_cp = yyg->yy_c_buf_p; /* Support of yytext. */ *yy_cp = yyg->yy_hold_char; /* yy_bp points to the position in yy_ch_buf of the start of * the current run. */ yy_bp = yy_cp; yy_current_state = yyg->yy_start; yy_current_state += YY_AT_BOL(); yy_match: do { register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)]; if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 861 ) yy_c = yy_meta[(unsigned int) yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; ++yy_cp; } while ( yy_current_state != 860 ); yy_cp = yyg->yy_last_accepting_cpos; yy_current_state = yyg->yy_last_accepting_state; yy_find_action: yy_act = yy_accept[yy_current_state]; YY_DO_BEFORE_ACTION; if ( yy_act != YY_END_OF_BUFFER && yy_rule_can_match_eol[yy_act] ) { int yyl; for ( yyl = 0; yyl < yyleng; ++yyl ) if ( yytext[yyl] == '\n' ) do{ yylineno++; yycolumn=0; }while(0) ; } do_action: /* This label is used only to access EOF actions. */ switch ( yy_act ) { /* beginning of action switch */ case 0: /* must back up */ /* undo the effects of YY_DO_BEFORE_ACTION */ *yy_cp = yyg->yy_hold_char; yy_cp = yyg->yy_last_accepting_cpos; yy_current_state = yyg->yy_last_accepting_state; goto yy_find_action; case 1: YY_RULE_SETUP #line 151 "compilers/imcc/imcc.l" { SET_LINE_NUMBER; } YY_BREAK case 2: /* rule 2 can match eol */ YY_RULE_SETUP #line 153 "compilers/imcc/imcc.l" { SET_LINE_NUMBER; imcc->frames->heredoc_rest = mem_sys_strndup(yytext, yyleng); BEGIN(heredoc2); } YY_BREAK case 3: /* rule 3 can match eol */ YY_RULE_SETUP #line 159 "compilers/imcc/imcc.l" { /* heredocs have highest priority * arrange them before all wildcard state matches */ /* Newline in the heredoc. Realloc and cat on. */ imcc->heredoc_content = (char*)mem_sys_realloc(imcc->heredoc_content, strlen(imcc->heredoc_content) + 3); strcpy(imcc->heredoc_content + strlen(imcc->heredoc_content), "\n"); } YY_BREAK case 4: YY_RULE_SETUP #line 171 "compilers/imcc/imcc.l" { SET_LINE_NUMBER; /* Are we at the end of the heredoc? */ if (STREQ(imcc->heredoc_end, yytext)) { /* End of the heredoc. */ yyguts_t * const yyg = (yyguts_t *)yyscanner; const int len = strlen(imcc->heredoc_content); /* delim */ imcc->heredoc_content[len] = imcc->heredoc_content[0]; imcc->heredoc_content[len + 1] = 0; mem_sys_free(imcc->heredoc_end); imcc->heredoc_end = NULL; imcc->frames->buffer = YY_CURRENT_BUFFER; valp->s = imcc->heredoc_content; yy_pop_state(yyscanner); yy_scan_string(imcc->frames->heredoc_rest,yyscanner); return STRINGC; } else { /* Part of the heredoc. Realloc and cat the line on. */ imcc->heredoc_content = (char *)mem_sys_realloc(imcc->heredoc_content, strlen(imcc->heredoc_content) + strlen(yytext) + 2); strcpy(imcc->heredoc_content + strlen(imcc->heredoc_content), yytext); } } YY_BREAK case 5: /* rule 5 can match eol */ YY_RULE_SETUP #line 208 "compilers/imcc/imcc.l" { STRING *str; yy_pop_state(yyscanner); yy_push_state(cmt3, yyscanner); str = Parrot_str_new(imcc->interp, yytext,0); imcc->frames->s.file = str; imcc->cur_unit->file = str; return FILECOMMENT; } YY_BREAK case 6: YY_RULE_SETUP #line 221 "compilers/imcc/imcc.l" { yy_pop_state(yyscanner); yy_push_state(cmt4, yyscanner); } YY_BREAK case 7: YY_RULE_SETUP #line 226 "compilers/imcc/imcc.l" { yylineno = imcc->line = atoi(yytext); yy_pop_state(yyscanner); yy_push_state(cmt4, yyscanner); return LINECOMMENT; } YY_BREAK case 8: /* rule 8 can match eol */ YY_RULE_SETUP #line 233 "compilers/imcc/imcc.l" { yy_pop_state(yyscanner); } YY_BREAK case 9: /* rule 9 can match eol */ YY_RULE_SETUP #line 237 "compilers/imcc/imcc.l" { if (imcc->expect_pasm == 2) BEGIN(INITIAL); imcc->expect_pasm = 0; return '\n'; } YY_BREAK case 10: YY_RULE_SETUP #line 246 "compilers/imcc/imcc.l" { yy_push_state(cmt5, yyscanner); } YY_BREAK case 11: /* rule 11 can match eol */ YY_RULE_SETUP #line 250 "compilers/imcc/imcc.l" { if (imcc->expect_pasm == 2) BEGIN(INITIAL); else yy_pop_state(yyscanner); imcc->expect_pasm = 0; return '\n'; } YY_BREAK case 12: /* rule 12 can match eol */ YY_RULE_SETUP #line 262 "compilers/imcc/imcc.l" { /* this is a stand-alone =cut, but we're not in POD mode, so ignore. */ SET_LINE_NUMBER; } YY_BREAK case 13: /* rule 13 can match eol */ YY_RULE_SETUP #line 267 "compilers/imcc/imcc.l" { SET_LINE_NUMBER; imcc->in_pod = 1; yy_push_state(pod, yyscanner); } YY_BREAK case 14: /* rule 14 can match eol */ YY_RULE_SETUP #line 273 "compilers/imcc/imcc.l" { SET_LINE_NUMBER; imcc->in_pod = 0; yy_pop_state(yyscanner); } YY_BREAK case 15: YY_RULE_SETUP #line 279 "compilers/imcc/imcc.l" { SET_LINE_NUMBER; } YY_BREAK case 16: /* rule 16 can match eol */ YY_RULE_SETUP #line 281 "compilers/imcc/imcc.l" { /* ignore */ } YY_BREAK case 17: YY_RULE_SETUP #line 283 "compilers/imcc/imcc.l" return ANNOTATE; YY_BREAK case 18: YY_RULE_SETUP #line 284 "compilers/imcc/imcc.l" return LEXICAL; YY_BREAK case 19: YY_RULE_SETUP #line 285 "compilers/imcc/imcc.l" return ARG; YY_BREAK case 20: YY_RULE_SETUP #line 286 "compilers/imcc/imcc.l" { SET_LINE_NUMBER; return SUB; } YY_BREAK case 21: YY_RULE_SETUP #line 287 "compilers/imcc/imcc.l" return ESUB; YY_BREAK case 22: YY_RULE_SETUP #line 288 "compilers/imcc/imcc.l" return PCC_BEGIN; YY_BREAK case 23: YY_RULE_SETUP #line 289 "compilers/imcc/imcc.l" return PCC_END; YY_BREAK case 24: YY_RULE_SETUP #line 290 "compilers/imcc/imcc.l" return PCC_CALL; YY_BREAK case 25: YY_RULE_SETUP #line 291 "compilers/imcc/imcc.l" return INVOCANT; YY_BREAK case 26: YY_RULE_SETUP #line 292 "compilers/imcc/imcc.l" return PCC_SUB; YY_BREAK case 27: YY_RULE_SETUP #line 293 "compilers/imcc/imcc.l" return PCC_BEGIN_RETURN; YY_BREAK case 28: YY_RULE_SETUP #line 294 "compilers/imcc/imcc.l" return PCC_END_RETURN; YY_BREAK case 29: YY_RULE_SETUP #line 295 "compilers/imcc/imcc.l" return PCC_BEGIN_YIELD; YY_BREAK case 30: YY_RULE_SETUP #line 296 "compilers/imcc/imcc.l" return PCC_END_YIELD; YY_BREAK case 31: YY_RULE_SETUP #line 298 "compilers/imcc/imcc.l" return METHOD; YY_BREAK case 32: YY_RULE_SETUP #line 299 "compilers/imcc/imcc.l" return MULTI; YY_BREAK case 33: YY_RULE_SETUP #line 300 "compilers/imcc/imcc.l" return MAIN; YY_BREAK case 34: YY_RULE_SETUP #line 301 "compilers/imcc/imcc.l" return LOAD; YY_BREAK case 35: YY_RULE_SETUP #line 302 "compilers/imcc/imcc.l" return INIT; YY_BREAK case 36: YY_RULE_SETUP #line 303 "compilers/imcc/imcc.l" return IMMEDIATE; YY_BREAK case 37: YY_RULE_SETUP #line 304 "compilers/imcc/imcc.l" return POSTCOMP; YY_BREAK case 38: YY_RULE_SETUP #line 305 "compilers/imcc/imcc.l" return SUBTAG; YY_BREAK case 39: YY_RULE_SETUP #line 306 "compilers/imcc/imcc.l" return ANON; YY_BREAK case 40: YY_RULE_SETUP #line 307 "compilers/imcc/imcc.l" return OUTER; YY_BREAK case 41: YY_RULE_SETUP #line 308 "compilers/imcc/imcc.l" return NEED_LEX; YY_BREAK case 42: YY_RULE_SETUP #line 309 "compilers/imcc/imcc.l" return VTABLE_METHOD; YY_BREAK case 43: YY_RULE_SETUP #line 310 "compilers/imcc/imcc.l" return NS_ENTRY; YY_BREAK case 44: YY_RULE_SETUP #line 311 "compilers/imcc/imcc.l" return SUB_INSTANCE_OF; YY_BREAK case 45: YY_RULE_SETUP #line 312 "compilers/imcc/imcc.l" return SUBID; YY_BREAK case 46: YY_RULE_SETUP #line 314 "compilers/imcc/imcc.l" return RESULT; YY_BREAK case 47: YY_RULE_SETUP #line 315 "compilers/imcc/imcc.l" return GET_RESULTS; YY_BREAK case 48: YY_RULE_SETUP #line 316 "compilers/imcc/imcc.l" return YIELDT; YY_BREAK case 49: YY_RULE_SETUP #line 317 "compilers/imcc/imcc.l" return SET_YIELD; YY_BREAK case 50: YY_RULE_SETUP #line 318 "compilers/imcc/imcc.l" return RETURN; YY_BREAK case 51: YY_RULE_SETUP #line 319 "compilers/imcc/imcc.l" return SET_RETURN; YY_BREAK case 52: YY_RULE_SETUP #line 320 "compilers/imcc/imcc.l" return TAILCALL; YY_BREAK case 53: YY_RULE_SETUP #line 321 "compilers/imcc/imcc.l" return LOADLIB; YY_BREAK case 54: YY_RULE_SETUP #line 323 "compilers/imcc/imcc.l" return ADV_FLAT; YY_BREAK case 55: YY_RULE_SETUP #line 324 "compilers/imcc/imcc.l" return ADV_SLURPY; YY_BREAK case 56: YY_RULE_SETUP #line 325 "compilers/imcc/imcc.l" return ADV_OPTIONAL; YY_BREAK case 57: YY_RULE_SETUP #line 326 "compilers/imcc/imcc.l" return ADV_OPT_FLAG; YY_BREAK case 58: YY_RULE_SETUP #line 327 "compilers/imcc/imcc.l" return ADV_NAMED; YY_BREAK case 59: YY_RULE_SETUP #line 328 "compilers/imcc/imcc.l" return ADV_ARROW; YY_BREAK case 60: YY_RULE_SETUP #line 329 "compilers/imcc/imcc.l" return ADV_INVOCANT; YY_BREAK case 61: YY_RULE_SETUP #line 330 "compilers/imcc/imcc.l" return ADV_CALL_SIG; YY_BREAK case 62: YY_RULE_SETUP #line 332 "compilers/imcc/imcc.l" return NAMESPACE; YY_BREAK case 63: YY_RULE_SETUP #line 333 "compilers/imcc/imcc.l" return HLL; YY_BREAK case 64: YY_RULE_SETUP #line 335 "compilers/imcc/imcc.l" return LOCAL; YY_BREAK case 65: YY_RULE_SETUP #line 336 "compilers/imcc/imcc.l" return CONST; YY_BREAK case 66: YY_RULE_SETUP #line 337 "compilers/imcc/imcc.l" return GLOBAL_CONST; YY_BREAK case 67: YY_RULE_SETUP #line 338 "compilers/imcc/imcc.l" return PARAM; YY_BREAK case 68: YY_RULE_SETUP #line 339 "compilers/imcc/imcc.l" return GOTO; YY_BREAK case 69: YY_RULE_SETUP #line 340 "compilers/imcc/imcc.l" return IF; YY_BREAK case 70: YY_RULE_SETUP #line 341 "compilers/imcc/imcc.l" return UNLESS; YY_BREAK case 71: YY_RULE_SETUP #line 342 "compilers/imcc/imcc.l" return PNULL; YY_BREAK case 72: YY_RULE_SETUP #line 343 "compilers/imcc/imcc.l" return INTV; YY_BREAK case 73: YY_RULE_SETUP #line 344 "compilers/imcc/imcc.l" return FLOATV; YY_BREAK case 74: YY_RULE_SETUP #line 346 "compilers/imcc/imcc.l" return PMCV; YY_BREAK case 75: YY_RULE_SETUP #line 347 "compilers/imcc/imcc.l" return STRINGV; YY_BREAK case 76: YY_RULE_SETUP #line 348 "compilers/imcc/imcc.l" return SHIFT_LEFT; YY_BREAK case 77: YY_RULE_SETUP #line 349 "compilers/imcc/imcc.l" return SHIFT_RIGHT; YY_BREAK case 78: YY_RULE_SETUP #line 350 "compilers/imcc/imcc.l" return SHIFT_RIGHT_U; YY_BREAK case 79: YY_RULE_SETUP #line 351 "compilers/imcc/imcc.l" return LOG_AND; YY_BREAK case 80: YY_RULE_SETUP #line 352 "compilers/imcc/imcc.l" return LOG_OR; YY_BREAK case 81: YY_RULE_SETUP #line 353 "compilers/imcc/imcc.l" return LOG_XOR; YY_BREAK case 82: YY_RULE_SETUP #line 354 "compilers/imcc/imcc.l" return RELOP_LT; YY_BREAK case 83: YY_RULE_SETUP #line 355 "compilers/imcc/imcc.l" return RELOP_LTE; YY_BREAK case 84: YY_RULE_SETUP #line 356 "compilers/imcc/imcc.l" return RELOP_GT; YY_BREAK case 85: YY_RULE_SETUP #line 357 "compilers/imcc/imcc.l" return RELOP_GTE; YY_BREAK case 86: YY_RULE_SETUP #line 358 "compilers/imcc/imcc.l" return RELOP_EQ; YY_BREAK case 87: YY_RULE_SETUP #line 359 "compilers/imcc/imcc.l" return RELOP_NE; YY_BREAK case 88: YY_RULE_SETUP #line 360 "compilers/imcc/imcc.l" return POW; YY_BREAK case 89: YY_RULE_SETUP #line 362 "compilers/imcc/imcc.l" return CONCAT; YY_BREAK case 90: YY_RULE_SETUP #line 363 "compilers/imcc/imcc.l" return DOT; YY_BREAK case 91: YY_RULE_SETUP #line 365 "compilers/imcc/imcc.l" return PLUS_ASSIGN; YY_BREAK case 92: YY_RULE_SETUP #line 366 "compilers/imcc/imcc.l" return MINUS_ASSIGN; YY_BREAK case 93: YY_RULE_SETUP #line 367 "compilers/imcc/imcc.l" return MUL_ASSIGN; YY_BREAK case 94: YY_RULE_SETUP #line 368 "compilers/imcc/imcc.l" return DIV_ASSIGN; YY_BREAK case 95: YY_RULE_SETUP #line 369 "compilers/imcc/imcc.l" return MOD_ASSIGN; YY_BREAK case 96: YY_RULE_SETUP #line 370 "compilers/imcc/imcc.l" return FDIV; YY_BREAK case 97: YY_RULE_SETUP #line 371 "compilers/imcc/imcc.l" return FDIV_ASSIGN; YY_BREAK case 98: YY_RULE_SETUP #line 372 "compilers/imcc/imcc.l" return BAND_ASSIGN; YY_BREAK case 99: YY_RULE_SETUP #line 373 "compilers/imcc/imcc.l" return BOR_ASSIGN; YY_BREAK case 100: YY_RULE_SETUP #line 374 "compilers/imcc/imcc.l" return BXOR_ASSIGN; YY_BREAK case 101: YY_RULE_SETUP #line 375 "compilers/imcc/imcc.l" return SHR_ASSIGN; YY_BREAK case 102: YY_RULE_SETUP #line 376 "compilers/imcc/imcc.l" return SHL_ASSIGN; YY_BREAK case 103: YY_RULE_SETUP #line 377 "compilers/imcc/imcc.l" return SHR_U_ASSIGN; YY_BREAK case 104: YY_RULE_SETUP #line 378 "compilers/imcc/imcc.l" return CONCAT_ASSIGN; YY_BREAK case 105: YY_RULE_SETUP #line 380 "compilers/imcc/imcc.l" { char *macro_name = NULL; int start_cond = YY_START; int macro_exists = 0; int c; int start_line; BEGIN(macro); c = yylex_skip(valp, imcc, " ", yyscanner); if (c != IDENTIFIER) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Constant names must be identifiers"); imcc->cur_macro_name = macro_name = valp->s; start_line = imcc->line; c = yylex_skip(valp, imcc, " ", yyscanner); if (c != INTC && c != FLOATC && c != STRINGC && c != REG) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Constant '%s' value must be a number, " "stringliteral or register", macro_name); /* macro_name becomes a hash key * the first one needs to remain; destroying the hash frees it * subsequent macro_names need destruction here to avoid leaks */ if (find_macro(imcc, macro_name)) macro_exists = 1; define_macro(imcc, macro_name, NULL, valp->s, start_line); mem_sys_free(valp->s); /* don't leak these */ if (macro_exists) mem_sys_free(macro_name); imcc->cur_macro_name = NULL; BEGIN(start_cond); return MACRO; } YY_BREAK case 106: YY_RULE_SETUP #line 423 "compilers/imcc/imcc.l" { /* the initial whitespace catcher misses this one */ SET_LINE_NUMBER; return read_macro(valp, imcc, yyscanner); } YY_BREAK case 107: YY_RULE_SETUP #line 429 "compilers/imcc/imcc.l" { const int c = yylex(valp,yyscanner,imcc); STRING *filename; if (c != STRINGC) return c; /* STRINGCs have a mem_sys_strdup()ed valp->s */ mem_sys_free(valp->s); YYCHOP(); filename = Parrot_str_new(imcc->interp, yytext + 1, 0); include_file(imcc, filename, yyscanner); } YY_BREAK case 108: YY_RULE_SETUP #line 443 "compilers/imcc/imcc.l" { if (valp) { char *label; size_t len; YYCHOP(); YYCHOP(); if (!imcc->frames || !imcc->frames->label) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "missing space?"); len = yyleng + 10; label = (char *)mem_sys_allocate(len); snprintf(label, len, "%s%d", yytext, imcc->frames->label); /* XXX: free valp->s if it exists? */ valp->s = label; } return LABEL; } YY_BREAK case 109: YY_RULE_SETUP #line 465 "compilers/imcc/imcc.l" { if (valp) { char *label; size_t len; YYCHOP(); if (!imcc->frames || !imcc->frames->label) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "missing space?"); len = yyleng + 10; label = (char *)mem_sys_allocate(len); snprintf(label, len, "%s%d", yytext, imcc->frames->label); /* XXX: free valp->s if it exists? */ valp->s = label; } return IDENTIFIER; } YY_BREAK case 110: YY_RULE_SETUP #line 485 "compilers/imcc/imcc.l" return COMMA; YY_BREAK case 111: YY_RULE_SETUP #line 487 "compilers/imcc/imcc.l" { /* trim last ':' */ YYCHOP(); if (valp) valp->s = mem_sys_strndup(yytext, yyleng); return LABEL; } YY_BREAK case 112: YY_RULE_SETUP #line 497 "compilers/imcc/imcc.l" { char * const macro_name = mem_sys_strndup(yytext + 1, yyleng - 1); int failed = expand_macro(imcc, macro_name, yyscanner); mem_sys_free(macro_name); if (!failed) { yyless(1); return DOT; } } YY_BREAK case 113: YY_RULE_SETUP #line 509 "compilers/imcc/imcc.l" DUP_AND_RET(valp, FLOATC); YY_BREAK case 114: YY_RULE_SETUP #line 510 "compilers/imcc/imcc.l" DUP_AND_RET(valp, INTC); YY_BREAK case 115: YY_RULE_SETUP #line 511 "compilers/imcc/imcc.l" DUP_AND_RET(valp, INTC); YY_BREAK case 116: YY_RULE_SETUP #line 512 "compilers/imcc/imcc.l" DUP_AND_RET(valp, INTC); YY_BREAK case 117: YY_RULE_SETUP #line 513 "compilers/imcc/imcc.l" DUP_AND_RET(valp, INTC); YY_BREAK case 118: YY_RULE_SETUP #line 515 "compilers/imcc/imcc.l" { valp->s = mem_sys_strndup(yytext, yyleng); return STRINGC; } YY_BREAK case 119: YY_RULE_SETUP #line 521 "compilers/imcc/imcc.l" { macro_frame_t *frame; /* Save the string we want to mark the end of the heredoc and snip off newline and quote. */ if (imcc->frames->heredoc_rest) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "nested heredoc not supported"); imcc->heredoc_end = mem_sys_strndup(yytext + 3, yyleng - 3); imcc->heredoc_end[strlen(imcc->heredoc_end) - 1] = 0; if (!strlen(imcc->heredoc_end)) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "empty heredoc delimiter"); frame = new_frame(imcc); frame->s.next = (parser_state_t *)imcc->frames; imcc->frames = frame; /* Start slurping up the heredoc. */ imcc->heredoc_content = (char *)mem_sys_allocate(2); /* preserve delim */ imcc->heredoc_content[0] = yytext[2]; /* eos */ imcc->heredoc_content[1] = 0; yy_push_state(heredoc1, yyscanner); } YY_BREAK case 120: YY_RULE_SETUP #line 549 "compilers/imcc/imcc.l" { /* charset:"..." */ valp->s = mem_sys_strndup(yytext, yyleng); /* this is actually not unicode but a string with a charset */ return USTRINGC; } YY_BREAK case 121: YY_RULE_SETUP #line 557 "compilers/imcc/imcc.l" { if (valp) (valp)->s = yytext; if (imcc->state->pasm_file) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "'%s' is not a valid register name in pasm mode", yytext); return IREG; } YY_BREAK case 122: YY_RULE_SETUP #line 565 "compilers/imcc/imcc.l" { if (valp) (valp)->s = yytext; if (imcc->state->pasm_file) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "'%s' is not a valid register name in pasm mode", yytext); return NREG; } YY_BREAK case 123: YY_RULE_SETUP #line 574 "compilers/imcc/imcc.l" { if (valp) (valp)->s = yytext; if (imcc->state->pasm_file) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "'%s' is not a valid register name in pasm mode", yytext); return SREG; } YY_BREAK case 124: YY_RULE_SETUP #line 583 "compilers/imcc/imcc.l" { if (valp) (valp)->s = yytext; if (imcc->state->pasm_file) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "'%s' is not a valid register name in pasm mode", yytext); return PREG; } YY_BREAK case 125: YY_RULE_SETUP #line 592 "compilers/imcc/imcc.l" { IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "'%s' is not a valid register name", yytext); } YY_BREAK case 126: YY_RULE_SETUP #line 597 "compilers/imcc/imcc.l" { if (imcc->state->pasm_file == 0) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "'%s' is only a valid register name in PASM mode", yytext); if (valp) valp->s = mem_sys_strndup(yytext, yyleng); return REG; } YY_BREAK case 127: YY_RULE_SETUP #line 609 "compilers/imcc/imcc.l" { return handle_identifier(imcc, valp, yytext); } YY_BREAK case 128: YY_RULE_SETUP #line 611 "compilers/imcc/imcc.l" /* skip */; YY_BREAK case 129: YY_RULE_SETUP #line 613 "compilers/imcc/imcc.l" { /* catch all except for state macro */ return yytext[0]; } YY_BREAK case YY_STATE_EOF(emit): #line 618 "compilers/imcc/imcc.l" { BEGIN(INITIAL); if (imcc->frames->s.pasm_file) { imcc->frames->s.pasm_file = 2; return EOM; } return 0; } YY_BREAK case YY_STATE_EOF(INITIAL): #line 629 "compilers/imcc/imcc.l" yyterminate(); YY_BREAK case 130: YY_RULE_SETUP #line 631 "compilers/imcc/imcc.l" { /* the initial whitespace catcher misses this one */ SET_LINE_NUMBER; DUP_AND_RET(valp, ENDM); } YY_BREAK case 131: /* rule 131 can match eol */ YY_RULE_SETUP #line 637 "compilers/imcc/imcc.l" { DUP_AND_RET(valp, '\n'); } YY_BREAK case 132: YY_RULE_SETUP #line 641 "compilers/imcc/imcc.l" return LABEL; YY_BREAK case 133: YY_RULE_SETUP #line 643 "compilers/imcc/imcc.l" { if (yylex(valp,yyscanner,imcc) != LABEL) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "LABEL expected"); if (valp) { char *label; size_t len; YYCHOP(); len = strlen(imcc->cur_macro_name) + yyleng + 15; label = (char *)mem_sys_allocate(len); snprintf(label, len, "local__%s__%s__$:", imcc->cur_macro_name, yytext+1); if (valp->s) mem_sys_free(valp->s); valp->s = label; } return LABEL; } YY_BREAK case 134: YY_RULE_SETUP #line 667 "compilers/imcc/imcc.l" { if (valp) { if (!imcc->cur_macro_name) { if (valp->s) mem_sys_free(valp->s); IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Invalid LABEL outside of macro"); } else { const char * const fmt = "local__%s__%s__$"; const size_t fmtlen = strlen(fmt) - (2 * strlen("%s")); const size_t len = strlen(imcc->cur_macro_name) + yyleng + fmtlen; char * const label = (char *)mem_sys_allocate(len); /* skip over ".$" prefix with the +2 */ snprintf(label, len, fmt, imcc->cur_macro_name, yytext + 2); if (valp->s) mem_sys_free(valp->s); valp->s = label; } } return IDENTIFIER; } YY_BREAK case 135: YY_RULE_SETUP #line 695 "compilers/imcc/imcc.l" DUP_AND_RET(valp, ' '); YY_BREAK case 136: YY_RULE_SETUP #line 696 "compilers/imcc/imcc.l" DUP_AND_RET(valp, REG); YY_BREAK case 137: YY_RULE_SETUP #line 697 "compilers/imcc/imcc.l" DUP_AND_RET(valp, REG); YY_BREAK case 138: YY_RULE_SETUP #line 698 "compilers/imcc/imcc.l" DUP_AND_RET(valp, IDENTIFIER); YY_BREAK case 139: YY_RULE_SETUP #line 699 "compilers/imcc/imcc.l" DUP_AND_RET(valp, MACRO); YY_BREAK case 140: YY_RULE_SETUP #line 700 "compilers/imcc/imcc.l" DUP_AND_RET(valp, yytext[0]); YY_BREAK case YY_STATE_EOF(macro): #line 701 "compilers/imcc/imcc.l" yyterminate(); YY_BREAK case 141: YY_RULE_SETUP #line 703 "compilers/imcc/imcc.l" ECHO; YY_BREAK #line 3238 "compilers/imcc/imclexer.c" case YY_STATE_EOF(pod): case YY_STATE_EOF(cmt1): case YY_STATE_EOF(cmt2): case YY_STATE_EOF(cmt3): case YY_STATE_EOF(cmt4): case YY_STATE_EOF(cmt5): case YY_STATE_EOF(heredoc1): case YY_STATE_EOF(heredoc2): yyterminate(); case YY_END_OF_BUFFER: { /* Amount of text matched not including the EOB char. */ int yy_amount_of_matched_text = (int) (yy_cp - yyg->yytext_ptr) - 1; /* Undo the effects of YY_DO_BEFORE_ACTION. */ *yy_cp = yyg->yy_hold_char; YY_RESTORE_YY_MORE_OFFSET if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW ) { /* We're scanning a new file or input source. It's * possible that this happened because the user * just pointed yyin at a new source and called * yylex(). If so, then we have to assure * consistency between YY_CURRENT_BUFFER and our * globals. Here is the right place to do so, because * this is the first action (other than possibly a * back-up) that will match for the new input source. */ yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin; YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL; } /* Note that here we test for yy_c_buf_p "<=" to the position * of the first EOB in the buffer, since yy_c_buf_p will * already have been incremented past the NUL character * (since all states make transitions on EOB to the * end-of-buffer state). Contrast this with the test * in input(). */ if ( yyg->yy_c_buf_p <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] ) { /* This was really a NUL. */ yy_state_type yy_next_state; yyg->yy_c_buf_p = yyg->yytext_ptr + yy_amount_of_matched_text; yy_current_state = yy_get_previous_state( yyscanner ); /* Okay, we're now positioned to make the NUL * transition. We couldn't have * yy_get_previous_state() go ahead and do it * for us because it doesn't know how to deal * with the possibility of jamming (and we don't * want to build jamming into it because then it * will run more slowly). */ yy_next_state = yy_try_NUL_trans( yy_current_state , yyscanner); yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; if ( yy_next_state ) { /* Consume the NUL. */ yy_cp = ++yyg->yy_c_buf_p; yy_current_state = yy_next_state; goto yy_match; } else { yy_cp = yyg->yy_last_accepting_cpos; yy_current_state = yyg->yy_last_accepting_state; goto yy_find_action; } } else switch ( yy_get_next_buffer( yyscanner ) ) { case EOB_ACT_END_OF_FILE: { yyg->yy_did_buffer_switch_on_eof = 0; if ( yywrap(yyscanner ) ) { /* Note: because we've taken care in * yy_get_next_buffer() to have set up * yytext, we can now set up * yy_c_buf_p so that if some total * hoser (like flex itself) wants to * call the scanner after we return the * YY_NULL, it'll still work - another * YY_NULL will get returned. */ yyg->yy_c_buf_p = yyg->yytext_ptr + YY_MORE_ADJ; yy_act = YY_STATE_EOF(YY_START); goto do_action; } else { if ( ! yyg->yy_did_buffer_switch_on_eof ) YY_NEW_FILE; } break; } case EOB_ACT_CONTINUE_SCAN: yyg->yy_c_buf_p = yyg->yytext_ptr + yy_amount_of_matched_text; yy_current_state = yy_get_previous_state( yyscanner ); yy_cp = yyg->yy_c_buf_p; yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; goto yy_match; case EOB_ACT_LAST_MATCH: yyg->yy_c_buf_p = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars]; yy_current_state = yy_get_previous_state( yyscanner ); yy_cp = yyg->yy_c_buf_p; yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; goto yy_find_action; } break; } default: YY_FATAL_ERROR( "fatal flex scanner internal error--no action found" ); } /* end of action switch */ } /* end of scanning one token */ } /* end of yylex */ /* yy_get_next_buffer - try to read in a new buffer * * Returns a code representing an action: * EOB_ACT_LAST_MATCH - * EOB_ACT_CONTINUE_SCAN - continue scanning from current position * EOB_ACT_END_OF_FILE - end of file */ static int yy_get_next_buffer (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf; register char *source = yyg->yytext_ptr; register int number_to_move, i; int ret_val; if ( yyg->yy_c_buf_p > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars + 1] ) YY_FATAL_ERROR( "fatal flex scanner internal error--end of buffer missed" ); if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 ) { /* Don't try to fill the buffer, so this is an EOF. */ if ( yyg->yy_c_buf_p - yyg->yytext_ptr - YY_MORE_ADJ == 1 ) { /* We matched a single character, the EOB, so * treat this as a final EOF. */ return EOB_ACT_END_OF_FILE; } else { /* We matched some text prior to the EOB, first * process it. */ return EOB_ACT_LAST_MATCH; } } /* Try to read more data. */ /* First move last chars to start of buffer. */ number_to_move = (int) (yyg->yy_c_buf_p - yyg->yytext_ptr) - 1; for ( i = 0; i < number_to_move; ++i ) *(dest++) = *(source++); if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING ) /* don't do the read, it's not guaranteed to return an EOF, * just force an EOF */ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars = 0; else { int num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; while ( num_to_read <= 0 ) { /* Not enough room in the buffer - grow it. */ /* just a shorter name for the current buffer */ YY_BUFFER_STATE b = YY_CURRENT_BUFFER; int yy_c_buf_p_offset = (int) (yyg->yy_c_buf_p - b->yy_ch_buf); if ( b->yy_is_our_buffer ) { int new_size = b->yy_buf_size * 2; if ( new_size <= 0 ) b->yy_buf_size += b->yy_buf_size / 8; else b->yy_buf_size *= 2; b->yy_ch_buf = (char *) /* Include room in for 2 EOB chars. */ yyrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2 ,yyscanner ); } else /* Can't grow it, we don't own it. */ b->yy_ch_buf = 0; if ( ! b->yy_ch_buf ) YY_FATAL_ERROR( "fatal error - scanner input buffer overflow" ); yyg->yy_c_buf_p = &b->yy_ch_buf[yy_c_buf_p_offset]; num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; } if ( num_to_read > YY_READ_BUF_SIZE ) num_to_read = YY_READ_BUF_SIZE; /* Read in more data. */ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]), yyg->yy_n_chars, (size_t) num_to_read ); YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } if ( yyg->yy_n_chars == 0 ) { if ( number_to_move == YY_MORE_ADJ ) { ret_val = EOB_ACT_END_OF_FILE; yyrestart(yyin ,yyscanner); } else { ret_val = EOB_ACT_LAST_MATCH; YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_EOF_PENDING; } } else ret_val = EOB_ACT_CONTINUE_SCAN; if ((yy_size_t) (yyg->yy_n_chars + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) { /* Extend the array by 50%, plus the number we really need. */ yy_size_t new_size = yyg->yy_n_chars + number_to_move + (yyg->yy_n_chars >> 1); YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size ,yyscanner ); if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" ); } yyg->yy_n_chars += number_to_move; YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] = YY_END_OF_BUFFER_CHAR; YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars + 1] = YY_END_OF_BUFFER_CHAR; yyg->yytext_ptr = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0]; return ret_val; } /* yy_get_previous_state - get the state just before the EOB char was reached */ static yy_state_type yy_get_previous_state (yyscan_t yyscanner) { register yy_state_type yy_current_state; register char *yy_cp; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_current_state = yyg->yy_start; yy_current_state += YY_AT_BOL(); for ( yy_cp = yyg->yytext_ptr + YY_MORE_ADJ; yy_cp < yyg->yy_c_buf_p; ++yy_cp ) { register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1); if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 861 ) yy_c = yy_meta[(unsigned int) yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; } return yy_current_state; } /* yy_try_NUL_trans - try to make a transition on the NUL character * * synopsis * next_state = yy_try_NUL_trans( current_state ); */ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state , yyscan_t yyscanner) { register int yy_is_jam; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* This var may be unused depending upon options. */ register char *yy_cp = yyg->yy_c_buf_p; register YY_CHAR yy_c = 1; if ( yy_accept[yy_current_state] ) { yyg->yy_last_accepting_state = yy_current_state; yyg->yy_last_accepting_cpos = yy_cp; } while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) { yy_current_state = (int) yy_def[yy_current_state]; if ( yy_current_state >= 861 ) yy_c = yy_meta[(unsigned int) yy_c]; } yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; yy_is_jam = (yy_current_state == 860); return yy_is_jam ? 0 : yy_current_state; } static void yyunput (int c, register char * yy_bp , yyscan_t yyscanner) { register char *yy_cp; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_cp = yyg->yy_c_buf_p; /* undo effects of setting up yytext */ *yy_cp = yyg->yy_hold_char; if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) { /* need to shift things up to make room */ /* +2 for EOB chars. */ register int number_to_move = yyg->yy_n_chars + 2; register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[ YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2]; register char *source = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]; while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) *--dest = *--source; yy_cp += (int) (dest - source); yy_bp += (int) (dest - source); YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_buf_size; if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) YY_FATAL_ERROR( "flex scanner push-back overflow" ); } *--yy_cp = (char) c; if ( c == '\n' ){ --yylineno; } yyg->yytext_ptr = yy_bp; yyg->yy_hold_char = *yy_cp; yyg->yy_c_buf_p = yy_cp; } #ifndef YY_NO_INPUT #ifdef __cplusplus static int yyinput (yyscan_t yyscanner) #else static int input (yyscan_t yyscanner) #endif { int c; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; *yyg->yy_c_buf_p = yyg->yy_hold_char; if ( *yyg->yy_c_buf_p == YY_END_OF_BUFFER_CHAR ) { /* yy_c_buf_p now points to the character we want to return. * If this occurs *before* the EOB characters, then it's a * valid NUL; if not, then we've hit the end of the buffer. */ if ( yyg->yy_c_buf_p < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] ) /* This was really a NUL. */ *yyg->yy_c_buf_p = '\0'; else { /* need more input */ int offset = yyg->yy_c_buf_p - yyg->yytext_ptr; ++yyg->yy_c_buf_p; switch ( yy_get_next_buffer( yyscanner ) ) { case EOB_ACT_LAST_MATCH: /* This happens because yy_g_n_b() * sees that we've accumulated a * token and flags that we need to * try matching the token before * proceeding. But for input(), * there's no matching to consider. * So convert the EOB_ACT_LAST_MATCH * to EOB_ACT_END_OF_FILE. */ /* Reset buffer status. */ yyrestart(yyin ,yyscanner); /*FALLTHROUGH*/ case EOB_ACT_END_OF_FILE: { if ( yywrap(yyscanner ) ) return EOF; if ( ! yyg->yy_did_buffer_switch_on_eof ) YY_NEW_FILE; #ifdef __cplusplus return yyinput(yyscanner); #else return input(yyscanner); #endif } case EOB_ACT_CONTINUE_SCAN: yyg->yy_c_buf_p = yyg->yytext_ptr + offset; break; } } } c = *(unsigned char *) yyg->yy_c_buf_p; /* cast for 8-bit char's */ *yyg->yy_c_buf_p = '\0'; /* preserve yytext */ yyg->yy_hold_char = *++yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_at_bol = (c == '\n'); if ( YY_CURRENT_BUFFER_LVALUE->yy_at_bol ) do{ yylineno++; yycolumn=0; }while(0) ; return c; } #endif /* ifndef YY_NO_INPUT */ /** Immediately switch to a different input stream. * @param input_file A readable stream. * @param yyscanner The scanner object. * @note This function does not reset the start condition to @c INITIAL . */ void yyrestart (FILE * input_file , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! YY_CURRENT_BUFFER ){ yyensure_buffer_stack (yyscanner); YY_CURRENT_BUFFER_LVALUE = yy_create_buffer(yyin,YY_BUF_SIZE ,yyscanner); } yy_init_buffer(YY_CURRENT_BUFFER,input_file ,yyscanner); yy_load_buffer_state(yyscanner ); } /** Switch to a different input buffer. * @param new_buffer The new input buffer. * @param yyscanner The scanner object. */ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* TODO. We should be able to replace this entire function body * with * yypop_buffer_state(); * yypush_buffer_state(new_buffer); */ yyensure_buffer_stack (yyscanner); if ( YY_CURRENT_BUFFER == new_buffer ) return; if ( YY_CURRENT_BUFFER ) { /* Flush out information for old buffer. */ *yyg->yy_c_buf_p = yyg->yy_hold_char; YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } YY_CURRENT_BUFFER_LVALUE = new_buffer; yy_load_buffer_state(yyscanner ); /* We don't actually know whether we did this switch during * EOF (yywrap()) processing, but the only time this flag * is looked at is after yywrap() is called, so it's safe * to go ahead and always set it. */ yyg->yy_did_buffer_switch_on_eof = 1; } static void yy_load_buffer_state (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; yyg->yytext_ptr = yyg->yy_c_buf_p = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos; yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file; yyg->yy_hold_char = *yyg->yy_c_buf_p; } /** Allocate and initialize an input buffer state. * @param file A readable stream. * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. * @param yyscanner The scanner object. * @return the allocated buffer state. */ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size , yyscan_t yyscanner) { YY_BUFFER_STATE b; b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) ,yyscanner ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); b->yy_buf_size = size; /* yy_ch_buf has to be 2 characters longer than the size given because * we need to put in 2 end-of-buffer characters. */ b->yy_ch_buf = (char *) yyalloc(b->yy_buf_size + 2 ,yyscanner ); if ( ! b->yy_ch_buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); b->yy_is_our_buffer = 1; yy_init_buffer(b,file ,yyscanner); return b; } /** Destroy the buffer. * @param b a buffer created with yy_create_buffer() * @param yyscanner The scanner object. */ void yy_delete_buffer (YY_BUFFER_STATE b , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! b ) return; if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0; if ( b->yy_is_our_buffer ) yyfree((void *) b->yy_ch_buf ,yyscanner ); yyfree((void *) b ,yyscanner ); } /* Initializes or reinitializes a buffer. * This function is sometimes called more than once on the same buffer, * such as during a yyrestart() or at EOF. */ static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file , yyscan_t yyscanner) { int oerrno = errno; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_flush_buffer(b ,yyscanner); b->yy_input_file = file; b->yy_fill_buffer = 1; /* If b is the current buffer, then yy_init_buffer was _probably_ * called from yyrestart() or through yy_get_next_buffer. * In that case, we don't want to reset the lineno or column. */ if (b != YY_CURRENT_BUFFER){ b->yy_bs_lineno = 1; b->yy_bs_column = 0; } b->yy_is_interactive = 0; errno = oerrno; } /** Discard all buffered characters. On the next scan, YY_INPUT will be called. * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. * @param yyscanner The scanner object. */ void yy_flush_buffer (YY_BUFFER_STATE b , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( ! b ) return; b->yy_n_chars = 0; /* We always need two end-of-buffer characters. The first causes * a transition to the end-of-buffer state. The second causes * a jam in that state. */ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR; b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR; b->yy_buf_pos = &b->yy_ch_buf[0]; b->yy_at_bol = 1; b->yy_buffer_status = YY_BUFFER_NEW; if ( b == YY_CURRENT_BUFFER ) yy_load_buffer_state(yyscanner ); } /** Pushes the new state onto the stack. The new state becomes * the current state. This function will allocate the stack * if necessary. * @param new_buffer The new state. * @param yyscanner The scanner object. */ void yypush_buffer_state (YY_BUFFER_STATE new_buffer , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (new_buffer == NULL) return; yyensure_buffer_stack(yyscanner); /* This block is copied from yy_switch_to_buffer. */ if ( YY_CURRENT_BUFFER ) { /* Flush out information for old buffer. */ *yyg->yy_c_buf_p = yyg->yy_hold_char; YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = yyg->yy_c_buf_p; YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; } /* Only push if top exists. Otherwise, replace top. */ if (YY_CURRENT_BUFFER) yyg->yy_buffer_stack_top++; YY_CURRENT_BUFFER_LVALUE = new_buffer; /* copied from yy_switch_to_buffer. */ yy_load_buffer_state(yyscanner ); yyg->yy_did_buffer_switch_on_eof = 1; } /** Removes and deletes the top of the stack, if present. * The next element becomes the new top. * @param yyscanner The scanner object. */ void yypop_buffer_state (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (!YY_CURRENT_BUFFER) return; yy_delete_buffer(YY_CURRENT_BUFFER ,yyscanner); YY_CURRENT_BUFFER_LVALUE = NULL; if (yyg->yy_buffer_stack_top > 0) --yyg->yy_buffer_stack_top; if (YY_CURRENT_BUFFER) { yy_load_buffer_state(yyscanner ); yyg->yy_did_buffer_switch_on_eof = 1; } } /* Allocates the stack if it does not exist. * Guarantees space for at least one push. */ static void yyensure_buffer_stack (yyscan_t yyscanner) { int num_to_alloc; struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (!yyg->yy_buffer_stack) { /* First allocation is just for 2 elements, since we don't know if this * scanner will even need a stack. We use 2 instead of 1 to avoid an * immediate realloc on the next call. */ num_to_alloc = 1; yyg->yy_buffer_stack = (struct yy_buffer_state**)yyalloc (num_to_alloc * sizeof(struct yy_buffer_state*) , yyscanner); if ( ! yyg->yy_buffer_stack ) YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); memset(yyg->yy_buffer_stack, 0, num_to_alloc * sizeof(struct yy_buffer_state*)); yyg->yy_buffer_stack_max = num_to_alloc; yyg->yy_buffer_stack_top = 0; return; } if (yyg->yy_buffer_stack_top >= (yyg->yy_buffer_stack_max) - 1){ /* Increase the buffer to prepare for a possible push. */ int grow_size = 8 /* arbitrary grow size */; num_to_alloc = yyg->yy_buffer_stack_max + grow_size; yyg->yy_buffer_stack = (struct yy_buffer_state**)yyrealloc (yyg->yy_buffer_stack, num_to_alloc * sizeof(struct yy_buffer_state*) , yyscanner); if ( ! yyg->yy_buffer_stack ) YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); /* zero only the new slots.*/ memset(yyg->yy_buffer_stack + yyg->yy_buffer_stack_max, 0, grow_size * sizeof(struct yy_buffer_state*)); yyg->yy_buffer_stack_max = num_to_alloc; } } /** Setup the input buffer state to scan directly from a user-specified character buffer. * @param base the character buffer * @param size the size in bytes of the character buffer * @param yyscanner The scanner object. * @return the newly allocated buffer state object. */ YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size , yyscan_t yyscanner) { YY_BUFFER_STATE b; if ( size < 2 || base[size-2] != YY_END_OF_BUFFER_CHAR || base[size-1] != YY_END_OF_BUFFER_CHAR ) /* They forgot to leave room for the EOB's. */ return 0; b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) ,yyscanner ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" ); b->yy_buf_size = size - 2; /* "- 2" to take care of EOB's */ b->yy_buf_pos = b->yy_ch_buf = base; b->yy_is_our_buffer = 0; b->yy_input_file = 0; b->yy_n_chars = b->yy_buf_size; b->yy_is_interactive = 0; b->yy_at_bol = 1; b->yy_fill_buffer = 0; b->yy_buffer_status = YY_BUFFER_NEW; yy_switch_to_buffer(b ,yyscanner ); return b; } /** Setup the input buffer state to scan a string. The next call to yylex() will * scan from a @e copy of @a str. * @param yystr a NUL-terminated string to scan * @param yyscanner The scanner object. * @return the newly allocated buffer state object. * @note If you want to scan bytes that may contain NUL values, then use * yy_scan_bytes() instead. */ YY_BUFFER_STATE yy_scan_string (yyconst char * yystr , yyscan_t yyscanner) { return yy_scan_bytes(yystr,strlen(yystr) ,yyscanner); } /** Setup the input buffer state to scan the given bytes. The next call to yylex() will * scan from a @e copy of @a bytes. * @param yybytes the byte buffer to scan * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes. * @param yyscanner The scanner object. * @return the newly allocated buffer state object. */ YY_BUFFER_STATE yy_scan_bytes (yyconst char * yybytes, int _yybytes_len , yyscan_t yyscanner) { YY_BUFFER_STATE b; char *buf; yy_size_t n; int i; /* Get memory for full buffer, including space for trailing EOB's. */ n = _yybytes_len + 2; buf = (char *) yyalloc(n ,yyscanner ); if ( ! buf ) YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" ); for ( i = 0; i < _yybytes_len; ++i ) buf[i] = yybytes[i]; buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR; b = yy_scan_buffer(buf,n ,yyscanner); if ( ! b ) YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" ); /* It's okay to grow etc. this buffer, and we should throw it * away when we're done. */ b->yy_is_our_buffer = 1; return b; } static void yy_push_state (int new_state , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( yyg->yy_start_stack_ptr >= yyg->yy_start_stack_depth ) { yy_size_t new_size; yyg->yy_start_stack_depth += YY_START_STACK_INCR; new_size = yyg->yy_start_stack_depth * sizeof( int ); if ( ! yyg->yy_start_stack ) yyg->yy_start_stack = (int *) yyalloc(new_size ,yyscanner ); else yyg->yy_start_stack = (int *) yyrealloc((void *) yyg->yy_start_stack,new_size ,yyscanner ); if ( ! yyg->yy_start_stack ) YY_FATAL_ERROR( "out of memory expanding start-condition stack" ); } yyg->yy_start_stack[yyg->yy_start_stack_ptr++] = YY_START; BEGIN(new_state); } static void yy_pop_state (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if ( --yyg->yy_start_stack_ptr < 0 ) YY_FATAL_ERROR( "start-condition stack underflow" ); BEGIN(yyg->yy_start_stack[yyg->yy_start_stack_ptr]); } static int yy_top_state (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyg->yy_start_stack[yyg->yy_start_stack_ptr - 1]; } #ifndef YY_EXIT_FAILURE #define YY_EXIT_FAILURE 2 #endif static void yy_fatal_error (yyconst char* msg , yyscan_t yyscanner) { (void) fprintf( stderr, "%s\n", msg ); exit( YY_EXIT_FAILURE ); } /* Redefine yyless() so it works in section 3 code. */ #undef yyless #define yyless(n) \ do \ { \ /* Undo effects of setting up yytext. */ \ int yyless_macro_arg = (n); \ YY_LESS_LINENO(yyless_macro_arg);\ yytext[yyleng] = yyg->yy_hold_char; \ yyg->yy_c_buf_p = yytext + yyless_macro_arg; \ yyg->yy_hold_char = *yyg->yy_c_buf_p; \ *yyg->yy_c_buf_p = '\0'; \ yyleng = yyless_macro_arg; \ } \ while ( 0 ) /* Accessor methods (get/set functions) to struct members. */ /** Get the user-defined data for this scanner. * @param yyscanner The scanner object. */ YY_EXTRA_TYPE yyget_extra (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyextra; } /** Get the current line number. * @param yyscanner The scanner object. */ int yyget_lineno (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (! YY_CURRENT_BUFFER) return 0; return yylineno; } /** Get the current column number. * @param yyscanner The scanner object. */ int yyget_column (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; if (! YY_CURRENT_BUFFER) return 0; return yycolumn; } /** Get the input stream. * @param yyscanner The scanner object. */ FILE *yyget_in (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyin; } /** Get the output stream. * @param yyscanner The scanner object. */ FILE *yyget_out (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyout; } /** Get the length of the current token. * @param yyscanner The scanner object. */ int yyget_leng (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yyleng; } /** Get the current token. * @param yyscanner The scanner object. */ char *yyget_text (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yytext; } /** Set the user-defined data. This data is never touched by the scanner. * @param user_defined The data to be associated with this scanner. * @param yyscanner The scanner object. */ void yyset_extra (YY_EXTRA_TYPE user_defined , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyextra = user_defined ; } /** Set the current line number. * @param line_number * @param yyscanner The scanner object. */ void yyset_lineno (int line_number , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* lineno is only valid if an input buffer exists. */ if (! YY_CURRENT_BUFFER ) yy_fatal_error( "yyset_lineno called with no buffer" , yyscanner); yylineno = line_number; } /** Set the current column. * @param line_number * @param yyscanner The scanner object. */ void yyset_column (int column_no , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* column is only valid if an input buffer exists. */ if (! YY_CURRENT_BUFFER ) yy_fatal_error( "yyset_column called with no buffer" , yyscanner); yycolumn = column_no; } /** Set the input stream. This does not discard the current * input buffer. * @param in_str A readable stream. * @param yyscanner The scanner object. * @see yy_switch_to_buffer */ void yyset_in (FILE * in_str , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyin = in_str ; } void yyset_out (FILE * out_str , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yyout = out_str ; } int yyget_debug (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; return yy_flex_debug; } void yyset_debug (int bdebug , yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; yy_flex_debug = bdebug ; } /* Accessor methods for yylval and yylloc */ /* User-visible API */ /* yylex_init is special because it creates the scanner itself, so it is * the ONLY reentrant function that doesn't take the scanner as the last argument. * That's why we explicitly handle the declaration, instead of using our macros. */ int yylex_init(yyscan_t* ptr_yy_globals) { if (ptr_yy_globals == NULL){ errno = EINVAL; return 1; } *ptr_yy_globals = (yyscan_t) yyalloc ( sizeof( struct yyguts_t ), NULL ); if (*ptr_yy_globals == NULL){ errno = ENOMEM; return 1; } /* By setting to 0xAA, we expose bugs in yy_init_globals. Leave at 0x00 for releases. */ memset(*ptr_yy_globals,0x00,sizeof(struct yyguts_t)); return yy_init_globals ( *ptr_yy_globals ); } /* yylex_init_extra has the same functionality as yylex_init, but follows the * convention of taking the scanner as the last argument. Note however, that * this is a *pointer* to a scanner, as it will be allocated by this call (and * is the reason, too, why this function also must handle its own declaration). * The user defined value in the first argument will be available to yyalloc in * the yyextra field. */ int yylex_init_extra(YY_EXTRA_TYPE yy_user_defined,yyscan_t* ptr_yy_globals ) { struct yyguts_t dummy_yyguts; yyset_extra (yy_user_defined, &dummy_yyguts); if (ptr_yy_globals == NULL){ errno = EINVAL; return 1; } *ptr_yy_globals = (yyscan_t) yyalloc ( sizeof( struct yyguts_t ), &dummy_yyguts ); if (*ptr_yy_globals == NULL){ errno = ENOMEM; return 1; } /* By setting to 0xAA, we expose bugs in yy_init_globals. Leave at 0x00 for releases. */ memset(*ptr_yy_globals,0x00,sizeof(struct yyguts_t)); yyset_extra (yy_user_defined, *ptr_yy_globals); return yy_init_globals ( *ptr_yy_globals ); } static int yy_init_globals (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* Initialization is the same as for the non-reentrant scanner. * This function is called from yylex_destroy(), so don't allocate here. */ yyg->yy_buffer_stack = 0; yyg->yy_buffer_stack_top = 0; yyg->yy_buffer_stack_max = 0; yyg->yy_c_buf_p = (char *) 0; yyg->yy_init = 0; yyg->yy_start = 0; yyg->yy_start_stack_ptr = 0; yyg->yy_start_stack_depth = 0; yyg->yy_start_stack = NULL; /* Defined in main.c */ #ifdef YY_STDINIT yyin = stdin; yyout = stdout; #else yyin = (FILE *) 0; yyout = (FILE *) 0; #endif /* For future reference: Set errno on error, since we are called by * yylex_init() */ return 0; } /* yylex_destroy is for both reentrant and non-reentrant scanners. */ int yylex_destroy (yyscan_t yyscanner) { struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* Pop the buffer stack, destroying each element. */ while(YY_CURRENT_BUFFER){ yy_delete_buffer(YY_CURRENT_BUFFER ,yyscanner ); YY_CURRENT_BUFFER_LVALUE = NULL; yypop_buffer_state(yyscanner); } /* Destroy the stack itself. */ yyfree(yyg->yy_buffer_stack ,yyscanner); yyg->yy_buffer_stack = NULL; /* Destroy the start condition stack. */ yyfree(yyg->yy_start_stack ,yyscanner ); yyg->yy_start_stack = NULL; /* Reset the globals. This is important in a non-reentrant scanner so the next time * yylex() is called, initialization will occur. */ yy_init_globals( yyscanner); /* Destroy the main struct (reentrant only). */ yyfree ( yyscanner , yyscanner ); yyscanner = NULL; return 0; } /* * Internal utility routines. */ #ifndef yytext_ptr static void yy_flex_strncpy (char* s1, yyconst char * s2, int n , yyscan_t yyscanner) { register int i; for ( i = 0; i < n; ++i ) s1[i] = s2[i]; } #endif #ifdef YY_NEED_STRLEN static int yy_flex_strlen (yyconst char * s , yyscan_t yyscanner) { register int n; for ( n = 0; s[n]; ++n ) ; return n; } #endif void *yyalloc (yy_size_t size , yyscan_t yyscanner) { return (void *) malloc( size ); } void *yyrealloc (void * ptr, yy_size_t size , yyscan_t yyscanner) { /* The cast to (char *) in the following accommodates both * implementations that use char* generic pointers, and those * that use void* generic pointers. It works with the latter * because both ANSI C and C++ allow castless assignment from * any pointer type to void*, and deal with argument conversions * as though doing an assignment. */ return (void *) realloc( (char *) ptr, size ); } void yyfree (void * ptr , yyscan_t yyscanner) { free( (char *) ptr ); /* see yyrealloc() for (char *) cast */ } #define YYTABLES_NAME "yytables" #line 703 "compilers/imcc/imcc.l" #ifdef yywrap # undef yywrap #endif int yywrap(void* yyscanner) { /* Add code here to open next source file and start scanning * yywrap returns 0 if scanning is to continue */ imc_info_t * imcc = yyget_extra(yyscanner); yyguts_t * const yyg = (yyguts_t *)yyscanner; if (!imcc->interp) { fprintf(stderr, "Argh, interp not found\n"); exit(1); } yy_delete_buffer(YY_CURRENT_BUFFER,yyscanner); /* pop old frame */ if (imcc->frames->s.next) { pop_parser_state(imcc, yyscanner); if (YYSTATE == INITIAL || YYSTATE == emit) BEGIN(imcc->frames->s.pasm_file ? emit : INITIAL); return 0; } return 1; } static macro_frame_t * new_frame(ARGMOD(imc_info_t *imcc)) { macro_frame_t * const tmp = mem_gc_allocate_zeroed_typed(imcc->interp, macro_frame_t); tmp->label = imcc->unique_count; imcc->unique_count++; tmp->s.line = imcc->line; tmp->s.handle = PIO_INVALID_HANDLE; if (imcc->frames) { tmp->s.pasm_file = imcc->frames->s.pasm_file; if (imcc->frames->s.file) tmp->s.file = imcc->frames->s.file; } tmp->s.interp = imcc->interp; return tmp; } static void scan_string(macro_frame_t *frame, ARGIN(const char *expansion), void *yyscanner) { yyguts_t * const yyg = (yyguts_t *)yyscanner; imc_info_t * imcc = yyget_extra(yyscanner); frame->buffer = YY_CURRENT_BUFFER; frame->s.next = (parser_state_t *)imcc->frames; imcc->frames = frame; /* start at the effective *starting line* of the macro */ imcc->line = frame->s.line - 2; yy_scan_string(expansion,yyscanner); } static int destroy_frame(struct macro_frame_t *frame, void *yyscanner) { YY_BUFFER_STATE buffer = frame->buffer; int ret = 0; int i; for (i = 0; i < frame->expansion.num_param; i++) { mem_sys_free(frame->expansion.name[i]); frame->expansion.name[i] = NULL; } if (frame->heredoc_rest) { mem_sys_free(frame->heredoc_rest); frame->heredoc_rest = NULL; } else { ret = frame->s.line; } mem_sys_free(frame); if (buffer != NULL) yy_switch_to_buffer(buffer,yyscanner); return ret; } static int yylex_skip(YYSTYPE *valp, ARGMOD(imc_info_t *imcc), const char *skip, void *yyscanner) { int c; const char *p; yyguts_t * const yyg = (yyguts_t *)yyscanner; do { c = yylex(valp,yyscanner,imcc); p = skip; while (*p && c != *p) p++; /* leave loop early if it gets found */ if (*p == '\0') break; /* free any mem_sys_strdup()ed strings */ if (yytext) mem_sys_free(valp->s); } while (*p != '\0'); if (c) DUP_AND_RET_FREE(valp, c); return c; } static char* read_braced(YYSTYPE *valp, ARGMOD(imc_info_t *imcc), const char *macro_name, char *current, void *yyscanner) { YYSTYPE val; size_t len = strlen(current); int c = yylex(&val,yyscanner,imcc); int count = 0; while (c != '}' || count > 0) { if (c == '}') count--; else if (c == '{') count++; if (c <= 0) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "End of file reached while reading arguments in '%s'", macro_name); len += strlen(val.s); current = (char *)mem_sys_realloc(current, len + 1); strcat(current,val.s); mem_sys_free(val.s); val.s = NULL; c = yylex(&val,yyscanner,imcc); } if (valp) { if (valp->s) mem_sys_free(valp->s); *valp = val; } else mem_sys_free(val.s); return current; } static int read_params(YYSTYPE *valp, ARGMOD(imc_info_t *imcc), params_t *params, ARGIN(const char *macro_name), int need_id, void *yyscanner) { YYSTYPE val; size_t len = 0; char *current = mem_sys_strndup("", 0); yyguts_t *yyg = (yyguts_t *)yyscanner; int c = yylex_skip(&val, imcc, " \n", yyscanner); params->num_param = 0; while (c != ')') { if (YYSTATE == heredoc2) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Heredoc in macro '%s' not allowed", macro_name); if (c <= 0) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "End of file reached while reading arguments in '%s'", macro_name); else if (c == ',') { if (params->num_param == MAX_PARAM) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "More than %d params in '%s'", MAX_PARAM, macro_name); params->name[params->num_param++] = current; current = mem_sys_strndup("", 0); len = 0; if (val.s) mem_sys_free(val.s); c = yylex_skip(&val, imcc, " \n", yyscanner); } else if (need_id && (*current || c != IDENTIFIER) && c != ' ') { IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Parameter definition in '%s' must be IDENTIFIER", macro_name); } else if (c == '{') { current = read_braced(&val, imcc, macro_name, current, yyscanner); mem_sys_free(val.s); c = yylex_skip(&val, imcc, " \n", yyscanner); len = strlen(current); } else { if (!need_id || c != ' ') { len += strlen(val.s); current = (char *)mem_sys_realloc(current, len + 1); strcat(current, val.s); } mem_sys_free(val.s); val.s = NULL; c = yylex(&val,yyscanner,imcc); } } params->name[params->num_param++] = current; if (valp) *valp = val; else mem_sys_free(val.s); return c; } static int read_macro(YYSTYPE *valp, ARGMOD(imc_info_t *imcc), void *yyscanner) { int c, start_line; params_t params; yyguts_t * const yyg = (yyguts_t *)yyscanner; int start_cond = YY_START; size_t buffer_size = 0; size_t buffer_used = 0; BEGIN(macro); c = yylex_skip(valp, imcc, " ", yyscanner); if (c != IDENTIFIER) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Macro names must be identifiers"); imcc->cur_macro_name = valp->s; start_line = imcc->line; memset(¶ms, 0, sizeof (params_t)); /* white space is allowed between macro and opening paren) */ c = yylex_skip(valp, imcc, " ", yyscanner); if (c == '(') { mem_sys_free(valp->s); valp->s = NULL; c = read_params(NULL, imcc, ¶ms, imcc->cur_macro_name, 1, yyscanner); c = yylex(valp,yyscanner,imcc); } while (c != ENDM) { int elem_len; if (c <= 0) { mem_sys_free(valp->s); IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "File ended before macro '%s' was complete", imcc->cur_macro_name); } if (valp->s) { elem_len = strlen(valp->s); if (buffer_used) { if (buffer_used + elem_len > buffer_size) { buffer_size += elem_len; buffer_size <<= 1; imcc->macro_buffer = (char *)mem_sys_realloc(imcc->macro_buffer, buffer_size); } } else { buffer_size = (elem_len << 1) > 1024 ? elem_len << 1 : 1024; imcc->macro_buffer = (char *)mem_sys_allocate_zeroed(buffer_size); } strcat(imcc->macro_buffer, valp->s); buffer_used += elem_len; mem_sys_free(valp->s); valp->s = NULL; } c = yylex(valp,yyscanner,imcc); } mem_sys_free(valp->s); valp->s = NULL; BEGIN(start_cond); define_macro(imcc, imcc->cur_macro_name, ¶ms, imcc->macro_buffer, start_line); mem_sys_free(imcc->macro_buffer); imcc->macro_buffer = NULL; imcc->cur_macro_name = NULL; return MACRO; } static char * find_macro_param(ARGMOD(imc_info_t *imcc), const char *name) { macro_frame_t *f; for (f = imcc->frames; f; f = (macro_frame_t *)f->s.next) { if (f->params) { int i; for (i = 0; i < f->params->num_param; i++) { if (STREQ(f->params->name[i], name)) return f->expansion.name[i]; } } } return NULL; } static void define_macro(ARGMOD(imc_info_t *imcc), ARGIN(const char *name), ARGIN(const params_t *params), ARGIN(const char *expansion), int start_line) { DECL_CONST_CAST; macro_t *m = find_macro(imcc, name); if (m) { mem_sys_free(m->expansion); m->expansion = NULL; } else { m = mem_gc_allocate_zeroed_typed(imcc->interp, macro_t); if (!imcc->macros) imcc->macros = Parrot_hash_new_cstring_hash(imcc->interp); Parrot_hash_put(imcc->interp, imcc->macros, PARROT_const_cast(char *, name), m); } if (params) m->params = *params; else memset(&m->params, 0, sizeof (params_t)); m->expansion = mem_sys_strdup(expansion); m->line = start_line; } static macro_t * find_macro(ARGMOD(imc_info_t *imcc), const char *name) { if (!imcc->macros) return NULL; return (macro_t *)Parrot_hash_get(imcc->interp, imcc->macros, name); } static int expand_macro(ARGMOD(imc_info_t *imcc), ARGIN(const char *name), void *yyscanner) { yyguts_t * const yyg = (yyguts_t *)yyscanner; const char * const expansion = find_macro_param(imcc, name); macro_t *m; if (expansion) { macro_frame_t * const frame = new_frame(imcc); /* When an error occurs, then report it as being in a macro */ frame->is_macro = 1; scan_string(frame, expansion, yyscanner); return 1; } m = find_macro(imcc, name); if (m) { int i, c, start_cond; macro_frame_t * frame = new_frame(imcc); frame->params = &m->params; /* When an error occurs, then report it as being in a macro */ frame->is_macro = 1; frame->s.file = Parrot_str_new(imcc->interp, name, 0); /* whitespace can be safely ignored */ do { #ifdef __cplusplus c = yyinput(yyscanner); #else c = input(yyscanner); #endif } while (c == ' ' || c == '\t'); if (c != '(') { if (m->params.num_param != 0) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Macro '%s' needs %d arguments", name, m->params.num_param); unput(c); scan_string(frame, m->expansion, yyscanner); return 1; } start_cond = YY_START; BEGIN(macro); read_params(NULL, imcc, &frame->expansion, name, 0, yyscanner); BEGIN(start_cond); if (frame->expansion.num_param == 0 && m->params.num_param == 1) { frame->expansion.name[0] = mem_sys_strndup("", 0); frame->expansion.num_param = 1; } if (frame->expansion.num_param != m->params.num_param) { IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Macro '%s' requires %d arguments, but %d given", name, m->params.num_param, frame->expansion.num_param); } /* expand arguments */ for (i = 0; i < frame->expansion.num_param; i++) { char * const current = frame->expansion.name[i]; /* parameter of outer macro */ if (current[0] == '.') { const char * const s = find_macro_param(imcc, current + 1); if (s) { frame->expansion.name[i] = mem_sys_strdup(s); mem_sys_free(current); } } else { const size_t len = strlen(current); if (len && (current[len - 1] == '$')) { /* local label */ const size_t slen = len + 10; char * const s = (char *)mem_sys_allocate(slen); current[len - 1] = '\0'; snprintf(s, slen, "%s%d", current, imcc->frames->label); frame->expansion.name[i] = s; mem_sys_free(current); } } } scan_string(frame, m->expansion, yyscanner); return 1; } return 0; } static void include_file(ARGMOD(imc_info_t *imcc), ARGIN(STRING *file_name), void *yyscanner) { yyguts_t * const yyg = (yyguts_t *)yyscanner; macro_frame_t * const frame = new_frame(imcc); STRING *s = Parrot_locate_runtime_file_str(imcc->interp, file_name, PARROT_RUNTIME_FT_INCLUDE); char *ext; PIOHANDLE file; if (STRING_IS_NULL(s) || (file = Parrot_io_internal_open(imcc->interp, s, PIO_F_READ)) == PIO_INVALID_HANDLE) { IMCC_fataly(imcc, EXCEPTION_EXTERNAL_ERROR, "No such file or directory '%Ss'", file_name); } frame->s.file = file_name; frame->s.handle = file; /* TODO: We do checks like this elsewhere. Create a utility function to check file type */ if (imcc_string_ends_with(imcc, file_name, ".pasm")) { frame->s.pasm_file = 1; BEGIN(emit); } else if (imcc_string_ends_with(imcc, file_name, ".pir")) { frame->s.pasm_file = 0; BEGIN(INITIAL); } scan_file(imcc, frame, file, yyscanner); } static void scan_file(ARGMOD(imc_info_t *imcc), macro_frame_t *frame, PIOHANDLE file, void *yyscanner) { yyguts_t * const yyg = (yyguts_t *)yyscanner; const int oldline = imcc->line; frame->buffer = YY_CURRENT_BUFFER; frame->s.next = (parser_state_t *)imcc->frames; imcc->frames = frame; imcc->state = (parser_state_t *)imcc->frames; /* let the start of line rule increment this to 1 */ imcc->line = 0; yy_switch_to_buffer(yy_create_buffer((FILE *)file,YY_BUF_SIZE,yyscanner),yyscanner); imcc->line = oldline; } void IMCC_push_parser_state(ARGMOD(imc_info_t *imcc), STRING *filename, int is_file, int is_pasm) { macro_frame_t * const frame = new_frame(imcc); frame->s.next = (parser_state_t *)imcc->frames; imcc->frames = frame; frame->s.line = imcc->line = 1; imcc->state = (parser_state_t *)imcc->frames; if (is_file) imcc->state->file = filename; else imcc->state->file = Parrot_str_new_constant(imcc->interp, "(file unknown)"); imcc->state->pasm_file = is_pasm; } static void pop_parser_state(ARGMOD(imc_info_t *imcc), void *yyscanner) { macro_frame_t * const tmp = imcc->frames; if (tmp) { int l; if (tmp->s.handle != PIO_INVALID_HANDLE) Parrot_io_internal_close(imcc->interp, tmp->s.handle); imcc->frames = (macro_frame_t *)imcc->frames->s.next; l = destroy_frame(tmp, yyscanner); if (l) imcc->line = l; } imcc->state = (parser_state_t *)imcc->frames; } void IMCC_pop_parser_state(ARGMOD(imc_info_t *imcc), void *yyscanner) { pop_parser_state(imcc, yyscanner); } PIOHANDLE determine_input_file_type(ARGMOD(imc_info_t * imcc), ARGIN(STRING *sourcefile)) { PIOHANDLE handle; if (!STRING_length(sourcefile)) IMCC_fatal_standalone(imcc, 1, "main: No source file specified.\n"); if (STRING_length(sourcefile) == 1 && STRING_ord(imcc->interp, sourcefile, 0) == '-') { handle = Parrot_io_internal_std_os_handle(imcc->interp, PIO_STDIN_FILENO); if ((FILE *)handle == NULL) { /* * We have to dup the handle because the stdin fd is 0 on UNIX and * lex would think it's a NULL FILE pointer and reset it to the * stdin FILE pointer. */ handle = Parrot_io_internal_dup(imcc->interp, handle); } } else { if (Parrot_file_stat_intval(imcc->interp, sourcefile, STAT_ISDIR)) Parrot_ex_throw_from_c_args(imcc->interp, NULL, EXCEPTION_EXTERNAL_ERROR, "imcc_compile_file: '%Ss' is a directory\n", sourcefile); handle = Parrot_io_internal_open(imcc->interp, sourcefile, PIO_F_READ); if (handle == PIO_INVALID_HANDLE) IMCC_fatal_standalone(imcc, EXCEPTION_EXTERNAL_ERROR, "Error reading source file %Ss.\n", sourcefile); if (imcc_string_ends_with(imcc, sourcefile, ".pasm")) SET_STATE_PASM_FILE(imcc); } if (imcc->verbose) { IMCC_info(imcc, 1, "debug = 0x%x\n", imcc->debug); IMCC_info(imcc, 1, "Reading %Ss\n", sourcefile); } return handle; } static PIOHANDLE imcc_setup_input(ARGMOD(imc_info_t * imcc), yyscan_t yyscanner, ARGIN(STRING *source), ARGIN(const char *source_c), int is_file) { if (is_file) { PIOHANDLE file = determine_input_file_type(imcc, source); imc_yyin_set(file, yyscanner); yy_switch_to_buffer(yy_create_buffer((FILE *)file,YY_BUF_SIZE,yyscanner),yyscanner); return file; } else { yy_scan_string(source_c,yyscanner); return PIO_INVALID_HANDLE; } } static void imcc_cleanup_input(ARGMOD(imc_info_t * imcc), PIOHANDLE file, ARGIN(char *source_c), int is_file) { if (is_file) Parrot_io_internal_close(imcc->interp, file); Parrot_str_free_cstring(source_c); } INTVAL imcc_compile_buffer_safe(ARGMOD(imc_info_t *imcc), yyscan_t yyscanner, ARGIN(STRING *source), int is_file, SHIM(int is_pasm)) { yyguts_t * const yyg = (yyguts_t *)yyscanner; YY_BUFFER_STATE volatile buffer; char * source_c = Parrot_str_to_cstring(imcc->interp, source); PIOHANDLE file; INTVAL success = 0; imcc->frames->s.next = NULL; buffer = YY_CURRENT_BUFFER; file = imcc_setup_input(imcc, yyscanner, source, source_c, is_file); emit_open(imcc); success = imcc_run_compilation(imcc, yyscanner); imcc_cleanup_input(imcc, file, source_c, is_file); if (buffer) yy_switch_to_buffer(buffer,yyscanner); return success; } static void do_a_better_error_message(imc_info_t * imcc, SHIM(void * yyscanner)) { STRING * loc; imcc->error_code = IMCC_PARSEFAIL_EXCEPTION; if (imcc->frames && imcc->frames->is_macro) loc = Parrot_sprintf_c(imcc->interp, "in macro '.%Ss' line %d", imcc->frames->s.file, imcc->line); else loc = Parrot_sprintf_c(imcc->interp, "in file '%Ss' line %d", imcc->frames->s.file, imcc->line); imcc->error_message = Parrot_sprintf_c(imcc->interp, "Unexpected parser exit. Unknown syntax error.\n" "\tLast line reported is %d\n" "\tLast file reported is %S", imcc->line, loc); } INTVAL imcc_run_compilation(ARGMOD(imc_info_t *imcc), void *yyscanner) { /* TODO: Kill this stuff and use Parrot exceptions exclusively */ IMCC_TRY(imcc->jump_buf, imcc->error_code) { if (yyparse(yyscanner, imcc)) { imcc->error_code = IMCC_PARSEFAIL_EXCEPTION; return 0; } imc_compile_all_units(imcc); return 1; } IMCC_CATCH(IMCC_FATAL_EXCEPTION) { imcc->error_code = IMCC_FATAL_EXCEPTION; } IMCC_CATCH(IMCC_FATALY_EXCEPTION) { imcc->error_code = IMCC_FATALY_EXCEPTION; } IMCC_END_TRY; return 0; } void IMCC_print_inc(ARGMOD(imc_info_t *imcc)) { macro_frame_t *f; STRING *old = imcc->frames->s.file; if (imcc->frames && imcc->frames->is_macro) IMCC_warning(imcc, "\n\tin macro '.%Ss' line %d\n", imcc->frames->s.file, imcc->line); else IMCC_warning(imcc, "\n\tin file '%Ss' line %d\n", imcc->frames->s.file, imcc->line); for (f = imcc->frames; f; f = (macro_frame_t *)f->s.next) { if (!STRING_equal(imcc->interp, f->s.file, old)) { IMCC_warning(imcc, "\tincluded from '%Ss' line %d\n", f->s.file, f->s.line); } old = f->s.file; } } /* void set_filename(ARGMOD(imc_info_t *imcc), char * const filename) Function to set the C as specified using the C<.line> directive. The parser needs to call back into the lexer (this file), because the parser does not have access to the lexer's private bits. */ void set_filename(ARGMOD(imc_info_t *imcc), char * const filename) { STRING *str = Parrot_str_new(imcc->interp, filename, 0); imcc->frames->s.file = str; /* in case .line is used outside a .sub, then this * can't be done; hence the check. * The mem_sys_strdup() is done, as the original #line implementation * duplicated the string twice as well; one for the * frames->s.file and one for cur_unit->file. * During the parse, the STRINGC is already mem_sys_strdup()ed once. */ if (imcc->cur_unit) imcc->cur_unit->file = str; } /* Functions to set and get yyin, as we can't decorate it for export (since it is defined in a file generated by yacc/bison). */ void imc_yyin_set(PIOHANDLE new_yyin, void *yyscanner) { yyguts_t * const yyg = (yyguts_t *)yyscanner; yyg->yyin_r = (FILE *)new_yyin; } PIOHANDLE imc_yyin_get(void *yyscanner) { const yyguts_t * const yyg = (yyguts_t *)yyscanner; return (PIOHANDLE)yyg->yyin_r; } /* return true if scanner is at EOF */ int at_eof(yyscan_t yyscanner) { yyguts_t * const yyg = (yyguts_t *)yyscanner; return yyg->yy_hold_char == '\0'; } static int handle_identifier(ARGMOD(imc_info_t *imcc), YYSTYPE *valp, const char *text) { if (!imcc->is_def) { SymReg *r = find_sym(imcc, text); if (r && (r->type & (VTIDENTIFIER|VT_CONSTP))) { valp->sr = r; return VAR; } if (imcc->cur_unit && imcc->cur_unit->instructions && (r = imcc->cur_unit->instructions->symregs[0]) && r->pcc_sub) { if (((r->pcc_sub->pragma & P_METHOD) || (imcc->cur_unit->is_vtable_method)) && !strcmp(text, "self")) { valp->sr = mk_ident(imcc, "self", 'P', VTIDENTIFIER); imcc->cur_unit->type |= IMC_HAS_SELF; return VAR; } } } valp->s = mem_sys_strdup(text); return (!imcc->is_def && is_op(imcc, valp->s) ? PARROT_OP : IDENTIFIER); } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ Makefile000644000765000765 45011533177635 17121 0ustar00brucebruce000000000000parrot-5.9.0/examples/tools# # Copyright (C) 2009, Parrot Foundation. # # Makefile for pbc_checker CXX= g++ CXXFLAGS = -Wall -Wextra LD = g++ pbc_checker: pbc_checker.o $(LD) -o pbc_checker pbc_checker.o pbc_checker.o: pbc_checker.cpp $(CXX) $(CXXFLAGS) -c pbc_checker.cpp clean: rm -f pbc_checker rm -f *.o # End coroutine.pasm000644000765000765 171611567202623 20205 0ustar00brucebruce000000000000parrot-5.9.0/examples/subs# Copyright (C) 2001-2005, Parrot Foundation. =head1 NAME examples/pasm/coroutine.pasm - Sample co-routines in Parrot =head1 SYNOPSIS % ./parrot examples/pasm/coroutine.pasm =head1 DESCRIPTION This shows you how to create two coroutines and C them. =head1 SEE ALSO F F =cut .pcc_sub :main main: # create a coro and save it on the user stack .const 'Sub' P0 = "MYCOROUTINE" # a coroutine carries state - clone it clone P0, P0 # create a second coro clone P1, P0 # Calling convention says P0 will contain the sub so.. print "Calling 1st co-routine\n" invokecc P0 invokecc P0 invokecc P0 print "Calling 2nd co-routine\n" invokecc P1 invokecc P1 invokecc P1 end # A coroutine .pcc_sub MYCOROUTINE: print "Entry\n" yield print "Resumed\n" yield print "Done\n" yield # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: DefaultTests.pm000644000765000765 456111656271050 21107 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/Harness# Copyright (C) 2006-2011, Parrot Foundation. =head1 NAME Parrot::Harness::DefaultTests - Tests run by default by F =head1 DESCRIPTION Upon request, this package exports four arrays holding glob patterns for directories holding test files: @runcore_tests @core_tests @library_tests @configure_tests The package also exports one array holding a list of test files: @developing_tests The definition of these lists is found in F. In addition, Parrot::Harness::DefaultTests exports B one subroutine: C. In list context, C returns a list of shell-expandable paths to the most common tests. In scalar context it returns a reference to that list. =cut package Parrot::Harness::DefaultTests; use strict; use warnings; our ( @runcore_tests, @core_tests, @library_tests, @configure_tests, @developing_tests ); use base qw( Exporter ); our @EXPORT = qw( get_common_tests ); our @EXPORT_OK = qw( @runcore_tests @core_tests @library_tests @configure_tests @developing_tests ); use lib qw( ./lib ); use Parrot::Harness::TestSets qw( %test_groups @major_test_group @near_core_test_group ); # runcore tests are always run. @runcore_tests = @{ $test_groups{runcore} }; # core tests are run unless --runcore-tests is present. Typically # this list and the list above are run in response to --core-tests foreach my $el (@near_core_test_group) { push @core_tests, @{$el}; } # library tests are run unless --runcore-tests or --core-tests is present. foreach my $el (@major_test_group) { push @library_tests, @{$el}; } # configure tests are tests to be run at the beginning of 'make test'; @configure_tests = @{ $test_groups{configure} }; @developing_tests = glob("@{ $test_groups{codingstd} }"); sub get_common_tests { my ($longopts) = @_; my @common_tests = @runcore_tests; unless ($longopts->{runcore_tests_only}) { push @common_tests, @core_tests; unless ($longopts->{core_tests_only}) { push @common_tests, @library_tests; unshift @common_tests, @configure_tests; } } wantarray ? return @common_tests : return [ @common_tests ]; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: fixedbooleanarray.pmc000644000765000765 3251212171255037 20304 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME src/pmc/fixedbooleanarray.pmc - fixed size array for booleans only =head1 DESCRIPTION The C PMC implements an array of fixed size, which stores booleans. It uses the C PMC for all conversions. The C PMC is extended by the C PMC. =head2 Functions =over 4 =item C Auxiliar function to avoid repeating the size evaluation. =cut */ #define BITS_PER_CHAR 8 /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_INLINE PARROT_CONST_FUNCTION static UINTVAL get_size_in_bytes(UINTVAL size); #define ASSERT_ARGS_get_size_in_bytes __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ PARROT_INLINE PARROT_CONST_FUNCTION static UINTVAL get_size_in_bytes(UINTVAL size) { ASSERT_ARGS(get_size_in_bytes) return (size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; } pmclass FixedBooleanArray auto_attrs provides array { ATTR UINTVAL size; /* # of bits this fba holds */ ATTR UINTVAL resize_threshold; /* max capacity before resizing */ ATTR unsigned char * bit_array; /* where the bits go */ /* =back =head2 Vtable functions =over 4 =item C Initializes the array. =cut */ VTABLE void init() { UNUSED(INTERP) PObj_custom_destroy_SET(SELF); } /* =item C Initializes the array. =cut */ VTABLE void init_int(INTVAL size) { const size_t size_in_bytes = get_size_in_bytes(size); if (size < 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, _("FixedBooleanArray: Cannot set array size to a negative number (%d)"), size); SET_ATTR_size(INTERP, SELF, size); SET_ATTR_resize_threshold(INTERP, SELF, size_in_bytes * BITS_PER_CHAR); SET_ATTR_bit_array(INTERP, SELF, mem_gc_allocate_n_zeroed_typed(INTERP, size_in_bytes, unsigned char)); PObj_custom_destroy_SET(SELF); } /* =item C Destroys the array. =cut */ VTABLE void destroy() { unsigned char *bit_array; GET_ATTR_bit_array(INTERP, SELF, bit_array); if (bit_array) mem_gc_free(INTERP, bit_array); } /* =item C Creates and returns a copy of the array. =cut */ VTABLE PMC *clone() { unsigned char * my_bit_array; UINTVAL resize_threshold, size; PMC * const dest = Parrot_pmc_new(INTERP, SELF->vtable->base_type); GET_ATTR_bit_array(INTERP, SELF, my_bit_array); GET_ATTR_size(INTERP, SELF, size); GET_ATTR_resize_threshold(INTERP, SELF, resize_threshold); if (my_bit_array) { unsigned char * clone_bit_array; const size_t size_in_bytes = get_size_in_bytes(resize_threshold); SET_ATTR_size(INTERP, dest, size); SET_ATTR_resize_threshold(INTERP, dest, resize_threshold); clone_bit_array = mem_gc_allocate_n_typed(INTERP, size_in_bytes, unsigned char); memcpy(clone_bit_array, my_bit_array, size_in_bytes); SET_ATTR_bit_array(INTERP, dest, clone_bit_array); } PObj_custom_destroy_SET(dest); return dest; } /* =item C Returns whether the array has any elements (meaning been initialized, for a fixed sized array). =cut */ VTABLE INTVAL get_bool() { return SELF.elements() ? 1 : 0; } /* =item C =cut */ VTABLE INTVAL elements() { UINTVAL size; GET_ATTR_size(INTERP, SELF, size); return size; } /* =item C Returns the number of elements in the array. =cut */ VTABLE INTVAL get_integer() { return SELF.elements(); } /* =item C Returns the integer value of the element at index C. =cut */ VTABLE INTVAL get_integer_keyed_int(INTVAL key) { UINTVAL size; const unsigned char * bit_array; GET_ATTR_bit_array(INTERP, SELF, bit_array); GET_ATTR_size(INTERP, SELF, size); if (key < 0 || (UINTVAL)key >= size) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "FixedBooleanArray: index out of bounds!"); return (bit_array[key / BITS_PER_CHAR] & (1 << (key % BITS_PER_CHAR))) ? 1 : 0; } /* =item C Returns the integer value of the element at index C<*key>. =cut */ VTABLE INTVAL get_integer_keyed(PMC *key) { /* simple int keys only */ const INTVAL k = VTABLE_get_integer(INTERP, key); return SELF.get_integer_keyed_int(k); } /* =item C Returns the floating-point value of the element at index C. =cut */ VTABLE FLOATVAL get_number_keyed_int(INTVAL key) { const INTVAL i = SELF.get_integer_keyed_int(key); return (FLOATVAL)i; } /* =item C Returns the floating-point value of the element at index C<*key>. =cut */ VTABLE FLOATVAL get_number_keyed(PMC *key) { const INTVAL k = VTABLE_get_integer(INTERP, key); return SELF.get_number_keyed_int(k); } /* =item C Returns the Parrot string representation of the array. =cut */ VTABLE STRING *get_string() { STRING *str = STRINGNULL; UINTVAL i; const UINTVAL elems = SELF.elements(); const STRING * const zero = CONST_STRING(INTERP, "0"); const STRING * const one = CONST_STRING(INTERP, "1"); for (i = 0; i < elems; ++i) { str = Parrot_str_concat(INTERP, str, SELF.get_integer_keyed_int((INTVAL)i) ? one : zero); } return str; } /* =item C Returns the Parrot string value of the element at index C. =cut */ VTABLE STRING *get_string_keyed_int(INTVAL key) { PMC * const val = SELF.get_pmc_keyed_int(key); return VTABLE_get_string(INTERP, val); } /* =item C Returns the Parrot string value of the element at index C<*key>. =cut */ VTABLE STRING *get_string_keyed(PMC *key) { const INTVAL k = VTABLE_get_integer(INTERP, key); return SELF.get_string_keyed_int(k); } /* =item C Returns the PMC value of the element at index C. =cut */ VTABLE PMC *get_pmc_keyed_int(INTVAL key) { return Parrot_pmc_new_init_int(INTERP, enum_class_Boolean, SELF.get_integer_keyed_int(key)); } /* =item C Returns the PMC value of the element at index C<*key>. =cut */ VTABLE PMC *get_pmc_keyed(PMC *key) { const INTVAL k = VTABLE_get_integer(INTERP, key); return SELF.get_pmc_keyed_int(k); } /* =item C Resizes the array to C elements. =cut */ VTABLE void set_integer_native(INTVAL size) { const size_t size_in_bytes = get_size_in_bytes(size); UINTVAL old_size; unsigned char *bit_array; GET_ATTR_size(INTERP, SELF, old_size); if (old_size || size < 1) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "FixedBooleanArray: Can't resize!"); SET_ATTR_size(INTERP, SELF, size); SET_ATTR_resize_threshold(INTERP, SELF, size_in_bytes * BITS_PER_CHAR); bit_array = mem_gc_allocate_n_typed(INTERP, size_in_bytes, unsigned char); memset(bit_array, 0, size_in_bytes); SET_ATTR_bit_array(INTERP, SELF, bit_array); } /* =item C Sets the integer value of the element at index C to C. =cut */ VTABLE void set_integer_keyed_int(INTVAL key, INTVAL value) { UINTVAL size; unsigned char * bit_array; GET_ATTR_bit_array(INTERP, SELF, bit_array); GET_ATTR_size(INTERP, SELF, size); if (key < 0 || (UINTVAL)key >= size) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "FixedBooleanArray: index out of bounds!"); if (value) bit_array[key/BITS_PER_CHAR] |= (1 << (key % BITS_PER_CHAR)); else bit_array[key/BITS_PER_CHAR] &= ~(1 << (key % BITS_PER_CHAR)); } /* =item C Sets the integer value of the element at index C to C. =cut */ VTABLE void set_integer_keyed(PMC *key, INTVAL value) { const INTVAL k = VTABLE_get_integer(INTERP, key); SELF.set_integer_keyed_int(k, value); } /* =item C Sets the floating-point value of the element at index C to C. =cut */ VTABLE void set_number_keyed_int(INTVAL key, FLOATVAL value) { SELF.set_integer_keyed_int(key, !FLOAT_IS_ZERO(value)); } /* =item C Sets the floating-point value of the element at index C to C. =cut */ VTABLE void set_number_keyed(PMC *key, FLOATVAL value) { const INTVAL k = VTABLE_get_integer(INTERP, key); SELF.set_number_keyed_int(k, value); } /* =item C Sets the Parrot string value of the element at index C to C. =cut */ VTABLE void set_string_keyed_int(INTVAL key, STRING *value) { INTVAL tempInt; PMC * const tempPMC = Parrot_pmc_new(INTERP, enum_class_Boolean); VTABLE_set_string_native(INTERP, tempPMC, value); tempInt = VTABLE_get_integer(INTERP, tempPMC); SELF.set_integer_keyed_int(key, tempInt); } /* =item C Sets the string value of the element at index C to C. =cut */ VTABLE void set_string_keyed(PMC *key, STRING *value) { const INTVAL k = VTABLE_get_integer(INTERP, key); SELF.set_string_keyed_int(k, value); } /* =item C Sets the PMC value of the element at index C to C<*src>. =cut */ VTABLE void set_pmc_keyed_int(INTVAL key, PMC *src) { const INTVAL tempInt = VTABLE_get_integer(INTERP, src); SELF.set_integer_keyed_int(key, tempInt); } /* =item C Sets the string value of the element at index C to C. =cut */ VTABLE void set_pmc_keyed(PMC *key, PMC *value) { const INTVAL k = VTABLE_get_integer(INTERP, key); SELF.set_pmc_keyed_int(k, value); } /* =item C Return a new iterator for SELF. =cut */ VTABLE PMC *get_iter() { return Parrot_pmc_new_init(INTERP, enum_class_ArrayIterator, SELF); } /* =back =head2 Freeze/thaw Interface =over 4 =item C Used to archive the string. =cut */ VTABLE void freeze(PMC *info) { UINTVAL size, resize_threshold; unsigned char * bit_array; STRING * s; GET_ATTR_size(INTERP, SELF, size); GET_ATTR_resize_threshold(INTERP, SELF, resize_threshold); GET_ATTR_bit_array(INTERP, SELF, bit_array); s = Parrot_str_new_init(INTERP, (char*)bit_array, (resize_threshold / BITS_PER_CHAR), Parrot_binary_encoding_ptr, 0); VTABLE_push_integer(INTERP, info, size); VTABLE_push_string(INTERP, info, s); } /* =item C Used to unarchive the string. =cut */ VTABLE void thaw(PMC *info) { SUPER(info); { const INTVAL size = VTABLE_shift_integer(INTERP, info); STRING * const s = VTABLE_shift_string(INTERP, info); const size_t size_in_bytes = get_size_in_bytes(size); unsigned char *bit_array; SELF.set_integer_native(size); if (s->bufused < size_in_bytes) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_BAD_BUFFER_SIZE, "FixedBooleanArray: invalid buffer size during thaw"); GET_ATTR_bit_array(INTERP, SELF, bit_array); memcpy(bit_array, s->strstart, size_in_bytes); } } /* =back =head2 Methods =over 4 =item C Sets all of the entries to true if fill is a true value, otherwise sets them all to false. =cut */ METHOD fill(INTVAL fill) { UINTVAL size; unsigned char * bit_array; size_t size_in_bytes; GET_ATTR_bit_array(INTERP, SELF, bit_array); GET_ATTR_size(INTERP, SELF, size); size_in_bytes = get_size_in_bytes(size); if (size_in_bytes) memset(bit_array, fill ? 0xff : 0, size_in_bytes); } } /* =back =head1 SEE ALSO F. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ check_toxxx.t000644000765000765 370511533177643 17465 0ustar00brucebruce000000000000parrot-5.9.0/t/codingstd#! perl # Copyright (C) 2006-2009, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More tests => 1; use Parrot::Distribution; =head1 NAME t/codingstd/check_toxxx.t - checks that the toxxx() functions are passed unsigned char =head1 SYNOPSIS # test all files % prove t/codingstd/check_toxxx.t # test specific files % perl t/codingstd/check_toxxx.t src/foo.c include/parrot/bar.h =head1 DESCRIPTION Checks all C language files to make sure that arguments to the toxxx() functions are explicitly cast to unsigned char. =head1 SEE ALSO L =cut my $DIST = Parrot::Distribution->new; my @files = @ARGV ? <@ARGV> : $DIST->get_c_language_files(); my @no_explicit_cast; my $toxxx_functions = "toupper|tolower"; foreach my $file (@files) { # if we have command line arguments, the file is the full path # otherwise, use the relevant Parrot:: path method my $path = @ARGV ? $file : $file->path; my $buf = $DIST->slurp($path); my @buffer_lines = split( /\n/, $buf ); # find out if toxxx() functions appear in the file my $num_toxxx = grep m/($toxxx_functions)\(/, @buffer_lines; # if so, check if the args are cast to unsigned char if ($num_toxxx) { # get the lines just matching toxxx my @toxxx_lines = grep m/($toxxx_functions)\(/, @buffer_lines; # find the instances without the explicit cast my $num_no_cast = grep !m/($toxxx_functions)\(\(unsigned char\)/, @toxxx_lines; $path .= "\n"; push @no_explicit_cast, $path if $num_no_cast; } else { next; } } ok( !scalar(@no_explicit_cast), 'toxxx() functions cast correctly' ) or diag( "toxxx() function not cast to unsigned char " . scalar @no_explicit_cast . " files:\n@no_explicit_cast" ); # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: templates.json000644000765000765 653312140013527 20164 0ustar00brucebruce000000000000parrot-5.9.0/tools/release{ "text.news" : true, "text.text" : " On behalf of the Parrot team, I'm proud to announce Parrot @release.version@, also known as \"@release.name@\". Parrot (@web.root@) is a virtual machine aimed at running all dynamic languages. Parrot @release.version@ is available on Parrot's FTP site (@ftp.path@), or by following the download instructions at @web.root@@web.source@. For those who would like to develop on Parrot, or help develop Parrot itself, we recommend using Git to retrieve the source code to get the latest and best Parrot code. Parrot @release.version@ News: @NEWS@ The SHA256 message digests for the downloadable tarballs are: @message_digests@ Many thanks to all our contributors for making this possible, and our sponsors for supporting this project. Our next scheduled release is @release.nextdate@. Enjoy! ", "html.news" : true, "html.text" : "

On behalf of the Parrot team, I'm proud to announce Parrot @release.version@, also known as "@release.name@". Parrot is a virtual machine aimed at running all dynamic languages.

Parrot @release.version@ is available on Parrot's FTP site, or by following the download instructions. For those who want to hack on Parrot or languages that run on top of Parrot, we recommend our organization page on GitHub, or you can go directly to the official Parrot Git repo on Github To clone the Parrot Git repo into a directory called 'parrot', use the following: 

    git clone git://github.com/parrot/parrot.git
If you want it to be in a directory other than 'parrot', then just give that as a second argument to clone: 
    git clone git://github.com/parrot/parrot.git parrot_foo

Parrot @release.version@ News:

@NEWS@

The SHA256 message digests for the downloadable tarballs are:

@message_digests@

Thanks to all our contributors for making this possible, and our sponsors for supporting this project. Our next release is @release.nextdate@.

Enjoy!

", "bugday.news" : false, "bugday.text" : " Bug Day On @bugday.day@, @bugday.date@, please join us on IRC in #parrot (irc.parrot.org) to work on closing out as many Trac tickets (https://trac.parrot.org) tickets as possible in the parrot queue. This will help us get ready for the next release of parrot: @release.version@, scheduled for @release.day@, @release.date@. You'll find C, parrot assembly, perl, documentation, and plenty of tasks to go around. Core developers will be available most of the day (starting at around 10am GMT) to answer questions. No experience with parrot necessary. --From: @wiki.root@@wiki.bugday@-- Check the list at: https://trac.parrot.org/parrot/report/3 Which contains all the tickets I'd like to see resolved in @release.version@. To see all the open tickets, use: https://trac.parrot.org/parrot/report If you've got something you're working on that you think you'll be getting done before the release, please - add a ticket for it (if necessary); - set its milestone to this release. Thanks in advance for your patches and commits. ^_^ ... Speaking of patches, we should also get through as many of these (accept or reject) as possible. @web.root@@web.openpatches@ " } anim_image.pir000644000765000765 552412101554066 17721 0ustar00brucebruce000000000000parrot-5.9.0/examples/sdl# Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME anim_image.pir - animate an image in a Parrot SDL window =head1 SYNOPSIS To run this file, run the following command from the Parrot directory: $ ./parrot examples/sdl/anim_image.pir Drew 1080 frames in 0.948230 seconds (1138.964142 fps) $ =head1 DESCRIPTION This program demonstrates how to animate an image in a Parrot SDL window. =cut .sub _main :main load_bytecode "SDL/App.pir" load_bytecode "SDL/Color.pir" load_bytecode "SDL/Rect.pir" load_bytecode "SDL/Image.pir" load_bytecode "SDL/Sprite.pir" .local pmc app app = new ['SDL'; 'App'] app.'init'( 'height' => 480, 'width' => 640, 'bpp' => 0, 'flags' => 1 ) .local pmc main_screen main_screen = app.'surface'() .local pmc dest_rect dest_rect = new ['SDL'; 'Rect'] dest_rect.'init'( 'height' => 100, 'width' => 100, 'x' => 0, 'y' => 190 ) .local pmc prev_rect prev_rect = new ['SDL'; 'Rect'] prev_rect.'init'( 'height' => 100, 'width' => 101, 'x' => 0, 'y' => 190 ) .local pmc source_rect source_rect = new ['SDL'; 'Rect'] source_rect.'init'( 'height' => 56, 'width' => 100, 'x' => 0, 'y' => 0 ) .local pmc black black = new ['SDL'; 'Color'] black.'init'( 'r' => 0, 'g' => 0, 'b' => 0 ) .local pmc image image = new ['SDL'; 'Image'] image.'init'( 'examples/sdl/parrot_small.png' ) .local pmc sprite sprite = new ['SDL'; 'Sprite'] sprite.'init'( 'surface' => image, 'source_x' => 0, 'source_y' => 0, 'dest_x' => 0, 'dest_y' => 190, 'bgcolor' => black ) .local num start_time time start_time _animate_on_x_axis( main_screen, sprite, 0, 540, 1) sleep 1 _animate_on_x_axis( main_screen, sprite, 540, 0, -1) .local num end_time time end_time .local num total_time total_time = end_time - start_time dec total_time .local num fps fps = 1080/total_time print "Drew 1080 frames in " print total_time print " seconds (" print fps print " fps)\n" sleep 1 app.'quit'() end .end .sub _animate_on_x_axis .param pmc screen .param pmc sprite .param int start_pos .param int end_pos .param int step_size .local int x_pos x_pos = start_pos .local pmc prev_rect .local pmc rect .local pmc rect_array rect_array = new 'ResizablePMCArray' set rect_array, 2 _loop: add x_pos, step_size sprite.'x'( x_pos ) (prev_rect, rect) = sprite.'draw_undraw'( screen ) set rect_array[ 0 ], prev_rect set rect_array[ 1 ], rect screen.'update_rects'( rect_array ) if x_pos != end_pos goto _loop .end =head1 AUTHOR chromatic, Echromatic at wgz dot orgE. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: pmc.t000644000765000765 1142512101554067 14523 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc#!perl # Copyright (C) 2001-2009, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Test tests => 15; use Parrot::PMC '%pmc_types'; =head1 NAME t/pmc/pmc.t - PMCs =head1 SYNOPSIS % prove t/pmc/pmc.t =head1 DESCRIPTION Contains a lot of PMC related tests. =cut pir_output_is( <<'CODE', <<'OUTPUT', "newpmc" ); .sub main :main say "starting" new $P0, ['Integer'] say "ending" .end CODE starting ending OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', 'typeof' ); .sub main :main new $P0, ['Integer'] typeof $S0, $P0 eq $S0, "Integer", OK_1 print "not " OK_1: print "ok 1\n" .end CODE ok 1 OUTPUT my $checkTypes; my %types_we_cant_test = map { $_ => 1; } ( # These require initializers. qw(default Null Iterator ArrayIterator HashIterator StringIterator OrderedHashIterator Enumerate ParrotObject ParrotThread BigInt LexInfo LexPad Object Handle Opcode OpLib StructView IMCCompiler), # Instances of these appear to have other types. qw(Proxy PMCProxy Class) ); while ( my ( $type, $id ) = each %pmc_types ) { next if $types_we_cant_test{$type}; my $set_ro = ( $type =~ /^Const\w+/ ) ? <<'PIR' : ''; new $P10, ['Integer'] set $P10, 1 setprop $P0, "_ro", $P10 PIR $checkTypes .= qq{ new \$P0, '$type'\n$set_ro\n}; $checkTypes .= qq{ set \$S1, "$type"\n}; $checkTypes .= <<'CHECK'; typeof $S0, $P0 ne $S0, $S1, L_BadName CHECK } pir_output_like( <<"CODE", qr/All names ok/, "PMC type check" ); .sub main :main new \$P10, ['Hash'] new \$P11, ['Hash'] $checkTypes say "All names ok." end L_BadName: print \$S1 print " PMCs have incorrect name \\"" print \$S0 print "\\"\\n" .end CODE pir_error_output_like( <<'CODE', <<'OUTPUT', 'find_method' ); .sub main :main new $P1, ['Integer'] find_method $P0, $P1, "no_such_meth" .end CODE /Method 'no_such_meth' not found for invocant of class 'Integer'/ OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "eq_addr same" ); .sub main :main new $P0, ['Integer'] set $P1, $P0 eq_addr $P0, $P1, OK1 print "not " OK1: print "ok 1\n" ne_addr $P0, $P1, BAD2 branch OK2 BAD2: print "not " OK2: print "ok 2\n" .end CODE ok 1 ok 2 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "eq_addr diff" ); .sub main :main new $P0, ['Integer'] new $P1, ['Integer'] ne_addr $P0, $P1, OK1 print "not " OK1: print "ok 1\n" eq_addr $P0, $P1, BAD2 branch OK2 BAD2: print "not " OK2: print "ok 2\n" .end CODE ok 1 ok 2 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "if_null" ); .sub main :main null $P0 if_null $P0, OK1 print "not " OK1: print "ok 1\n" new $P0, ['Integer'] if_null $P0, BAD2 branch OK2 BAD2: print "not " OK2: print "ok 2\n" .end CODE ok 1 ok 2 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "Env PMCs are singletons" ); .sub main :main new $P0, ['Env'] new $P1, ['Env'] eq_addr $P0, $P1, ok print "not the same " ok: print "ok\n" .end CODE ok OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "issame" ); .sub main :main new $P0, ['Undef'] new $P1, ['Undef'] set $P1, $P0 issame $I0, $P0, $P1 print $I0 isntsame $I0, $P0, $P1 print $I0 new $P2, ['Undef'] issame $I0, $P0, $P2 print $I0 isntsame $I0, $P0, $P2 say $I0 .end CODE 1001 OUTPUT pir_output_is( <<'CODE', <<'OUT', ".const - Sub constant" ); .sub main :main print "ok 1\n" .const 'Sub' $P0 = "foo" invokecc $P0 print "ok 3\n" .end .sub foo print "ok 2\n" returncc .end CODE ok 1 ok 2 ok 3 OUT pir_output_is( <<'CODE', <<'OUT', "Integer pmc constant " ); .sub main :main .const 'Integer' i = "42" say i .end CODE 42 OUT pir_output_is( <<'CODE', <<'OUT', "Float pmc constant " ); .sub main :main .const 'Float' j = "4.2" say j .end CODE 4.2 OUT pir_output_is( <<'CODE', <<'OUT', "pmc constant" ); .sub main :main .const 'Integer' $P0 = "42" say $P0 .end CODE 42 OUT pir_output_is( <<'CODE', <<'OUT', "logical or, and, xor" ); .sub main :main new $P0, ['Integer'] set $P0, 2 new $P1, ['Undef'] or $P2, $P0, $P1 eq_addr $P2, $P0, ok1 print "not " ok1: print "ok 1\n" and $P2, $P0, $P1 eq_addr $P2, $P1, ok2 print "not " ok2: print "ok 2\n" xor $P2, $P0, $P1 eq_addr $P2, $P0, ok3 print "not " ok3: print "ok 3\n" .end CODE ok 1 ok 2 ok 3 OUT pir_output_is( <<'CODE', <<'OUTPUT', "new_p_s" ); .sub main :main new $P3, ['Integer'] set $P3, "42" typeof $S0, $P3 print $S0 print "\n" set $I0, $P3 print $I0 print "\n" .end CODE String 42 OUTPUT # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: ch07_objects.pod000644000765000765 2653311533177634 20206 0ustar00brucebruce000000000000parrot-5.9.0/docs/book/pir=pod =head1 Classes and Objects Many of Parrot's core classes -- such as C, C, or C -- are written in C, but you can also write your own classes in PIR. PIR doesn't have the shiny syntax of high-level object-oriented languages, but it provides the necessary features to construct well-behaved objects every bit as powerful as those of high-level object systems. X Parrot developers often use the word "PMCs" to refer to the objects defined in C classes and "objects" to refer to the objects defined in PIR. In truth, all PMCs are objects and all objects are PMCs, so the distinction is a community tradition with no official meaning. =head2 Class Declaration X The CX opcode defines a new class. It takes a single argument, the name of the class to define. =begin PIR_FRAGMENT $P0 = newclass 'Foo' =end PIR_FRAGMENT Just as with Parrot's core classes, the CX opcode instantiates a new object of a named class. =begin PIR_FRAGMENT $P1 = new 'Foo' =end PIR_FRAGMENT In addition to a string name for the class, C can also instantiate an object from a class object or from a keyed namespace name. =begin PIR_FRAGMENT $P0 = newclass 'Foo' $P1 = new $P0 $P2 = new ['Bar';'Baz'] =end PIR_FRAGMENT =head2 Attributes X X The C opcode defines a named attribute -- or I -- in the class: =begin PIR_FRAGMENT $P0 = newclass 'Foo' addattribute $P0, 'bar' =end PIR_FRAGMENT The CX opcode sets the value of a declared attribute. You must declare an attribute before you may set it. The value of an attribute is always a PMC, never an integer, number, or string.N, C, or C PMC.> =begin PIR_FRAGMENT $P6 = box 42 setattribute $P1, 'bar', $P6 =end PIR_FRAGMENT The CX opcode fetches the value of a named attribute. It takes an object and an attribute name as arguments and returns the attribute PMC: =begin PIR_FRAGMENT $P10 = getattribute $P1, 'bar' =end PIR_FRAGMENT Because PMCs are containers, you may modify an object's attribute by retrieving the attribute PMC and modifying its value. You don't need to call C for the change to stick: =begin PIR_FRAGMENT $P10 = getattribute $P1, 'bar' $P10 = 5 =end PIR_FRAGMENT =head2 Instantiation With a created class, we can use the C opcode to instantiate an object of that class in the same way we can instantiate a new PMC. =begin PIR_FRAGMENT $P0 = newclass "Foo" $P1 = new $P0 =end PIR_FRAGMENT Or, if we don't have the class object handy, we can do it by name too: =begin PIR_FRAGMENT $P1 = new "Foo" =end PIR_FRAGMENT PMCs have two VTABLE interface functions for dealing with instantiating a new object: C and C. The former is called when a new PMC is created, the later is called when a new PMC is created with an initialization argument. =begin PIR .namespace ["Foo"] .sub 'init' :vtable say "Creating a new Foo" .end .sub 'init_pmc' :vtable .param pmc args print "Creating a new Foo with argument " say args .end .namespace[] .sub 'main' :main $P1 = new ['Foo'] # init $P2 = new ['Foo'], $P1 # init_pmc .end =end PIR =head2 Methods X X X Methods in PIR are subroutines stored in the class object. Define a method with the C<.sub> directive and the C<:method>X<:method subroutine modifier> modifier: =begin PIR .sub half :method $P0 = getattribute self, 'bar' $P1 = $P0 / 2 .return($P1) .end =end PIR This method returns the integer value of the C attribute of the object divided by two. Notice that the code never declares the named variable C. Methods always make the invocant object -- the object on which the method was invoked -- available in a local variable called CX. The C<:method> modifier adds the subroutine to the class object associated with the currently selected namespace, so every class definition file must contain a C<.namespace>X<.namespace directive> declaration. Class files for languages may also contain an C<.HLL>X<.HLL directive> declaration to associate the namespace with the appropriate high-level language: =begin PIR .HLL 'php' .namespace [ 'Foo' ] =end PIR Method calls in PIR use a period (C<.>) to separate the object from the method name. The method name is either a literal string in quotes or a string variable. The method call looks up the method in the invocant object using the string name: =begin PIR_FRAGMENT $P0 = $P1.'half'() $S2 = 'double' $P0 = $P1.$S2() =end PIR_FRAGMENT You can also pass a method object to the method call instead of looking it up by string name: =begin PIR_FRAGMENT $P2 = get_global 'triple' $P0 = $P1.$P2() =end PIR_FRAGMENT Parrot always treats a PMC used in the method position as a method object, so you can't pass a C PMC as the method name. Methods can have multiple arguments and multiple return values just like subroutines: =begin PIR_FRAGMENT ($P0, $S1) = $P2.'method'($I3, $P4) =end PIR_FRAGMENT The CX opcode checks whether an object has a particular method. It returns 0 (false) or 1 (true): =begin PIR_FRAGMENT $I0 = can $P3, 'add' =end PIR_FRAGMENT =head2 Inheritance X X The CX opcode creates a new class that inherits methods and attributes from another class. It takes two arguments: the name of the parent class and the name of the new class: =begin PIR_FRAGMENT $P3 = subclass 'Foo', 'Bar' =end PIR_FRAGMENT C can also take a class object as the parent class instead of a class name: =begin PIR_FRAGMENT $P3 = subclass $P2, 'Bar' =end PIR_FRAGMENT X The CX opcode also adds a parent class to a subclass. This is especially useful for multiple inheritance, as the C opcode only accepts a single parent class: =begin PIR_FRAGMENT $P4 = newclass 'Baz' addparent $P3, $P4 addparent $P3, $P5 =end PIR_FRAGMENT To override an inherited method in the child class, define a method with the same name in the subclass. This example code overrides C's C method to return a more meaningful name: =begin PIR .namespace [ 'Bar' ] .sub 'who_am_i' :method .return( 'I am proud to be a Bar' ) .end =end PIR X Object creation for subclasses is the same as for ordinary classes: =begin PIR_FRAGMENT $P5 = new 'Bar' =end PIR_FRAGMENT Calls to inherited methods are just like calls to methods defined in the class: =begin PIR_FRAGMENT $P1.'increment'() =end PIR_FRAGMENT The C opcode checks whether an object is an instance of or inherits from a particular class. It returns 0 (false) or 1 (true): =begin PIR_FRAGMENT $I0 = isa $P3, 'Foo' $I0 = isa $P3, 'Bar' =end PIR_FRAGMENT =head2 Overriding Vtable Functions X X The C PMCX is a core PMC written in C that provides basic object-like behavior. Every object instantiated from a PIR class inherits a default set of vtable functions from C, but you can override them with your own PIR subroutines. The C<:vtable>X<:vtable subroutine modifier> modifier marks a subroutine as a vtable override. As it does with methods, Parrot stores vtable overrides in the class associated with the currently selected namespace: =begin PIR .sub 'init' :vtable $P6 = new 'Integer' setattribute self, 'bar', $P6 .return() .end =end PIR Subroutines acting as vtable overrides must either have the name of an actual vtable function or include the vtable function name in the C<:vtable> modifier: =begin PIR .sub foozle :vtable('init') # ... .end =end PIR You must call methods on objects explicitly, but Parrot calls vtable functions implicitly in multiple contexts. For example, creating a new object with C<$P3 = new 'Foo'> will call C with the new C object. As an example of some of the common vtable overrides, the C<=>X<= operator> operator (or CX opcode) calls C's vtable function C when its left-hand side is a C object and the argument is an integer literal or integer variable: =begin PIR_FRAGMENT $P3 = 30 =end PIR_FRAGMENT The C<+>X<+ operator> operator (or CX opcode) calls C's C vtable function when it adds two C objects: =begin PIR_FRAGMENT $P3 = new 'Foo' $P3 = 3 $P4 = new 'Foo' $P4 = 1774 $P5 = $P3 + $P4 # or: add $P5, $P3, $P4 =end PIR_FRAGMENT The CX opcode calls C's C vtable function when it increments a C object: =begin PIR_FRAGMENT inc $P3 =end PIR_FRAGMENT Parrot calls C's C and C vtable functions to retrieve an integer or string value from a C object: =begin PIR_FRAGMENT $I10 = $P5 # get_integer say $P5 # get_string =end PIR_FRAGMENT =head2 Introspection X X Classes defined in PIR using the C opcode are instances of the C PMCX. This PMC contains all the meta-information for the class, such as attribute definitions, methods, vtable overrides, and its inheritance hierarchy. The opcode CX provides a way to peek behind the curtain of encapsulation to see what makes a class tick. When called with no arguments, C returns an associative array containing data on all characteristics of the class that it chooses to reveal: =begin PIR_FRAGMENT $P1 = inspect $P0 $P2 = $P1['attributes'] =end PIR_FRAGMENT When called with a string argument, C only returns the data for a specific characteristic of the class: =begin PIR_FRAGMENT $P0 = inspect $P1, 'parents' =end PIR_FRAGMENT Table 7-1 shows the introspection characteristics supported by C. =begin table Class Introspection =headrow =row =cell Characteristic =cell Description =bodyrows =row =cell C =cell Information about the attributes the class will instantiate in its objects. An associative array, where the keys are the attribute names and the values are hashes of metadata. =row =cell C =cell An C PMC containing any integer flags set on the class object. =row =cell C =cell A list of methods provided by the class. An associative array where the keys are the method names and the values are the invocable method objects. =row =cell C =cell A C PMC containing the name of the class. =row =cell C =cell The C PMC associated with the class. =row =cell C =cell An array of C objects that this class inherits from directly (via C or C). Does not include indirectly inherited parents. =row =cell C =cell An array of C objects composed into the class. =row =cell C =cell A list of vtable overrides defined by the class. An associative array where the keys are the vtable names and the values are the invocable sub objects. =end table =cut # Local variables: # c-file-style: "parrot" # End: # vim: expandtab shiftwidth=4: opcode_doc.t000644000765000765 446311533177643 17236 0ustar00brucebruce000000000000parrot-5.9.0/t/codingstd#! perl # Copyright (C) 2001-2010, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More tests => 1; =head1 NAME t/perl/opcode_doc.t - check opcode documentation =head1 SYNOPSIS % prove t/perl/opcode_doc.t =head1 DESCRIPTION Checks whether all opcodes are documented. =cut my @docerr; sub slurp { my ($filename) = @_; open my $FILE, '<', "$filename" or die "can't open '$filename' for reading"; my @file = <$FILE>; close $FILE; return @file; } sub analyse { my ( $filename, $ops ) = @_; my %file; foreach my $op ( keys %$ops ) { my $args = $ops->{$op}; next if $op =~ /^DELETED/; next if $op =~ /^isgt/; # doced but rewritten next if $op =~ /^isge/; foreach my $arg ( keys %$args ) { my $e = $args->{$arg}; my $val = $e->{status}; next if $val == 3; # doc & impl $file{ $e->{def} } = "no documentation for $op($arg)" if exists $e->{def}; $file{ $e->{doc} } = "no definition of $op($arg)" if exists $e->{doc}; } } foreach my $line ( sort { $a <=> $b } keys %file ) { push @docerr, "$filename:$line: $file{$line}\n"; } } sub check_op_doc { my ($filename) = @_; my @file = slurp($filename); my %op; my $lineno = 0; foreach my $line (@file) { ++$lineno; if ( my ($item) = $line =~ /^=item\s+(.+\(.*)/ ) { if ( $item =~ /^([BC])\<(.*)\>\s*\((.*?)\)/ ) { print "$filename:$lineno: use B<...> instead of C<...>\n" if $1 eq "C"; my ( $op, $args ) = ( $2, $3 ); $args =~ s!\s*/\*.*?\*/!!; # del C comment in args $op{$op}{$args}{doc} = $lineno; $op{$op}{$args}{status} |= 1; } } elsif ( $line =~ /^(inline )?\s*op\s*(\S+)\s*\((.*?)\)/ ) { $op{$2}{$3}{def} = $lineno; $op{$2}{$3}{status} |= 2; } } analyse( $filename, \%op ); } foreach my $file () { check_op_doc $file; } ok( !@docerr, 'opcode documentation' ) or diag("Opcode documentation errors:\n@docerr"); # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: embed.pod000644000765000765 7733312101554066 15256 0ustar00brucebruce000000000000parrot-5.9.0/docs# Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME embed.pod - Parrot embedding system =head1 NOTE Parrot's embedding API is being replaced with a newer version. This document is for the old embedding API and will be phased out over time. Documentation for the newer API is located at F. =head1 SYNOPSIS #include "parrot/parrot.h" #include "parrot/extend.h" int main(int argc, char* argv[]) { Parrot_Interp interp; Parrot_PackFile pf; interp = Parrot_new(NULL); if (!interp) { fprintf(stderr, "Cannot create Parrot interpreter!\n"); return 1; } pf = Parrot_pbc_read(interp, "foo.pbc", 0); Parrot_pbc_load(interp, pf); Parrot_runcode(interp, argc, argv); Parrot_destroy(interp); return 0; } =head1 FILES =over 4 =item F =back =head1 DESCRIPTION This is the documentation for Parrot's embedding API. =head2 Data structures =over 4 =item C The topmost data structure in Parrot is C, which represents a Parrot interpreter. It is a required argument to almost every Parrot API function. The structure is opaque in an embedded environment, so you cannot directly access any of its members. =item C A Parrot packfile, the internal structure containing Parrot bytecode. =item C Parrot's internal string type, which contains character encoding information. =item C A Polymorphic Container. This is the opaque external type for (PMC *). Note that this is a macro, so there can be only one C declaration per line. =item C Parrot's integer numeric type. =item C Parrot's floating point numeric type. =item C Parrot's unsigned integer numeric type. =back =head2 Function signatures What is a function signature? It is a string which represents the calling and return conventions of a function. It is a very succinct representation of the answer to the question "How do I call this function and what does it return?". All function signatures follow the form of: Foo->Bar where C and C are a list of zero or more Parrot datatypes. C and C are individually called 'type signatures'. The datatypes on the left of the arrow are function arguments being passed in and the datatypes on the right are the datatype being returned. No spaces are allowed in a function signature. There are four datatypes that can be used in Parrot function signatures: I <=> Parrot_Int N <=> Parrot_Float (Numeric) S <=> Parrot_String P <=> Parrot_PMC Here are some example function signatures and what they mean: INN->N In: Integer, two Numerics Out: Numeric SIN->S In: String, Integer, Numeric Out: String P->S In: PMC Out: String PiP->S In: PMC (method call) Out: String NN->N In: Two Numerics Out: Numeric I->I In: Integer Out: Integer I->N In: Integer Out: Numeric N->P In: Numeric Out: PMC Pi-> In: none (method call) Out: none ->I In: none Out: Integer -> In: none Out: none TODO: Multiple return values? There is also the C datatype, which may only appear at the beginning of a function signature. It stands for "PMC invocant" and basically means SELF. C will only be used if calling a method on an object. Parrot function signature are mostly used when calling C. =head2 Interpreter initialization and destruction =over 4 =item C Creates a new interpreter, inheriting some data structures from a parent interpreter, if supplied. The first interpreter in any process should be created with a NULL parent, and all subsequent interpreters in the same process should use the first interpreter as their parent. Failure to do so may result in unpredictable errors. =item C Sets or unsets interpreter flags. Flags should be OR'd together. Valid flags include: =over 4 =item PARROT_NO_FLAGS The default. No flags. =item PARROT_BOUNDS_FLAG True if bytecode bounds should be tracked. =item PARROT_GC_DEBUG_FLAG True if debugging memory management. =item PARROT_EXTERN_CODE_FLAG True if reusing another interpreters code. =item PARROT_DESTROY_FLAG True if the last interpreter shall cleanup. =item PARROT_IS_THREAD True if interpreter is a thread. =item PARROT_THR_COPY_INTERP True if thread start copies interpreter state. =item PARROT_THR_THREAD_POOL True if type3 threads are being used. =back These are defined in F. =item C Sets the runcore for the interpreter. Must be called before executing any bytecode. Valid runcores include: =over 4 =item PARROT_SLOW_CORE =item PARROT_FUNCTION_CORE =item PARROT_FAST_CORE =item PARROT_EXEC_CORE =item PARROT_GC_DEBUG_CORE =back See F for the definitive list. If you're not sure which runcore to use, don't call this function. The default will be fine for most cases. (TODO: document runcores here). =item C Sets the interpreter's trace flags. Flags should be OR'd together. Valid flags are: =over 4 =item PARROT_NO_TRACE =item PARROT_TRACE_OPS_FLAG =item PARROT_TRACE_FIND_METH_FLAG =item PARROT_TRACE_SUB_CALL_FLAG =item PARROT_ALL_TRACE_FLAGS Z<> =back =item C Sets the executable name of the calling process. Note that the name is a Parrot string, not a C string. =item C Destroys an interpreter. At the time of this writing, this is a no-op. See . =item C Destroys an interpreter, regardless of the environment. The exit code is currently unused. =item C Destroys the interpreter and exits with an exit code of C. Before exiting, the function calls all registered exit handlers in LIFO order. C is usually called as the last exit handler. =item C Registers an exit handler to be called from C in LIFO order. The handler function should accept as arguments an interpreter, an integer exit code, and an argument (which can be NULL). =back =head2 Loading and running bytecode =over 4 =item C Reads Parrot bytecode or PIR from the file referenced by C. Returns a packfile structure for use by C. C should be 0. =item C Loads a packfile into the interpreter. After this operation the interpreter is ready to run the bytecode in the packfile. =item C Runs the bytecode associated with the interpreter. Use C and C to pass arguments to the bytecode. =item C Creates a "dummy" packfile in lieu of actually creating one from a bytecode file on disk. =item C Reads and load Parrot bytecode or PIR from the file referenced by C. You should create a dummy packfile beforehand; see C for details. Due to the void return type, the behavior of this function on error is unclear. =back =head2 Data manipulation =head3 Native types =over 4 =item C Returns the internal type number corresponding to C. Useful for instantiating various Parrot data types. =item C XXX needs to be a formal Parrot_* API. Returns the C string representation of a Parrot string. =item C XXX needs to be a formal Parrot_* API. Returns the Parrot string representation of a C string. =item C XXX needs to be a formal Parrot_* API. A macro for simplifying calls to C. =back =head3 PMCs =over 4 =item C Creates a new PMC of the type identified by C. Use C to obtain the correct type number. =item C Registers an externally created PMC with the garbage collector. You MUST call this for any PMCs you create outside of Parrot bytecode, otherwise your PMC may be garbage collected before you are finished using it. =item C Unregisters an externally created PMC from the garbage collector. You MUST call this after you are finished using PMCs you create outside of Parrot bytecode, or risk memory leaks. =back =head3 Globals =over 4 =item C Find and return a global called C in the current namespace. Returns C if not found. =item C Search the namespace PMC C for an object with name C. Return the object, or NULL if not found. =item C Store the PMC C into the namespace PMC C with name C. =back =head3 Lexicals Not documented yet. =head2 Calling subroutines =over 4 =item C Call a Parrot subroutine using the supplied function signature. Variables to be filled with return values are passed as references in the varargs list, after all arguments. =back =head2 Objects =head3 Creating and destroying objects =over 4 =item C Returns the class corresponding to the supplied namespace. =item C Instantiates a new object of class C, which can be obtained from C. Passes an optional PMC argument C to the constructor (see init versus init_pmc). Use C if you are not supplying an argument. =back =head3 Calling methods =over 4 =item C Methods are called using the same API function as calling a subroutine. The first argument should be the object that the method will be invoked on, and it should have the signature "Pi", which stands for "PMC invocant". =back =head1 COMPILING Note: This section is aimed at you if you are writing an application external to parrot which links against an installed parrot library. =head2 Caveats Several API functions are missing prototypes in Parrot's header files. This means you may receive type warnings during compilation even though the types of your arguments and return variables are correct. In this case it is safe to cast to the correct type; not doing so may cause undesired behavior. =head2 Compiler and linker flags Your application will need to include the appropriate header files and link against parrot and its dependencies. Because the location of these files can vary from platform to platform, and build to build, a general method is provided to find out the necessary flags to use. C is the helper tool for determining anything related to parrot configuration, determining compiler and linker flags to build against parrot is no different. To start, you should find C in the path or allow your user to provide this location for you. You can check this by running C with C as the argument to determine the version of parrot you are working with. To determine the necessary C compiler flags, use C: parrot_config embed-cflags ... and to find the necessary linker flags, use C: parrot_config embed-ldflags The C command can be incorporated with a compile as shown here performing both compiling and linking in one step. cc src/disassemble.c `parrot_config embed-cflags` `parrot_config embed-ldflags` =head1 EXAMPLES =head2 Load bytecode as a library and run a single subroutine #include #include int main(int argc, char *argv[]) { Parrot_Interp interp; Parrot_PackFile pf; Parrot_PMC sub; Parrot_String pstr; interp = Parrot_new(NULL); imcc_init(interp); /* create a new packfile -- any name will do */ pf = PackFile_new_dummy(interp, "my-parrot-code"); pstr = string_from_literal(interp, "foo.pir"); Parrot_load_bytecode(interp, pstr); /* find the subroutine named "foo" in the global namespace */ pstr = string_from_literal(interp, "foo"); sub = Parrot_ns_find_current_namespace_global(interp, pstr); /* run foo(), which returns nothing */ Parrot_ext_call(interp, sub, "->"); Parrot_destroy(interp); return(0); } =head1 EXPORTED FUNCTIONS The Parrot embedding API is not finalized, and it will go through several deprecation cycles before stabilizing. Below is the comprehensive list of candidates for inclusion in the Parrot embedding API. It includes the following types of functions: =over 4 =item * The core functions documented above =item * Functions required by macros =item * Parrot_PMC_* VTABLE wrappers =item * Miscellaneous functions whose utility outside of the core is uncertain. This includes functions used by HLLs. =item * Functions that should be removed in a future deprecation cycle. A good example of this is most of the internal string_* functions, which now have formal Parrot_str_* wrappers. =back The list may also be augmented if additional functionality is required. =over 4 =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =back =head1 SEE ALSO F and F for Parrot's use of the embedding system. =cut VERSION000644000765000765 612227313723 13477 0ustar00brucebruce000000000000parrot-5.9.05.9.0 gc_api.h000644000765000765 4667412101554067 17100 0ustar00brucebruce000000000000parrot-5.9.0/include/parrot/* gc_api.h * Copyright (C) 2001-2010, Parrot Foundation. * Overview: * Handles dead object destruction of the various headers * History: * Initial version by Mike Lambert on 2002.05.27 */ #ifndef PARROT_GC_API_H_GUARD #define PARROT_GC_API_H_GUARD #include "parrot/parrot.h" /* * we need an alignment that is the same as malloc(3) have for * allocating Buffer items like FLOATVAL (double) * This should be either a config hint or tested */ #ifdef MALLOC_ALIGNMENT # define BUFFER_ALIGNMENT MALLOC_ALIGNMENT #else /* or (2 * sizeof (size_t)) */ # define BUFFER_ALIGNMENT 8 #endif #define BUFFER_ALIGN_1 (BUFFER_ALIGNMENT - 1) #define BUFFER_ALIGN_MASK ~BUFFER_ALIGN_1 #define WORD_ALIGN_1 (sizeof (void *) - 1) #define WORD_ALIGN_MASK ~WORD_ALIGN_1 #define ALIGNED_STRING_SIZE(len) (((len) + sizeof (void*) + WORD_ALIGN_1) & WORD_ALIGN_MASK) #define PARROT_GC_WRITE_BARRIER(i, p) do { if (PObj_GC_need_write_barrier_TEST((p))) Parrot_gc_write_barrier((i), (p)); } while(0) typedef struct _Parrot_GC_Init_Args { void *stacktop; const char *system; Parrot_Float4 nursery_size; Parrot_Int dynamic_threshold; Parrot_Int min_threshold; Parrot_UInt numthreads; } Parrot_GC_Init_Args; typedef enum _gc_sys_type_enum { MS, /* mark and sweep */ INF, /* infinite memory core */ MS2, GMS } gc_sys_type_enum; /* pool iteration */ typedef enum { POOL_PMC = 0x01, POOL_BUFFER = 0x02, POOL_CONST = 0x04, POOL_ALL = 0x07 } pool_iter_enum; struct Memory_Block; struct Var_Size_Pool; struct Fixed_Size_Pool; struct Fixed_Size_Arena; struct Memory_Pools; typedef enum { GC_TRACE_FULL = 1, GC_TRACE_ROOT_ONLY = 2, GC_TRACE_SYSTEM_ONLY = 3 } Parrot_gc_trace_type; typedef int (*pool_iter_fn)(PARROT_INTERP, struct Memory_Pools *, struct Fixed_Size_Pool *, int, void*); typedef void (*add_free_object_fn_type)(PARROT_INTERP, struct Memory_Pools *, struct Fixed_Size_Pool *, void *); typedef void * (*get_free_object_fn_type)(PARROT_INTERP, struct Memory_Pools *, struct Fixed_Size_Pool *); typedef void (*alloc_objects_fn_type)(PARROT_INTERP, struct Memory_Pools *, struct Fixed_Size_Pool *); typedef void (*gc_object_fn_type)(PARROT_INTERP, ARGMOD(struct Memory_Pools *), ARGIN(struct Fixed_Size_Pool *), ARGMOD(PObj *)); /* &gen_from_enum(interpinfo.pasm) prefix(INTERPINFO_) */ typedef enum { TOTAL_MEM_ALLOC = 1, TOTAL_MEM_USED, GC_MARK_RUNS, GC_COLLECT_RUNS, ACTIVE_PMCS, ACTIVE_BUFFERS, TOTAL_PMCS, TOTAL_BUFFERS, HEADER_ALLOCS_SINCE_COLLECT, MEM_ALLOCS_SINCE_COLLECT, TOTAL_COPIED, IMPATIENT_PMCS, GC_LAZY_MARK_RUNS, EXTENDED_PMCS, CURRENT_RUNCORE, PARROT_INTSIZE, PARROT_FLOATSIZE, PARROT_POINTERSIZE, PARROT_INTMAX, PARROT_INTMIN, /* interpinfo_p constants */ CURRENT_CTX, CURRENT_SUB, CURRENT_CONT, CURRENT_LEXPAD, CURRENT_TASK, /* interpinfo_s constants */ EXECUTABLE_FULLNAME, EXECUTABLE_BASENAME, RUNTIME_PREFIX, GC_SYS_NAME, PARROT_OS, PARROT_OS_VERSION, PARROT_OS_VERSION_NUMBER, CPU_ARCH, CPU_TYPE } Interpinfo_enum; /* &end_gen */ #define GC_trace_stack_FLAG (UINTVAL)(1 << 1) /* trace system areas and stack */ #define GC_trace_normal_FLAG (UINTVAL)(1 << 1) /* the same */ #define GC_lazy_FLAG (UINTVAL)(1 << 2) /* timely destruction run */ #define GC_finish_FLAG (UINTVAL)(1 << 3) /* on Parrot exit: mark (almost) all PMCs dead and */ #define GC_strings_cb_FLAG (UINTVAL)(1 << 4) /* Invoked from String GC during mem_alloc to sweep dead strings */ /* garbage collect. */ /* HEADERIZER BEGIN: src/gc/api.c */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_EXPORT void Parrot_block_GC_mark(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_block_GC_mark_locked(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_block_GC_sweep(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT int Parrot_gc_active_pmcs(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT int Parrot_gc_active_sized_buffers(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_gc_allocate_buffer_storage_aligned(PARROT_INTERP, ARGOUT(Parrot_Buffer *buffer), size_t size) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*buffer); PARROT_EXPORT PARROT_CANNOT_RETURN_NULL void * Parrot_gc_allocate_fixed_size_storage(PARROT_INTERP, size_t size) __attribute__nonnull__(1); PARROT_EXPORT PARROT_CANNOT_RETURN_NULL void * Parrot_gc_allocate_memory_chunk(PARROT_INTERP, size_t size) __attribute__nonnull__(1); PARROT_EXPORT PARROT_CANNOT_RETURN_NULL void * Parrot_gc_allocate_memory_chunk_with_interior_pointers(PARROT_INTERP, size_t size) __attribute__nonnull__(1); PARROT_EXPORT PARROT_CANNOT_RETURN_NULL void * Parrot_gc_allocate_pmc_attributes(PARROT_INTERP, ARGMOD(PMC *pmc)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*pmc); PARROT_EXPORT void Parrot_gc_allocate_string_storage(PARROT_INTERP, ARGOUT(STRING *str), size_t size) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*str); PARROT_EXPORT void Parrot_gc_compact_memory_pool(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_gc_completely_unblock(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT size_t Parrot_gc_count_collect_runs(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT size_t Parrot_gc_count_lazy_mark_runs(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT size_t Parrot_gc_count_mark_runs(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_gc_destroy_child_interp( ARGMOD(Interp *dest_interp), ARGIN(Interp *source_interp)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest_interp); PARROT_EXPORT void Parrot_gc_finalize(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_gc_free_bufferlike_header(PARROT_INTERP, ARGMOD(Parrot_Buffer *obj), size_t size) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*obj); PARROT_EXPORT void Parrot_gc_free_fixed_size_storage(PARROT_INTERP, size_t size, ARGMOD(void *data)) __attribute__nonnull__(1) __attribute__nonnull__(3) FUNC_MODIFIES(*data); PARROT_EXPORT PARROT_CANNOT_RETURN_NULL void Parrot_gc_free_memory_chunk(PARROT_INTERP, ARGIN_NULLOK(void *data)) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_gc_free_pmc_attributes(PARROT_INTERP, ARGFREE(PMC *pmc)) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_gc_free_pmc_header(PARROT_INTERP, ARGMOD(PMC *pmc)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*pmc); PARROT_EXPORT void Parrot_gc_free_string_header(PARROT_INTERP, ARGMOD(STRING *s)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*s); PARROT_EXPORT size_t Parrot_gc_headers_alloc_since_last_collect(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT UINTVAL Parrot_gc_impatient_pmcs(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_gc_initialize(PARROT_INTERP, ARGIN(Parrot_GC_Init_Args *args)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_EXPORT void Parrot_gc_mark_and_sweep(PARROT_INTERP, UINTVAL flags) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_gc_mark_PMC_alive_fun(PARROT_INTERP, ARGMOD_NULLOK(PMC *obj)) __attribute__nonnull__(1) FUNC_MODIFIES(*obj); PARROT_EXPORT void Parrot_gc_mark_PObj_alive(PARROT_INTERP, ARGMOD(PObj *obj)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*obj); PARROT_EXPORT void Parrot_gc_mark_STRING_alive_fun(PARROT_INTERP, ARGMOD_NULLOK(STRING *obj)) __attribute__nonnull__(1) FUNC_MODIFIES(*obj); PARROT_EXPORT size_t Parrot_gc_mem_alloc_since_last_collect(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT Parrot_Buffer * Parrot_gc_new_bufferlike_header(PARROT_INTERP, size_t size) __attribute__nonnull__(1); PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_gc_new_pmc_header(PARROT_INTERP, UINTVAL flags) __attribute__nonnull__(1); PARROT_EXPORT PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT STRING * Parrot_gc_new_string_header(PARROT_INTERP, UINTVAL flags) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_gc_pmc_needs_early_collection(PARROT_INTERP, ARGMOD(PMC *pmc)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*pmc); PARROT_EXPORT void Parrot_gc_reallocate_buffer_storage(PARROT_INTERP, ARGMOD(Parrot_Buffer *buffer), size_t newsize) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*buffer); PARROT_EXPORT PARROT_CANNOT_RETURN_NULL void * Parrot_gc_reallocate_memory_chunk(PARROT_INTERP, ARGFREE(void *data), size_t newsize) __attribute__nonnull__(1); PARROT_EXPORT PARROT_CANNOT_RETURN_NULL void * Parrot_gc_reallocate_memory_chunk_with_interior_pointers(PARROT_INTERP, ARGFREE(void *data), size_t newsize, size_t oldsize) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_gc_reallocate_string_storage(PARROT_INTERP, ARGMOD(STRING *str), size_t newsize) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*str); PARROT_EXPORT PARROT_CANNOT_RETURN_NULL STRING * Parrot_gc_sys_name(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT UINTVAL Parrot_gc_total_copied(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT size_t Parrot_gc_total_memory_allocated(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT size_t Parrot_gc_total_memory_used(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT int Parrot_gc_total_pmcs(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT int Parrot_gc_total_sized_buffers(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_gc_write_barrier(PARROT_INTERP, ARGIN(PMC *pmc)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_EXPORT unsigned int Parrot_is_blocked_GC_mark(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT unsigned int Parrot_is_blocked_GC_sweep(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_unblock_GC_mark(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_unblock_GC_mark_locked(PARROT_INTERP) __attribute__nonnull__(1); PARROT_EXPORT void Parrot_unblock_GC_sweep(PARROT_INTERP) __attribute__nonnull__(1); #define ASSERT_ARGS_Parrot_block_GC_mark __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_block_GC_mark_locked __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_block_GC_sweep __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_active_pmcs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_active_sized_buffers \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_allocate_buffer_storage_aligned \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(buffer)) #define ASSERT_ARGS_Parrot_gc_allocate_fixed_size_storage \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_allocate_memory_chunk \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_allocate_memory_chunk_with_interior_pointers \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_allocate_pmc_attributes \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(pmc)) #define ASSERT_ARGS_Parrot_gc_allocate_string_storage \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(str)) #define ASSERT_ARGS_Parrot_gc_compact_memory_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_completely_unblock __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_count_collect_runs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_count_lazy_mark_runs \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_count_mark_runs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_destroy_child_interp \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest_interp) \ , PARROT_ASSERT_ARG(source_interp)) #define ASSERT_ARGS_Parrot_gc_finalize __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_free_bufferlike_header \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(obj)) #define ASSERT_ARGS_Parrot_gc_free_fixed_size_storage \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(data)) #define ASSERT_ARGS_Parrot_gc_free_memory_chunk __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_free_pmc_attributes __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_free_pmc_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(pmc)) #define ASSERT_ARGS_Parrot_gc_free_string_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(s)) #define ASSERT_ARGS_Parrot_gc_headers_alloc_since_last_collect \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_impatient_pmcs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_initialize __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(args)) #define ASSERT_ARGS_Parrot_gc_mark_and_sweep __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_mark_PMC_alive_fun __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_mark_PObj_alive __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(obj)) #define ASSERT_ARGS_Parrot_gc_mark_STRING_alive_fun \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_mem_alloc_since_last_collect \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_new_bufferlike_header \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_new_pmc_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_new_string_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_pmc_needs_early_collection \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(pmc)) #define ASSERT_ARGS_Parrot_gc_reallocate_buffer_storage \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(buffer)) #define ASSERT_ARGS_Parrot_gc_reallocate_memory_chunk \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_reallocate_memory_chunk_with_interior_pointers \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_reallocate_string_storage \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(str)) #define ASSERT_ARGS_Parrot_gc_sys_name __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_total_copied __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_total_memory_allocated \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_total_memory_used __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_total_pmcs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_total_sized_buffers __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gc_write_barrier __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(pmc)) #define ASSERT_ARGS_Parrot_is_blocked_GC_mark __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_is_blocked_GC_sweep __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_unblock_GC_mark __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_unblock_GC_mark_locked __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_unblock_GC_sweep __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: src/gc/api.c */ # define Parrot_gc_mark_STRING_alive(interp, obj) Parrot_gc_mark_STRING_alive_fun((interp), (obj)) #if defined(PARROT_IN_CORE) #ifdef THREAD_DEBUG # define Parrot_gc_mark_PMC_alive(interp, obj) \ do if (!PMC_IS_NULL(obj) \ && (!PObj_is_shared_TEST(obj) || !Interp_flags_TEST((interp), PARROT_IS_THREAD))) { \ PARROT_ASSERT((obj)->orig_interp == (interp)); \ Parrot_gc_mark_PMC_alive_fun((interp), (obj)); \ } \ while (0) #else # define Parrot_gc_mark_PMC_alive(interp, obj) \ do if (!PMC_IS_NULL(obj) \ && (!PObj_is_shared_TEST(obj) || !Interp_flags_TEST((interp), PARROT_IS_THREAD))) { \ Parrot_gc_mark_PMC_alive_fun((interp), (obj)); \ } \ while (0) #endif #else # define Parrot_gc_mark_PMC_alive(interp, obj) Parrot_gc_mark_PMC_alive_fun((interp), (obj)) #endif #endif /* PARROT_GC_API_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ README.pod000644000765000765 154512101554066 16154 0ustar00brucebruce000000000000parrot-5.9.0/compilers# Copyright (C) 2001-2012, Parrot Foundation. =pod =head1 NAME compilers/README.pod - Readme file for the 'compilers/' top-level directory. =head1 DESCRIPTION This directory contains the source files for several compilers: =over 4 =item data_json - The compiler which generates a JSON representation of a PMC. =item imcc ("Intermediate Code Compiler") - The compiler which translates PIR source code into Parrot bytecode. =item opsc ("Opcode compiler") - The compiler which converts opcode definition files into C source code. =item pct ("Parrot Compiler Toolkit") - The compiler which PCT uses. =item pge ("Parrot Grammar Engine") - An implementation of Perl6 regex's for PCT. =item tge ("Tree Grammar Engine") - A tool for transforming a Parrot Abstract Syntax Tree (PAST). =back =head1 COPYRIGHT Copyright (C) 2012, Parrot Foundation. =cut spf_render.c000644000765000765 7310712101554067 17132 0ustar00brucebruce000000000000parrot-5.9.0/src/string/* Copyright (C) 2001-2009, Parrot Foundation. =head1 NAME src/spf_render.c - Parrot sprintf =head1 DESCRIPTION Implements the main function that drives the C family and its utility functions. =head2 Utility Functions =over 4 =cut */ #include "parrot/parrot.h" #include "spf_private.h" #include "spf_render.str" typedef enum { PHASE_FLAGS = 0, PHASE_WIDTH, PHASE_PREC, PHASE_TYPE, PHASE_TERM, PHASE_DONE } PHASE; typedef struct SpfInfo_tag { UINTVAL width; UINTVAL prec; INTVAL flags; INTVAL type; PHASE phase; } SpfInfo; #define SPRINTF_RESET_SPFINFO(s) do {\ (s).width = 0; \ (s).prec = 0; \ (s).flags = 0; \ (s).type = 0; \ (s).phase = PHASE_FLAGS; \ } while (0) enum { FLAG_MINUS = (1<<0), FLAG_PLUS = (1<<1), FLAG_ZERO = (1<<2), FLAG_SPACE = (1<<3), FLAG_SHARP = (1<<4), FLAG_WIDTH = (1<<5), FLAG_PREC = (1<<6) }; /* HEADERIZER HFILE: src/string/spf_private.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void canonicalize_exponent( ARGMOD(char *tc), ARGIN(const SpfInfo *info)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*tc); static void gen_sprintf_call( ARGOUT(char *out), ARGMOD(SpfInfo *info), int thingy) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*out) FUNC_MODIFIES(*info); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static STRING * handle_flags(PARROT_INTERP, ARGIN(const SpfInfo *info), ARGIN(STRING *str), INTVAL is_int_type, ARGIN_NULLOK(STRING* prefix)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3); PARROT_CANNOT_RETURN_NULL static void str_concat_w_flags(PARROT_INTERP, ARGOUT(PMC * sb), ARGIN(const SpfInfo *info), ARGMOD(STRING *src), ARGIN_NULLOK(STRING *prefix)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) FUNC_MODIFIES(* sb) FUNC_MODIFIES(*src); #define ASSERT_ARGS_canonicalize_exponent __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(tc) \ , PARROT_ASSERT_ARG(info)) #define ASSERT_ARGS_gen_sprintf_call __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(out) \ , PARROT_ASSERT_ARG(info)) #define ASSERT_ARGS_handle_flags __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(info) \ , PARROT_ASSERT_ARG(str)) #define ASSERT_ARGS_str_concat_w_flags __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(sb) \ , PARROT_ASSERT_ARG(info) \ , PARROT_ASSERT_ARG(src)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* Per Dan's orders, we will not use sprintf if snprintf isn't * around for us. */ #ifdef _MSC_VER # define snprintf _snprintf #endif /* =item C Handles C<+>, C<->, C<0>, C<#>, space, width, and prec. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static STRING * handle_flags(PARROT_INTERP, ARGIN(const SpfInfo *info), ARGIN(STRING *str), INTVAL is_int_type, ARGIN_NULLOK(STRING* prefix)) { ASSERT_ARGS(handle_flags) UINTVAL len = Parrot_str_byte_length(interp, str); if (is_int_type) { if (info->flags & FLAG_PREC && info->prec == 0 && len == 1 && STRING_ord(interp, str, 0) == '0') { str = Parrot_str_chopn(interp, str, len); len = 0; } /* +, space */ if (!len || STRING_ord(interp, str, 0) != '-') { if (info->flags & FLAG_PLUS) { STRING * const cs = CONST_STRING(interp, "+"); str = Parrot_str_concat(interp, cs, str); ++len; } else if (info->flags & FLAG_SPACE) { STRING * const cs = CONST_STRING(interp, " "); str = Parrot_str_concat(interp, cs, str); ++len; } } /* # 0x ... */ if ((info->flags & FLAG_SHARP) && prefix) { str = Parrot_str_concat(interp, prefix, str); len += Parrot_str_byte_length(interp, prefix); } /* XXX sharp + fill ??? */ } else { /* string precision */ if (info->flags & FLAG_PREC && info->prec == 0) { str = Parrot_str_chopn(interp, str, len); len = 0; } else if (info->flags & FLAG_PREC && info->prec < len) { str = Parrot_str_chopn(interp, str, -(INTVAL)(info->prec)); len = info->prec; } } if ((info->flags & FLAG_WIDTH) && info->width > len) { STRING * const filler = ((info->flags & FLAG_ZERO) && !(info->flags & FLAG_MINUS)) ? CONST_STRING(interp, "0") : CONST_STRING(interp, " "); STRING * const fill = Parrot_str_repeat(interp, filler, info->width - len); if (info->flags & FLAG_MINUS) { /* left-align */ str = Parrot_str_concat(interp, str, fill); } else { /* right-align */ /* signed and zero padded */ if (info->flags & FLAG_ZERO && (STRING_ord(interp, str, 0) == '-' || STRING_ord(interp, str, 0) == '+')) { STRING * const temp = STRING_substr(interp, str, 1, len-1); str = Parrot_str_chopn(interp, str, -1); str = Parrot_str_concat(interp, str, fill); str = Parrot_str_concat(interp, str, temp); } else { str = Parrot_str_concat(interp, fill, str); } } } return str; } /* =item C Used by Parrot_sprintf_format. Prepends supplied prefix for numeric values. (e.g. 0x for hex.) Returns the pointer to the modified string. =cut */ PARROT_CANNOT_RETURN_NULL static void str_concat_w_flags(PARROT_INTERP, ARGOUT(PMC * sb), ARGIN(const SpfInfo *info), ARGMOD(STRING *src), ARGIN_NULLOK(STRING *prefix)) { ASSERT_ARGS(str_concat_w_flags) src = handle_flags(interp, info, src, 1, prefix); VTABLE_push_string(interp, sb, src); } /* =item C Turn the info structure back into an sprintf format. Far from being pointless, this is used to call C when we're confronted with a float. =cut */ static void gen_sprintf_call(ARGOUT(char *out), ARGMOD(SpfInfo *info), int thingy) { ASSERT_ARGS(gen_sprintf_call) const int flags = info->flags; char *p = out; *p++ = '%'; if (flags) { if (flags & FLAG_MINUS) *p++ = '-'; if (flags & FLAG_PLUS) *p++ = '+'; if (flags & FLAG_ZERO) *p++ = '0'; if (flags & FLAG_SPACE) *p++ = ' '; if (flags & FLAG_SHARP) *p++ = '#'; if (flags & FLAG_WIDTH) { if (info->width > PARROT_SPRINTF_BUFFER_SIZE - 1) info->width = PARROT_SPRINTF_BUFFER_SIZE; p += sprintf(p, "%u", (unsigned)info->width); } if (flags & FLAG_PREC) { if (info->prec > PARROT_SPRINTF_MAX_PREC) info->prec = PARROT_SPRINTF_MAX_PREC; *p++ = '.'; p += sprintf(p, "%u", (unsigned)info->prec); } } if (thingy == 'd' || thingy == 'i' ||thingy == 'u') { /* the u?int isa HUGEU?INTVAL aka long long * the 'll' modifier is specced in susv3 - hopefully all our * compilers support it too */ *p++ = 'l'; *p++ = 'l'; } *p++ = (char)thingy; *p = '\0'; } /* =item C This function is called to canonicalize any exponent in a formatted float. PARROT_SPRINTF_EXP_DIGITS specifies the standard number of exponent digits that we want. Remember that the exponent has the form "...Esddd", where "s" is the sign, "ddd" is some number of digits, and there may be trailing spaces. =cut */ static void canonicalize_exponent(ARGMOD(char *tc), ARGIN(const SpfInfo *info)) { ASSERT_ARGS(canonicalize_exponent) const size_t exp_digits = PARROT_SPRINTF_EXP_DIGITS; size_t len = strlen(tc); size_t last_pos = len; size_t non0_pos = len; size_t sign_pos = 0; size_t e_pos = 0; int i; /* Scan the formatted number backward to find the positions of the last digit, leftmost non-0 exponent digit, sign, and E. */ for (i = len-1; i >= 0 && e_pos == 0; --i) { switch (tc[i]) { case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': non0_pos = i; /* fall through */ case '0': if (last_pos == len) last_pos = i; break; case '+': case '-': sign_pos = i; break; case 'E': case 'e': e_pos = i; break; default: break; } } /* If there is an E, and it is followed by a sign, and there are leading zeroes on the exponent, and there are more than the standard number of exponent digits, then we have work to do. */ if (e_pos != 0 && sign_pos == e_pos + 1 && non0_pos > sign_pos + 1 && last_pos - sign_pos > exp_digits) { /* Close up to eliminate excess exponent digits and adjust the length. Don't forget to move the NUL. */ const size_t keep = (last_pos - non0_pos + 1 > exp_digits) ? len - non0_pos : exp_digits + (len - last_pos - 1); memmove(&tc[sign_pos+1], &tc[len - keep], keep+1); len = sign_pos + 1 + keep; /* If it's a fixed-width field and we're too short now, we have more work to do. If the field is left-justified, pad the number on the right. Otherwise pad the number on the left, possibly with leading zeroes. */ if ((info->flags & FLAG_WIDTH) && len < info->width) { if (info->flags & FLAG_MINUS) { while (len < info->width) { strcat(tc, " "); ++len; } } else { size_t i; memmove(&tc[info->width - len], &tc[0], len+1); for (i = 0; i < info->width - len; ++i) tc[i] = (info->flags & FLAG_ZERO) ? '0' : ' '; } } } } /* =item C This is the engine that does all the formatting. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * Parrot_sprintf_format(PARROT_INTERP, ARGIN(const STRING *pat), ARGMOD(SPRINTF_OBJ *obj)) { ASSERT_ARGS(Parrot_sprintf_format) INTVAL i; INTVAL len = 0; INTVAL old = 0; const INTVAL pat_len = (INTVAL)Parrot_str_length(interp, pat); HUGEINTVAL num; HUGEINTVAL sharedint = 0; SpfInfo info = { 0, 0, 0, 0, (PHASE)0 }; /* Storage for flags, etc. */ PMC * const targ = Parrot_pmc_new_init_int(interp, enum_class_StringBuilder, pat_len * 2); INTVAL fmt_start_idx; /* ts is used almost universally as an intermediate target; * tc is used as a temporary buffer by Parrot_str_from_uint and * as a target by gen_sprintf_call. */ STRING *substr = NULL; char tc[PARROT_SPRINTF_BUFFER_SIZE]; for (i = 0; i < pat_len; ++i) { /* Check if we have a '%'. If not, increase the len and continue. */ if (STRING_ord(interp, pat, i) != '%') { len++; continue; } /* We have found a '%'. If we have a len (a number of characters before the '%') take a substring of all those and add it to the buffer */ if (len) { substr = STRING_substr(interp, pat, old, len); VTABLE_push_string(interp, targ, substr); } len = 0; /* Reset the len */ old = i; fmt_start_idx = i; /* If we have a "%%" pattern, we're just going to output a single '%', so reset the counts and continue. */ if (STRING_ord(interp, pat, i + 1) == '%') { /* skip this one, make next the first char * of literal sequence, starting at old */ ++i; ++old; ++len; continue; } /* hoo boy, here we go... */ SPRINTF_RESET_SPFINFO(info); /* Reset temporaries */ tc[0] = '\0'; /* This can be really hard to understand, so I'll try to explain beforehand. * A rough grammar for a printf format is: * * grammar Parrot::PrintF_Format { * rule format { * ( )* * } * * rule other_stuff { * [<[^\%]> | \%\%]*: * } * * rule field { * \% * ? * ? * [\.]? * ? * * } * * rule flags { * <[ * + # prefix with a + if necessary * - # left-align * 0 # zero-pad * # space-pad * \# # 0, 0x on octal, hex; force decimal point on float * ]>+ * } * * rule width { * [\d|\*]+ # minimum width * } * * rule prec { * [\d|\*]+ # width on integers; * # number of digits after decimal on floats; * # maximum width on strings * } * * rule size { * <[ * h # short (or float) * l # long * H # HUGEwhateverVAL (long [long]?, [long]? double) * v # whateverVAL * O # opcode_t * P # really a PMC * S # Parrot string (only with %s) * ]> * } * * rule term { * <[ * c # char * d # integer * i # integer * o # octal * x # hex * X # hex with capital X (if #) * b # binary * B # binary with capital B (if #) * u # unsigned integer * p # pointer * * e # 1e1 * E # 1E1 * f # 1.0 * g # 1, 0.1, 1e1 * G # 1, 0.1, 1E1 * * s # string * ]> * } * } * * Complication: once upon a time, %P existed. Now you should * use %Ps, %Pd or %Pf, but we still need to support the old form. * The same is true of %S--%Ss is the best form, but %S is still * supported. */ for (++i; i < pat_len && info.phase != PHASE_DONE; ++i) { const INTVAL ch = STRING_ord(interp, pat, i); switch (info.phase) { /*@fallthrough@ */ case PHASE_FLAGS: switch (ch) { case '-': info.flags |= FLAG_MINUS; continue; case '+': info.flags |= FLAG_PLUS; continue; case '0': info.flags |= FLAG_ZERO; continue; case ' ': info.flags |= FLAG_SPACE; continue; case '#': info.flags |= FLAG_SHARP; continue; default: info.phase = PHASE_WIDTH; } /*@fallthrough@ */ case PHASE_WIDTH: switch (ch) { case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': info.flags |= FLAG_WIDTH; info.width *= 10; info.width += ch - '0'; continue; case '*': info.flags |= FLAG_WIDTH; num = obj->getint(interp, SIZE_XVAL, obj); if (num < 0) { info.flags |= FLAG_MINUS; info.width = -num; } else { info.width = num; } continue; case '.': info.phase = PHASE_PREC; continue; default: info.phase = PHASE_PREC; } /*@fallthrough@ */ case PHASE_PREC: switch (ch) { case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': info.flags |= FLAG_PREC; info.prec *= 10; info.prec += ch - '0'; continue; case '*': info.flags |= FLAG_PREC; info.prec = (UINTVAL)obj->getint(interp, SIZE_XVAL, obj); info.phase = PHASE_TYPE; continue; default: info.phase = PHASE_TYPE; } /*@fallthrough@ */ case PHASE_TYPE: switch (ch) { case 'h': info.type = SIZE_SHORT; continue; case 'l': info.type = SIZE_LONG; continue; case 'L': case 'H': info.type = SIZE_HUGE; continue; case 'v': info.type = SIZE_XVAL; continue; case 'O': info.type = SIZE_OPCODE; continue; case 'P': info.type = SIZE_PMC; continue; case 'S': info.type = SIZE_PSTR; continue; default: info.phase = PHASE_TERM; } /*@fallthrough@ */ case PHASE_TERM: switch (ch) { /* INTEGERS */ case 'c': { STRING * const ts = Parrot_str_chr(interp, (UINTVAL)obj->getint(interp, info.type, obj)); str_concat_w_flags(interp, targ, &info, ts, NULL); } break; case 'o': { const UHUGEINTVAL theuint = obj->getuint(interp, info.type, obj); STRING * const ts = Parrot_str_from_uint(interp, tc, theuint, 8, 0); STRING * const prefix = CONST_STRING(interp, "0"); /* unsigned conversion - no plus */ info.flags &= ~FLAG_PLUS; str_concat_w_flags(interp, targ, &info, ts, prefix); } break; case 'x': { const UHUGEINTVAL theuint = obj->getuint(interp, info.type, obj); STRING * const ts = Parrot_str_from_uint(interp, tc, theuint, 16, 0); STRING * const prefix = CONST_STRING(interp, "0x"); /* unsigned conversion - no plus */ info.flags &= ~FLAG_PLUS; str_concat_w_flags(interp, targ, &info, ts, prefix); } break; case 'X': { STRING * const prefix = CONST_STRING(interp, "0X"); const UHUGEINTVAL theuint = obj->getuint(interp, info.type, obj); STRING * ts = Parrot_str_from_uint(interp, tc, theuint, 16, 0); ts = Parrot_str_upcase(interp, ts); /* unsigned conversion - no plus */ info.flags &= ~FLAG_PLUS; str_concat_w_flags(interp, targ, &info, ts, prefix); } break; case 'b': { STRING * const prefix = CONST_STRING(interp, "0b"); const UHUGEINTVAL theuint = obj->getuint(interp, info.type, obj); STRING * const ts = Parrot_str_from_uint(interp, tc, theuint, 2, 0); /* unsigned conversion - no plus */ info.flags &= ~FLAG_PLUS; str_concat_w_flags(interp, targ, &info, ts, prefix); } break; case 'B': { STRING * const prefix = CONST_STRING(interp, "0B"); const HUGEINTVAL theint = obj->getint(interp, info.type, obj); STRING * const ts = Parrot_str_from_int_base(interp, tc, theint, 2); /* unsigned conversion - no plus */ info.flags &= ~FLAG_PLUS; str_concat_w_flags(interp, targ, &info, ts, prefix); } break; case 'u': { const UHUGEINTVAL theuint = obj->getuint(interp, info.type, obj); sharedint = theuint; } goto do_sprintf; case 'd': case 'i': /* EVIL: Work around bug in glibc that makes %0lld * sometimes output an empty string. */ if (!(info.flags & FLAG_WIDTH)) info.flags &= ~FLAG_ZERO; sharedint = obj->getint(interp, info.type, obj); do_sprintf: { STRING *ts; gen_sprintf_call(tc, &info, ch); ts = cstr2pstr(tc); { char * const tempstr = Parrot_str_to_cstring(interp, ts); #ifdef PARROT_HAS_SNPRINTF snprintf(tc, PARROT_SPRINTF_BUFFER_SIZE, tempstr, sharedint); #else /* the buffer is 4096, so no problem here */ sprintf(tc, tempstr, sharedint); #endif Parrot_str_free_cstring(tempstr); } VTABLE_push_string(interp, targ, cstr2pstr(tc)); } break; case 'p': { STRING * const prefix = CONST_STRING(interp, "0x"); const void * const ptr = obj->getptr(interp, info.type, obj); STRING * const ts = Parrot_str_from_uint(interp, tc, (UHUGEINTVAL) (size_t) ptr, 16, 0); str_concat_w_flags(interp, targ, &info, ts, prefix); } break; /* FLOATS - We cheat on these and use snprintf. */ case 'e': case 'E': case 'f': case 'g': case 'G': { STRING *ts; const HUGEFLOATVAL thefloat = obj->getfloat(interp, info.type, obj); /* check for Inf and NaN values */ if (PARROT_FLOATVAL_IS_POSINF(thefloat)) { ts = cstr2pstr(PARROT_CSTRING_INF_POSITIVE); } else if (PARROT_FLOATVAL_IS_NEGINF(thefloat)) { ts = cstr2pstr(PARROT_CSTRING_INF_NEGATIVE); } else if (PARROT_FLOATVAL_IS_NAN(thefloat)) { ts = cstr2pstr(PARROT_CSTRING_NAN_QUIET); } else { /* turn -0.0 into 0.0 */ gen_sprintf_call(tc, &info, ch); ts = cstr2pstr(tc); } /* XXX lost precision if %Hg or whatever */ { char * const tempstr = Parrot_str_to_cstring(interp, ts); #ifdef PARROT_HAS_SNPRINTF snprintf(tc, PARROT_SPRINTF_BUFFER_SIZE, tempstr, (double)thefloat); #else /* the buffer is 4096, so no problem here */ sprintf(tc, tempstr, (double)thefloat); #endif Parrot_str_free_cstring(tempstr); } if (ch == 'e' || ch == 'E' || ch == 'g' || ch == 'G') canonicalize_exponent(tc, &info); VTABLE_push_string(interp, targ, cstr2pstr(tc)); } break; /* STRINGS */ case 'r': /* Python repr */ /* XXX the right fix is to add a getrepr entry * * to SPRINTF_OBJ, but for now, getstring_pmc * * is inlined and modified to call get_repr */ if (obj->getstring == pmc_core.getstring) { PMC * const tmp = VTABLE_get_pmc_keyed_int(interp, ((PMC *)obj->data), (obj->index)); STRING * const string = VTABLE_get_repr(interp, tmp); STRING * const ts = handle_flags(interp, &info, string, 0, NULL); ++obj->index; VTABLE_push_string(interp, targ, ts); break; } case 's': CASE_s: { STRING * const string = obj->getstring(interp, info.type, obj); /* XXX Silently ignore? */ if (!STRING_IS_NULL(string)) { STRING * const ts = handle_flags(interp, &info, string, 0, NULL); VTABLE_push_string(interp, targ, ts); } } break; default: /* fake the old %P and %S commands */ if (info.type == SIZE_PMC || info.type == SIZE_PSTR) { --i; goto CASE_s; /* case 's' will see the SIZE_PMC or SIZE_PSTR * and assume it was %Ps (or %Ss). Genius, * no? */ } else { Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_CHARACTER, "'%c' is not valid in sprintf format sequence '%Ss'", ch, STRING_substr(interp, pat, fmt_start_idx, i - fmt_start_idx + 1)); } } info.phase = PHASE_DONE; break; case PHASE_DONE: default: /* This is the terminating condition of the surrounding * loop, so we absolutely shouldn't be here. Throw an * exception and hope this doesn't happen often. */ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_CHARACTER, "Catastrophic sprintf error. Your input is very bad. " "Please file a bug report."); } } old = i; --i; } if (len) { substr = STRING_substr(interp, pat, old, len); VTABLE_push_string(interp, targ, substr); } return VTABLE_get_string(interp, targ); } /* =back =head1 SEE ALSO F, F, F =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ 006-bad_step.t000644000765000765 432611533177643 17225 0ustar00brucebruce000000000000parrot-5.9.0/t/configure#! perl # Copyright (C) 2007, Parrot Foundation. # 006-bad_step.t use strict; use warnings; use Test::More tests => 11; use Carp; use lib qw( lib ); use Parrot::Configure; use Parrot::Configure::Options qw( process_options ); $| = 1; is( $|, 1, "output autoflush is set" ); my ($args, $step_list_ref) = process_options( { argv => [], mode => q{configure}, } ); ok( defined $args, "process_options returned successfully" ); my %args = %$args; my $conf = Parrot::Configure->new; ok( defined $conf, "Parrot::Configure->new() returned okay" ); my $badstep = q{bad::step}; my $badsteppath = q{bad/step.pm}; $conf->add_steps($badstep); my @confsteps = @{ $conf->steps }; isnt( scalar @confsteps, 0, "Parrot::Configure object 'steps' key holds non-empty array reference" ); is( scalar @confsteps, 1, "Parrot::Configure object 'steps' key holds ref to 1-element array" ); my $nontaskcount = 0; foreach my $k (@confsteps) { $nontaskcount++ unless $k->isa("Parrot::Configure::Task"); } is( $nontaskcount, 0, "Each step is a Parrot::Configure::Task object" ); is( $confsteps[0]->step, $badstep, "'step' element of Parrot::Configure::Task struct identified" ); ok( !ref( $confsteps[0]->object ), "'object' element of Parrot::Configure::Task struct is not yet a ref" ); $conf->options->set(%args); is( $conf->options->{c}->{debugging}, 1, "command-line option '--debugging' has been stored in object" ); my $rv; eval { $rv = $conf->runsteps; }; like( $@, qr/Can't locate $badsteppath in \@INC/, #' "Got expected die message when runsteps() called with nonexistent step" ); pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME 006-bad_step.t - test bad step failure case in Parrot::Configure =head1 SYNOPSIS % prove t/configure/006-bad_step.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file examine what happens when you attempt to do a C on a non-existent step. =head1 AUTHOR James E Keenan =head1 SEE ALSO Parrot::Configure, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: 05-trace.t000644000765000765 1565411533177646 17420 0ustar00brucebruce000000000000parrot-5.9.0/t/postconfigure#! perl # Copyright (C) 2007, Parrot Foundation. # 05-trace.t use strict; use warnings; no warnings 'once'; use Carp; use Test::More; if ( ( -e qq{./lib/Parrot/Config/Generated.pm} ) and ( -e qq{./.configure_trace.sto} ) ) { plan tests => 40; } else { plan skip_all => q{Tests irrelevant unless configuration completed with tracing requested}; } use lib qw( lib ); use Parrot::Config; use_ok('Parrot::Configure::Trace'); $Storable::Eval = 1; use Parrot::Configure::Step::List qw( get_steps_list ); my $obj; eval { $obj = Parrot::Configure::Trace->new( [ storable => '.configure_trace.sto', ] ); }; like( $@, qr/^Constructor correctly failed due to non-hashref argument/, "Correctly failed due to argument other than hash ref" ); eval { $obj = Parrot::Configure::Trace->new( { storable => 'somestrangename.sto', } ); }; like( $@, qr/^Unable to retrieve storable file of configuration step data/, "Correctly failed due to non-existent config data file" ); ok( $obj = Parrot::Configure::Trace->new(), "Constructor returned true" ); isa_ok( $obj, q{Parrot::Configure::Trace} ); my $steps = $obj->list_steps(); my $steps_number = scalar( @{$steps} ); is( ref($steps), q{ARRAY}, "list_steps() correctly returned array ref" ); # Sanity check! my @PConfig_steps = split /\s+/, $PConfig{configuration_steps}; is_deeply( $steps, [ @PConfig_steps ], "list_steps() returned same as \$Parrot::Config::PConfig{configuration_steps}" ); my $index = $obj->index_steps(); is( ref($index), q{HASH}, "index_steps() correctly returned hash ref" ); is( scalar( keys %{$index} ), $steps_number, "list_steps() and index_steps() return same number of elements" ); my ( $attr, $trig, $bad ); $attr = $obj->trace_options_c( { attr => 'yacc', } ); is( ref($attr), q{ARRAY}, "trace_options_c() correctly returned array ref" ); is( scalar( @{$attr} ), $steps_number, "trace_options_c() and list_steps() return same number of elements" ); $attr = $obj->trace_options_c( { attr => 'yacc', verbose => 1, } ); is( ref($attr), q{ARRAY}, "trace_options_c() correctly returned array ref" ); is( scalar( @{$attr} ), $steps_number, "trace_options_c() and list_steps() return same number of elements" ); $bad = 0; foreach my $el ( @{$attr} ) { $bad++ unless ref($el) eq 'HASH'; } is( $bad, 0, "With 'verbose', each element in array returned by trace_options_c() is hash ref" ); $trig = $obj->trace_options_triggers( { trig => 'yacc', } ); is( ref($trig), q{ARRAY}, "trace_options_triggers() correctly returned array ref" ); is( scalar( @{$trig} ), $steps_number, "trace_options_triggers() and list_steps() return same number of elements" ); $trig = $obj->trace_options_triggers( { trig => 'yacc', verbose => 1, } ); is( ref($trig), q{ARRAY}, "trace_options_triggers() correctly returned array ref" ); is( scalar( @{$trig} ), $steps_number, "trace_options_triggers() and list_steps() return same number of elements" ); $bad = 0; foreach my $el ( @{$trig} ) { $bad++ unless ref($el) eq 'HASH'; } is( $bad, 0, "With 'verbose', each element in array returned by trace_options_triggers() is hash ref" ); $attr = $obj->trace_data_c( { attr => 'yacc', } ); is( ref($attr), q{ARRAY}, "trace_data_c() correctly returned array ref" ); is( scalar( @{$attr} ), $steps_number, "trace_data_c() and list_steps() return same number of elements" ); $attr = $obj->trace_data_c( { attr => 'yacc', verbose => 1, } ); is( ref($attr), q{ARRAY}, "trace_data_c() correctly returned array ref" ); is( scalar( @{$attr} ), $steps_number, "trace_data_c() and list_steps() return same number of elements" ); $bad = 0; my $list_diff_steps; $list_diff_steps = $obj->diff_data_c( { attr => 'ccflags' } ); is(ref($list_diff_steps), 'ARRAY', "diff_data_c returned array ref"); for (my $i=0; $i <= $#$list_diff_steps; $i++) { $bad++ if ref($list_diff_steps->[$i]) ne 'HASH'; } is($bad, 0, "Output of diff_data_c() is ref to array of hashrefs"); $bad = 0; $list_diff_steps = $obj->diff_data_c( { attr => 'inc' } ); is(ref($list_diff_steps), 'ARRAY', "diff_data_c returned array ref"); for (my $i=0; $i <= $#$list_diff_steps; $i++) { $bad++ if ref($list_diff_steps->[$i]) ne 'HASH'; } is($bad, 0, "Output of diff_data_c() is ref to array of hashrefs"); $bad = 0; foreach my $el ( @{$attr} ) { $bad++ unless ref($el) eq 'HASH'; } is( $bad, 0, "With 'verbose', each element in array returned by trace_data_c() is hash ref" ); $trig = $obj->trace_data_triggers( { trig => 'yacc', } ); is( ref($trig), q{ARRAY}, "trace_data_triggers() correctly returned array ref" ); is( scalar( @{$trig} ), $steps_number, "trace_data_triggers() and list_steps() return same number of elements" ); $trig = $obj->trace_data_triggers( { trig => 'yacc', verbose => 1, } ); is( ref($trig), q{ARRAY}, "trace_data_triggers() correctly returned array ref" ); is( scalar( @{$trig} ), $steps_number, "trace_data_triggers() and list_steps() return same number of elements" ); $bad = 0; foreach my $el ( @{$trig} ) { $bad++ unless ref($el) eq 'HASH'; } is( $bad, 0, "With 'verbose', each element in array returned by trace_data_triggers() is hash ref" ); my @state; my $test_step = 'gen::makefiles'; ok( $state[0] = $obj->get_state_at_step($index->{$test_step}), "get_state_at_step() returned true" ); ok( $state[1] = $obj->get_state_at_step($test_step), "get_state_at_step() returned true" ); is_deeply( $state[0], $state[1], "Numeric and string arguments gave same result" ); my $state; eval { $state = $obj->get_state_at_step(0); }; like( $@, qr/^Must supply positive integer as step number/, "Correctly failed due to non-positive argument" ); eval { $state = $obj->get_state_at_step(1000000); }; like( $@, qr/^Must supply positive integer as step number/, "Correctly failed due to non-existent step" ); eval { $state = $obj->get_state_at_step(q{init::something}); }; like( $@, qr/^Must supply valid step name/, "Correctly failed due to non-existent step" ); pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME 05-trace.t - test Parrot::Configure::Trace =head1 SYNOPSIS % prove t/postconfigure/05-trace.t =head1 DESCRIPTION The files in this directory test functionality used by F. Certain of the modules Cd by F have functionality which is only meaningful I F has actually been run and Parrot::Config::Generated has been created. So certain tests need to be run when your Parrot filesystem is in a "pre-F, post-F" state. The tests in this file test Parrot::Configure::Trace methods. =head1 AUTHOR James E Keenan =head1 SEE ALSO Parrot::Configure::Trace, Parrot::Configure, Parrot::Configure::Options, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: eval.pmc000644000765000765 2632712226525704 15546 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME src/pmc/eval.pmc - Dynamic code evaluation =head1 DESCRIPTION C extends C to provide C-like dynamic code evaluation and execution. =cut */ #include "pmc/pmc_sub.h" /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static PMC* get_sub(PARROT_INTERP, ARGIN(PMC *self), int idx) __attribute__nonnull__(1) __attribute__nonnull__(2); static void mark_ct(PARROT_INTERP, ARGIN(PMC *self)) __attribute__nonnull__(1) __attribute__nonnull__(2); #define ASSERT_ARGS_get_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self)) #define ASSERT_ARGS_mark_ct __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ pmclass Eval extends Sub provides invokable auto_attrs { /* =head2 Vtable functions =over 4 =item C Initializes a new empty Eval. =item C Destroy the Eval and its associated bytecode. =item C Mark this Eval. =cut */ VTABLE void init() { Parrot_Sub_attributes *sub_data; SUPER(); PMC_get_sub(INTERP, SELF, sub_data); sub_data->seg = NULL; PObj_custom_mark_destroy_SETALL(SELF); } VTABLE void destroy() { /* * If the compiled code contained any .sub (or .pcc.sub) * subroutines, these subs got installed in the globals * during compiling this bytecode segment. * * These globals still exist, calling them will segfault * as the segment is destroyed now. * * TT # 1230: * Walk the fixups, locate globals and nullify the Sub PMC * This probably needs a pointer into the globals. * * OTOH - if the global exists - this eval pmc ought * to be alive and destroy isn't called. */ PackFile_ByteCode *cur_cs; Parrot_Sub_attributes *sub_data; PMC_get_sub(INTERP, SELF, sub_data); if (!sub_data) { SUPER(); return; } cur_cs = sub_data->seg; if (!cur_cs) { SUPER(); return; } /* XXX Quick and dirty fix for TT #995 */ #if 0 if ((struct PackFile *)cur_cs == INTERP->initial_pf || cur_cs == INTERP->code) { SUPER(); return; } #endif #if 0 seg = (PackFile_Segment *)cur_cs->const_table; if (seg) { PackFile_Segment_destroy(INTERP, seg); cur_cs->const_table = NULL; } seg = (PackFile_Segment *)cur_cs->debugs; if (seg) { PackFile_Segment_destroy(INTERP, seg); cur_cs->debugs = NULL; } seg = (PackFile_Segment *)cur_cs; if (seg) PackFile_Segment_destroy(INTERP, seg); #endif sub_data->seg = NULL; SUPER(); } VTABLE void mark() { SUPER(); mark_ct(INTERP, SELF); } /* =item C Returns the address of the associated packfile. =cut */ VTABLE void *get_pointer() { Parrot_Sub_attributes *sub; PMC_get_sub(INTERP, SELF, sub); if (sub) { const PackFile_ByteCode * const seg = sub->seg; if (seg) return seg->base.pf; } return NULL; } /* =item C Invokes the first subroutine in the eval code. =cut */ VTABLE opcode_t *invoke(void *next) { PMC * const sub = SELF.get_pmc_keyed_int(0); return VTABLE_invoke(INTERP, sub, next); } /* =item C Get a STRING representing the bytecode for this code segment, suitable for writing to disc and later loading via C. =cut */ VTABLE STRING *get_string() { Parrot_Sub_attributes *sub; PackFile *pf = PackFile_new(INTERP, 0); PackFile_ByteCode *seg; STRING *res; size_t size, aligned_size; PMC_get_sub(INTERP, SELF, sub); seg = sub->seg; PackFile_add_segment(INTERP, &pf->directory, (PackFile_Segment *)seg); if (seg->const_table) PackFile_add_segment(INTERP, &pf->directory, (PackFile_Segment *)seg->const_table); if (seg->debugs) PackFile_add_segment(INTERP, &pf->directory, (PackFile_Segment *)seg->debugs); size = PackFile_pack_size(INTERP, pf) * sizeof (opcode_t); /* * work around packfile bug: * as far as I have checked it the story is: * - PackFile_pack_size() assumes 16 byte alignment but doesn't * have the actual start of the code (packed) * - PackFile_pack() uses 16 bye alignment relative to the start * of the code, which isn't really the same * Therefore align code at 16, which should give the desired * effect */ aligned_size = size + 15; res = Parrot_str_new_init(INTERP, NULL, aligned_size, Parrot_binary_encoding_ptr, 0); res->strlen = res->bufused = size; if ((size_t)(res->strstart) & 0xf) { char *adr = res->strstart; adr += 16 - ((size_t)adr & 0xf); res->strstart = adr; } /* We block GC while doing the packing, since GC run during a pack has been observed to cause problems. There may be a Better Fix. See http://rt.perl.org/rt3/Ticket/Display.html?id=40410 for example of the problem (note on line that segfaults, it is *cursor that is pointing to dealloced memory). */ Parrot_block_GC_mark(INTERP); PackFile_pack(INTERP, pf, (opcode_t *)res->strstart); Parrot_unblock_GC_mark(INTERP); /* now remove all segments from directory again and destroy * the packfile */ pf->directory.num_segments = 0; PackFile_destroy(INTERP, pf); return res; } /* =item C Returns the Sub PMC of the element at index C or PMCNULL. =cut */ VTABLE PMC *get_pmc_keyed_int(INTVAL key) { return get_sub(INTERP, SELF, key); } /* =item C Archives the evaled code =item C Unarchives the code. =cut */ VTABLE void freeze(PMC *info) { STRING * const packed = SELF.get_string(); VTABLE_push_string(INTERP, info, packed); SUPER(info); } VTABLE void thaw(PMC *info) { STRING * const packed = VTABLE_shift_string(INTERP, info); PackFile *pf; PMC *pfpmc; Parrot_Sub_attributes *sub; size_t i; SUPER(info); pf = PackFile_new(INTERP, 0); pfpmc = Parrot_pf_get_packfile_pmc(INTERP, pf, STRINGNULL); if (!PackFile_unpack(INTERP, pf, (opcode_t *)packed->strstart, packed->strlen)) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR, "couldn't unpack packfile"); for (i = 0; i < pf->directory.num_segments; ++i) { PackFile_Segment * const seg = pf->directory.segments[i]; if (seg->type == PF_BYTEC_SEG) { PMC_get_sub(INTERP, SELF, sub); sub->seg = (PackFile_ByteCode *)seg; break; } } pf->directory.num_segments = 0; /* * TT #1292 this isn't ok - it seems that the packfile * gets attached to INTERP->code and is * destroyed again during interpreter destruction */ /* PackFile_destroy(INTERP, pf); */ } VTABLE INTVAL elements() { INTVAL n = 0; Parrot_Sub_attributes *sub; PackFile_ByteCode *seg; PMC_get_sub(INTERP, SELF, sub); seg = sub->seg; if (seg) { const PackFile_ConstTable * const ct = seg->const_table; if (ct) { INTVAL i; STRING * const SUB = CONST_STRING(interp, "Sub"); for (i = 0; i < ct->pmc.const_count; ++i) { PMC * const x = ct->pmc.constants[i]; if (VTABLE_isa(interp, x, SUB)) ++n; } } } return n; } /* =back =head2 Methods =over 4 =item C Return the main sub, if any, null PMC otherwise. =cut */ METHOD get_main() { PMC * const mainsub = Parrot_pf_get_packfile_main_sub(INTERP, SELF); RETURN(PMC * mainsub); } /* =item C Return an object providing indexed access to all subs in the compilation unit (i.e., self). Provides compability with new packfile_pmc API. =item C Dummy method to emulate C method of the PackFileView PMC. Returns true if C is equal to C<"init">, since C<:init> subs are automatically invoked when an EvalPMC is loaded, and false for all other tags. =cut */ METHOD all_subs() { RETURN(PMC * SELF); } METHOD is_initialized(STRING *tag) { const INTVAL ret = STRING_equal(interp, tag, CONST_STRING(interp, "init")); RETURN(INTVAL ret); } } /* =back =head2 Auxiliar functions =over 4 =item C Get the Cth Sub PMC from the constants table. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static PMC* get_sub(PARROT_INTERP, ARGIN(PMC *self), int idx) { ASSERT_ARGS(get_sub) Parrot_Sub_attributes *sub; PackFile_ByteCode *seg; PMC_get_sub(interp, self, sub); seg = sub->seg; if (seg) { const PackFile_ConstTable * const ct = seg->const_table; if (ct) { INTVAL i; for (i = 0; i < ct->pmc.const_count; ++i) { STRING * const SUB = CONST_STRING(interp, "Sub"); PMC * const x = ct->pmc.constants[i]; if (VTABLE_isa(interp, x, SUB)) if (!idx--) return x; } } } return PMCNULL; } /* =item C Mark the bytecode segment pointed to by this Eval for GC. =cut */ static void mark_ct(PARROT_INTERP, ARGIN(PMC *self)) { ASSERT_ARGS(mark_ct) Parrot_Sub_attributes *sub; PackFile_ByteCode *seg; PMC_get_sub(interp, self, sub); seg = sub->seg; if (seg) { const PackFile_ConstTable * const ct = seg->const_table; if (ct) { INTVAL i; for (i = 0; i < ct->pmc.const_count; ++i) { PMC * const csub = ct->pmc.constants[i]; Parrot_gc_mark_PMC_alive(interp, csub); } } } } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ iota.pm000644000765000765 135311533177644 20655 0ustar00brucebruce000000000000parrot-5.9.0/t/configure/testlib/init# Copyright (C) 2001-2003, Parrot Foundation. =head1 NAME t/configure/testlib/init/iota.pm - Module used in configuration tests =head1 DESCRIPTION Nonsense module used only in testing the configuration system. =cut package init::iota; use strict; use warnings; use base qw(Parrot::Configure::Step); sub _init { my $self = shift; my %data; $data{description} = q{Determining if your computer does iota}; $data{args} = [ qw( ) ]; $data{result} = q{}; return \%data; } my $result = undef; sub runstep { my ( $self, $conf ) = @_; $self->set_result($result); return; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: fixedbooleanarray_pmc.in000644000765000765 3215011567202625 25376 0ustar00brucebruce000000000000parrot-5.9.0/t/tools/dev/headerizer/testlib/* Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME src/pmc/fixedbooleanarray.pmc - fixed size array for booleans only =head1 DESCRIPTION The C PMC implements an array of fixed size, which stores booleans. It uses the C PMC for all conversions. The C PMC is extended by the C PMC. =head2 Functions =over 4 =item C Auxiliar function to avoid repeating the size evaluation. =cut */ #define BITS_PER_CHAR 8 /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_INLINE static UINTVAL get_size_in_bytes(UINTVAL size); #define ASSERT_ARGS_get_size_in_bytes __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ PARROT_INLINE static UINTVAL get_size_in_bytes(UINTVAL size) { ASSERT_ARGS(get_size_in_bytes) return (size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; } pmclass FixedBooleanArray auto_attrs provides array { ATTR UINTVAL size; /* # of bits this fba holds */ ATTR UINTVAL resize_threshold; /* max capacity before resizing */ ATTR unsigned char * bit_array; /* where the bits go */ /* =back =head2 Vtable functions =over 4 =item C Initializes the array. =cut */ VTABLE void init() { PObj_custom_destroy_SET(SELF); } /* =item C Initializes the array. =cut */ VTABLE void init_int(INTVAL size) { const size_t size_in_bytes = get_size_in_bytes(size); if (size < 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, _("FixedBooleanArray: Cannot set array size to a negative number (%d)"), size); SET_ATTR_size(INTERP, SELF, size); SET_ATTR_resize_threshold(INTERP, SELF, size_in_bytes * BITS_PER_CHAR); SET_ATTR_bit_array(INTERP, SELF, mem_gc_allocate_n_zeroed_typed(INTERP, size_in_bytes, unsigned char)); PObj_custom_destroy_SET(SELF); } /* =item C Destroys the array. =cut */ VTABLE void destroy() { unsigned char *bit_array; GET_ATTR_bit_array(INTERP, SELF, bit_array); if (bit_array) mem_gc_free(INTERP, bit_array); } /* =item C Creates and returns a copy of the array. =cut */ VTABLE PMC *clone() { unsigned char * my_bit_array, * clone_bit_array; UINTVAL resize_threshold, size; PMC * const dest = Parrot_pmc_new(INTERP, SELF->vtable->base_type); GET_ATTR_bit_array(INTERP, SELF, my_bit_array); GET_ATTR_size(INTERP, SELF, size); GET_ATTR_resize_threshold(INTERP, SELF, resize_threshold); if (my_bit_array) { const size_t size_in_bytes = get_size_in_bytes(resize_threshold); SET_ATTR_size(INTERP, dest, size); SET_ATTR_resize_threshold(INTERP, dest, resize_threshold); clone_bit_array = mem_gc_allocate_n_typed(INTERP, size_in_bytes, unsigned char); mem_sys_memcopy(clone_bit_array, my_bit_array, size_in_bytes); SET_ATTR_bit_array(INTERP, dest, clone_bit_array); } PObj_custom_destroy_SET(dest); return dest; } /* =item C Returns whether the array has any elements (meaning been initialized, for a fixed sized array). =cut */ VTABLE INTVAL get_bool() { return SELF.elements() ? 1 : 0; } /* =item C =cut */ VTABLE INTVAL elements() { UINTVAL size; GET_ATTR_size(INTERP, SELF, size); return size; } /* =item C Returns the number of elements in the array. =cut */ VTABLE INTVAL get_integer() { return SELF.elements(); } /* =item C Returns the integer value of the element at index C. =cut */ VTABLE INTVAL get_integer_keyed_int(INTVAL key) { UINTVAL size; const unsigned char * bit_array; GET_ATTR_bit_array(INTERP, SELF, bit_array); GET_ATTR_size(INTERP, SELF, size); if (key < 0 || (UINTVAL)key >= size) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "FixedBooleanArray: index out of bounds!"); return (bit_array[key / BITS_PER_CHAR] & (1 << (key % BITS_PER_CHAR))) ? 1 : 0; } /* =item C Returns the integer value of the element at index C<*key>. =cut */ VTABLE INTVAL get_integer_keyed(PMC *key) { /* simple int keys only */ const INTVAL k = VTABLE_get_integer(INTERP, key); return SELF.get_integer_keyed_int(k); } /* =item C Returns the floating-point value of the element at index C. =cut */ VTABLE FLOATVAL get_number_keyed_int(INTVAL key) { const INTVAL i = SELF.get_integer_keyed_int(key); return (FLOATVAL)i; } /* =item C Returns the floating-point value of the element at index C<*key>. =cut */ VTABLE FLOATVAL get_number_keyed(PMC *key) { const INTVAL k = VTABLE_get_integer(INTERP, key); return SELF.get_number_keyed_int(k); } /* =item C Returns the Parrot string representation of the array. =cut */ VTABLE STRING *get_string() { STRING *zero, *one; STRING *str = STRINGNULL; UINTVAL i; UINTVAL elems = SELF.elements(); zero = CONST_STRING(INTERP, "0"); one = CONST_STRING(INTERP, "1"); for (i = 0; i < elems; ++i) { if (SELF.get_integer_keyed_int((INTVAL)i)) str = Parrot_str_concat(INTERP, str, one); else str = Parrot_str_concat(INTERP, str, zero); } return str; } /* =item C Returns the Parrot string value of the element at index C. =cut */ VTABLE STRING *get_string_keyed_int(INTVAL key) { PMC * const val = SELF.get_pmc_keyed_int(key); return VTABLE_get_string(INTERP, val); } /* =item C Returns the Parrot string value of the element at index C<*key>. =cut */ VTABLE STRING *get_string_keyed(PMC *key) { const INTVAL k = VTABLE_get_integer(INTERP, key); return SELF.get_string_keyed_int(k); } /* =item C Returns the PMC value of the element at index C. =cut */ VTABLE PMC *get_pmc_keyed_int(INTVAL key) { return Parrot_pmc_new_init_int(INTERP, enum_class_Boolean, SELF.get_integer_keyed_int(key)); } /* =item C Returns the PMC value of the element at index C<*key>. =cut */ VTABLE PMC *get_pmc_keyed(PMC *key) { const INTVAL k = VTABLE_get_integer(INTERP, key); return SELF.get_pmc_keyed_int(k); } /* =item C Resizes the array to C elements. =cut */ VTABLE void set_integer_native(INTVAL size) { const size_t size_in_bytes = get_size_in_bytes(size); UINTVAL old_size; unsigned char *bit_array; GET_ATTR_size(INTERP, SELF, old_size); if (old_size || size < 1) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "FixedBooleanArray: Can't resize!"); SET_ATTR_size(INTERP, SELF, size); SET_ATTR_resize_threshold(INTERP, SELF, size_in_bytes * BITS_PER_CHAR); bit_array = mem_gc_allocate_n_typed(INTERP, size_in_bytes, unsigned char); memset(bit_array, 0, size_in_bytes); SET_ATTR_bit_array(INTERP, SELF, bit_array); } /* =item C Sets the integer value of the element at index C to C. =cut */ VTABLE void set_integer_keyed_int(INTVAL key, INTVAL value) { UINTVAL size; unsigned char * bit_array; GET_ATTR_bit_array(INTERP, SELF, bit_array); GET_ATTR_size(INTERP, SELF, size); if (key < 0 || (UINTVAL)key >= size) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "FixedBooleanArray: index out of bounds!"); if (value) bit_array[key/BITS_PER_CHAR] |= (1 << (key % BITS_PER_CHAR)); else bit_array[key/BITS_PER_CHAR] &= ~(1 << (key % BITS_PER_CHAR)); } /* =item C Sets the integer value of the element at index C to C. =cut */ VTABLE void set_integer_keyed(PMC *key, INTVAL value) { const INTVAL k = VTABLE_get_integer(INTERP, key); SELF.set_integer_keyed_int(k, value); } /* =item C Sets the floating-point value of the element at index C to C. =cut */ VTABLE void set_number_keyed_int(INTVAL key, FLOATVAL value) { SELF.set_integer_keyed_int(key, !FLOAT_IS_ZERO(value)); } /* =item C Sets the floating-point value of the element at index C to C. =cut */ VTABLE void set_number_keyed(PMC *key, FLOATVAL value) { const INTVAL k = VTABLE_get_integer(INTERP, key); SELF.set_number_keyed_int(k, value); } /* =item C Sets the Parrot string value of the element at index C to C. =cut */ VTABLE void set_string_keyed_int(INTVAL key, STRING *value) { INTVAL tempInt; PMC * const tempPMC = Parrot_pmc_new(INTERP, enum_class_Boolean); VTABLE_set_string_native(INTERP, tempPMC, value); tempInt = VTABLE_get_integer(INTERP, tempPMC); SELF.set_integer_keyed_int(key, tempInt); } /* =item C Sets the string value of the element at index C to C. =cut */ VTABLE void set_string_keyed(PMC *key, STRING *value) { const INTVAL k = VTABLE_get_integer(INTERP, key); SELF.set_string_keyed_int(k, value); } /* =item C Sets the PMC value of the element at index C to C<*src>. =cut */ VTABLE void set_pmc_keyed_int(INTVAL key, PMC *src) { const INTVAL tempInt = VTABLE_get_integer(INTERP, src); SELF.set_integer_keyed_int(key, tempInt); } /* =item C Sets the string value of the element at index C to C. =cut */ VTABLE void set_pmc_keyed(PMC *key, PMC *value) { const INTVAL k = VTABLE_get_integer(INTERP, key); SELF.set_pmc_keyed_int(k, value); } /* =item C Return a new iterator for SELF. =cut */ VTABLE PMC *get_iter() { return Parrot_pmc_new_init(INTERP, enum_class_ArrayIterator, SELF); } /* =back =head2 Freeze/thaw Interface =over 4 =item C Used to archive the string. =cut */ VTABLE void freeze(PMC *info) { UINTVAL size, resize_threshold; unsigned char * bit_array; STRING * s; GET_ATTR_size(INTERP, SELF, size); GET_ATTR_resize_threshold(INTERP, SELF, resize_threshold); GET_ATTR_bit_array(INTERP, SELF, bit_array); s = Parrot_str_new(INTERP, (char*)bit_array, (resize_threshold / BITS_PER_CHAR)); VTABLE_push_integer(INTERP, info, size); VTABLE_push_string(INTERP, info, s); } /* =item C Used to unarchive the string. =cut */ VTABLE void thaw(PMC *info) { SUPER(info); { const INTVAL size = VTABLE_shift_integer(INTERP, info); STRING * const s = VTABLE_shift_string(INTERP, info); unsigned char * const bit_array = (unsigned char *)Parrot_str_to_cstring(INTERP, s); const UINTVAL threshold = Parrot_str_byte_length(INTERP, s) * BITS_PER_CHAR; SET_ATTR_size(INTERP, SELF, size); SET_ATTR_resize_threshold(INTERP, SELF, threshold); SET_ATTR_bit_array(INTERP, SELF, bit_array); } } /* =back =head2 Methods =over 4 =item C Sets all of the entires to true if fill is a true value, otherwise sets them all to false. =cut */ METHOD fill(INTVAL fill) { UINTVAL size; unsigned char * bit_array; size_t size_in_bytes; GET_ATTR_bit_array(INTERP, SELF, bit_array); GET_ATTR_size(INTERP, SELF, size); size_in_bytes = get_size_in_bytes(size); if (size_in_bytes) memset(bit_array, fill ? 0xff : 0, size_in_bytes); } } /* =back =head1 SEE ALSO F. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4: */ glossary.pod000644000765000765 2423412101554066 16035 0ustar00brucebruce000000000000parrot-5.9.0/docs# Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME docs/glossary.pod - Parrot Glossary =head1 DESCRIPTION Short descriptions of words and acronyms found in Parrot development. =head1 VERSION LAST UPDATED: 24 MAY 2012 glossary.pod is updated and maintained from Parrot's GitHub repository. You may get the most up-to-date version at: L<< https://github.com/parrot/parrot/docs/glossary.pod >> =head1 GLOSSARY =for comment Please keep this file alphabetical. =over 4 =item AST Abstract Syntax Tree: a data structure typically generated by a language parser. =item bcg Bytecode Generation: bcg will be part of the Parrot Compiler tools. It will aid in converting POST to bytecode. =item Continuations Think of continuations as an execution "context". This context includes everything local to that execution path, not just the stack. It is a snapshot in time (minus global variables). While it is similar to C's C (taking the continuation)/C (invoking the continuation), C'ing only works "down" the stack; jumping "up" the stack (ie, back to a frame that has returned) is bad. Continuations can work either way. We can do two important things with continuations: =over 4 =item 1 Create and pass a continuation object to a subroutine, which may recursively pass that object up the call chain until, at some point, the continuation can be called/executed to handle the final computation or return value. This is pretty much tail recursion. =item 2 Continuations can be taken at an arbitrary call depth, freezing the call chain (context) at that point in time. If we save that continuation object into a variable, we can later reinstate the complete context by its "handle". This allows neat things like backtracking that aren't easily done in conventional stacked languages, such as C. Since continuations represent "branches" in context, it requires an environment that uses some combination of heap-based stacks, stack trees and/or stack copying. =back It is common in a system that supports continuations to implement L on top of them. A continuation is a sort of super-closure. When you take a continuation, it makes a note of the current call stack and lexical scratchpads, along with the current location in the code. When you invoke a continuation, the system drops what it's doing, puts the call stack and scratchpads back, and jumps to the execution point you were at when the continuation was taken. It is, in effect, like you never left that point in your code. Note that, like with closures, it only puts the B back in scope - it doesn't do anything with the values in the variables that are in those scratchpads. =item Co-Routines Co-routines are virtually identical to normal subroutines, except while subroutines always execute from their starting instruction to where they return, co-routines may suspend themselves (or be suspended asynchronously if the language permits) and resume at that point later. We can implement things like "factories" with co-routines. If the co-routine never returns, every time we call it, we "resume" the routine. A co-routine is a subroutine that can stop in the middle, and start back up later at the point you stopped. For example: sub sample : coroutine { print "A\n"; yield; print "B\n"; return; } sample(); print "Foo!\n"; sample(); will print A Foo! B Basically, the C keyword says, "Stop here, but the next time we're called, pick up at the next statement." If you return from a co-routine, the next invocation starts back at the beginning. Co-routines remember all their state, local variables, and suchlike things. =item COW Copy On Write: a technique that copies strings lazily. If you have a string A, and make a copy of it to get string B, the two strings should be identical, at least to start. With COW, they are, because string A and string B aren't actually two separate strings - they're the same string, marked COW. If either string A or string B are changed, the system notes it and only at that point does it make a copy of the string data and change it. If the program never actually changes the string - something that's fairly common - the program need never make a copy, saving both memory and time. =item destruction Destruction is low level memory clean up, such as calling C on Ced memory. This happens after L<"finalization">, and if resources are adequate, may only happen as a side effect of program exit. =item DOD Dead Object Detection: the process of sweeping through all the objects, variables, and whatnot inside of Parrot, and deciding which ones are in use and which ones aren't. The ones that aren't in use are then freed up for later reuse. (After they're destroyed, if active destruction is warranted.) See also: L<"GC"> =item finalization Finalization is high-level, user visible cleanup of objects, such as closing an associated DB handle. Finalization reduces active objects down to passive blocks of memory, but does not actually reclaim that memory. Memory is reclaimed by the related L<"destruction"> operation, as and when necessary. =item GC Garbage Collection: the process of sweeping through all the active objects, variables, and structures, marking the memory they're using as in use, and all other memory is freed up for later reuse. Garbage Collection and Dead Object Detection are separate in Parrot, since we generally chew through memory segments faster than we chew through objects. (This is a characteristic peculiar to Perl and other languages that do string processing. Other languages chew through objects faster than memory) See also: L<"DOD"> =item HLL High-Level Language; Any of the languages that target the parrot virtual machine. =item ICU International Components for Unicode ICU is a C and C++ library that provides support for Unicode on a variety of platforms. It was distributed with parrot at one time, but current releases require you to get your own copy. L =item IMCC Intermediate Code Compiler: the component of parrot that compiles PASM and PIR into bytecode. See also L<"PIR">. =item JAPH Just another Parrot Hacker: or, a small script that generates that text. =item MRO Method resolution order =item NCI Native Call Interface: parrot's interface to native "C" libraries, without a C-compiler. =item NQP Not Quite Perl (6): designed to be a very small compiler for quickly generating PIR routines to create transformers for Parrot (especially HLL compilers). See also L<"PCT">. =item Packfile Another name for a PBC file, due to the names used for data structures in one of the early implementations in Perl 5. =item PAST Acronym for Parrot Abstract Syntax Tree, a set of classes that represent an abstract syntax tree. See also L<"PCT">. =item PASM Parrot Assembly Language is the lowest level language before being translated in to bytecode. Generally PIR is used. =item PBC Parrot bytecode. The name for the "executable" files that can be passed to the Parrot interpreter for immediate execution (although PASM and IMC files can be executed directly, too). See also L<"Packfile">. =item PCT Parrot Compiler Toolkit: a complete set of tools and libraries that are designed to create compilers targeting Parrot. The principal components of PCT are PGE, PCT::HLLCompiler (a compiler driver), PAST classes, POST classes, PCT::Grammar (a base class for PGE grammars). In the ideal case, a language can be implemented by providing its parser (using Perl 6 rules) which is generated by PGE, and providing a module written in NQP that contains the I that are to be invoked during the parse. These actions can then create the appropriate PAST nodes. A PAST to PIR transformation already exists. Depending on the language, other phases can be added, or overridden (for instance, the PAST to PIR transformation). =item PDD Parrot Design Document: documents that describe the features parrot must implement. See also L<< Running|http://docs.parrot.org/parrot/latest/html/docs/running.pod.html >> and L<< PDD 0: Design Document Format|http://docs.parrot.org/parrot/latest/html/docs/pdds/pdd00_pdd.pod.html >>. =item PGE Parrot Grammar Engine. See also L<"PCT">. =item PIR Parrot Intermediate Representation: A medium-level assembly language for Parrot that hides messy details like register allocation so language compiler writers who target Parrot don't have to roll their own. Files have the extension C<.pir>. =item PMC Polymorphic Container: these classes are the primitives that HLLs use to represent their fundamental types, such as Perl's scalar values. =item Pod The preferred format for all kinds of documentation in Parrot. =item POST Parrot Opcode Syntax Tree: A set of classes that represent opcodes. See also L<"PCT">. =item Predereferencing A bytecode transformation technique which reduces the amount of pointer dereferencing done in the inner loop of the interpreter by pre-converting opcode numbers into pointers to their opfuncs, and also converting the register numbers and constant numbers in the arguments to the ops into pointers. =item run core aka run loop, aka runcore. The way Parrot executes PBCs. See running.pod for a list of available runcores, and how to tell parrot which one to use. L<< Running|http://docs.parrot.org/parrot/latest/html/docs/running.pod.html >> =item SMOP Simple Meta Object Protocol: A prototype object model written in PIR. =item TGE Tree Grammar Engine: a tool that can be used to generate tree transformers. =item vtable A table of operations attached to some data types, such as PMCs and strings. Vtables are used to avoid using switches or long C chains to handle different data types. They're similar to method calls, except that their names are pre-selected, and there is no direct way to invoke them from PIR. =item Warnock's Dilemma The dilemma you face when posting a message to a public forum about something and not even getting an acknowledgement of its existence. This leaves you wondering if your problem is unimportant or previously addressed, if everyone is waiting on someone else to answer you, or if maybe your mail never actually made it to anyone else in the forum. =back =cut gc-leaky-call.t000644000765000765 327311567202625 16177 0ustar00brucebruce000000000000parrot-5.9.0/t/op#!./parrot --gc-min-threshold=100 # Copyright (C) 2010, Parrot Foundation. =head1 NAME t/op/gc-leaky-call.t - test for memory leaks in the Garbage Collector =head1 SYNOPSIS % prove t/op/gc-leaky-call.t =head1 DESCRIPTION Tests that we actually do a GC mark and sweep after a large number of function calls. =cut .include 'interpinfo.pasm' .sub _main :main .include 'test_more.pir' $S0 = interpinfo .INTERPINFO_GC_SYS_NAME if $S0 == "inf" goto dont_run_hanging_tests diag($S0) plan(3) test_gc_mark_sweep() goto test_end dont_run_hanging_tests: skip_all("Not relevant for this GC") test_end: .end .sub test_gc_mark_sweep .local int counter .local int cycles cycles = 10 cycle: counter = 0 loop: "consume"() inc counter if counter < 1e6 goto loop $I1 = interpinfo.INTERPINFO_GC_COLLECT_RUNS if $I1 goto done dec cycles if cycles > 0 goto cycle done: $I2 = interpinfo.INTERPINFO_GC_MARK_RUNS $S0 = interpinfo .INTERPINFO_GC_SYS_NAME if $S0 == "gms" goto last_alloc $I3 = interpinfo.INTERPINFO_TOTAL_MEM_ALLOC goto test last_alloc: $I3 = interpinfo.INTERPINFO_MEM_ALLOCS_SINCE_COLLECT test: $S1 = $I1 $S0 = "performed " . $S1 $S0 .= " (which should be >=1) GC collect runs" ok($I1,$S0) $S1 = $I2 $S0 = "performed " . $S1 $S0 .= " (which should be >=1) GC mark runs" ok($I2,$S0) $S1 = $I3 $S0 = "allocated " . $S1 $S0 .= " (which should be <= 6_000_000) bytes of memory" $I4 = isle $I3, 6000000 ok($I4,$S0) .end .sub consume .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: stress2.pl000644000765000765 151611533177634 20423 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks# Copyright (C) 2001-2007, Parrot Foundation. =head1 NAME examples/benchmarks/stress2.pl - GC stress-testing =head1 SYNOPSIS % time perl examples/benchmarks/stress2.pl =head1 DESCRIPTION Creates 200 arrays of 10000 elements each. =cut use strict; use warnings; foreach ( 1 .. 20 ) { my @arr; foreach ( 1 .. 10 ) { $arr[$_] = buildarray(); } } sub buildarray { my @foo; foreach ( 1 .. 10000 ) { $foo[$_] = $_; } return \@foo; } =head1 SEE ALSO F, F, F, F, F, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: README.pod000644000765000765 47312101554067 15171 0ustar00brucebruce000000000000parrot-5.9.0/t/src# Copyright (C) 2003-2012, Parrot Foundation. =pod =head1 NAME t/src/README.pod - Readme file for the 't/src/' directory. =head1 DESCRIPTION This directory contains test code in C. I the documentation in F<../../docs/tests.pod>. =head1 COPYRIGHT Copyright (C) 2003-2012, Parrot Foundation. =cut test_setenv_c.in000644000765000765 60211567202622 20674 0ustar00brucebruce000000000000parrot-5.9.0/config/auto/env/* Copyright (C) 2003-2009, Parrot Foundation. test for setenv */ #include #include int main(int argc, char **argv) { if (setenv("PARROT_TEST", "flaf", 1)) { puts("borken"); } else { puts("ok"); } return 0; } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ tabs.t000644000765000765 271311533177643 16065 0ustar00brucebruce000000000000parrot-5.9.0/t/codingstd#! perl # Copyright (C) 2006-2009, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More tests => 1; use Parrot::Distribution; =head1 NAME t/codingstd/tabs.t - checks for tab indents in C source and headers =head1 SYNOPSIS # test all files % prove t/codingstd/tabs.t # test specific files % perl t/codingstd/tabs.t src/foo.c include/parrot/bar.h =head1 DESCRIPTION Checks that files do not use tabs to indent. =head1 SEE ALSO L =cut my $DIST = Parrot::Distribution->new; my @files = @ARGV ? <@ARGV> : $DIST->get_c_language_files(); my @tabs; foreach my $file (@files) { # if we have command line arguments, the file is the full path # otherwise, use the relevant Parrot:: path method my $path = @ARGV ? $file : $file->path; open my $fh, '<', $path or die "Cannot open '$path' for reading: $!\n"; my $line = 1; # search each line for leading tabs while (<$fh>) { if ( $_ =~ m/^ *\t/ ) { push @tabs => "$path:$line\n"; } $line++; } close $fh; } ## L ok( !scalar(@tabs), "tabs in leading whitespace" ) or diag( "Found tab in leading whitespace " . scalar(@tabs) . " instances. Lines found:\n@tabs" ); # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: static-triangle.pir000644000765000765 377511533177634 21447 0ustar00brucebruce000000000000parrot-5.9.0/examples/opengl# Copyright (C) 2006-2008, Parrot Foundation. =head1 TITLE static-triangle.pir - Minimal OpenGL/GLUT setup and render for NCI tests =head1 SYNOPSIS $ cd parrot-home $ ./parrot examples/opengl/static-triangle.pir =head1 DESCRIPTION This is a simplified version of F, attempting to remove everything not absolutely necessary. This should make it easier to debug problems with the Parrot NCI system. To quit the example, close the window using your window manager (using the X in the corner of the window title bar, for example), since all keyboard handling has been removed. =cut .include 'opengl_defines.pasm' .sub main :main .param pmc argv # Load OpenGL library and a helper library for calling glutInit load_bytecode 'OpenGL.pbc' load_bytecode 'NCI/Utils.pbc' # Import all OpenGL/GLU/GLUT functions .local pmc import_gl import_gl = get_global ['OpenGL'], '_export_all_functions' import_gl() # Initialize GLUT .local pmc call_toolkit_init call_toolkit_init = get_global ['NCI'; 'Utils'], 'call_toolkit_init' .const 'Sub' glutInit = 'glutInit' argv = call_toolkit_init(glutInit, argv) # Set display mode, create GLUT window, save window handle .local int mode mode = .GLUT_DOUBLE | .GLUT_RGBA glutInitDisplayMode(mode) .local pmc window window = new 'Integer' window = glutCreateWindow('Static Triangle NCI Test') set_global 'glut_window', window # Set up GLUT callbacks .const 'Sub' draw = 'draw' glutDisplayFunc (draw) # Enter the GLUT main loop glutMainLoop() .end .sub draw .local int buffers buffers = .GL_COLOR_BUFFER_BIT | .GL_DEPTH_BUFFER_BIT glClear(buffers) glBegin(.GL_TRIANGLES) glColor3d(1,0,0) glVertex3f(-1, -1, 0) glColor3d(0, 1, 0) glVertex3f(1, -1, 0) glColor3d(0, 0, 1) glVertex3f(0, 1, 0) glEnd() glutSwapBuffers() .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: Bytes.pir000644000765000765 275312101554066 17616 0ustar00brucebruce000000000000parrot-5.9.0/examples/streams =head1 DESCRIPTION This example shows the usage of C. =head1 FUNCTIONS =over 4 =item _main =cut .sub _main :main .local pmc stream load_bytecode 'Stream/Sub.pbc' load_bytecode 'Stream/Replay.pbc' $P0 = new ['Stream'; 'Sub'] # set the stream's source sub .const 'Sub' temp = "_hello" assign $P0, temp stream = new ['Stream'; 'Replay'] assign stream, $P0 $S0 = stream."read_bytes"( 3 ) print "'hel': [" print $S0 print "]\n" stream = clone stream $P0 = clone stream $S0 = stream."read_bytes"( 4 ) print "'lowo': [" print $S0 print "] = " $S0 = $P0."read_bytes"( 4 ) print "[" print $S0 print "]\n" $S0 = stream."read"() print "'rld!': [" print $S0 print "]\n" $S0 = stream."read_bytes"( 100 ) print "'parrotis cool': [" print $S0 print "]\n" end .end =item _hello This sub is used as the source for the stream. It just writes some text to the stream. =cut .sub _hello :method self."write"( "hello" ) self."write"( "world!" ) self."write"( "parrot" ) self."write"( "is cool" ) .end =back =head1 AUTHOR Jens Rieks Eparrot at jensbeimsurfen dot deE is the author and maintainer. Please send patches and suggestions to the Perl 6 Internals mailing list. =head1 COPYRIGHT Copyright (C) 2004-2009, Parrot Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: zlib-01.t000644000765000765 1011512101554067 16444 0ustar00brucebruce000000000000parrot-5.9.0/t/steps/auto#! perl # Copyright (C) 2010-2013, Parrot Foundation. use strict; use warnings; use Test::More tests => 24; use Carp; use lib qw( lib t/configure/testlib ); use_ok('config::auto::zlib'); use Parrot::Configure::Options qw( process_options ); use Parrot::Configure::Step::Test; use Parrot::Configure::Test qw( test_step_constructor_and_description ); use IO::CaptureOutput qw( capture ); ########## --without-zlib ########## my ($args, $step_list_ref) = process_options( { argv => [ q{--without-zlib} ], mode => q{configure}, } ); my $conf = Parrot::Configure::Step::Test->new; $conf->include_config_results( $args ); my $pkg = q{auto::zlib}; $conf->add_steps($pkg); my $serialized = $conf->pcfreeze(); $conf->options->set( %{$args} ); my $step = test_step_constructor_and_description($conf); my $ret = $step->runstep($conf); ok( $ret, "runstep() returned true value" ); is($conf->data->get('has_zlib'), 0, "Got expected value for 'has_zlib'"); is($step->result(), q{skipped}, "Expected result was set"); $conf->replenish($serialized); ########## _select_lib() ########## ($args, $step_list_ref) = process_options( { argv => [ ], mode => q{configure}, } ); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); # Mock different OS/compiler combinations. my ($osname, $cc, $initial_libs); $initial_libs = $conf->data->get('libs'); $osname = 'mswin32'; $cc = 'gcc'; is($step->_select_lib( { conf => $conf, osname => $osname, cc => $cc, win32_nongcc => 'zlib.lib', default => '-lz', } ), '-lz', "_select_lib() returned expected value"); $osname = 'mswin32'; $cc = 'cc'; is($step->_select_lib( { conf => $conf, osname => $osname, cc => $cc, win32_nongcc => 'zlib.lib', default => '-lz', } ), 'zlib.lib', "_select_lib() returned expected value"); $osname = 'foobar'; $cc = 'cc'; is($step->_select_lib( { conf => $conf, osname => $osname, cc => $cc, win32_nongcc => 'zlib.lib', default => '-lz', } ), '-lz', "_select_lib() returned expected value"); $conf->replenish($serialized); ########## --without-zlib; _evaluate_cc_run() ########## ($args, $step_list_ref) = process_options( { argv => [ q{--without-zlib} ], mode => q{configure}, } ); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); my ($test, $has_zlib); $test = qq{1.2.3\n}; $has_zlib = 0; $conf->options->set(verbose => undef); $has_zlib = $step->_evaluate_cc_run($conf, $test, $has_zlib); is($has_zlib, 1, "'has_zlib' set as expected"); is($step->result(), 'yes, 1.2.3', "Expected result was set"); # Prepare for next test $step->set_result(undef); $test = qq{foobar}; $has_zlib = 0; $conf->options->set(verbose => undef); $has_zlib = $step->_evaluate_cc_run($conf, $test, $has_zlib); is($has_zlib, 0, "'has_zlib' set as expected"); ok(! defined $step->result(), "Result is undefined, as expected"); { my $stdout; $test = qq{1.2.3\n}; $has_zlib = 0; $conf->options->set(verbose => 1); capture( sub { $has_zlib = $step->_evaluate_cc_run($conf, $test, $has_zlib); }, \$stdout, ); is($has_zlib, 1, "'has_zlib' set as expected"); is($step->result(), 'yes, 1.2.3', "Expected result was set"); like($stdout, qr/\(yes\)/, "Got expected verbose output"); # Prepare for next test $step->set_result(undef); } pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME auto/zlib-01.t - test auto::zlib =head1 SYNOPSIS % prove t/steps/auto/zlib-01.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file test auto::zlib. =head1 HISTORY Mostly taken from F. =head1 AUTHOR Francois Perrad =head1 SEE ALSO config::auto::zlib, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: PAST.pir000644000765000765 143711533177633 17364 0ustar00brucebruce000000000000parrot-5.9.0/compilers/pct/src =head1 NAME PAST - Parrot abstract syntax tree =head1 DESCRIPTION This file brings together the various PAST/POST modules to build the PAST.pbc module. =cut .include 'compilers/pct/src/PCT/Node.pir' .include 'compilers/pct/src/PAST/Node.pir' .include 'compilers/pct/src/PAST/Compiler.pir' .include 'compilers/pct/src/POST/Node.pir' .include 'compilers/pct/src/POST/Compiler.pir' =head1 AUTHOR Patrick Michaud is the author and maintainer. Please send patches and suggestions to the Parrot porters or Perl 6 compilers mailing lists. =head1 HISTORY 2007-11-29 Created from older PAST-pm version. =head1 COPYRIGHT Copyright (C) 2007-2008, Parrot Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: Dumper.pm000644000765000765 1176212101554067 17314 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/Pmc2c# Copyright (C) 2004-2012, Parrot Foundation. package Parrot::Pmc2c::Dumper; use strict; use warnings; use Parrot::Pmc2c::UtilFunctions qw(slurp spew filename); use Parrot::Pmc2c::Parser qw(parse_pmc); use Carp; use base 'Exporter'; @Parrot::Pmc2c::Dumper::EXPORT_OK = 'dump_pmc'; =head1 NAME Parrot::Pmc2c::Dumper =head1 DESCRIPTION Create dump file for PMCs. =head1 FUNCTIONS =head2 Public Functions =head3 C $return_value = dump_pmc($pmc2cMain); B Creates a F<.dump> file for each file listed in pmc2cMain's C key (which can be found in the directories listed in pmc2cMain's C key). B B Returns 1 upon success. B Called when C<--dump> is specified as the command-line option to F. =cut sub dump_pmc { my ($self) = @_; my $pmc2cMain = $self; my @files = @{ $pmc2cMain->{args} }; my $pmcs; # help those dumb 'shells' that are not shells @files = glob $files[0] if $files[0] eq 'src/pmc/*.pmc'; # make sure that a default.dump will always be created if it doesn't $pmc2cMain->find_file('default.dump') or unshift @files, 'default.pmc'; # load and parse all pmc files in @files for my $filename (@files) { my $parsed_pmc = parse_pmc( $pmc2cMain, $filename ); $pmcs->{ $parsed_pmc->name } = $parsed_pmc; } $pmcs->{default} = $pmc2cMain->read_dump("default.pmc") unless $pmcs->{default}; # ensure that the default pmc's super entries point back to itself. my $vtable_dump = $pmc2cMain->read_dump("vtable.pmc"); my $default_pmc = $pmcs->{default}; for my $vt_method_name ( @{ $vtable_dump->names } ) { $default_pmc->super_method( $vt_method_name, 'default' ); } for my $pmc ( values %$pmcs ) { next if $pmc->name =~ /default$/ && $pmc->dump_is_current($pmc2cMain->find_file('default.dump')); gen_parent_lookup_info( $pmc, $pmc2cMain, $pmcs ); gen_parent_reverse_lookup_info( $pmc, $pmcs, $vtable_dump ); $pmc->dump; } return 1; } =head2 Non-Public Methods These functions are expressed as methods called on the Parrot::Pmc2c::Pmc2cMain object, but only because they make use of data stored in that object. They are called within the publicly available methods described above and are not intended to be publicly callable. =head3 C $pmc2cMain->gen_parent_lookup_info($name, \%all); B Generate an ordered list of parent classes to put in the C<$classes->{name}->{parents}> array, using the given directories to find parents. B List of two arguments: =over 4 =item * String holding class name. =item * Hash reference holding data structure being built up within C. =back B Returns 1 upon success. B Called within C. =cut sub gen_parent_lookup_info { my ( $pmc, $pmc2cMain, $pmcs ) = @_; my @c3_work_queue = ( $pmc->name ); while (@c3_work_queue) { my $current_pmc_name = shift @c3_work_queue; next if $current_pmc_name eq 'default'; for my $parent_name ( @{ [ @{ $pmcs->{$current_pmc_name}->parents } ] } ) { next if $parent_name eq 'default'; # load $parent_name pmc into $pmcs if needed $pmcs->{$parent_name} = $pmc2cMain->read_dump( lc("$parent_name.pmc") ) unless $pmcs->{$parent_name}; $pmc->add_parent( $pmcs->{$parent_name} ); # add parent_name on to work queue list. push @c3_work_queue, $parent_name; } } # default should appear very last in the @c3 order $pmc->add_parent( $pmcs->{"default"} ); return 1; } =head2 Subroutines =head3 C $class = gen_parent_reverse_lookup_info($name, $all, $vt); B Generate a list of inherited methods for C<$name> by searching the inheritance tree. The method list is found in C<$vt>. B List of three elements: =over 4 =item * String holding name of class being dumped. =item * Reference to the hash holding the data structure being built up within C. =item * The result of a call of C on F. =back B Returns 1 upon success. B Called within C. =cut sub gen_parent_reverse_lookup_info { my ( $pmc, $pmcs, $vt ) = @_; # for each vt_meth in pmc, locate the implementing foreach my $vt_method_name ( @{ $vt->names } ) { # skip if super mapping is already set next if $pmc->super_method($vt_method_name); foreach my $parent_name ( @{ $pmc->parents } ) { my $parent = $pmcs->{$parent_name}; if ( $pmc->parent_has_method( $parent_name, $vt_method_name ) ) { $pmc->super_method( $vt_method_name, $parent ); last; } } } return 1; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: exit.h000644000765000765 623512101554067 16574 0ustar00brucebruce000000000000parrot-5.9.0/include/parrot/* exit.h * Copyright (C) 2001-2010, Parrot Foundation. * Overview: * * Data Structure and Algorithms: * History: * Notes: * References: * exit.c */ #ifndef PARROT_EXIT_H_GUARD #define PARROT_EXIT_H_GUARD #include "parrot/compiler.h" /* compiler capabilities */ typedef void (*exit_handler_f)(PARROT_INTERP, int , void *); typedef struct _handler_node_t { exit_handler_f function; void *arg; struct _handler_node_t *next; } handler_node_t; /* This macro is used to exit Parrot, when all else fails. This is a last resort. This may be platform specific if certain systems cannot just call the libc exit() function */ #define PARROT_FORCE_EXIT(x) exit(x) /* The DUMPCORE macro is defined for most platforms, but defined here if not * found elsewhere, so we're sure it's safe to call. */ #ifndef DUMPCORE # define DUMPCORE() do { \ fprintf(stderr, "Sorry, coredump is not yet implemented " \ "for this platform.\n\n"); \ PARROT_FORCE_EXIT(EXIT_FAILURE); \ } while (0) #endif #define PANIC(interp, message) Parrot_x_panic_and_exit((interp), (message), __FILE__, __LINE__) /* HEADERIZER BEGIN: src/exit.c */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_EXPORT PARROT_DOES_NOT_RETURN PARROT_COLD void Parrot_x_exit(PARROT_INTERP, int status) __attribute__nonnull__(1); PARROT_EXPORT PARROT_DOES_NOT_RETURN PARROT_COLD void Parrot_x_jump_out(NULLOK_INTERP, int status); PARROT_EXPORT void Parrot_x_on_exit(PARROT_INTERP, ARGIN(exit_handler_f function), ARGIN_NULLOK(void *arg)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_EXPORT PARROT_DOES_NOT_RETURN PARROT_COLD void Parrot_x_panic_and_exit( NULLOK_INTERP, ARGIN_NULLOK(const char *message), ARGIN_NULLOK(const char *file), unsigned int line); PARROT_COLD PARROT_NO_ADDRESS_SAFETY_ANALYSIS void Parrot_x_execute_on_exit_handlers(PARROT_INTERP, int status) __attribute__nonnull__(1); PARROT_DOES_NOT_RETURN PARROT_COLD void Parrot_x_force_error_exit( NULLOK_INTERP, int exitcode, ARGIN(const char * format), ...) __attribute__nonnull__(3); #define ASSERT_ARGS_Parrot_x_exit __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_x_jump_out __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) #define ASSERT_ARGS_Parrot_x_on_exit __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(function)) #define ASSERT_ARGS_Parrot_x_panic_and_exit __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) #define ASSERT_ARGS_Parrot_x_execute_on_exit_handlers \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_x_force_error_exit __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(format)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: src/exit.c */ #endif /* PARROT_EXIT_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ IGNOREME000644000765000765 011533177633 21122 0ustar00brucebruce000000000000parrot-5.9.0/compilers/opsc/gen/Ops/Transpbc.c000644000765000765 22265212101554066 16402 0ustar00brucebruce000000000000parrot-5.9.0/compilers/imcc/* * Copyright (C) 2002-2010, Parrot Foundation. */ #include "imc.h" #include "pbc.h" #include "parrot/packfile.h" #include "parrot/pmc_freeze.h" #include "pmc/pmc_sub.h" #include "pmc/pmc_callcontext.h" #include "parrot/oplib/core_ops.h" #include "pmc/pmc_key.h" /* HEADERIZER HFILE: compilers/imcc/pbc.h */ /* =head1 NAME compilers/imcc/pbc.c =head1 DESCRIPTION emit imcc instructions into Parrot interpreter the e_pbc_emit function is called per instruction Notes: I'm using existing data structures here (SymReg *) to store various global items (currently only PMC constants). The index in the constant table is in SymReg * ->color data member. This looks odd, but the register number from imc.c:allocate is also there for variables, so it's a little bit consistent at least. So when reading color here it's either a constant table index or a Parrot register number, depending on data type. TODO memory clean up -lt =head2 Functions =over 4 =cut */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void add_1_const( ARGMOD(imc_info_t * imcc), ARGMOD(SymReg *r), ARGMOD(PackFile_ByteCode * bc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(*r) FUNC_MODIFIES(* bc); PARROT_WARN_UNUSED_RESULT static int add_const_num( ARGMOD(imc_info_t * imcc), ARGIN_NULLOK(const char *buf), ARGMOD(PackFile_ByteCode * bc)) __attribute__nonnull__(1) __attribute__nonnull__(3) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(* bc); PARROT_IGNORABLE_RESULT static int /*@alt void@*/ add_const_pmc_sub( ARGMOD(imc_info_t * imcc), ARGMOD(SymReg *r), size_t offs, size_t end) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(*r); PARROT_IGNORABLE_RESULT static int /*@alt void@*/ add_const_str( ARGMOD(imc_info_t * imcc), ARGIN(STRING *s), ARGIN(PackFile_ByteCode * const bc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(* imcc); static int add_const_table_pmc(ARGMOD(imc_info_t * imcc), ARGIN(PMC *pmc)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(* imcc); static opcode_t build_key( ARGMOD(imc_info_t * imcc), ARGIN(SymReg *key_reg), ARGMOD(PackFile_ByteCode * bc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(* bc); static void constant_folding( ARGMOD(imc_info_t * imcc), ARGIN(const IMC_Unit *unit), ARGMOD(PackFile_ByteCode * bc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(* bc); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PMC* create_lexinfo( ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit), ARGIN(PMC *sub_pmc), int need_lex, ARGMOD(PackFile_ByteCode * bc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(5) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(*unit) FUNC_MODIFIES(* bc); PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static subs_t * find_global_label( ARGMOD(imc_info_t * imcc), ARGIN(const char *name), ARGIN(const subs_t *sym), ARGOUT(int *pc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(*pc); PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static PMC* find_outer( ARGMOD(imc_info_t * imcc), ARGIN(const IMC_Unit *unit)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(* imcc); PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static subs_t * find_sub_by_subid( ARGMOD(imc_info_t * imcc), ARGIN(const char *lookup), ARGIN(const subs_t *sym), ARGOUT(int *pc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(*pc); static void fixup_globals(ARGMOD(imc_info_t * imcc)) __attribute__nonnull__(1) FUNC_MODIFIES(* imcc); PARROT_WARN_UNUSED_RESULT static size_t get_code_size( ARGMOD(imc_info_t * imcc), ARGIN(const IMC_Unit *unit), ARGOUT(size_t *src_lines)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(*src_lines); PARROT_WARN_UNUSED_RESULT static int get_old_size( ARGMOD(imc_info_t * imcc), ARGIN(PackFile_ByteCode * bc), ARGOUT(int *ins_line)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(*ins_line); static void imcc_globals_destroy(PARROT_INTERP, int ex, ARGMOD(void *param)) __attribute__nonnull__(3) FUNC_MODIFIES(*param); static void init_fixedintegerarray_from_string( ARGMOD(imc_info_t * imcc), ARGIN(PMC *p), ARGIN(STRING *s)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(* imcc); static void make_new_sub(ARGMOD(imc_info_t * imcc), ARGIN(IMC_Unit *unit)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(* imcc); static void make_pmc_const(ARGMOD(imc_info_t * imcc), ARGMOD(SymReg *r)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(*r); PARROT_CANNOT_RETURN_NULL PARROT_MALLOC static PMC* mk_multi_sig( ARGMOD(imc_info_t * imcc), ARGIN(const SymReg *r), ARGMOD(PackFile_ByteCode * bc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(* bc); static void store_fixup( ARGMOD(imc_info_t * imcc), ARGIN(const SymReg *r), int pc, int offset) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(* imcc); static void store_key_const( ARGMOD(imc_info_t * imcc), ARGIN(const char *str), int idx) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(* imcc); static void store_sub_size( ARGMOD(imc_info_t * imcc), size_t size, size_t ins_line) __attribute__nonnull__(1) FUNC_MODIFIES(* imcc); static void store_sub_tags( ARGMOD(imc_info_t * imcc), ARGIN(pcc_sub_t * sub), const int sub_idx, ARGMOD(PackFile_ConstTable * ct)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(4) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(* ct); static void verify_signature( ARGMOD(imc_info_t * imcc), ARGIN(const Instruction *ins), ARGIN(opcode_t *pc), ARGMOD(PackFile_ByteCode * bc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(* bc); #define ASSERT_ARGS_add_1_const __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(r) \ , PARROT_ASSERT_ARG(bc)) #define ASSERT_ARGS_add_const_num __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(bc)) #define ASSERT_ARGS_add_const_pmc_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(r)) #define ASSERT_ARGS_add_const_str __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(s) \ , PARROT_ASSERT_ARG(bc)) #define ASSERT_ARGS_add_const_table_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(pmc)) #define ASSERT_ARGS_build_key __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(key_reg) \ , PARROT_ASSERT_ARG(bc)) #define ASSERT_ARGS_constant_folding __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit) \ , PARROT_ASSERT_ARG(bc)) #define ASSERT_ARGS_create_lexinfo __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit) \ , PARROT_ASSERT_ARG(sub_pmc) \ , PARROT_ASSERT_ARG(bc)) #define ASSERT_ARGS_find_global_label __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(name) \ , PARROT_ASSERT_ARG(sym) \ , PARROT_ASSERT_ARG(pc)) #define ASSERT_ARGS_find_outer __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit)) #define ASSERT_ARGS_find_sub_by_subid __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(lookup) \ , PARROT_ASSERT_ARG(sym) \ , PARROT_ASSERT_ARG(pc)) #define ASSERT_ARGS_fixup_globals __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc)) #define ASSERT_ARGS_get_code_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit) \ , PARROT_ASSERT_ARG(src_lines)) #define ASSERT_ARGS_get_old_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(bc) \ , PARROT_ASSERT_ARG(ins_line)) #define ASSERT_ARGS_imcc_globals_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(param)) #define ASSERT_ARGS_init_fixedintegerarray_from_string \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(p) \ , PARROT_ASSERT_ARG(s)) #define ASSERT_ARGS_make_new_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit)) #define ASSERT_ARGS_make_pmc_const __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(r)) #define ASSERT_ARGS_mk_multi_sig __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(r) \ , PARROT_ASSERT_ARG(bc)) #define ASSERT_ARGS_store_fixup __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(r)) #define ASSERT_ARGS_store_key_const __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(str)) #define ASSERT_ARGS_store_sub_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc)) #define ASSERT_ARGS_store_sub_tags __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(sub) \ , PARROT_ASSERT_ARG(ct)) #define ASSERT_ARGS_verify_signature __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(ins) \ , PARROT_ASSERT_ARG(pc) \ , PARROT_ASSERT_ARG(bc)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Frees memory allocated for IMCC globals for one particular compilation unit. =cut */ static void imcc_globals_destroy(SHIM_INTERP, SHIM(int ex), ARGMOD(void *param)) { ASSERT_ARGS(imcc_globals_destroy) imc_info_t * const imcc = (imc_info_t*)param; /* This is an allowed condition? See TT #629 */ if (imcc->globals) { code_segment_t *cs = imcc->globals->cs; while (cs) { subs_t *s = cs->subs; code_segment_t * const prev_cs = cs->prev; while (s) { subs_t * const prev_s = s->prev; clear_sym_hash(&s->fixup); mem_sys_free(s); s = prev_s; } clear_sym_hash(&cs->key_consts); mem_sys_free(cs); cs = prev_cs; } imcc->globals->cs = NULL; } } /* =item C Adds a PMC to the const table, returning its position. =cut */ static int add_const_table_pmc(ARGMOD(imc_info_t * imcc), ARGIN(PMC *pmc)) { ASSERT_ARGS(add_const_table_pmc) PackFile_ByteCode * const bc = Parrot_pf_get_current_code_segment(imcc->interp); PackFile_ConstTable * const ct = bc->const_table; if (!ct->pmc.constants) ct->pmc.constants = mem_gc_allocate_n_zeroed_typed(imcc->interp, 1, PMC *); else ct->pmc.constants = mem_gc_realloc_n_typed_zeroed(imcc->interp, ct->pmc.constants, ct->pmc.const_count + 1, ct->pmc.const_count, PMC *); PObj_is_shared_SET(pmc); /* packfile constants will be shared among threads */ ct->pmc.constants[ct->pmc.const_count++] = pmc; return ct->pmc.const_count - 1; } /* =item C Opens a compilation unit to emit PBC. TODO: Try to pull as much of the Parrot-related logic out of here and into the front-ends (or higher). =cut */ int e_pbc_open(ARGMOD(imc_info_t * imcc)) { ASSERT_ARGS(e_pbc_open) PackFile_ByteCode * const current_bc = Parrot_pf_get_current_code_segment(imcc->interp); code_segment_t * const cs = mem_gc_allocate_zeroed_typed(imcc->interp, code_segment_t); if (!imcc->globals) imcc->globals = mem_gc_allocate_zeroed_typed(imcc->interp, imcc_globals); if (imcc->globals->cs) clear_sym_hash(&imcc->globals->cs->key_consts); else { /* register cleanup code */ Parrot_x_on_exit(imcc->interp, imcc_globals_destroy, imcc); } /* free previous cached key constants if any */ create_symhash(imcc, &cs->key_consts); cs->next = NULL; cs->prev = imcc->globals->cs; cs->subs = NULL; cs->first = NULL; cs->jit_info = NULL; if (!imcc->globals->first) imcc->globals->first = cs; else cs->prev->next = cs; PARROT_ASSERT(current_bc); imcc->globals->cs = cs; return 0; } /* =item C Allocates a new globals->cs->subs structure. =cut */ static void make_new_sub(ARGMOD(imc_info_t * imcc), ARGIN(IMC_Unit *unit)) { ASSERT_ARGS(make_new_sub) subs_t * const s = mem_gc_allocate_zeroed_typed(imcc->interp, subs_t); s->prev = imcc->globals->cs->subs; s->unit = unit; s->pmc_const = -1; s->lexinfo_const = -1; if (imcc->globals->cs->subs) imcc->globals->cs->subs->next = s; if (!imcc->globals->cs->first) imcc->globals->cs->first = s; imcc->globals->cs->subs = s; create_symhash(imcc, &s->fixup); } /* =item C Get the size/line of bytecode in ops to this point. =cut */ PARROT_WARN_UNUSED_RESULT static int get_old_size(ARGMOD(imc_info_t * imcc), ARGIN(PackFile_ByteCode * bc), ARGOUT(int *ins_line)) { ASSERT_ARGS(get_old_size) size_t size = 0; *ins_line = 0; if (imcc->globals->cs && bc->base.data) { const subs_t *s; for (s = imcc->globals->cs->subs; s; s = s->prev) { size += s->size; *ins_line += s->ins_line; } } return size; } /* =item C Sets the given size and line parameters for the current compilation unit. =cut */ static void store_sub_size(ARGMOD(imc_info_t * imcc), size_t size, size_t ins_line) { ASSERT_ARGS(store_sub_size) imcc->globals->cs->subs->size = size; imcc->globals->cs->subs->ins_line = ins_line; } /* =item C Stores fixup information for the given register, program counter, and offset. =cut */ static void store_fixup(ARGMOD(imc_info_t * imcc), ARGIN(const SymReg *r), int pc, int offset) { ASSERT_ARGS(store_fixup) SymReg * const fixup = _mk_address(imcc, &imcc->globals->cs->subs->fixup, r->name, U_add_all); if (r->set == 'p') fixup->set = 'p'; if (r->type & VT_ENCODED) fixup->type |= VT_ENCODED; if (r->usage & U_SUBID_LOOKUP) fixup->usage = U_SUBID_LOOKUP; if (r->usage & U_LEXINFO_LOOKUP) fixup->usage = U_LEXINFO_LOOKUP; if (r->usage & U_LEXICAL) fixup->usage |= U_LEXICAL; /* set_p_pc = 2 */ fixup->color = pc; fixup->offset = offset; } /* =item C Stores a constant key for the current compilation unit. =cut */ static void store_key_const(ARGMOD(imc_info_t * imcc), ARGIN(const char *str), int idx) { ASSERT_ARGS(store_key_const) SymReg * const c = _mk_const(imcc, &imcc->globals->cs->key_consts, str, 0); c->color = idx; } /* =item C Stores globals for later fixup, returning the code size in number of ops. =cut */ PARROT_WARN_UNUSED_RESULT static size_t get_code_size(ARGMOD(imc_info_t * imcc), ARGIN(const IMC_Unit *unit), ARGOUT(size_t *src_lines)) { ASSERT_ARGS(get_code_size) Instruction *ins = unit->instructions; size_t code_size; op_lib_t *core_ops = PARROT_GET_CORE_OPLIB(imcc->interp); /* run through instructions: * - sanity check * - calc code size * - calc nr of src lines for debug info * - remember addr of labels * - remember set_p_pc for global fixup */ *src_lines = 0; for (code_size = 0; ins ; ins = ins->next) { char * const opname = ins->opname; const int opsize = ins->opsize; if (ins->type & ITLABEL) ins->symregs[0]->color = code_size; if (!opname || !*opname) { if (opsize) IMCC_fatal(imcc, 1, "get_code_size: non instruction with size found\n"); continue; } if (STREQ(opname, ".annotate")) { /* Annotations contribute nothing to code size, since they do not * end up in bytecode segment. */ continue; } (*src_lines)++; if (!ins->op) IMCC_fatal(imcc, 1, "get_code_size: " "no opnum ins#%d %d\n", ins->index, ins); if (ins->op == &core_ops->op_info_table[PARROT_OP_set_p_pc]) { /* set_p_pc opcode */ IMCC_debug(imcc, DEBUG_PBC_FIXUP, "PMC constant %s\n", ins->symregs[1]->name); if (ins->symregs[1]->usage & U_FIXUP) store_fixup(imcc, ins->symregs[1], code_size, 2); } code_size += opsize; } return code_size; } /* =item C add libdeps to byte code =cut */ void imcc_pbc_add_libdep(ARGMOD(imc_info_t * imcc), ARGIN(STRING *libname)) { ASSERT_ARGS(imcc_pbc_add_libdep) PackFile_ByteCode * const bc = Parrot_pf_get_current_code_segment(imcc->interp); size_t i; /* bail out early if compiling to text format */ if (!bc) return; /* check if already present (avoids duplicates) */ for (i = 0; i < bc->n_libdeps; i++) { if (STRING_equal(imcc->interp, libname, bc->libdeps[i])) return; } bc->n_libdeps++; bc->libdeps = mem_gc_realloc_n_typed_zeroed(imcc->interp, bc->libdeps, bc->n_libdeps, bc->n_libdeps - 1, STRING *); bc->libdeps[bc->n_libdeps - 1] = libname; } /* =item C Lookup the mapping of an op for the current bytecode segment or make one if none exists. =cut */ static opcode_t bytecode_map_op(ARGMOD(imc_info_t * imcc), op_info_t *info) { op_lib_t *lib = info->lib; op_func_t op_func = OP_INFO_OPFUNC(info); PackFile_ByteCode * const bc = Parrot_pf_get_current_code_segment(imcc->interp); PackFile_ByteCode_OpMappingEntry *om; opcode_t i; for (i = 0; i < bc->op_mapping.n_libs; i++) { if (lib == bc->op_mapping.libs[i].lib) { om = &bc->op_mapping.libs[i]; goto found_lib; } } /* library not yet mapped */ bc->op_mapping.n_libs++; bc->op_mapping.libs = mem_gc_realloc_n_typed_zeroed(imcc->interp, bc->op_mapping.libs, bc->op_mapping.n_libs, bc->op_mapping.n_libs - 1, PackFile_ByteCode_OpMappingEntry); /* initialize a new lib entry */ om = &bc->op_mapping.libs[bc->op_mapping.n_libs - 1]; om->lib = lib; om->n_ops = 0; om->lib_ops = mem_gc_allocate_n_zeroed_typed(imcc->interp, 0, opcode_t); om->table_ops = mem_gc_allocate_n_zeroed_typed(imcc->interp, 0, opcode_t); found_lib: for (i = 0; i < om->n_ops; i++) { if (bc->op_func_table[om->table_ops[i]] == op_func) return om->table_ops[i]; } /* op not yet mapped */ bc->op_count++; bc->op_func_table = mem_gc_realloc_n_typed_zeroed(imcc->interp, bc->op_func_table, bc->op_count, bc->op_count - 1, op_func_t); bc->op_func_table[bc->op_count - 1] = op_func; bc->op_info_table = mem_gc_realloc_n_typed_zeroed(imcc->interp, bc->op_info_table, bc->op_count, bc->op_count - 1, op_info_t *); bc->op_info_table[bc->op_count - 1] = info; /* initialize new op mapping */ om->n_ops++; om->lib_ops = mem_gc_realloc_n_typed_zeroed(imcc->interp, om->lib_ops, om->n_ops, om->n_ops - 1, opcode_t); for (i = 0; i < lib->op_count; i++) { if (lib->op_func_table[i] == op_func) { om->lib_ops[om->n_ops - 1] = i; break; } } PARROT_ASSERT(om->lib_ops[om->n_ops - 1] || !i); om->table_ops = mem_gc_realloc_n_typed_zeroed(imcc->interp, om->table_ops, om->n_ops, om->n_ops - 1, opcode_t); om->table_ops[om->n_ops - 1] = bc->op_count - 1; return bc->op_count - 1; } /* =item C Finds a global label, returning the symreg (and setting the (absolute) pc through the out parameter). =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static subs_t * find_global_label(ARGMOD(imc_info_t * imcc), ARGIN(const char *name), ARGIN(const subs_t *sym), ARGOUT(int *pc)) { ASSERT_ARGS(find_global_label) subs_t *s; *pc = 0; for (s = imcc->globals->cs->first; s; s = s->next) { const SymReg * const r = s->unit->instructions->symregs[0]; /* if names and namespaces are matching - ok */ if (r && r->name && (strcmp(r->name, name) == 0) && ((sym->unit->_namespace && s->unit->_namespace && (strcmp(sym->unit->_namespace->name, s->unit->_namespace->name) == 0)) || (!sym->unit->_namespace && !s->unit->_namespace))) return s; *pc += s->size; } return NULL; } /* =item C Find the first sub in the current code segment with a given subid. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static subs_t * find_sub_by_subid(ARGMOD(imc_info_t * imcc), ARGIN(const char *lookup), ARGIN(const subs_t *sym), ARGOUT(int *pc)) { ASSERT_ARGS(find_sub_by_subid) subs_t *s; UNUSED(sym); *pc = 0; for (s = imcc->globals->cs->first; s; s = s->next) { const SymReg * const r = s->unit->instructions->symregs[0]; /* if subid matches - ok */ if (r && (r->subid && (strcmp(r->subid->name, lookup) == 0))) return s; *pc += s->size; } return NULL; } /* =item C Fixes global information -- particularly locations of global symbols. =cut */ static void fixup_globals(ARGMOD(imc_info_t * imcc)) { ASSERT_ARGS(fixup_globals) subs_t *s; int jumppc = 0; op_lib_t *core_ops = PARROT_GET_CORE_OPLIB(imcc->interp); PackFile_ByteCode * const bc = Parrot_pf_get_current_code_segment(imcc->interp); for (s = imcc->globals->cs->first; s; s = s->next) { const SymHash * const hsh = &s->fixup; unsigned int i; for (i = 0; i < hsh->size; i++) { SymReg *fixup; for (fixup = hsh->data[i]; fixup; fixup = fixup->next) { int pc, pmc_const; const int addr = jumppc + fixup->color; int subid_lookup = 0; subs_t *s1; /* check in matching namespace */ if (fixup->usage & U_LEXICAL) s1 = NULL; else if (fixup->usage & U_SUBID_LOOKUP) { subid_lookup = 1; /* s1 = find_sub_by_subid(interp, fixup->name, &pc); */ s1 = find_sub_by_subid(imcc, fixup->name, s, &pc); } else if (fixup->usage & U_LEXINFO_LOOKUP) { s1 = find_sub_by_subid(imcc, fixup->name, s, &pc); if (!s1 || s1->pmc_const == -1) IMCC_fataly(imcc, EXCEPTION_INVALID_OPERATION, "Sub '%s' not found\n", fixup->name); if (s1->lexinfo_const == -1) { PackFile_ConstTable * const ct = bc->const_table; PMC *sub_pmc = ct->pmc.constants[s1->pmc_const]; Parrot_Sub_attributes *sub; PMC_get_sub(imcc->interp, sub_pmc, sub); if (!sub->lex_info) IMCC_fataly(imcc, EXCEPTION_INVALID_OPERATION, "Sub '%s' does not have a lexinfo\n", fixup->name); s1->lexinfo_const = add_const_table_pmc(imcc, sub->lex_info); } bc->base.data[addr+fixup->offset] = s1->lexinfo_const; continue; } else s1 = find_global_label(imcc, fixup->name, s, &pc); /* * if failed change opcode: * set_p_pc => find_name p_sc * if a sub label is found * convert to find_name, if the sub is a multi */ if (s1) { PARROT_ASSERT(s1->unit); if (s1->unit->type & IMC_PCCSUB) { const Instruction * const ins = s1->unit->instructions; SymReg *r1; pcc_sub_t *pcc_sub; PARROT_ASSERT(ins); r1 = ins->symregs[0]; PARROT_ASSERT(r1); pcc_sub = r1->pcc_sub; PARROT_ASSERT(pcc_sub); /* if the sub is multi, don't insert constant */ if (pcc_sub->nmulti && !subid_lookup) s1 = NULL; } } if (!s1) { SymReg * const nam = mk_const(imcc, fixup->name, fixup->type & VT_ENCODED ? 'U' : 'S'); /* TODO: Don't hard-code this op name in here. Ask libparrot for a suitable op to use to find a sub. */ op_info_t *op = &core_ops->op_info_table[PARROT_OP_find_sub_not_null_p_sc]; PARROT_ASSERT(op); bc->base.data[addr] = bytecode_map_op(imcc, op); if (nam->color < 0) nam->color = add_const_str(imcc, IMCC_string_from_reg(imcc, nam), bc); bc->base.data[addr+2] = nam->color; IMCC_debug(imcc, DEBUG_PBC_FIXUP, "fixup const PMC" " find_name sub '%s' const nr: %d\n", fixup->name, nam->color); continue; } pmc_const = s1->pmc_const; if (pmc_const < 0) { IMCC_fatal(imcc, 1, "fixup_globals: " "couldn't find sub 2 '%s'\n", fixup->name); } bc->base.data[addr+fixup->offset] = pmc_const; IMCC_debug(imcc, DEBUG_PBC_FIXUP, "fixup const PMC" " sub '%s' const nr: %d\n", fixup->name, pmc_const); continue; } } jumppc += s->size; } } /* =item C Creates and returns a constant STRING, given a stringish SymReg. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * IMCC_string_from_reg(ARGMOD(imc_info_t * imcc), ARGIN(const SymReg *r)) { ASSERT_ARGS(IMCC_string_from_reg) char *buf = r->name; if (r->type & VT_ENCODED) { /* * the lexer parses: foo:"string" * get first part as encoding, rest as string */ #define MAX_NAME 31 char encoding_name[MAX_NAME + 1]; char * p = strchr(buf, '"'); size_t len; PARROT_ASSERT(p && p[-1] == ':'); len = p - buf - 1; if (len > MAX_NAME) len = MAX_NAME; memcpy(encoding_name, buf, len); encoding_name[len] = '\0'; return Parrot_str_unescape(imcc->interp, p + 1, '"', encoding_name); } else if (*buf == '"') { buf++; return Parrot_str_unescape(imcc->interp, buf, '"', NULL); } else if (*buf == '\'') { buf++; return Parrot_str_new_init(imcc->interp, buf, strlen(buf) - 1, Parrot_ascii_encoding_ptr, PObj_constant_FLAG); } /* unquoted bare name - ASCII only don't unescape it */ return Parrot_str_new_init(imcc->interp, buf, strlen(buf), Parrot_ascii_encoding_ptr, PObj_constant_FLAG); } /* =item C Creates a Parrot C from a string constant found in PIR or PASM. This includes cases where charset and/or encoding are specified. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * IMCC_string_from__STRINGC(ARGMOD(imc_info_t * imcc), ARGIN(char *buf)) { ASSERT_ARGS(IMCC_string_from__STRINGC) const int ascii = (*buf == '\'' || *buf == '"'); if (!ascii) { /* * the lexer parses: foo:"string" * get first part as charset, rest as string */ STRING *s; const char *charset; char * const p = strchr(buf, '"'); PARROT_ASSERT(p && p[-1] == ':'); p[-1] = 0; charset = buf; /* past delim */ buf = p + 1; s = Parrot_str_unescape(imcc->interp, buf, '"', charset); /* restore colon, as we may reuse this string */ p[-1] = ':'; return s; } else if (*buf == '"') { buf++; return Parrot_str_unescape(imcc->interp, buf, '"', NULL); } else if (*buf == '\'') { buf++; return Parrot_str_new_init(imcc->interp, buf, strlen(buf) - 1, Parrot_ascii_encoding_ptr, PObj_constant_FLAG); } else { IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Unknown STRING format: '%s'\n", buf); } } /* =item C Adds a constant string to constant_table. =cut */ PARROT_IGNORABLE_RESULT static int add_const_str(ARGMOD(imc_info_t * imcc), ARGIN(STRING *s), ARGIN(PackFile_ByteCode * const bc)) { ASSERT_ARGS(add_const_str) PackFile_ConstTable * const ct = bc->const_table; const int i = PackFile_ConstTable_rlookup_str(imcc->interp, ct, s); if (i >= 0) return i; if (!ct->str.constants) ct->str.constants = mem_gc_allocate_n_zeroed_typed(imcc->interp, 1, STRING *); else ct->str.constants = mem_gc_realloc_n_typed_zeroed(imcc->interp, ct->str.constants, ct->str.const_count + 1, ct->str.const_count, STRING *); /* initialize rlookup cache */ if (!ct->string_hash) ct->string_hash = Parrot_hash_create(imcc->interp, enum_type_INTVAL, Hash_key_type_STRING_enc); ct->str.constants[ct->str.const_count] = s; Parrot_hash_put(imcc->interp, ct->string_hash, s, (void *)ct->str.const_count); return ct->str.const_count++; } /* =item C Adds a constant num to constant_table. =cut */ PARROT_WARN_UNUSED_RESULT static int add_const_num(ARGMOD(imc_info_t * imcc), ARGIN_NULLOK(const char *buf), ARGMOD(PackFile_ByteCode * bc)) { ASSERT_ARGS(add_const_num) PackFile_ConstTable *ct = bc->const_table; STRING * const s = Parrot_str_new(imcc->interp, buf, 0); if (!ct->num.constants) ct->num.constants = mem_gc_allocate_n_zeroed_typed(imcc->interp, 1, FLOATVAL); else ct->num.constants = mem_gc_realloc_n_typed_zeroed(imcc->interp, ct->num.constants, ct->num.const_count + 1, ct->num.const_count, FLOATVAL); ct->num.constants[ct->num.const_count] = Parrot_str_to_num(imcc->interp, s); return ct->num.const_count++; } /* =item C Creates and returns a multi-signature PMC given a SymReg. =cut */ PARROT_CANNOT_RETURN_NULL PARROT_MALLOC static PMC* mk_multi_sig(ARGMOD(imc_info_t * imcc), ARGIN(const SymReg *r), ARGMOD(PackFile_ByteCode * bc)) { ASSERT_ARGS(mk_multi_sig) PackFile_ConstTable *ct; PMC *multi_sig; pcc_sub_t * const pcc_sub = r->pcc_sub; const INTVAL n = pcc_sub->nmulti; INTVAL i; /* a :multi sub with no arguments */ if (!pcc_sub->multi[0]) return Parrot_pmc_new(imcc->interp, enum_class_FixedIntegerArray); multi_sig = Parrot_pmc_new_init_int(imcc->interp, enum_class_FixedPMCArray, n); ct = bc->const_table; for (i = 0; i < n; ++i) { /* multi[i] can be a Key too - * store PMC constants instead of bare strings */ PMC *sig_pmc; r = pcc_sub->multi[i]; if (r->set == 'S') { STRING * const type_name = ct->str.constants[r->color]; const INTVAL type_num = Parrot_pmc_get_type_str(imcc->interp, type_name); if (type_num == enum_type_undef) { sig_pmc = Parrot_pmc_new(imcc->interp, enum_class_String); VTABLE_set_string_native(imcc->interp, sig_pmc, type_name); } else sig_pmc = Parrot_pmc_new_init_int(imcc->interp, enum_class_Integer, type_num); } else { PARROT_ASSERT(r->set == 'K'); sig_pmc = ct->pmc.constants[r->color]; } VTABLE_set_pmc_keyed_int(imcc->interp, multi_sig, i, sig_pmc); } return multi_sig; } typedef void (*decl_func_t)(Interp *, PMC *, STRING *, INTVAL); /* =item C Creates and returns a new LexInfo PMC for all lexicals in the given sub in the current compilation unit. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static PMC* create_lexinfo(ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit), ARGIN(PMC *sub_pmc), int need_lex, ARGMOD(PackFile_ByteCode * bc)) { ASSERT_ARGS(create_lexinfo) PMC *lex_info = NULL; const SymHash * const hsh = &unit->hash; const PackFile_ConstTable * const ct = bc->const_table; const INTVAL lex_info_id = Parrot_hll_get_ctx_HLL_type(imcc->interp, enum_class_LexInfo); unsigned int i; for (i = 0; i < hsh->size; i++) { SymReg *r; for (r = hsh->data[i]; r; r = r->next) { if (r->usage & U_LEXICAL) { SymReg *n; if (!lex_info) { lex_info = Parrot_pmc_new_noinit(imcc->interp, lex_info_id); VTABLE_init_pmc(imcc->interp, lex_info, sub_pmc); } /* at least one lexical name */ n = r->reg; PARROT_ASSERT(n); while (n) { STRING *lex_name; INTVAL reg_type; const int k = n->color; Parrot_Sub_attributes *sub; PARROT_ASSERT(k >= 0); lex_name = ct->str.constants[k]; PARROT_ASSERT(PObj_is_string_TEST(lex_name)); PMC_get_sub(imcc->interp, sub_pmc, sub); IMCC_debug(imcc, DEBUG_PBC_CONST, "add lexical '%s' to sub name '%Ss'\n", n->name, sub->name); if (VTABLE_exists_keyed_str(imcc->interp, lex_info, lex_name)) IMCC_fataly(imcc, EXCEPTION_INVALID_OPERATION, "Multiple declarations of lexical '%S'\n", lex_name); reg_type = r->set == 'I' ? REGNO_INT : r->set == 'N' ? REGNO_NUM : r->set == 'S' ? REGNO_STR : REGNO_PMC; VTABLE_set_integer_keyed_str(imcc->interp, lex_info, lex_name, (r->color << 2) | reg_type); /* next possible name */ n = n->reg; } } } } if (!lex_info && need_lex) { lex_info = Parrot_pmc_new_noinit(imcc->interp, lex_info_id); VTABLE_init_pmc(imcc->interp, lex_info, sub_pmc); } return lex_info; } /* =item C Returns any :outer sub for the current compilation unit. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static PMC* find_outer(ARGMOD(imc_info_t * imcc), ARGIN(const IMC_Unit *unit)) { ASSERT_ARGS(find_outer) subs_t *s; PMC *current; char *cur_name_str; Parrot_Sub_attributes *sub; size_t len; if (!unit->outer) return NULL; /* * we need that the :outer sub is already compiled, * because we are freezing the outer Sub PMC along with this * one */ len = strlen(unit->outer->name); if (!len) return NULL; for (s = imcc->globals->cs->first; s; s = s->next) { if (STREQ(s->unit->subid->name, unit->outer->name)) { PObj_get_FLAGS(s->unit->sub_pmc) |= SUB_FLAG_IS_OUTER; return s->unit->sub_pmc; } } /* could be eval too; check if :outer is the current sub. If not, look in the current namespace */ current = Parrot_pcc_get_sub(imcc->interp, CURRENT_CONTEXT(imcc->interp)); if (PMC_IS_NULL(current)) { PMC * const ns = Parrot_pcc_get_namespace(imcc->interp, CURRENT_CONTEXT(imcc->interp)); STRING * const invokable_s = Parrot_str_new(imcc->interp, "invokable", 0); STRING * const unit_name_s = Parrot_str_new(imcc->interp, unit->outer->name, 0); current = VTABLE_get_pmc_keyed_str(imcc->interp, ns, unit_name_s); if (current->vtable->base_type != enum_class_Sub && !VTABLE_does(imcc->interp, current, invokable_s)) current = PMCNULL; } if (PMC_IS_NULL(current)) IMCC_fatal(imcc, 1, "Undefined :outer sub '%s'.\n", unit->outer->name); PMC_get_sub(imcc->interp, current, sub); cur_name_str = Parrot_str_to_cstring(imcc->interp, sub->name); if (strlen(cur_name_str) == len && (memcmp(cur_name_str, unit->outer->name, len) == 0)) { Parrot_str_free_cstring(cur_name_str); return current; } Parrot_str_free_cstring(cur_name_str); return NULL; } /* =item C Adds a constant Sub in the current compilation unit, denoted by the offset and end positions. =cut */ #define UNIT_FREE_CHAR(x) \ do { \ mem_sys_free((x)); \ (x) = NULL; \ } while (0); PARROT_IGNORABLE_RESULT static int add_const_pmc_sub(ARGMOD(imc_info_t * imcc), ARGMOD(SymReg *r), size_t offs, size_t end) { ASSERT_ARGS(add_const_pmc_sub) PMC *ns_pmc; PMC *sub_pmc; Parrot_Sub_attributes *sub; PackFile_ByteCode * const interp_code = Parrot_pf_get_current_code_segment(imcc->interp); PackFile_ConstTable * const ct = interp_code->const_table; IMC_Unit * const unit = imcc->globals->cs->subs->unit; int i; int ns_const = -1; SymReg * const ns = unit->_namespace ? unit->_namespace->reg : NULL; if (unit->_namespace) { /* strip namespace off from front */ static const char ns_sep[] = "@@@"; char *real_name = strstr(r->name, ns_sep); if (real_name) { /* Unfortunately, there is no strrstr, then iterate until last */ char *aux = strstr(real_name + 3, ns_sep); if (aux) { while (aux) { real_name = aux; aux = strstr(real_name + 3, ns_sep); } real_name += 3; } } IMCC_debug(imcc, DEBUG_PBC_CONST, "name space const = %d ns name '%s'\n", ns->color, ns->name); ns_const = ns->color; if (real_name) { char * const p = mem_sys_strdup(real_name); mem_sys_free(r->name); r->name = p; } } /* Do we have to create an instance of a specific type for this sub? */ if (unit->instance_of) { /* Look it up as a class and as a PMC type. */ STRING * const classname = Parrot_str_new(imcc->interp, unit->instance_of + 1, strlen(unit->instance_of) - 2); PMC * const classobj = Parrot_oo_get_class_str(imcc->interp, classname); if (!PMC_IS_NULL(classobj)) sub_pmc = VTABLE_instantiate(imcc->interp, classobj, PMCNULL); else { const INTVAL type = Parrot_pmc_get_type_str(imcc->interp, classname); if (type <= 0) Parrot_ex_throw_from_c_args(imcc->interp, NULL, EXCEPTION_NO_CLASS, "Class '%Ss' specified in :instanceof(...) not found", classname); sub_pmc = Parrot_pmc_new(imcc->interp, type); } } else { /* use a possible type mapping for the Sub PMCs, and create it */ const INTVAL type = r->pcc_sub->yield ? enum_class_Coroutine : enum_class_Sub; const INTVAL hlltype = Parrot_hll_get_ctx_HLL_type(imcc->interp, type); sub_pmc = Parrot_pmc_new(imcc->interp, hlltype); } /* Set flags and get the sub info. */ PMC_get_sub(imcc->interp, sub_pmc, sub); PObj_get_FLAGS(sub_pmc) |= (r->pcc_sub->pragma & SUB_FLAG_PF_MASK); Sub_comp_get_FLAGS(sub) |= (r->pcc_sub->pragma & SUB_COMP_FLAG_MASK); r->color = add_const_str(imcc, IMCC_string_from_reg(imcc, r), interp_code); sub->name = ct->str.constants[r->color]; /* If the unit has no subid, set the subid to match the name. */ if (!unit->subid) unit->subid = r; else { /* trim the quotes */ char *oldname = unit->subid->name; unit->subid->name = mem_sys_strdup(unit->subid->name + 1); unit->subid->name[strlen(unit->subid->name) - 1] = 0; mem_sys_free(oldname); /* create string constant for it. */ unit->subid->color = add_const_str(imcc, IMCC_string_from_reg(imcc, unit->subid), interp_code); } sub->subid = ct->str.constants[unit->subid->color]; ns_pmc = NULL; if (ns) { switch (ns->set) { case 'K': if (ns_const >= 0 && ns_const < ct->pmc.const_count) ns_pmc = ct->pmc.constants[ns_const]; break; case 'S': if (ns_const >= 0 && ns_const < ct->str.const_count) { ns_pmc = Parrot_pmc_new(imcc->interp, enum_class_String); VTABLE_set_string_native(imcc->interp, ns_pmc, ct->str.constants[ns_const]); } break; default: break; } } sub->namespace_name = ns_pmc; sub->start_offs = offs; sub->end_offs = end; sub->HLL_id = unit->hll_id; for (i = 0; i < 4; ++i) sub->n_regs_used[i] = unit->n_regs_used[i]; sub->lex_info = create_lexinfo(imcc, unit, sub_pmc, r->pcc_sub->pragma & P_NEED_LEX, interp_code); sub->outer_sub = find_outer(imcc, unit); sub->vtable_index = -1; /* check if it's declared multi */ if (r->pcc_sub->nmulti) sub->multi_signature = mk_multi_sig(imcc, r, interp_code); else sub->multi_signature = NULL; if (unit->is_vtable_method == 1) { STRING *vtable_name; INTVAL vtable_index; /* Work out the name of the vtable function. */ if (unit->vtable_name) { vtable_name = Parrot_str_new(imcc->interp, unit->vtable_name + 1, strlen(unit->vtable_name) - 2); UNIT_FREE_CHAR(unit->vtable_name); } else vtable_name = sub->name; /* Check this is a valid vtable function to override. */ vtable_index = Parrot_get_vtable_index(imcc->interp, vtable_name); if (vtable_index == -1) IMCC_fatal(imcc, 1, "'%S' is not a vtable, but was used with :vtable.\n", vtable_name); /* TODO check for duplicates */ sub->vtable_index = vtable_index; } if (unit->is_method == 1) { /* Work out the name of the method. */ if (unit->method_name) { sub->method_name = IMCC_string_from__STRINGC(imcc, unit->method_name); UNIT_FREE_CHAR(unit->method_name); } else sub->method_name = sub->name; } else sub->method_name = STRINGNULL; if (unit->has_ns_entry_name == 1) { /* Work out the name of the ns entry. */ if (unit->ns_entry_name) { sub->ns_entry_name = IMCC_string_from__STRINGC(imcc, unit->ns_entry_name); UNIT_FREE_CHAR(unit->ns_entry_name); } else sub->ns_entry_name = sub->name; } else sub->ns_entry_name = sub->name; Parrot_ns_store_sub(imcc->interp, sub_pmc); /* store the sub */ { const int k = add_const_table_pmc(imcc, sub_pmc); unit->sub_pmc = sub_pmc; imcc->globals->cs->subs->pmc_const = k; if (DEBUG_PBC_CONST & imcc->debug) { Parrot_Sub_attributes *outer_sub; if (sub->outer_sub) PMC_get_sub(imcc->interp, sub->outer_sub, outer_sub); IMCC_debug(imcc, DEBUG_PBC_CONST, "add_const_pmc_sub '%s' flags %x color %d (%Ss) " "lex_info %s :outer(%Ss)\n", r->name, r->pcc_sub->pragma, k, sub_pmc->vtable->whoami, sub->lex_info ? "yes" : "no", sub->outer_sub ? outer_sub->name : Parrot_str_new(imcc->interp, "*none*", 0)); } if (r->pcc_sub->pragma & P_MAIN && !imcc->seen_main) { imcc->seen_main = 1; interp_code->main_sub = k; } else if (interp_code->main_sub < 0) { interp_code->main_sub = k; } /* * store the sub's strings */ { PMC * const strings = Parrot_freeze_strings(imcc->interp, sub_pmc); const int n = VTABLE_elements(imcc->interp, strings); for (i = 0; i < n; i++) { add_const_str(imcc, VTABLE_get_string_keyed_int(imcc->interp, strings, i), interp_code); } } store_sub_tags(imcc, r->pcc_sub, k, ct); return k; } } /* =item C Store the tags associated with a sub in the provided constant table. =cut */ static void store_sub_tags(ARGMOD(imc_info_t * imcc), ARGIN(pcc_sub_t * sub), const int sub_idx, ARGMOD(PackFile_ConstTable * ct)) { ASSERT_ARGS(store_sub_tags) opcode_t i; for (i = 0; i < sub->nflags; i++) { SymReg * const flag = sub->flags[i]; STRING * const tag = Parrot_str_new(imcc->interp, flag->name + 1, strlen(flag->name) - 2); const int tag_idx = add_const_str(imcc, tag, ct->code); Parrot_pf_tag_constant(imcc->interp, ct, tag_idx, sub_idx); } } /* =item C Builds a Key PMC from the given SymReg. Color is a Parrot register number or a constant table index. For the rest, please consult PDD08_KEYS(1). Additionally, I build a string representation of the key, which gets cached in the globals.keys. =cut */ static opcode_t build_key(ARGMOD(imc_info_t * imcc), ARGIN(SymReg *key_reg), ARGMOD(PackFile_ByteCode * bc)) { ASSERT_ARGS(build_key) PackFile_ConstTable *ct = bc->const_table; SymReg *reg = key_reg->set == 'K' ? key_reg->nextkey : key_reg; PMC *head = NULL; PMC *tail = NULL; opcode_t regno, k; for (; reg; reg = reg->nextkey) { SymReg *r = reg; if (tail) { PMC * temp = Parrot_pmc_new(imcc->interp, enum_class_Key); SETATTR_Key_next_key(imcc->interp, tail, temp); GETATTR_Key_next_key(imcc->interp, tail, tail); } else { head = tail = Parrot_pmc_new(imcc->interp, enum_class_Key); } switch (r->type) { case VTIDENTIFIER: /* P[S0] */ case VTPASM: /* P[S0] */ case VTREG: /* P[S0] */ /* if key is a copy created by link_keys, use the original */ if (r->reg && r->reg->type == r->type) r = r->reg; /* don't emit mapped regs in key parts */ regno = r->color >= 0 ? r->color : -1 - r->color; switch (r->set) { case 'I': Parrot_key_set_register(imcc->interp, tail, regno, KEY_integer_FLAG); break; case 'S': Parrot_key_set_register(imcc->interp, tail, regno, KEY_string_FLAG); break; case 'P': Parrot_key_set_register(imcc->interp, tail, regno, KEY_pmc_FLAG); break; default: IMCC_fatal(imcc, 1, "build_key: wrong register set '%c' (%d) in keyed access. " "Expects one of 'I', 'S' or 'P'\n", r->set, r->set); } IMCC_debug(imcc, DEBUG_PBC_CONST, " keypart reg %s %c%d\n", r->name, r->set, (int)r->color); break; case VT_CONSTP: r = r->reg; /* Fall through. */ case VTCONST: case VTCONST|VT_ENCODED: switch (r->set) { case 'S': /* P["key"] */ /* str constant */ Parrot_key_set_string(imcc->interp, tail, ct->str.constants[r->color]); break; case 'I': /* P[;42;..] */ /* int constant */ Parrot_key_set_integer(imcc->interp, tail, atol(r->name)); break; default: IMCC_fatal(imcc, 1, "build_key: unknown set\n"); } break; default: IMCC_fatal(imcc, 1, "build_key: " "unknown type 0x%x on %s\n", r->type, r->name); } } { STRING *name = Parrot_key_set_to_string(imcc->interp, head); char *cname = Parrot_str_to_cstring(imcc->interp, name); SymReg * const r = _get_sym(&imcc->globals->cs->key_consts, cname); if (r) { k = r->color; } else { k = add_const_table_pmc(imcc, head); store_key_const(imcc, cname, k); } Parrot_str_free_cstring(cname); } /* single 'S' keys already have their color assigned */ if (key_reg->set == 'K') key_reg->color = k; return k; } /* =item C Creates and returns an INTEGER given an integer-like SymReg. =cut */ PARROT_WARN_UNUSED_RESULT INTVAL IMCC_int_from_reg(ARGMOD(imc_info_t * imcc), ARGIN(const SymReg *r)) { ASSERT_ARGS(IMCC_int_from_reg) INTVAL i; const char *digits; int base; if (r->type & VT_CONSTP) r = r->reg; digits = r->name; base = 10; errno = 0; if (digits[0] == '0') { switch (toupper((unsigned char)digits[1])) { case 'B': base = 2; break; case 'O': base = 8; break; case 'X': base = 16; break; default: break; } } if (base == 10) { i = strtol(digits, NULL, base); } else { i = strtoul(digits + 2, NULL, base); } /* * TODO * - is this portable? * - there are some more atol()s in this file */ if (errno == ERANGE) IMCC_fatal(imcc, 1, "add_1_const:" "Integer overflow '%s'", r->name); return i; } /* =item C Initializes the passed FIA from a string representation I<"(el0, el1, ...)">. =cut */ static void init_fixedintegerarray_from_string(ARGMOD(imc_info_t * imcc), ARGIN(PMC *p), ARGIN(STRING *s)) { ASSERT_ARGS(init_fixedintegerarray_from_string) INTVAL n, elem, l; char *src, *chr, *start, *end; int base; if (STRING_max_bytes_per_codepoint(s) != 1) Parrot_ex_throw_from_c_args(imcc->interp, NULL, EXCEPTION_INVALID_ENCODING, "unhandled string encoding in FixedIntegerArray initialization"); l = Parrot_str_byte_length(imcc->interp, s); if (!l) return; start = src = Parrot_str_to_cstring(imcc->interp, s); end = src + l - 1; /* Skip leading whitespace and ( */ while (*start == ' ' || *start == '\t' || *start == '(') { ++start; } /* Skip trailing whitespace and ) */ while (end >= start && (*end == ' ' || *end == '\t' || *end == ')')) { --end; } ++end; /* no content */ if (start == end) { Parrot_str_free_cstring(src); return; } /* count commas */ for (chr = start, n = 0; chr < end; chr++) { if (*chr == ',') n++; } /* presize the array */ VTABLE_set_integer_native(imcc->interp, p, n + 1); /* parse string */ for (chr = start, n = 0; chr < end;) { /* Check for comma */ if (n > 0) { if (*chr == ',') { ++chr; } else { Parrot_ex_throw_from_c_args(imcc->interp, NULL, EXCEPTION_INVALID_STRING_REPRESENTATION, "expected ',' in FixedIntegerArray initialization"); } } /* Skip value-leading whitespace */ while (*chr == ' ' || *chr == '\t') { ++chr; } /* Leading 0, 0b, 0x */ base = 10; if (*chr == '0') { ++chr; switch (*chr) { case 'b': case 'B': base = 2; ++chr; break; case 'x': case 'X': base = 16; ++chr; break; default: base = 8; } } /* Store value */ elem = strtoul(chr, &chr, base); VTABLE_set_integer_keyed_int(imcc->interp, p, n++, elem); /* See if there are any garbage characters after the number */ switch (*chr) { case ' ': case '\t': case ')': ++chr; /* Fallthrough */ case '\0': break; case ',': /* Hold onto the , for the test at the start of the loop */ break; default: Parrot_ex_throw_from_c_args(imcc->interp, NULL, EXCEPTION_INVALID_STRING_REPRESENTATION, "invalid number in FixedIntegerArray initialization"); } /* Skip value-trailing whitespace */ while (*chr == ' ' || *chr == '\t') { ++chr; } } Parrot_str_free_cstring(src); } /* =item C Creates a constant PMC, given a SymReg. =cut */ static void make_pmc_const(ARGMOD(imc_info_t * imcc), ARGMOD(SymReg *r)) { ASSERT_ARGS(make_pmc_const) /* TODO: Is there a way to get this without violating the encapsulation of all these structures? */ PMC * const _class = imcc->interp->vtables[r->pmc_type]->pmc_class; STRING *s; PMC *p; if (PMC_IS_NULL(_class)) IMCC_fatal(imcc, 1, "make_pmc_const: no such pmc"); if (*r->name == '"') s = Parrot_str_unescape(imcc->interp, r->name + 1, '"', NULL); else if (*r->name == '\'') s = Parrot_str_unescape(imcc->interp, r->name + 1, '\'', NULL); else s = Parrot_str_unescape(imcc->interp, r->name, 0, NULL); p = Parrot_pmc_new(imcc->interp, r->pmc_type); switch (r->pmc_type) { case enum_class_Integer: VTABLE_set_integer_native(imcc->interp, p, Parrot_str_to_int(imcc->interp, s)); break; case enum_class_Float: VTABLE_set_number_native(imcc->interp, p, Parrot_str_to_num(imcc->interp, s)); break; case enum_class_String: VTABLE_set_string_native(imcc->interp, p, s); break; case enum_class_FixedIntegerArray: init_fixedintegerarray_from_string(imcc, p, s); break; default: Parrot_ex_throw_from_c_args(imcc->interp, NULL, EXCEPTION_INVALID_OPERATION, "Can't generate PMC constant for this type."); } /* append PMC constant */ r->color = add_const_table_pmc(imcc, p); } /* =item C Adds a constant SymReg to the constant table, depending on its type. =cut */ static void add_1_const(ARGMOD(imc_info_t * imcc), ARGMOD(SymReg *r), ARGMOD(PackFile_ByteCode * bc)) { ASSERT_ARGS(add_1_const) if (r->color >= 0) return; if (r->use_count <= 0) return; switch (r->set) { case 'I': r->color = IMCC_int_from_reg(imcc, r); break; case 'S': if (r->type & VT_CONSTP) r = r->reg; r->color = add_const_str(imcc, IMCC_string_from_reg(imcc, r), bc); break; case 'N': r->color = add_const_num(imcc, r->name, bc); break; case 'K': { SymReg *key = r; for (r = r->nextkey; r; r = r->nextkey) if (r->type & (VTCONST|VT_CONSTP)) add_1_const(imcc, r, bc); build_key(imcc, key, bc); } break; case 'P': make_pmc_const(imcc, r); IMCC_debug(imcc, DEBUG_PBC_CONST, "PMC const %s\tcolor %d\n", r->name, r->color); break; default: break; } if (!r) return; IMCC_debug(imcc, DEBUG_PBC_CONST, "const %s\tcolor %d use_count %d\n", r->name, r->color, r->use_count); } /* =item C Stores a constant's idx for later reuse. =cut */ static void constant_folding(ARGMOD(imc_info_t * imcc), ARGIN(const IMC_Unit *unit), ARGMOD(PackFile_ByteCode * bc)) { ASSERT_ARGS(constant_folding) const SymHash *hsh = &imcc->ghash; unsigned int i; /* go through all consts of current sub */ for (i = 0; i < hsh->size; i++) { SymReg *r; /* normally constants are in ghash ... */ for (r = hsh->data[i]; r; r = r->next) { if (r->type & (VTCONST|VT_CONSTP)) add_1_const(imcc, r, bc); if (r->usage & U_LEXICAL) { SymReg *n = r->reg; /* r->reg is a chain of names for the same lex sym */ while (n) { /* lex_name */ add_1_const(imcc, n, bc); n = n->reg; } } } } /* ... but keychains 'K' are in local hash, they may contain * variables and constants */ hsh = &unit->hash; for (i = 0; i < hsh->size; i++) { SymReg *r; /* normally constants are in ghash ... */ for (r = hsh->data[i]; r; r = r->next) { if (r->type & VTCONST) add_1_const(imcc, r, bc); } } /* and finally, there may be an outer Sub */ if (unit->outer) add_1_const(imcc, unit->outer, bc); } /* =item C Starts a new PBC emitting of a compilation unit, if the given compilation unit has any instructions. =cut */ void e_pbc_new_sub(ARGMOD(imc_info_t * imcc), SHIM(void *param), ARGIN(IMC_Unit *unit)) { ASSERT_ARGS(e_pbc_new_sub) if (!unit->instructions) return; /* we start a new compilation unit */ make_new_sub(imcc, unit); } /* =item C Finishes the PBC emitting of a given compilation unit. =cut */ void e_pbc_end_sub(ARGMOD(imc_info_t * imcc), SHIM(void *param), ARGIN(IMC_Unit *unit)) { ASSERT_ARGS(e_pbc_end_sub) Instruction *ins = unit->instructions; int pragma; if (!ins) return; /* * if the sub was marked IMMEDIATE, we run it now * This is *dangerous*: all possible global state can be messed * up, e.g. when that sub starts loading bytecode */ /* we run only PCC subs */ if (!ins->symregs[0] || !ins->symregs[0]->pcc_sub) return; pragma = ins->symregs[0]->pcc_sub->pragma; if (pragma & P_IMMEDIATE && (pragma & P_ANON)) { /* clear global symbols temporarily -- TT #1324, for example */ imcc_globals *g = imcc->globals; SymHash ghash; imcc->globals = NULL; memmove(&ghash, &imcc->ghash, sizeof (SymHash)); memset(&imcc->ghash, 0, sizeof (SymHash)); IMCC_debug(imcc, DEBUG_PBC, "immediate sub '%s'", ins->symregs[0]->name); /* TODO: Don't use this function, it is deprecated (TT #2140). We need to find a better mechanism to do this. */ PackFile_fixup_subs(imcc->interp, PBC_IMMEDIATE, NULL); imcc->globals = g; memmove(&imcc->ghash, &ghash, sizeof (SymHash)); } } /* =item C Checks if any get_ argument contains constants and fills in type bits for argument types and constants, if missing. =cut */ static void verify_signature(ARGMOD(imc_info_t * imcc), ARGIN(const Instruction *ins), ARGIN(opcode_t *pc), ARGMOD(PackFile_ByteCode * bc)) { ASSERT_ARGS(verify_signature) PMC *changed_sig = NULL; PMC * const sig_arr = bc->const_table->pmc.constants[pc[-1]]; op_lib_t *core_ops = PARROT_GET_CORE_OPLIB(imcc->interp); int needed = 0; int no_consts = (ins->op == &core_ops->op_info_table[PARROT_OP_get_results_pc] || ins->op == &core_ops->op_info_table[PARROT_OP_get_params_pc]); INTVAL i, n; PARROT_ASSERT(PObj_is_PMC_TEST(sig_arr)); PARROT_ASSERT(sig_arr->vtable->base_type == enum_class_FixedIntegerArray); n = VTABLE_elements(imcc->interp, sig_arr); if (n != ins->symreg_count - 1) IMCC_fatal(imcc, 1, "syntax error: parameter count mismatch in '%s'" " -- have %d, want %d", ins->opname, ins->symreg_count - 1, n); for (i = 0; i < n; ++i) { SymReg * const r = ins->symregs[i + 1]; INTVAL sig = VTABLE_get_integer_keyed_int(imcc->interp, sig_arr, i); if (! (sig & PARROT_ARG_NAME) && no_consts && (r->type & VTCONST)) IMCC_fatal(imcc, 1, "e_pbc_emit: " "constant argument '%s' in get param/result\n", r->name); if ((r->type & VTCONST) && !(sig & PARROT_ARG_CONSTANT)) { if (!changed_sig) changed_sig = VTABLE_clone(imcc->interp, sig_arr); sig |= PARROT_ARG_CONSTANT; VTABLE_set_integer_keyed_int(imcc->interp, changed_sig, i, sig); } switch (r->set) { case 'I': needed = PARROT_ARG_INTVAL; break; case 'S': needed = PARROT_ARG_STRING; break; case 'P': needed = PARROT_ARG_PMC; break; case 'N': needed = PARROT_ARG_FLOATVAL; break; default : break; } if (needed != (sig & PARROT_ARG_TYPE_MASK)) { if (!changed_sig) changed_sig = VTABLE_clone(imcc->interp, sig_arr); sig &= ~PARROT_ARG_TYPE_MASK; sig |= needed; VTABLE_set_integer_keyed_int(imcc->interp, changed_sig, i, sig); } } /* append PMC constant */ if (changed_sig) pc[-1] = add_const_table_pmc(imcc, changed_sig); } /* =item C Starts to emit code for one instruction. =cut */ int e_pbc_emit(ARGMOD(imc_info_t * imcc), SHIM(void *param), ARGIN(const IMC_Unit *unit), ARGIN(const Instruction *ins)) { ASSERT_ARGS(e_pbc_emit) int ok = 0; int i; op_lib_t *core_ops = PARROT_GET_CORE_OPLIB(imcc->interp); PMC * const interp_pf_pmc = Parrot_pf_get_current_packfile(imcc->interp); PackFile * const interp_pf = (PackFile*)VTABLE_get_pointer(imcc->interp, interp_pf_pmc); PackFile_ByteCode * const interp_code = Parrot_pf_get_current_code_segment(imcc->interp); /* first instruction, do initialisation ... */ if (ins == unit->instructions) { size_t ins_size, seg_size; const size_t old_size = get_old_size(imcc, interp_code, &imcc->ins_line); const size_t code_size = get_code_size(imcc, unit, &ins_size); const size_t bytes = (old_size + code_size) * sizeof (opcode_t); IMCC_debug(imcc, DEBUG_PBC, "code_size(ops) %d old_size %d\n", code_size, old_size); constant_folding(imcc, unit, interp_code); store_sub_size(imcc, code_size, ins_size); /* allocate code */ interp_code->base.data = (opcode_t *) mem_sys_realloc(interp_code->base.data, bytes); /* reallocating this removes its mmaped-ness; needs encapsulation */ interp_code->base.pf->is_mmap_ped = 0; interp_code->base.size = old_size + code_size; imcc->pc = (opcode_t *)interp_code->base.data + old_size; imcc->npc = 0; /* FIXME length and multiple subs */ seg_size = (size_t)imcc->ins_line + ins_size + 1; imcc->debug_seg = Parrot_new_debug_seg(imcc->interp, interp_code, seg_size); Parrot_debug_add_mapping(imcc->interp, imcc->debug_seg, old_size, unit->file); /* if item is a PCC_SUB entry then store it constants */ if (ins->symregs[0] && ins->symregs[0]->pcc_sub) { add_const_pmc_sub(imcc, ins->symregs[0], old_size, old_size + code_size); } else { /* need a dummy to hold register usage */ SymReg * const r = mk_sub_label(imcc, "(null)"); r->type = VT_PCC_SUB; r->pcc_sub = mem_gc_allocate_zeroed_typed(imcc->interp, pcc_sub_t); add_const_pmc_sub(imcc, r, old_size, old_size + code_size); } } /* if this is not the first sub then store the sub */ if (imcc->npc && unit->pasm_file && ins->symregs[0] && ins->symregs[0]->pcc_sub) { /* we can only set the offset for PASM code */ add_const_pmc_sub(imcc, ins->symregs[0], imcc->npc, imcc->npc); } if (ins->opname && strcmp(ins->opname, ".annotate") == 0) { /* It's an annotation. */ int annotation_type; /* Add annotations seg if we're missing one. */ if (!interp_code->annotations) Parrot_pf_get_annotations_segment(imcc->interp, interp_pf, interp_code); /* Add annotation. */ switch (ins->symregs[1]->set) { case 'I': annotation_type = PF_ANNOTATION_KEY_TYPE_INT; break; case 'S': annotation_type = PF_ANNOTATION_KEY_TYPE_STR; break; default: IMCC_fatal(imcc, 1, "e_pbc_emit:invalid type for annotation value\n"); } PackFile_Annotations_add_entry(imcc->interp, interp_code->annotations, imcc->pc - interp_code->base.data, ins->symregs[0]->color, annotation_type, ins->symregs[1]->color); } else if (ins->opname && *ins->opname) { SymReg *addr, *r; op_info_t *op_info; opcode_t last_label = 1; if ((ins->type & ITBRANCH) && ((addr = get_branch_reg(ins)) != NULL) && !REG_NEEDS_ALLOC(addr)) { /* fixup local jumps - calc offset */ if (addr->color == -1) IMCC_fatal(imcc, 1, "e_pbc_emit: no label offset defined for '%s'\n", addr->name); last_label = addr->color - imcc->npc; IMCC_debug(imcc, DEBUG_PBC_FIXUP, "branch label at pc %d addr %d %s %d\n", imcc->npc, addr->color, addr->name, last_label); } /* add debug line info */ if (imcc->debug_seg) imcc->debug_seg->base.data[imcc->ins_line++] = (opcode_t)ins->line; /* Get the info for that opcode */ op_info = ins->op; IMCC_debug(imcc, DEBUG_PBC, "%d %s", imcc->npc, op_info->full_name); /* Start generating the bytecode */ *(imcc->pc)++ = bytecode_map_op(imcc, op_info); for (i = 0; i < op_info->op_count-1; i++) { switch (op_info->types[i]) { case PARROT_ARG_IC: /* branch instruction */ if (op_info->labels[i]) { if (last_label == 1) /* we don't have a branch with offset 1 !? */ IMCC_fatal(imcc, 1, "e_pbc_emit: " "no label offset found\n"); *(imcc->pc)++ = last_label; last_label = 1; break; /* else fall through */ } case PARROT_ARG_I: case PARROT_ARG_N: case PARROT_ARG_S: case PARROT_ARG_P: case PARROT_ARG_K: case PARROT_ARG_KI: case PARROT_ARG_KIC: case PARROT_ARG_SC: case PARROT_ARG_NC: case PARROT_ARG_PC: r = ins->symregs[i]; if (r->type & VT_CONSTP) r = r->reg; *(imcc->pc)++ = (opcode_t) r->color; IMCC_debug(imcc, DEBUG_PBC, " %d", r->color); break; case PARROT_ARG_KC: r = ins->symregs[i]; if (r->set == 'K') { PARROT_ASSERT(r->color >= 0); *(imcc->pc)++ = r->color; } else *(imcc->pc)++ = build_key(imcc, r, interp_code); IMCC_debug(imcc, DEBUG_PBC, " %d", imcc->pc[-1]); break; default: IMCC_fatal(imcc, 1, "e_pbc_emit:unknown argtype in parrot op\n"); break; } } if (ins->op == &core_ops->op_info_table[PARROT_OP_set_args_pc] || ins->op == &core_ops->op_info_table[PARROT_OP_get_results_pc] || ins->op == &core_ops->op_info_table[PARROT_OP_get_params_pc] || ins->op == &core_ops->op_info_table[PARROT_OP_set_returns_pc]) { /* TODO get rid of verify_signature - PIR call sigs are already * fixed, but PASM still needs it */ verify_signature(imcc, ins, imcc->pc, interp_code); /* emit var_args part */ for (; i < ins->opsize - 1; ++i) { r = ins->symregs[i]; if (r->type & VT_CONSTP) r = r->reg; *(imcc->pc)++ = (opcode_t) r->color; IMCC_debug(imcc, DEBUG_PBC, " %d", r->color); } } IMCC_debug(imcc, DEBUG_PBC, "\t%d\n", ins); imcc->npc += ins->opsize; } return ok; } /* =item C Closes this PMC unit. =cut */ void e_pbc_close(ARGMOD(imc_info_t * imcc), SHIM(void *param)) { ASSERT_ARGS(e_pbc_close) fixup_globals(imcc); } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ model_users.pod000644000765000765 736412101554066 17267 0ustar00brucebruce000000000000parrot-5.9.0/docs/req# Copyright (C) 2005-2012, Parrot Foundation. =pod =head1 NAME docs/req/model_users.pod - Model Users For Parrot Design Decisions =head1 DESCRIPTION This document exists to give Parrot design a direction. =head1 RATIONALE Before we can make design decisions, we need a metric to evaluate them. The best metrics are based on I intuition. This document is designed to inform the intuition. Below are listed some model users with random (or, in some cases, not-so-random) names. Questions to ask yourself: Do you know anyone who fits these descriptions? If so, what else would you write about them? How would you describe them? What else do they care about? What do they I care about? And let's remember that, in the end, we can't really please everyone. So we have to pick who we'll please, and who we'll piss off. It just can't be helped. =head1 MODEL USERS =head2 "Audrey": Perl 6 implementer Audrey has a favorite language, Perl 6, and he wants to target it to Parrot. Audrey: =over 4 =item * values speed, but not above all else =item * values interoperability of languages, especially with Perl 5 =item * doesn't care about PBC particularly, though he knows his users might, eventually =item * doesn't mind incompatible source changes, as long as the entire tool chain still works after upgrading =back =head2 "Nick": Ponie implementer Nick is implementing Perl 5 with (over? under? inside?) Parrot. Nick: =over 4 =item * doesn't care about dynamic loading of features =item * ??? =back =head2 "Dick": Scripting an existing application Dick has an application that needs some scripting features, so he's embedding Parrot to get PIR and the languages that target it, e.g. Perl 6. Dick: =over 4 =item * cares mostly about ease and stability of embedding (no memory leaks! no seg faults!) =item * is probably not very sensitive to performance, since scripting interfaces are never speed demons anyway =item * probably bundles a specific Parrot version (or linkage to a specific version) and maybe precompiled pbcs with his program =item * may be more or less tolerant of changes depending on the system into which Parrot is embedded =back =head2 "Tom": Embedded system creator Tom loves Perl 6, so wants to write his special-purpose embedded system to run on Parrot. The platform is very limited, and speed is not particularly crucial. Tom: =over 4 =item * cares mostly about stable long-term execution (no memory leaks! no seg faults!) =item * doesn't care about inter-version compatibility, since he bundles Parrot with his product =item * doesn't care very much about performance =item * depends on PBC for space efficiency =item * wants to be able to strip down Parrot for deployment, omitting subsystems that are large or which depend on large external systems =back =head2 "Ilya": Intensive CPU User Ilya writes high-performance CPU-bound code, typically involving either intense data structure manipulation or floating point math. Ilya: =over 4 =item * cares about performance to exclusion of most other factors =item * doesn't care about PBC one way or the other =item * can't handle incompatible source changes; is likely to pick a favorite feature set and stick with it =back =head2 "Magpie": Lover of shiny things Magpie sees something shiny -- a new runtime, or a new language, or even better, a new language on a new runtime -- and is willing to do a lot to make it work, just so he can play with it. Magpie: =over 4 =item * loves neat features =item * doesn't care about PBC, backwards compatibility, or any of the things that make a platform stable and useful for users who don't care about shiny tech =item * will put up with almost any change as long as the inconvenience leads to something even more shiny =back =cut Coroutine.pir000644000765000765 1532211533177636 23140 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library/Parrot=head1 TITLE Parrot::Coroutine - A pure PIR implementation of coroutines =head1 SYNOPSIS .sub onload :load load_bytecode 'Parrot/Coroutine.pbc' .end ## Recursive coroutine to enumerate tree elements. Each element that is ## not a FixedPMCArray is yielded in turn. .sub enumerate_tree .param pmc coro .param pmc tree_node .param int depth :optional .param int depth_p :opt_flag if depth_p goto have_depth depth = 0 have_depth: inc depth $I0 = isa tree_node, 'FixedPMCArray' if $I0 goto recur print "[leaf " print tree_node print "]\n" coro.'yield'(tree_node) .return () recur: ## Loop through array elements, recurring on each. .local int size, i i = 0 size = tree_node again: if i >= size goto done print "[recur: depth " print depth print ' elt ' print i print "]\n" $P1 = tree_node[i] enumerate_tree(coro, $P1, depth) inc i goto again done: .return () .end .sub print_tree .param pmc tree .local int coro_class, idx .local pmc coro .const 'Sub' coro_sub = "enumerate_tree" coro = new ['Parrot'; 'Coroutine'], coro_sub ($P0 :optional, $I0 :opt_flag) = coro.'resume'(coro, tree) idx = 0 loop: unless $I0 goto done print 'print_tree: ' print idx print ' => ' print $P0 print "\n" ($P0 :optional, $I0 :opt_flag) = coro.'resume'() goto loop done: .end =head1 DESCRIPTION This object class provides an implementation of coroutines that is written in pure PIR using continuations. =cut .sub onload_create_class :load $P0 = get_class ['Parrot'; 'Coroutine'] unless null $P0 goto END $P0 = newclass ['Parrot'; 'Coroutine'] addattribute $P0, "state" ## State: 1 is new/valid, 0 is dead. addattribute $P0, "initial_sub" ## Initial sub. addattribute $P0, "yield_cont" ## Continuation to for yielding. addattribute $P0, "resume_cont" ## Continuation from which to resume. END: .return () .end .namespace ['Parrot'; 'Coroutine'] .include "interpinfo.pasm" =head2 METHODS =head3 B This method is normally called via the C op: .local pmc coro .const 'Sub' coro_sub = "enumerate_tree" coro_class = get_class ['Parrot'; 'Coroutine'] coro = coro_class.'new'('initial_sub' => coro_sub) Given a sub, it initializes a new C object. =cut .sub init_pmc :vtable :method .param pmc init_args ## [should complain if sub is not a sub or closure. -- rgr, 8-Oct-06.] .local pmc state state = new 'Undef' state = 1 setattribute self, 'state', state .end ## [it would be nice to include a pointer value. -- rgr, 8-Oct-06.] .sub get_string :vtable :method .return ('') .end =head3 B Invoke the coroutine. The first time this is called on a new coroutine, the initial sub is invoked with the passed arguments. The second and subsequent times, the args are delivered as the result of the previous C operation. If the coroutine subsequently yields, the values passed to the C method are returned as the values from C. If the coroutine returns normally (i.e. from the original sub), then those values are passed returned from the C method, and the coroutine is marked as dead, in which case it is an error to attempt to resume it again. =cut .sub resume :method .param pmc args :slurpy ## Decide whether we're dead. .local pmc state state = getattribute self, 'state' unless state goto dead ## Decide where to go. If we've never been invoked before, we need to ## call the sub. .local pmc entry entry = getattribute self, 'resume_cont' unless null entry goto doit entry = getattribute self, 'initial_sub' doit: ## Remember where to return when we yield. .local pmc cc cc = interpinfo .INTERPINFO_CURRENT_CONT setattribute self, 'yield_cont', cc ## Call the entry with our args. Most of the time, it will yield (by ## calling our continuation for us) instead of returning directly. .local pmc result (result :slurpy) = entry(args :flat) ## If we returned normally, then the coroutine is dead. state = 0 ## Note that the value of the yield_cont slot will normally have been ## changed magically behind our backs by a subsequent yield/resume, so ## we can't just return directly. cc = getattribute self, 'yield_cont' .tailcall cc(result :flat) dead: ## Complain about attempted zombie creation. .local pmc error error = new 'Exception' error = "Can't reanimate a dead coroutine.\n" throw error .end =head3 B Within the coroutine, C returns arbitrary values back to the caller, making it look like the values came from the last C call. The next time the caller decides to resume the coroutine, the arguments passed to C are returned as the values from C. =cut ## Return values to the calling thread. .sub yield :method .param pmc args :slurpy ## Remember where to go when we are resumed. .local pmc cc cc = interpinfo .INTERPINFO_CURRENT_CONT setattribute self, 'resume_cont', cc ## Return to the coro caller. cc = getattribute self, 'yield_cont' .tailcall cc(args :flat) .end =head1 BUGS =over 4 =item 1. We should really keep more state details. The only legal state transitions should be 'new' to 'resumed' to 'yielded' to 'resumed' to 'yielded' ..., except that one might at any time transition to 'dead', which is (not surprisingly) the terminal state. =back Please report any others you find to Cparrot-dev@lists.parrot.orgE>. =head1 SEE ALSO L -- coroutines defined. C -- "same fringe" test case. C -- the C implementation. L -- definition of the coroutine API for the Lua programming language, upon which the C API is based. L -- Scheme tutorial chapter that introduces call/cc and uses it to solve "same fringe" via coroutines. =head1 AUTHOR Bob Rogers Crogers-perl6@rgrjr.dyndns.orgE> =head1 COPYRIGHT Copyright (C) 2006-2008, Parrot Foundation. This program is free software. It is subject to the same license as The Parrot Interpreter. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: 023-version.t000644000765000765 540011533177643 17122 0ustar00brucebruce000000000000parrot-5.9.0/t/configure#! perl # Copyright (C) 2007, Parrot Foundation. # 023-version.t use strict; use warnings; use Test::More tests => 14; use Carp; use Cwd; use File::Copy; use File::Temp qw| tempdir |; use lib qw( lib t/configure/testlib ); use Parrot::BuildUtil; use Make_VERSION_File qw| make_VERSION_file |; my $cwd = cwd(); { my $tdir = tempdir( CLEANUP => 1 ); ok( chdir $tdir, "Changed to temporary directory for testing" ); ok( ( mkdir "lib" ), "Able to make directory lib" ); ok( ( mkdir "lib/Parrot" ), "Able to make directory lib/Parrot" ); # Case 5: Valid version number make_VERSION_file(q{0.4.11}); my ( $pv, @pv ); @pv = Parrot::BuildUtil::parrot_version(); is_deeply( \@pv, [ 0, 4, 11 ], "Correct version number returned in list context" ); $pv = Parrot::BuildUtil::parrot_version(); is( $pv, q{0.4.11}, "Correct version number returned in scalar context" ); unlink q{VERSION} or croak "Unable to delete file from tempdir after testing"; ok( chdir $cwd, "Able to change back to directory after testing" ); } { my $tdir = tempdir( CLEANUP => 1 ); ok( chdir $tdir, "Changed to temporary directory for testing" ); my $rv = set_bc_version(q{3.07}); my ($bc_major, $bc_minor) = Parrot::BuildUtil::get_bc_version(); is( $bc_major, 3, "Got expected bytecode major version" ); is( $bc_minor, 7, "Got expected bytecode minor version" ); ok( chdir $cwd, "Able to change back to directory after testing" ); } { my $tdir = tempdir( CLEANUP => 1 ); ok( chdir $tdir, "Changed to temporary directory for testing" ); my $rv = set_bc_version(q{3.tomboy}); eval { my ($bc_major, $bc_minor) = Parrot::BuildUtil::get_bc_version(); }; like( $@, qr/No bytecode version found/, "Got expected error message on failure to find bytecode version" ); ok( chdir $cwd, "Able to change back to directory after testing" ); } pass("Completed all tests in $0"); sub set_bc_version { my $version_str = shift; my $compat_file = 'PBC_COMPAT'; my ( $bc_major, $bc_minor ); open my $OUT, '>', $compat_file or die "Can't write $compat_file"; print $OUT "$version_str\n"; close $OUT; return 1; } ################### DOCUMENTATION ################### =head1 NAME 023-version.t - test C =head1 SYNOPSIS % prove t/configure/023-version.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file test Parrot::BuildUtil (F). =head1 AUTHOR James E Keenan =head1 SEE ALSO Parrot::BuildUtil, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: index.json000644000765000765 457512101554066 16565 0ustar00brucebruce000000000000parrot-5.9.0/docs/index{ "page" : "index", "content" : [ { "source" : [ "docs/intro.pod", "docs/book/pct/ch02_getting_started.pod", "docs/parrot.pod", "docs/project/roles_responsibilities.pod", "docs/parrothist.pod", "DONORS.pod", "docs/glossary.pod", "docs/project/support_policy.pod" ], "title" : "Introduction" }, { "source" : [ "docs/running.pod", "docs/tests.pod", "docs/gettingstarted.pod", "docs/submissions.pod" ], "title" : "Working with Parrot" }, { "source" : [ "docs/book/pct/ch03_compiler_tools.pod", ":pct_tutorial", "docs/book/pct/ch04_pge.pod", "docs/book/pct/ch05_nqp.pod", "docs/compiler_faq.pod" ], "title" : "Implementing Languages on Parrot" }, { "source" : [ "docs/overview.pod", ":pdds", ":pmc", ":ops", ":developer", ":tools", "editor/README.pod" ], "title" : "Design, Internals & Development" }, { "source" : [ "docs/book/pir/*" ], "title" : "PIR Book" }, { "source" : [ "docs/book/pct/*" ], "title" : "PCT Book" }, { "source" : [ "docs/book/draft/ch01_introduction.pod", "docs/book/draft/ch02_getting_started.pod", "docs/book/draft/ch07_dynpmcs.pod", "docs/book/draft/ch08_dynops.pod", "docs/book/draft/ch10_opcode_reference.pod", "docs/book/draft/ch11_directive_reference.pod", "docs/book/draft/ch12_operator_reference.pod", "docs/book/draft/chXX_hlls.pod", "docs/book/draft/chXX_library.pod", "docs/book/draft/chXX_testing_and_debugging.pod", "docs/book/draft/appa_glossary.pod", "docs/book/draft/appb_patch_submission.pod", "docs/book/draft/appc_command_line_options.pod", "docs/book/draft/appd_build_options.pod", "docs/book/draft/appe_source_code.pod" ], "title" : "Parrot Developer's Guide: PIR (draft)" } ], "title" : "Home" } uuid.t000644000765000765 555311533177644 15576 0ustar00brucebruce000000000000parrot-5.9.0/t/library#!./parrot # Copyright (C) 2008-2010, Parrot Foundation. =head1 NAME t/library/uuid.t =head1 SYNOPSIS % prove t/library/uuid.t =head1 DESCRIPTION uuid library tests =cut .sub main :main load_bytecode 'uuid.pbc' .include 'test_more.pir' plan(20) test_generate_1() test_generate_2() test_generate_random() test_generate_time() test_parse_1() test_parse_2() test_time() test_type() test_variant() .end .sub test_generate_1 $P0 = get_global ['uuid'], 'generate' $P1 = $P0() $S1 = typeof $P1 is($S1,'uuid', 'generate 1') .end .sub test_generate_2 $P0 = get_global ['uuid'], 'generate' $P1 = $P0() like($P1, '<[0..9a..f]>**8\-<[0..9a..f]>**4\-<[0..9a..f]>**4\-<[0..9a..f]>**4\-<[0..9a..f]>**12', 'generate 2' ) .end .sub test_generate_random $P0 = get_global ['uuid'], 'generate_random' $P1 = $P0() like($P1, '<[0..9a..f]>**8\-<[0..9a..f]>**4\-<[0..9a..f]>**4\-<[0..9a..f]>**4\-<[0..9a..f]>**12', 'generate random') .end .sub test_generate_time $P0 = get_global ['uuid'], 'generate_time' $P1 = $P0() like($P1, '<[0..9a..f]>**8\-<[0..9a..f]>**4\-<[0..9a..f]>**4\-<[0..9a..f]>**4\-<[0..9a..f]>**12', 'generate time') .end .sub test_parse_1 $P0 = get_global ['uuid'], 'parse' ($I0, $P1) = $P0("84949cc5-4701-4a84-895b-354c584a981b") is($I0, 0, 'parse 1') $S1 = typeof $P1 is($S1, 'uuid', 'parse 1') .end .sub test_parse_2 $P0 = get_global ['uuid'], 'parse' $I0 = $P0("84949cc5-4701-4a84-895b-354c584a981b") is($I0, 0, 'parse 2') $I0 = $P0("84949CC5-4701-4A84-895B-354C584A981B") is($I0, 0, 'parse 2') $I0 = $P0("84949cc5-4701-4a84-895b-354c584a981bc") is($I0, -1, 'parse 2') $I0 = $P0("84949cc5-4701-4a84-895b-354c584a981") is($I0, -1, 'parse 2') $I0 = $P0("84949cc5x4701-4a84-895b-354c584a981b") is($I0, -1, 'parse 2') $I0 = $P0("84949cc504701-4a84-895b-354c584a981b") is($I0, -1, 'parse 2') $I0 = $P0("84949cc5-470104a84-895b-354c584a981b") is($I0, -1, 'parse 2') $I0 = $P0("84949cc5-4701-4a840895b-354c584a981b") is($I0, -1, 'parse 2') $I0 = $P0("84949cc5-4701-4a84-895b0354c584a981b") is($I0, -1, 'parse 2') $I0 = $P0("g4949cc5-4701-4a84-895b-354c584a981b") is($I0, -1, 'parse 2') $I0 = $P0("84949cc5-4701-4a84-895b-354c584a981g") is($I0, -1, 'parse 2') .end .sub test_time $P0 = get_global ['uuid'], 'parse' ($I0, $P1) = $P0("84949cc5-4701-4a84-895b-354c584a981b") $I1 = $P1.'time'() is($I1, -1, 'time') .end .sub test_type $P0 = get_global ['uuid'], 'generate' $P1 = $P0() $I0 = $P1.'type'() is($I0, 4, 'type') .end .sub test_variant $P0 = get_global ['uuid'], 'generate' $P1 = $P0() $I0 = $P1.'variant'() is($I0, 1, 'variant') .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: imageiosize.pmc000644000765000765 1666712101554067 17126 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2010-2012, Parrot Foundation. =head1 NAME src/pmc/imageiosize.pmc - ImageIOSize PMC =head1 DESCRIPTION Gets the size of an ImageIO image without the allocation costs. =head1 STATIC FUNCTIONS =over 4 =cut */ #define GROW_TO_16_BYTE_BOUNDARY(size) ((size) + ((size) % 16 ? 16 - (size) % 16 : 0)) /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_INLINE static int check_seen(PARROT_INTERP, ARGIN(const PMC *self), ARGIN(const PMC *v)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3); #define ASSERT_ARGS_check_seen __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(self) \ , PARROT_ASSERT_ARG(v)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Check the seen hash to prevent duplicate serialization. =cut */ PARROT_INLINE static int check_seen(PARROT_INTERP, ARGIN(const PMC *self), ARGIN(const PMC *v)) { ASSERT_ARGS(check_seen) const Hash * const seen = (Hash *)VTABLE_get_pointer(interp, PARROT_IMAGEIOSIZE(self)->seen); const HashBucket * const b = Parrot_hash_get_bucket(interp, seen, v); if (b) return 1; else return 0; } pmclass ImageIOSize auto_attrs { ATTR PMC *seen; /* seen hash */ ATTR PMC *todo; /* todo list */ ATTR struct PackFile_ConstTable *pf_ct; ATTR INTVAL size; /* =back =head1 VTABLES =over 4 =cut */ /* =item C Initializes the PMC. =cut */ VTABLE void init() { PARROT_IMAGEIOSIZE(SELF)->todo = Parrot_pmc_new(INTERP, enum_class_ResizablePMCArray); PARROT_IMAGEIOSIZE(SELF)->pf_ct = NULL; PARROT_IMAGEIOSIZE(SELF)->size = 0; PARROT_IMAGEIOSIZE(SELF)->seen = Parrot_pmc_new(INTERP, enum_class_Hash); VTABLE_set_pointer(INTERP, PARROT_IMAGEIOSIZE(SELF)->seen, Parrot_hash_new_intval_hash(INTERP)); PObj_flag_CLEAR(private1, SELF); PObj_custom_mark_SET(SELF); } /* =item C Initializes the PMC with a pre-existing C. =cut */ VTABLE void init_pmc(PMC *pf_ct) { PARROT_IMAGEIOSIZE(SELF)->todo = Parrot_pmc_new(INTERP, enum_class_ResizablePMCArray); PARROT_IMAGEIOSIZE(SELF)->pf_ct = (PackFile_ConstTable *)VTABLE_get_pointer(INTERP, pf_ct); PARROT_IMAGEIOSIZE(SELF)->size = 0; PARROT_IMAGEIOSIZE(SELF)->seen = Parrot_pmc_new(INTERP, enum_class_Hash); VTABLE_set_pointer(INTERP, PARROT_IMAGEIOSIZE(SELF)->seen, Parrot_hash_new_intval_hash(INTERP)); PObj_flag_SET(private1, SELF); PObj_custom_mark_SET(SELF); } /* =item C Marks the PMC as alive. =cut */ VTABLE void mark() { Parrot_gc_mark_PMC_alive(INTERP, PARROT_IMAGEIOSIZE(SELF)->todo); Parrot_gc_mark_PMC_alive(INTERP, PARROT_IMAGEIOSIZE(SELF)->seen); } /* =item C Gets the result PMC after a thaw. =cut */ VTABLE PMC *get_pmc() { PMC * const ret = Parrot_pmc_new_init_int(INTERP, enum_class_Integer, PARROT_IMAGEIOSIZE(SELF)->size); return ret; } /* =item C Returns the flags describing the visit action =cut */ VTABLE INTVAL get_integer() { UNUSED(INTERP) UNUSED(SELF) return VISIT_FREEZE_NORMAL; } /* =item C Pushes the integer C onto the end of the image. The argument C is currently ignored. =cut */ VTABLE void push_integer(INTVAL v) { UNUSED(INTERP) UNUSED(v) const size_t len = PF_size_integer() * sizeof (opcode_t); PARROT_IMAGEIOSIZE(SELF)->size += len; } /* =item C Pushes the float C onto the end of the image. The argument C is currently ignored. =cut */ VTABLE void push_float(FLOATVAL v) { UNUSED(INTERP) UNUSED(v) const size_t len = PF_size_number() * sizeof (opcode_t); PARROT_IMAGEIOSIZE(SELF)->size += len; } /* =item C Pushes the string C<*v> onto the end of the image. =cut */ VTABLE void push_string(STRING *v) { if (PObj_flag_TEST(private1, SELF)) { /* store a reference to constant table entry of string */ const PackFile_ConstTable * const table = PARROT_IMAGEIOSIZE(SELF)->pf_ct; const int idx = PackFile_ConstTable_rlookup_str(INTERP, table, v); if (idx >= 0) { STATICSELF.push_integer(idx); return; } /* XXX * handle cases where the PMC has changed after Parrot_freeze_strings was called * eg: :immediate subs */ STATICSELF.push_integer(-1); /* TODO * should really be: * PANIC(INTERP, "string not previously in constant table when freezing to packfile"); */ } { const size_t len = PF_size_string(v) * sizeof (opcode_t); PARROT_IMAGEIOSIZE(SELF)->size += len; } } /* =item C Pushes a reference to pmc C<*v> onto the end of the image. If C<*v> hasn't been seen yet, it is also pushed onto the todo list. =cut */ VTABLE void push_pmc(PMC *v) { if (PMC_IS_NULL(v) || check_seen(INTERP, SELF, v)) SELF.push_integer(0); else { INTVAL cno, idx; PackFile_ConstTable * const ct = PARROT_IMAGEIOSIZE(SELF)->pf_ct; Hash * const seen = (Hash *)VTABLE_get_pointer(INTERP, PARROT_IMAGEIOSIZE(SELF)->seen); if (PObj_flag_TEST(private1, SELF) && PackFile_ConstTable_rlookup_pmc(INTERP, ct, v, &cno, &idx)) { SELF.push_integer(0); SELF.push_integer(cno); SELF.push_integer(idx); } else { SELF.push_integer(0); VTABLE_push_integer(INTERP, SELF, v->vtable->base_type); VTABLE_push_pmc(INTERP, PARROT_IMAGEIOSIZE(SELF)->todo, v); } Parrot_hash_put(INTERP, seen, v, v); } } VTABLE void *get_pointer() { return VTABLE_get_pointer(INTERP, PARROT_IMAGEIOSIZE(SELF)->seen); } VTABLE void set_pmc(PMC *p) { if (!PObj_flag_TEST(private1, SELF)) { const UINTVAL header_length = GROW_TO_16_BYTE_BOUNDARY(PACKFILE_HEADER_BYTES); PARROT_IMAGEIOSIZE(SELF)->size += header_length; } STATICSELF.push_pmc(p); { PMC * const todo = PARROT_IMAGEIOSIZE(SELF)->todo; while (VTABLE_elements(INTERP, todo)) { PMC * const current = VTABLE_shift_pmc(INTERP, todo); VTABLE_freeze(INTERP, current, SELF); VTABLE_visit(INTERP, current, SELF); SELF.push_pmc(PMC_metadata(current)); } } } /* =back =cut */ } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ sub.c000644000765000765 3373112101554067 14265 0ustar00brucebruce000000000000parrot-5.9.0/src/* Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME src/sub.c - Subroutines =head1 DESCRIPTION Subroutines, continuations, co-routines and other fun stuff... =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" #include "parrot/oplib/ops.h" #include "sub.str" #include "pmc/pmc_sub.h" #include "pmc/pmc_continuation.h" #include "parrot/oplib/core_ops.h" /* HEADERIZER HFILE: include/parrot/sub.h */ /* =item C Return namespace, name, and location of subroutine. =cut */ PARROT_EXPORT PARROT_CAN_RETURN_NULL PARROT_WARN_UNUSED_RESULT STRING* Parrot_sub_full_sub_name(PARROT_INTERP, ARGIN_NULLOK(PMC* sub_pmc)) { ASSERT_ARGS(Parrot_sub_full_sub_name) if (sub_pmc && VTABLE_defined(interp, sub_pmc)) { Parrot_Sub_attributes *sub; PMC_get_sub(interp, sub_pmc, sub); if (PMC_IS_NULL(sub->namespace_stash)) { return sub->name; } else { PMC *ns_array; STRING * const semicolon = CONST_STRING(interp, ";"); STRING *res; /* * When running with -t4, the invoke done in * Parrot_ns_get_name stomps on settings in interp; we * have to save these and restore them to avoid affecting * the running program. */ PMC * const saved_ccont = interp->current_cont; Parrot_block_GC_mark(interp); ns_array = Parrot_ns_get_name(interp, sub->namespace_stash); /* Restore stuff that might have got overwritten */ interp->current_cont = saved_ccont; if (sub->name) VTABLE_push_string(interp, ns_array, sub->name); res = Parrot_str_join(interp, semicolon, ns_array); Parrot_unblock_GC_mark(interp); return res; } } return NULL; } /* =item C Takes pointers to a context and its information table. Populates the table and returns 0 or 1. XXX needs explanation Used by Parrot_sub_Context_infostr. =cut */ PARROT_EXPORT int Parrot_sub_context_get_info(PARROT_INTERP, ARGIN(PMC *ctx), ARGOUT(Parrot_Context_info *info)) { ASSERT_ARGS(Parrot_sub_context_get_info) PMC *subpmc; Parrot_Sub_attributes *sub; opcode_t *pc; /* set file/line/pc defaults */ info->file = CONST_STRING(interp, "(unknown file)"); info->line = -1; info->pc = -1; info->nsname = NULL; info->subname = NULL; info->fullname = NULL; subpmc = Parrot_pcc_get_sub(interp, ctx); /* is the current sub of the specified context valid? */ if (PMC_IS_NULL(subpmc)) { info->subname = Parrot_str_new(interp, "???", 3); info->nsname = info->subname; info->fullname = Parrot_str_new(interp, "??? :: ???", 10); info->pc = -1; return 0; } /* fetch Parrot_sub of the current sub in the given context */ if (!VTABLE_isa(interp, subpmc, CONST_STRING(interp, "Sub"))) return 1; PMC_get_sub(interp, subpmc, sub); /* set the sub name */ info->subname = sub->name; /* set the namespace name and fullname of the sub */ if (PMC_IS_NULL(sub->namespace_name)) { info->nsname = CONST_STRING(interp, ""); info->fullname = info->subname; } else { info->nsname = VTABLE_get_string(interp, sub->namespace_name); info->fullname = Parrot_sub_full_sub_name(interp, subpmc); } pc = Parrot_pcc_get_pc(interp, ctx); /* return here if there is no current pc */ if (!pc) return 1; /* calculate the current pc */ info->pc = pc - sub->seg->base.data; /* determine the current source file/line */ if (pc) { const size_t offs = info->pc; size_t i, n; opcode_t *pc = sub->seg->base.data; PackFile_Debug * const debug = sub->seg->debugs; if (!debug) return 0; for (i = n = 0; n < sub->seg->base.size; ++i) { op_info_t * const op_info = sub->seg->op_info_table[*pc]; opcode_t var_args = 0; if (i >= debug->base.size) return 0; if (n >= offs) { /* set source line and file */ info->line = debug->base.data[i]; info->file = Parrot_debug_pc_to_filename(interp, debug, i); break; } ADD_OP_VAR_PART(interp, sub->seg, pc, var_args); n += op_info->op_count + var_args; pc += op_info->op_count + var_args; } } return 1; } /* =item C Given a PMC sub and the current opcode, returns the corresponding PIR line number. =cut */ INTVAL Parrot_sub_get_line_from_pc(PARROT_INTERP, ARGIN_NULLOK(PMC *subpmc), ARGIN_NULLOK(opcode_t *pc)) { ASSERT_ARGS(Parrot_sub_get_line_from_pc) Parrot_Sub_attributes *sub; opcode_t *base_pc, *debug_ops; size_t i, op, current_annotation, debug_size, code_size; if (!subpmc || !pc) return -1; PMC_get_sub(interp, subpmc, sub); debug_ops = sub->seg->debugs->base.data; debug_size = sub->seg->debugs->base.size; code_size = sub->seg->base.size; base_pc = sub->seg->base.data; current_annotation = pc - base_pc; /* assert pc is in correct segment */ PARROT_ASSERT(base_pc <= pc && pc <= base_pc + code_size); for (i = op = 0; op < code_size; ++i) { op_info_t * const op_info = sub->seg->op_info_table[*base_pc]; opcode_t var_args = 0; if (i >= debug_size) return -1; if (op >= current_annotation) return debug_ops[i]; ADD_OP_VAR_PART(interp, sub->seg, base_pc, var_args); op += op_info->op_count + var_args; base_pc += op_info->op_count + var_args; } return -1; } /* =item C Given a PMC sub and the current opcode, returns the corresponding PIR file name. =cut */ PARROT_CANNOT_RETURN_NULL STRING * Parrot_sub_get_filename_from_pc(PARROT_INTERP, ARGIN_NULLOK(PMC *subpmc), ARGIN_NULLOK(opcode_t *pc)) { ASSERT_ARGS(Parrot_sub_get_filename_from_pc) Parrot_Sub_attributes *sub; PackFile_Debug *debug; int position; if (!subpmc || !pc) return CONST_STRING(interp, "unknown file"); PMC_get_sub(interp, subpmc, sub); debug = sub->seg->debugs; position = pc - sub->seg->base.data; return Parrot_debug_pc_to_filename(interp, debug, position); } /* =item C Formats context information for display. Takes a context pointer and returns a pointer to the text. Used in debug.c and warnings.c =cut */ PARROT_EXPORT PARROT_CAN_RETURN_NULL PARROT_WARN_UNUSED_RESULT STRING* Parrot_sub_Context_infostr(PARROT_INTERP, ARGIN(PMC *ctx), int is_top) { ASSERT_ARGS(Parrot_sub_Context_infostr) Parrot_Context_info info; STRING *res = NULL; const char * const msg = is_top ? "current instr.:" : "called from Sub"; Parrot_block_GC_mark(interp); if (Parrot_sub_context_get_info(interp, ctx, &info)) { res = Parrot_sprintf_c(interp, "%s '%Ss' pc %d (%Ss:%d)", msg, info.fullname, info.pc, info.file, info.line); } Parrot_unblock_GC_mark(interp); return res; } /* =item C Locate the LexPad containing the given name. Return NULL on failure. =cut */ PARROT_CAN_RETURN_NULL PARROT_WARN_UNUSED_RESULT PMC* Parrot_sub_find_pad(PARROT_INTERP, ARGIN(STRING *lex_name), ARGIN(PMC *ctx)) { ASSERT_ARGS(Parrot_sub_find_pad) while (1) { PMC * const lex_pad = Parrot_pcc_get_lex_pad(interp, ctx); PMC * outer = Parrot_pcc_get_outer_ctx(interp, ctx); if (PMC_IS_NULL(outer)) return lex_pad; PARROT_ASSERT(outer->vtable->base_type == enum_class_CallContext); if (!PMC_IS_NULL(lex_pad)) if (VTABLE_exists_keyed_str(interp, lex_pad, lex_name)) return lex_pad; ctx = outer; } } /* =item C Locate the LexPad containing the given C in C and its caller pads. Return PMCNULL on failure. =cut */ PARROT_CAN_RETURN_NULL PARROT_WARN_UNUSED_RESULT PMC* Parrot_sub_find_dynamic_pad(PARROT_INTERP, ARGIN(STRING *lex_name), ARGIN(PMC *ctx)) { ASSERT_ARGS(Parrot_sub_find_dynamic_pad) while (1) { PMC * const lex_pad = Parrot_pcc_get_lex_pad(interp, ctx); PMC * caller = Parrot_pcc_get_caller_ctx(interp, ctx); if (PMC_IS_NULL(caller)) return lex_pad; if (!PMC_IS_NULL(lex_pad)) if (VTABLE_exists_keyed_str(interp, lex_pad, lex_name)) return lex_pad; ctx = caller; } } /* =item C Capture the current lexical environment of a sub. =cut */ PARROT_EXPORT void Parrot_sub_capture_lex(PARROT_INTERP, ARGMOD(PMC *sub_pmc)) { ASSERT_ARGS(Parrot_sub_capture_lex) PMC * const ctx = CURRENT_CONTEXT(interp); Parrot_Sub_attributes *current_sub; Parrot_Sub_attributes *sub; PMC_get_sub(interp, Parrot_pcc_get_sub(interp, ctx), current_sub); /* MultiSub gets special treatment */ if (VTABLE_isa(interp, sub_pmc, CONST_STRING(interp, "MultiSub"))) { PMC * const iter = VTABLE_get_iter(interp, sub_pmc); while (VTABLE_get_bool(interp, iter)) { PMC * const child_pmc = VTABLE_shift_pmc(interp, iter); Parrot_Sub_attributes *child_sub, *child_outer_sub; PMC_get_sub(interp, child_pmc, child_sub); if (!PMC_IS_NULL(child_sub->outer_sub)) { PMC_get_sub(interp, child_sub->outer_sub, child_outer_sub); if (STRING_equal(interp, current_sub->subid, child_outer_sub->subid)) { PARROT_GC_WRITE_BARRIER(interp, child_pmc); child_sub->outer_ctx = ctx; } } } return; } /* the sub_pmc has to have an outer_sub that is the caller */ PMC_get_sub(interp, sub_pmc, sub); if (PMC_IS_NULL(sub->outer_sub)) return; /* set the sub's outer context to the current context */ PARROT_GC_WRITE_BARRIER(interp, sub_pmc); sub->outer_ctx = ctx; } /* =item C Used where? XXX Creates a new closure, saving the context information. Takes a pointer to a subroutine. Returns a pointer to the closure, (or throws exceptions if invalid). =cut */ PARROT_EXPORT PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT PMC* Parrot_sub_new_closure(PARROT_INTERP, ARGIN(PMC *sub_pmc)) { ASSERT_ARGS(Parrot_sub_new_closure) PMC * const clos_pmc = VTABLE_clone(interp, sub_pmc); Parrot_sub_capture_lex(interp, clos_pmc); return clos_pmc; } /* =item C Verifies that the provided continuation is sane. =cut */ void Parrot_sub_continuation_check(PARROT_INTERP, ARGIN(const PMC *pmc)) { ASSERT_ARGS(Parrot_sub_continuation_check) PMC * const to_ctx = PARROT_CONTINUATION(pmc)->to_ctx; if (PMC_IS_NULL(to_ctx)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Continuation invoked after deactivation."); } /* =item C Restores the appropriate context for the continuation. =cut */ void Parrot_sub_continuation_rewind_environment(PARROT_INTERP, ARGIN(PMC *pmc)) { ASSERT_ARGS(Parrot_sub_continuation_rewind_environment) PMC * const to_ctx = PARROT_CONTINUATION(pmc)->to_ctx; PMC * const sig = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); /* debug print before context is switched */ if (Interp_trace_TEST(interp, PARROT_TRACE_SUB_CALL_FLAG)) { PMC * const sub = Parrot_pcc_get_sub(interp, to_ctx); Parrot_io_eprintf(interp, "# Back in sub '%Ss\n", Parrot_sub_full_sub_name(interp, sub)); } /* set context */ Parrot_pcc_set_context(interp, to_ctx); Parrot_pcc_set_signature(interp, to_ctx, sig); } /* =item C Gets a Parrot_sub structure from something that isn't a Sub PMC, but rather a subclass. =cut */ PARROT_EXPORT PARROT_CANNOT_RETURN_NULL void * Parrot_get_sub_pmc_from_subclass(PARROT_INTERP, ARGIN(PMC *subclass)) { ASSERT_ARGS(Parrot_get_sub_pmc_from_subclass) /* Ensure we really do have a subclass of sub. */ if (VTABLE_isa(interp, subclass, CONST_STRING(interp, "Sub"))) { PMC *key, *sub_pmc; /* If it's actually a PMC still, probably does the same structure * underneath. */ if (!PObj_is_object_TEST(subclass)) { return PARROT_SUB(subclass); } /* Get the Sub PMC itself. */ key = Parrot_pmc_new(interp, enum_class_String); VTABLE_set_string_native(interp, key, CONST_STRING(interp, "Sub")); sub_pmc = VTABLE_get_attr_keyed(interp, subclass, key, CONST_STRING(interp, "proxy")); if (sub_pmc->vtable->base_type == enum_class_Sub) { return PARROT_SUB(sub_pmc); } } Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Attempting to do sub operation on non-Sub."); } /* =back =head1 SEE ALSO F. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ Text.pir000644000765000765 1213511533177636 21260 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library/PGE# Copyright (C) 2005-2009, Parrot Foundation. =head1 TITLE PGE::Text - rules for extracting delimited text sequences from strings =head1 DESCRIPTION The various rules in this module may be used to extract delimited strings from within PGE rules. (They can of course be called directly, also.) =cut .namespace [ 'PGE';'Text' ] .include "cclass.pasm" .sub "__onload" :load .local pmc p6meta p6meta = get_hll_global 'P6metaclass' p6meta.'new_class'('PGE::Text', 'parent'=>'PGE::Grammar') .end =head2 Available rules =over 4 =item C Extracts a balanced-bracket-delimited substring from the current position of C using the delimiters specified by C, and returns a C object containing the result of the extraction. =cut .sub "bracketed" .param pmc tgt # target to match .param string delim :optional # optional delimiters .param int has_delim :opt_flag .param pmc adverbs :slurpy :named # named options .local pmc mob # return match object .local string target # target as string .local string bal, bra, ket # balanced brackets .local string delim_bra, delim_ket # delims for this match .local string lookket # closing bracket char .local int from, pos # current match position .local int balanced # in balanced match .local pmc stack # lookket backtracking $P0 = get_hll_global ['PGE'], 'Match' (mob, pos, target) = $P0.'new'(tgt) from = pos if has_delim goto mkdelims delim = "{}()[]<>" mkdelims: # set up delimiters delim_bra = '' # list of open delims delim_ket = '' # list of close delims bal = '{}()[]<>' # list of balance delims bra = '{{(([[<<' # balanced openers ket = '}}))]]>>' # balanced closers $I0 = length delim # length of delim string mkdelims_1: dec $I0 if $I0 < 0 goto extract $S0 = substr delim, $I0, 1 $I1 = index bal, $S0 if $I1 < 0 goto mkdelims_2 $S1 = substr bra, $I1, 1 delim_bra .= $S1 $S1 = substr ket, $I1, 1 delim_ket .= $S1 goto mkdelims_1 mkdelims_2: delim_bra .= $S0 delim_ket .= $S0 goto mkdelims_1 extract: $S0 = substr target, pos, 1 if $S0 == "\\" goto end # leading escape fails $I0 = index delim_bra, $S0 if $I0 < 0 goto end # no leading delim fails lookket = '' balanced = 1 stack = new 'ResizableStringArray' next: $S0 = substr target, pos, 1 # check current pos if $S0 == '' goto fail # end of string -> fail if $S0 == "\\" goto escape # skip escaped pos if $S0 == lookket goto close # end of current nest if balanced < 0 goto skip # skip to next char $I0 = index delim_bra, $S0 # open new nest? if $I0 >= 0 goto open $I0 = index delim_ket, $S0 # unbalanced nest?> if $I0 >= 0 goto fail skip: inc pos # move to next char goto next # try next escape: pos += 2 # skip escape + char goto next # try next open: # open new nesting push stack, lookket # save current nest lookket = substr delim_ket, $I0, 1 # search to end of nest balanced = index bra, $S0 # is this a balanced nest? inc pos # skip open char goto next # continue scanning close: # close current nesting lookket = pop stack # restore previous nest balanced = 1 # we're balancing again inc pos # skip close char if lookket != '' goto next # still nested? mob.'to'(pos) # set end of match $I0 = from + 1 # create delim-less submatch $I1 = pos - 1 $P0 = mob.'new'(mob, 'pos' => $I0) $P0.'to'($I1) mob[0] = $P0 fail: # fail match end: .return (mob) .end =back =head1 AUTHOR Patrick Michaud (pmichaud@pobox.com) is the author and maintainer. Patches and suggestions should be sent to the Perl 6 compiler list (perl6-compiler@perl.org). =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: io.pir000644000765000765 570311567202623 17670 0ustar00brucebruce000000000000parrot-5.9.0/examples/pir/befunge# Copyright (C) 2002-2009, Parrot Foundation. # ** string mode # # string mode. # befunge stack: # before: ... # after: ... c # c = ord(current char) .sub io__push_char $P0 = get_global "status" $P1 = get_global "stack" $I0 = $P0["val"] push $P1, $I0 set_global "stack", $P1 .end # ** input # # io__input_char() # # input character. # befunge stack: # before: ... # after: ... c # c = getchar() # no return value. # .sub "io__input_char" $P0 = get_global "user_input" $S0 = $P0 $I0 = length $S0 if $I0 > 0 goto _IO__INPUT_CHAR__SUBSTR $P1 = getinterp $P1 = $P1.'stdin_handle'() $S0 = $P1.'readline'() $S0 = chopn $S0, 1 _IO__INPUT_CHAR__SUBSTR: $S1 = replace $S0, 0, 1, "" $P0 = $S0 set_global "user_input", $P0 $I0 = ord $S1 stack__push($I0) .end # # io__input_integer() # # input integer. # befunge stack: # before: ... # after: ... i # i = readint() # no return value. # .sub "io__input_integer" $P0 = get_global "user_input" $S0 = $P0 .local int len len = length $S0 if len > 0 goto _IO__INPUT_INT__PARSE_INPUT $P1 = getinterp $P1 = $P1.'stdin_handle'() $S0 = $P1.'readline'() $S0 = chopn $S0, 1 len = length $S0 _IO__INPUT_INT__PARSE_INPUT: .local int i .local string buf i = 0 buf = "" _IO__INPUT_INT__NEXT_CHAR: $S1 = substr $S0, i, 1 if $S1 < '0' goto _IO__INPUT_INT__NAN if $S1 > '9' goto _IO__INPUT_INT__NAN buf = concat buf, $S1 inc i if i < len goto _IO__INPUT_INT__NEXT_CHAR _IO__INPUT_INT__NAN: $S0 = replace $S0, 0, i, "" $P0 = $S0 set_global "user_input", $P0 $I0 = buf stack__push($I0) .end # ** output # # io__output_char() # # output character. # befunge stack: # before: ... i # after: ... # writechar( chr(i) ) # .sub "io__output_char" $I0 = stack__pop() $S0 = chr $I0 print $S0 .end # # io__output_int() # # output integer. # befunge stack: # before: ... i # after: ... # writeint(i) # .sub "io__output_int" $I0 = stack__pop() print $I0 print " " .end # ** playfield tinkering # # io__value_get() # # get a value from the playfield. # befunge stack: # before: ... x y # after: ... i # i = value_at(x,y) # .sub "io__value_get" .local int x, y y = stack__pop() x = stack__pop() $P0 = get_global "playfield" $I0 = $P0[y;x] stack__push($I0) .end # # io__value_put() # # put a value in the playfield. # befunge stack: # before: ... i x y # after: ... # value_at(x,y) = i # .sub "io__value_put" .local int x, y, v y = stack__pop() x = stack__pop() v = stack__pop() $P0 = get_global "playfield" $P0[y;x] = v set_global"playfield", $P0 .end ######################################################################## # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: cfg.h000644000765000765 1107411716253437 16365 0ustar00brucebruce000000000000parrot-5.9.0/compilers/imcc/* * Copyright (C) 2002-2011, Parrot Foundation. */ /* Data structures: */ /* Two-way linked list of predecessors and successors */ #ifndef PARROT_CFG_H_GUARD #define PARROT_CFG_H_GUARD typedef struct _edge { struct _basic_block *from; struct _basic_block *to; struct _edge *pred_next; struct _edge *succ_next; struct _edge *next; } Edge; typedef struct _basic_block { Instruction *start; /* First instruction in basic block */ Instruction *end; /* Last instruction in basic block */ Edge *pred_list; Edge *succ_list; int loop_depth; unsigned int index; /* on bb_list*/ int flag; } Basic_block; enum block_enum_flags_t { BB_IS_SUB = 1 << 0 }; typedef struct _loop_info { Set *loop; /* loop set containing bb's */ Set *exits; /* blocks that exit the loop */ int depth; /* depth of this loop */ unsigned int n_entries; /* nr of entries to this loop */ unsigned int header; /* header block of loop */ unsigned int preheader; /* preheader block of loop, if 1 entry point */ unsigned int size; /* no of blocks in loop */ } Loop_info; /* Functions: */ /* HEADERIZER BEGIN: compilers/imcc/cfg.c */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ void build_cfg(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*unit); void clear_basic_blocks(ARGMOD(IMC_Unit *unit)) __attribute__nonnull__(1) FUNC_MODIFIES(*unit); void compute_dominance_frontiers( ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*unit); void compute_dominators(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*unit); PARROT_WARN_UNUSED_RESULT PARROT_PURE_FUNCTION int edge_count(ARGIN(const IMC_Unit *unit)) __attribute__nonnull__(1); void find_basic_blocks( ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), int first) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*unit); void find_loops(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*unit); PARROT_WARN_UNUSED_RESULT PARROT_PURE_FUNCTION int natural_preheader( ARGIN(const IMC_Unit *unit), ARGIN(const Loop_info *loop_info)) __attribute__nonnull__(1) __attribute__nonnull__(2); void search_predecessors_not_in( ARGIN(const Basic_block *node), ARGMOD(Set *s)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*s); #define ASSERT_ARGS_build_cfg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit)) #define ASSERT_ARGS_clear_basic_blocks __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(unit)) #define ASSERT_ARGS_compute_dominance_frontiers __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit)) #define ASSERT_ARGS_compute_dominators __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit)) #define ASSERT_ARGS_edge_count __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(unit)) #define ASSERT_ARGS_find_basic_blocks __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit)) #define ASSERT_ARGS_find_loops __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit)) #define ASSERT_ARGS_natural_preheader __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(unit) \ , PARROT_ASSERT_ARG(loop_info)) #define ASSERT_ARGS_search_predecessors_not_in __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(node) \ , PARROT_ASSERT_ARG(s)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: compilers/imcc/cfg.c */ #endif /* PARROT_CFG_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ BlackBox.pm000644000765000765 17405311644422074 17333 0ustar00brucebruce000000000000parrot-5.9.0/lib/Pod/Simple package Pod::Simple::BlackBox; # # "What's in the box?" "Pain." # ########################################################################### # # This is where all the scary things happen: parsing lines into # paragraphs; and then into directives, verbatims, and then also # turning formatting sequences into treelets. # # Are you really sure you want to read this code? # #----------------------------------------------------------------------------- # # The basic work of this module Pod::Simple::BlackBox is doing the dirty work # of parsing Pod into treelets (generally one per non-verbatim paragraph), and # to call the proper callbacks on the treelets. # # Every node in a treelet is a ['name', {attrhash}, ...children...] use integer; # vroom! use strict; use Carp (); use vars qw($VERSION ); $VERSION = '3.19'; #use constant DEBUG => 7; BEGIN { require Pod::Simple; *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ sub parse_line { shift->parse_lines(@_) } # alias # - - - Turn back now! Run away! - - - sub parse_lines { # Usage: $parser->parse_lines(@lines) # an undef means end-of-stream my $self = shift; my $code_handler = $self->{'code_handler'}; my $cut_handler = $self->{'cut_handler'}; $self->{'line_count'} ||= 0; my $scratch; DEBUG > 4 and print "# Parsing starting at line ", $self->{'line_count'}, ".\n"; DEBUG > 5 and print "# About to parse lines: ", join(' ', map defined($_) ? "[$_]" : "EOF", @_), "\n"; my $paras = ($self->{'paras'} ||= []); # paragraph buffer. Because we need to defer processing of =over # directives and verbatim paragraphs. We call _ponder_paragraph_buffer # to process this. $self->{'pod_para_count'} ||= 0; my $line; foreach my $source_line (@_) { if( $self->{'source_dead'} ) { DEBUG > 4 and print "# Source is dead.\n"; last; } unless( defined $source_line ) { DEBUG > 4 and print "# Undef-line seen.\n"; push @$paras, ['~end', {'start_line' => $self->{'line_count'}}]; push @$paras, $paras->[-1], $paras->[-1]; # So that it definitely fills the buffer. $self->{'source_dead'} = 1; $self->_ponder_paragraph_buffer; next; } if( $self->{'line_count'}++ ) { ($line = $source_line) =~ tr/\n\r//d; # If we don't have two vars, we'll end up with that there # tr/// modding the (potentially read-only) original source line! } else { DEBUG > 2 and print "First line: [$source_line]\n"; if( ($line = $source_line) =~ s/^\xEF\xBB\xBF//s ) { DEBUG and print "UTF-8 BOM seen. Faking a '=encoding utf8'.\n"; $self->_handle_encoding_line( "=encoding utf8" ); $line =~ tr/\n\r//d; } elsif( $line =~ s/^\xFE\xFF//s ) { DEBUG and print "Big-endian UTF-16 BOM seen. Aborting parsing.\n"; $self->scream( $self->{'line_count'}, "UTF16-BE Byte Encoding Mark found; but Pod::Simple v$Pod::Simple::VERSION doesn't implement UTF16 yet." ); splice @_; push @_, undef; next; # TODO: implement somehow? } elsif( $line =~ s/^\xFF\xFE//s ) { DEBUG and print "Little-endian UTF-16 BOM seen. Aborting parsing.\n"; $self->scream( $self->{'line_count'}, "UTF16-LE Byte Encoding Mark found; but Pod::Simple v$Pod::Simple::VERSION doesn't implement UTF16 yet." ); splice @_; push @_, undef; next; # TODO: implement somehow? } else { DEBUG > 2 and print "First line is BOM-less.\n"; ($line = $source_line) =~ tr/\n\r//d; } } DEBUG > 5 and print "# Parsing line: [$line]\n"; if(!$self->{'in_pod'}) { if($line =~ m/^=([a-zA-Z]+)/s) { if($1 eq 'cut') { $self->scream( $self->{'line_count'}, "=cut found outside a pod block. Skipping to next block." ); ## Before there were errata sections in the world, it was ## least-pessimal to abort processing the file. But now we can ## just barrel on thru (but still not start a pod block). #splice @_; #push @_, undef; next; } else { $self->{'in_pod'} = $self->{'start_of_pod_block'} = $self->{'last_was_blank'} = 1; # And fall thru to the pod-mode block further down } } else { DEBUG > 5 and print "# It's a code-line.\n"; $code_handler->(map $_, $line, $self->{'line_count'}, $self) if $code_handler; # Note: this may cause code to be processed out of order relative # to pods, but in order relative to cuts. # Note also that we haven't yet applied the transcoding to $line # by time we call $code_handler! if( $line =~ m/^#\s*line\s+(\d+)\s*(?:\s"([^"]+)")?\s*$/ ) { # That RE is from perlsyn, section "Plain Old Comments (Not!)", #$fname = $2 if defined $2; #DEBUG > 1 and defined $2 and print "# Setting fname to \"$fname\"\n"; DEBUG > 1 and print "# Setting nextline to $1\n"; $self->{'line_count'} = $1 - 1; } next; } } # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . # Else we're in pod mode: # Apply any necessary transcoding: $self->{'_transcoder'} && $self->{'_transcoder'}->($line); # HERE WE CATCH =encoding EARLY! if( $line =~ m/^=encoding\s+\S+\s*$/s ) { $line = $self->_handle_encoding_line( $line ); } if($line =~ m/^=cut/s) { # here ends the pod block, and therefore the previous pod para DEBUG > 1 and print "Noting =cut at line ${$self}{'line_count'}\n"; $self->{'in_pod'} = 0; # ++$self->{'pod_para_count'}; $self->_ponder_paragraph_buffer(); # by now it's safe to consider the previous paragraph as done. $cut_handler->(map $_, $line, $self->{'line_count'}, $self) if $cut_handler; # TODO: add to docs: Note: this may cause cuts to be processed out # of order relative to pods, but in order relative to code. } elsif($line =~ m/^\s*$/s) { # it's a blank line if(!$self->{'start_of_pod_block'} and @$paras and $paras->[-1][0] eq '~Verbatim') { DEBUG > 1 and print "Saving blank line at line ${$self}{'line_count'}\n"; push @{$paras->[-1]}, $line; } # otherwise it's not interesting if(!$self->{'start_of_pod_block'} and !$self->{'last_was_blank'}) { DEBUG > 1 and print "Noting para ends with blank line at ${$self}{'line_count'}\n"; } $self->{'last_was_blank'} = 1; } elsif($self->{'last_was_blank'}) { # A non-blank line starting a new para... if($line =~ m/^(=[a-zA-Z][a-zA-Z0-9]*)(?:\s+|$)(.*)/s) { # THIS IS THE ONE PLACE WHERE WE CONSTRUCT NEW DIRECTIVE OBJECTS my $new = [$1, {'start_line' => $self->{'line_count'}}, $2]; # Note that in "=head1 foo", the WS is lost. # Example: ['=head1', {'start_line' => 123}, ' foo'] ++$self->{'pod_para_count'}; $self->_ponder_paragraph_buffer(); # by now it's safe to consider the previous paragraph as done. push @$paras, $new; # the new incipient paragraph DEBUG > 1 and print "Starting new ${$paras}[-1][0] para at line ${$self}{'line_count'}\n"; } elsif($line =~ m/^\s/s) { if(!$self->{'start_of_pod_block'} and @$paras and $paras->[-1][0] eq '~Verbatim') { DEBUG > 1 and print "Resuming verbatim para at line ${$self}{'line_count'}\n"; push @{$paras->[-1]}, $line; } else { ++$self->{'pod_para_count'}; $self->_ponder_paragraph_buffer(); # by now it's safe to consider the previous paragraph as done. DEBUG > 1 and print "Starting verbatim para at line ${$self}{'line_count'}\n"; push @$paras, ['~Verbatim', {'start_line' => $self->{'line_count'}}, $line]; } } else { ++$self->{'pod_para_count'}; $self->_ponder_paragraph_buffer(); # by now it's safe to consider the previous paragraph as done. push @$paras, ['~Para', {'start_line' => $self->{'line_count'}}, $line]; DEBUG > 1 and print "Starting plain para at line ${$self}{'line_count'}\n"; } $self->{'last_was_blank'} = $self->{'start_of_pod_block'} = 0; } else { # It's a non-blank line /continuing/ the current para if(@$paras) { DEBUG > 2 and print "Line ${$self}{'line_count'} continues current paragraph\n"; push @{$paras->[-1]}, $line; } else { # Unexpected case! die "Continuing a paragraph but \@\$paras is empty?"; } $self->{'last_was_blank'} = $self->{'start_of_pod_block'} = 0; } } # ends the big while loop DEBUG > 1 and print(pretty(@$paras), "\n"); return $self; } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ sub _handle_encoding_line { my($self, $line) = @_; # The point of this routine is to set $self->{'_transcoder'} as indicated. return $line unless $line =~ m/^=encoding\s+(\S+)\s*$/s; DEBUG > 1 and print "Found an encoding line \"=encoding $1\"\n"; my $e = $1; my $orig = $e; push @{ $self->{'encoding_command_reqs'} }, "=encoding $orig"; my $enc_error; # Cf. perldoc Encode and perldoc Encode::Supported require Pod::Simple::Transcode; if( $self->{'encoding'} ) { my $norm_current = $self->{'encoding'}; my $norm_e = $e; foreach my $that ($norm_current, $norm_e) { $that = lc($that); $that =~ s/[-_]//g; } if($norm_current eq $norm_e) { DEBUG > 1 and print "The '=encoding $orig' line is ", "redundant. ($norm_current eq $norm_e). Ignoring.\n"; $enc_error = ''; # But that doesn't necessarily mean that the earlier one went okay } else { $enc_error = "Encoding is already set to " . $self->{'encoding'}; DEBUG > 1 and print $enc_error; } } elsif ( # OK, let's turn on the encoding do { DEBUG > 1 and print " Setting encoding to $e\n"; $self->{'encoding'} = $e; 1; } and $e eq 'HACKRAW' ) { DEBUG and print " Putting in HACKRAW (no-op) encoding mode.\n"; } elsif( Pod::Simple::Transcode::->encoding_is_available($e) ) { die($enc_error = "WHAT? _transcoder is already set?!") if $self->{'_transcoder'}; # should never happen require Pod::Simple::Transcode; $self->{'_transcoder'} = Pod::Simple::Transcode::->make_transcoder($e); eval { my @x = ('', "abc", "123"); $self->{'_transcoder'}->(@x); }; $@ && die( $enc_error = "Really unexpected error setting up encoding $e: $@\nAborting" ); } else { my @supported = Pod::Simple::Transcode::->all_encodings; # Note unsupported, and complain DEBUG and print " Encoding [$e] is unsupported.", "\nSupporteds: @supported\n"; my $suggestion = ''; # Look for a near match: my $norm = lc($e); $norm =~ tr[-_][]d; my $n; foreach my $enc (@supported) { $n = lc($enc); $n =~ tr[-_][]d; next unless $n eq $norm; $suggestion = " (Maybe \"$e\" should be \"$enc\"?)"; last; } my $encmodver = Pod::Simple::Transcode::->encmodver; $enc_error = join '' => "This document probably does not appear as it should, because its ", "\"=encoding $e\" line calls for an unsupported encoding.", $suggestion, " [$encmodver\'s supported encodings are: @supported]" ; $self->scream( $self->{'line_count'}, $enc_error ); } push @{ $self->{'encoding_command_statuses'} }, $enc_error; return '=encoding ALREADYDONE'; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - sub _handle_encoding_second_level { # By time this is called, the encoding (if well formed) will already # have been acted one. my($self, $para) = @_; my @x = @$para; my $content = join ' ', splice @x, 2; $content =~ s/^\s+//s; $content =~ s/\s+$//s; DEBUG > 2 and print "Ogling encoding directive: =encoding $content\n"; if($content eq 'ALREADYDONE') { # It's already been handled. Check for errors. if(! $self->{'encoding_command_statuses'} ) { DEBUG > 2 and print " CRAZY ERROR: It wasn't really handled?!\n"; } elsif( $self->{'encoding_command_statuses'}[-1] ) { $self->whine( $para->[1]{'start_line'}, sprintf "Couldn't do %s: %s", $self->{'encoding_command_reqs' }[-1], $self->{'encoding_command_statuses'}[-1], ); } else { DEBUG > 2 and print " (Yup, it was successfully handled already.)\n"; } } else { # Otherwise it's a syntax error $self->whine( $para->[1]{'start_line'}, "Invalid =encoding syntax: $content" ); } return; } #~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~` { my $m = -321; # magic line number sub _gen_errata { my $self = $_[0]; # Return 0 or more fake-o paragraphs explaining the accumulated # errors on this document. return() unless $self->{'errata'} and keys %{$self->{'errata'}}; my @out; foreach my $line (sort {$a <=> $b} keys %{$self->{'errata'}}) { push @out, ['=item', {'start_line' => $m}, "Around line $line:"], map( ['~Para', {'start_line' => $m, '~cooked' => 1}, #['~Top', {'start_line' => $m}, $_ #] ], @{$self->{'errata'}{$line}} ) ; } # TODO: report of unknown entities? unrenderable characters? unshift @out, ['=head1', {'start_line' => $m, 'errata' => 1}, 'POD ERRORS'], ['~Para', {'start_line' => $m, '~cooked' => 1, 'errata' => 1}, "Hey! ", ['B', {}, 'The above document had some coding errors, which are explained below:' ] ], ['=over', {'start_line' => $m, 'errata' => 1}, ''], ; push @out, ['=back', {'start_line' => $m, 'errata' => 1}, ''], ; DEBUG and print "\n<<\n", pretty(\@out), "\n>>\n\n"; return @out; } } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ############################################################################## ## ## stop reading now stop reading now stop reading now stop reading now stop ## ## HERE IT BECOMES REALLY SCARY ## ## stop reading now stop reading now stop reading now stop reading now stop ## ############################################################################## sub _ponder_paragraph_buffer { # Para-token types as found in the buffer. # ~Verbatim, ~Para, ~end, =head1..4, =for, =begin, =end, # =over, =back, =item # and the null =pod (to be complained about if over one line) # # "~data" paragraphs are something we generate at this level, depending on # a currently open =over region # Events fired: Begin and end for: # directivename (like head1 .. head4), item, extend, # for (from =begin...=end, =for), # over-bullet, over-number, over-text, over-block, # item-bullet, item-number, item-text, # Document, # Data, Para, Verbatim # B, C, longdirname (TODO -- wha?), etc. for all directives # my $self = $_[0]; my $paras; return unless @{$paras = $self->{'paras'}}; my $curr_open = ($self->{'curr_open'} ||= []); my $scratch; DEBUG > 10 and print "# Paragraph buffer: <<", pretty($paras), ">>\n"; # We have something in our buffer. So apparently the document has started. unless($self->{'doc_has_started'}) { $self->{'doc_has_started'} = 1; my $starting_contentless; $starting_contentless = ( !@$curr_open and @$paras and ! grep $_->[0] ne '~end', @$paras # i.e., if the paras is all ~ends ) ; DEBUG and print "# Starting ", $starting_contentless ? 'contentless' : 'contentful', " document\n" ; $self->_handle_element_start( ($scratch = 'Document'), { 'start_line' => $paras->[0][1]{'start_line'}, $starting_contentless ? ( 'contentless' => 1 ) : (), }, ); } my($para, $para_type); while(@$paras) { last if @$paras == 1 and ( $paras->[0][0] eq '=over' or $paras->[0][0] eq '~Verbatim' or $paras->[0][0] eq '=item' ) ; # Those're the three kinds of paragraphs that require lookahead. # Actually, an "=item Foo" inside an region # and any =item inside an region (rare) # don't require any lookahead, but all others (bullets # and numbers) do. # TODO: whinge about many kinds of directives in non-resolving =for regions? # TODO: many? like what? =head1 etc? $para = shift @$paras; $para_type = $para->[0]; DEBUG > 1 and print "Pondering a $para_type paragraph, given the stack: (", $self->_dump_curr_open(), ")\n"; if($para_type eq '=for') { next if $self->_ponder_for($para,$curr_open,$paras); } elsif($para_type eq '=begin') { next if $self->_ponder_begin($para,$curr_open,$paras); } elsif($para_type eq '=end') { next if $self->_ponder_end($para,$curr_open,$paras); } elsif($para_type eq '~end') { # The virtual end-document signal next if $self->_ponder_doc_end($para,$curr_open,$paras); } # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ #~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ if(grep $_->[1]{'~ignore'}, @$curr_open) { DEBUG > 1 and print "Skipping $para_type paragraph because in ignore mode.\n"; next; } #~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ if($para_type eq '=pod') { $self->_ponder_pod($para,$curr_open,$paras); } elsif($para_type eq '=over') { next if $self->_ponder_over($para,$curr_open,$paras); } elsif($para_type eq '=back') { next if $self->_ponder_back($para,$curr_open,$paras); } else { # All non-magical codes!!! # Here we start using $para_type for our own twisted purposes, to # mean how it should get treated, not as what the element name # should be. DEBUG > 1 and print "Pondering non-magical $para_type\n"; my $i; # Enforce some =headN discipline if($para_type =~ m/^=head\d$/s and ! $self->{'accept_heads_anywhere'} and @$curr_open and $curr_open->[-1][0] eq '=over' ) { DEBUG > 2 and print "'=$para_type' inside an '=over'!\n"; $self->whine( $para->[1]{'start_line'}, "You forgot a '=back' before '$para_type'" ); unshift @$paras, ['=back', {}, ''], $para; # close the =over next; } if($para_type eq '=item') { my $over; unless(@$curr_open and ($over = $curr_open->[-1])->[0] eq '=over') { $self->whine( $para->[1]{'start_line'}, "'=item' outside of any '=over'" ); unshift @$paras, ['=over', {'start_line' => $para->[1]{'start_line'}}, ''], $para ; next; } my $over_type = $over->[1]{'~type'}; if(!$over_type) { # Shouldn't happen1 die "Typeless over in stack, starting at line " . $over->[1]{'start_line'}; } elsif($over_type eq 'block') { unless($curr_open->[-1][1]{'~bitched_about'}) { $curr_open->[-1][1]{'~bitched_about'} = 1; $self->whine( $curr_open->[-1][1]{'start_line'}, "You can't have =items (as at line " . $para->[1]{'start_line'} . ") unless the first thing after the =over is an =item" ); } # Just turn it into a paragraph and reconsider it $para->[0] = '~Para'; unshift @$paras, $para; next; } elsif($over_type eq 'text') { my $item_type = $self->_get_item_type($para); # That kills the content of the item if it's a number or bullet. DEBUG and print " Item is of type ", $para->[0], " under $over_type\n"; if($item_type eq 'text') { # Nothing special needs doing for 'text' } elsif($item_type eq 'number' or $item_type eq 'bullet') { die "Unknown item type $item_type" unless $item_type eq 'number' or $item_type eq 'bullet'; # Undo our clobbering: push @$para, $para->[1]{'~orig_content'}; delete $para->[1]{'number'}; # Only a PROPER item-number element is allowed # to have a number attribute. } else { die "Unhandled item type $item_type"; # should never happen } # =item-text thingies don't need any assimilation, it seems. } elsif($over_type eq 'number') { my $item_type = $self->_get_item_type($para); # That kills the content of the item if it's a number or bullet. DEBUG and print " Item is of type ", $para->[0], " under $over_type\n"; my $expected_value = ++ $curr_open->[-1][1]{'~counter'}; if($item_type eq 'bullet') { # Hm, it's not numeric. Correct for this. $para->[1]{'number'} = $expected_value; $self->whine( $para->[1]{'start_line'}, "Expected '=item $expected_value'" ); push @$para, $para->[1]{'~orig_content'}; # restore the bullet, blocking the assimilation of next para } elsif($item_type eq 'text') { # Hm, it's not numeric. Correct for this. $para->[1]{'number'} = $expected_value; $self->whine( $para->[1]{'start_line'}, "Expected '=item $expected_value'" ); # Text content will still be there and will block next ~Para } elsif($item_type ne 'number') { die "Unknown item type $item_type"; # should never happen } elsif($expected_value == $para->[1]{'number'}) { DEBUG > 1 and print " Numeric item has the expected value of $expected_value\n"; } else { DEBUG > 1 and print " Numeric item has ", $para->[1]{'number'}, " instead of the expected value of $expected_value\n"; $self->whine( $para->[1]{'start_line'}, "You have '=item " . $para->[1]{'number'} . "' instead of the expected '=item $expected_value'" ); $para->[1]{'number'} = $expected_value; # correcting!! } if(@$para == 2) { # For the cases where we /didn't/ push to @$para if($paras->[0][0] eq '~Para') { DEBUG and print "Assimilating following ~Para content into $over_type item\n"; push @$para, splice @{shift @$paras},2; } else { DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n"; push @$para, ''; # Just so it's not contentless } } } elsif($over_type eq 'bullet') { my $item_type = $self->_get_item_type($para); # That kills the content of the item if it's a number or bullet. DEBUG and print " Item is of type ", $para->[0], " under $over_type\n"; if($item_type eq 'bullet') { # as expected! if( $para->[1]{'~_freaky_para_hack'} ) { DEBUG and print "Accomodating '=item * Foo' tolerance hack.\n"; push @$para, delete $para->[1]{'~_freaky_para_hack'}; } } elsif($item_type eq 'number') { $self->whine( $para->[1]{'start_line'}, "Expected '=item *'" ); push @$para, $para->[1]{'~orig_content'}; # and block assimilation of the next paragraph delete $para->[1]{'number'}; # Only a PROPER item-number element is allowed # to have a number attribute. } elsif($item_type eq 'text') { $self->whine( $para->[1]{'start_line'}, "Expected '=item *'" ); # But doesn't need processing. But it'll block assimilation # of the next para. } else { die "Unhandled item type $item_type"; # should never happen } if(@$para == 2) { # For the cases where we /didn't/ push to @$para if($paras->[0][0] eq '~Para') { DEBUG and print "Assimilating following ~Para content into $over_type item\n"; push @$para, splice @{shift @$paras},2; } else { DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n"; push @$para, ''; # Just so it's not contentless } } } else { die "Unhandled =over type \"$over_type\"?"; # Shouldn't happen! } $para_type = 'Plain'; $para->[0] .= '-' . $over_type; # Whew. Now fall thru and process it. } elsif($para_type eq '=extend') { # Well, might as well implement it here. $self->_ponder_extend($para); next; # and skip } elsif($para_type eq '=encoding') { # Not actually acted on here, but we catch errors here. $self->_handle_encoding_second_level($para); next; # and skip } elsif($para_type eq '~Verbatim') { $para->[0] = 'Verbatim'; $para_type = '?Verbatim'; } elsif($para_type eq '~Para') { $para->[0] = 'Para'; $para_type = '?Plain'; } elsif($para_type eq 'Data') { $para->[0] = 'Data'; $para_type = '?Data'; } elsif( $para_type =~ s/^=//s and defined( $para_type = $self->{'accept_directives'}{$para_type} ) ) { DEBUG > 1 and print " Pondering known directive ${$para}[0] as $para_type\n"; } else { # An unknown directive! DEBUG > 1 and printf "Unhandled directive %s (Handled: %s)\n", $para->[0], join(' ', sort keys %{$self->{'accept_directives'}} ) ; $self->whine( $para->[1]{'start_line'}, "Unknown directive: $para->[0]" ); # And maybe treat it as text instead of just letting it go? next; } if($para_type =~ s/^\?//s) { if(! @$curr_open) { # usual case DEBUG and print "Treating $para_type paragraph as such because stack is empty.\n"; } else { my @fors = grep $_->[0] eq '=for', @$curr_open; DEBUG > 1 and print "Containing fors: ", join(',', map $_->[1]{'target'}, @fors), "\n"; if(! @fors) { DEBUG and print "Treating $para_type paragraph as such because stack has no =for's\n"; #} elsif(grep $_->[1]{'~resolve'}, @fors) { #} elsif(not grep !$_->[1]{'~resolve'}, @fors) { } elsif( $fors[-1][1]{'~resolve'} ) { # Look to the immediately containing for if($para_type eq 'Data') { DEBUG and print "Treating Data paragraph as Plain/Verbatim because the containing =for ($fors[-1][1]{'target'}) is a resolver\n"; $para->[0] = 'Para'; $para_type = 'Plain'; } else { DEBUG and print "Treating $para_type paragraph as such because the containing =for ($fors[-1][1]{'target'}) is a resolver\n"; } } else { DEBUG and print "Treating $para_type paragraph as Data because the containing =for ($fors[-1][1]{'target'}) is a non-resolver\n"; $para->[0] = $para_type = 'Data'; } } } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ if($para_type eq 'Plain') { $self->_ponder_Plain($para); } elsif($para_type eq 'Verbatim') { $self->_ponder_Verbatim($para); } elsif($para_type eq 'Data') { $self->_ponder_Data($para); } else { die "\$para type is $para_type -- how did that happen?"; # Shouldn't happen. } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ $para->[0] =~ s/^[~=]//s; DEBUG and print "\n", pretty($para), "\n"; # traverse the treelet (which might well be just one string scalar) $self->{'content_seen'} ||= 1; $self->_traverse_treelet_bit(@$para); } } return; } ########################################################################### # The sub-ponderers... sub _ponder_for { my ($self,$para,$curr_open,$paras) = @_; # Fake it out as a begin/end my $target; if(grep $_->[1]{'~ignore'}, @$curr_open) { DEBUG > 1 and print "Ignoring ignorable =for\n"; return 1; } for(my $i = 2; $i < @$para; ++$i) { if($para->[$i] =~ s/^\s*(\S+)\s*//s) { $target = $1; last; } } unless(defined $target) { $self->whine( $para->[1]{'start_line'}, "=for without a target?" ); return 1; } DEBUG > 1 and print "Faking out a =for $target as a =begin $target / =end $target\n"; $para->[0] = 'Data'; unshift @$paras, ['=begin', {'start_line' => $para->[1]{'start_line'}, '~really' => '=for'}, $target, ], $para, ['=end', {'start_line' => $para->[1]{'start_line'}, '~really' => '=for'}, $target, ], ; return 1; } sub _ponder_begin { my ($self,$para,$curr_open,$paras) = @_; my $content = join ' ', splice @$para, 2; $content =~ s/^\s+//s; $content =~ s/\s+$//s; unless(length($content)) { $self->whine( $para->[1]{'start_line'}, "=begin without a target?" ); DEBUG and print "Ignoring targetless =begin\n"; return 1; } my ($target, $title) = $content =~ m/^(\S+)\s*(.*)$/; $para->[1]{'title'} = $title if ($title); $para->[1]{'target'} = $target; # without any ':' $content = $target; # strip off the title $content =~ s/^:!/!:/s; my $neg; # whether this is a negation-match $neg = 1 if $content =~ s/^!//s; my $to_resolve; # whether to process formatting codes $to_resolve = 1 if $content =~ s/^://s; my $dont_ignore; # whether this target matches us foreach my $target_name ( split(',', $content, -1), $neg ? () : '*' ) { DEBUG > 2 and print " Considering whether =begin $content matches $target_name\n"; next unless $self->{'accept_targets'}{$target_name}; DEBUG > 2 and print " It DOES match the acceptable target $target_name!\n"; $to_resolve = 1 if $self->{'accept_targets'}{$target_name} eq 'force_resolve'; $dont_ignore = 1; $para->[1]{'target_matching'} = $target_name; last; # stop looking at other target names } if($neg) { if( $dont_ignore ) { $dont_ignore = ''; delete $para->[1]{'target_matching'}; DEBUG > 2 and print " But the leading ! means that this is a NON-match!\n"; } else { $dont_ignore = 1; $para->[1]{'target_matching'} = '!'; DEBUG > 2 and print " But the leading ! means that this IS a match!\n"; } } $para->[0] = '=for'; # Just what we happen to call these, internally $para->[1]{'~really'} ||= '=begin'; $para->[1]{'~ignore'} = (! $dont_ignore) || 0; $para->[1]{'~resolve'} = $to_resolve || 0; DEBUG > 1 and print " Making note to ", $dont_ignore ? 'not ' : '', "ignore contents of this region\n"; DEBUG > 1 and $dont_ignore and print " Making note to treat contents as ", ($to_resolve ? 'verbatim/plain' : 'data'), " paragraphs\n"; DEBUG > 1 and print " (Stack now: ", $self->_dump_curr_open(), ")\n"; push @$curr_open, $para; if(!$dont_ignore or scalar grep $_->[1]{'~ignore'}, @$curr_open) { DEBUG > 1 and print "Ignoring ignorable =begin\n"; } else { $self->{'content_seen'} ||= 1; $self->_handle_element_start((my $scratch='for'), $para->[1]); } return 1; } sub _ponder_end { my ($self,$para,$curr_open,$paras) = @_; my $content = join ' ', splice @$para, 2; $content =~ s/^\s+//s; $content =~ s/\s+$//s; DEBUG and print "Ogling '=end $content' directive\n"; unless(length($content)) { $self->whine( $para->[1]{'start_line'}, "'=end' without a target?" . ( ( @$curr_open and $curr_open->[-1][0] eq '=for' ) ? ( " (Should be \"=end " . $curr_open->[-1][1]{'target'} . '")' ) : '' ) ); DEBUG and print "Ignoring targetless =end\n"; return 1; } unless($content =~ m/^\S+$/) { # i.e., unless it's one word $self->whine( $para->[1]{'start_line'}, "'=end $content' is invalid. (Stack: " . $self->_dump_curr_open() . ')' ); DEBUG and print "Ignoring mistargetted =end $content\n"; return 1; } unless(@$curr_open and $curr_open->[-1][0] eq '=for') { $self->whine( $para->[1]{'start_line'}, "=end $content without matching =begin. (Stack: " . $self->_dump_curr_open() . ')' ); DEBUG and print "Ignoring mistargetted =end $content\n"; return 1; } unless($content eq $curr_open->[-1][1]{'target'}) { $self->whine( $para->[1]{'start_line'}, "=end $content doesn't match =begin " . $curr_open->[-1][1]{'target'} . ". (Stack: " . $self->_dump_curr_open() . ')' ); DEBUG and print "Ignoring mistargetted =end $content at line $para->[1]{'start_line'}\n"; return 1; } # Else it's okay to close... if(grep $_->[1]{'~ignore'}, @$curr_open) { DEBUG > 1 and print "Not firing any event for this =end $content because in an ignored region\n"; # And that may be because of this to-be-closed =for region, or some # other one, but it doesn't matter. } else { $curr_open->[-1][1]{'start_line'} = $para->[1]{'start_line'}; # what's that for? $self->{'content_seen'} ||= 1; $self->_handle_element_end( my $scratch = 'for' ); } DEBUG > 1 and print "Popping $curr_open->[-1][0] $curr_open->[-1][1]{'target'} because of =end $content\n"; pop @$curr_open; return 1; } sub _ponder_doc_end { my ($self,$para,$curr_open,$paras) = @_; if(@$curr_open) { # Deal with things left open DEBUG and print "Stack is nonempty at end-document: (", $self->_dump_curr_open(), ")\n"; DEBUG > 9 and print "Stack: ", pretty($curr_open), "\n"; unshift @$paras, $self->_closers_for_all_curr_open; # Make sure there is exactly one ~end in the parastack, at the end: @$paras = grep $_->[0] ne '~end', @$paras; push @$paras, $para, $para; # We need two -- once for the next cycle where we # generate errata, and then another to be at the end # when that loop back around to process the errata. return 1; } else { DEBUG and print "Okay, stack is empty now.\n"; } # Try generating errata section, if applicable unless($self->{'~tried_gen_errata'}) { $self->{'~tried_gen_errata'} = 1; my @extras = $self->_gen_errata(); if(@extras) { unshift @$paras, @extras; DEBUG and print "Generated errata... relooping...\n"; return 1; # I.e., loop around again to process these fake-o paragraphs } } splice @$paras; # Well, that's that for this paragraph buffer. DEBUG and print "Throwing end-document event.\n"; $self->_handle_element_end( my $scratch = 'Document' ); return 1; # Hasta la byebye } sub _ponder_pod { my ($self,$para,$curr_open,$paras) = @_; $self->whine( $para->[1]{'start_line'}, "=pod directives shouldn't be over one line long! Ignoring all " . (@$para - 2) . " lines of content" ) if @$para > 3; # Content ignored unless 'pod_handler' is set if (my $pod_handler = $self->{'pod_handler'}) { my ($line_num, $line) = map $_, $para->[1]{'start_line'}, $para->[2]; $line = $line eq '' ? "=pod" : "=pod $line"; # imitate cut_handler output $pod_handler->($line, $line_num, $self); } # The surrounding methods set content_seen, so let us remain consistent. # I do not know why it was not here before -- should it not be here? # $self->{'content_seen'} ||= 1; return; } sub _ponder_over { my ($self,$para,$curr_open,$paras) = @_; return 1 unless @$paras; my $list_type; if($paras->[0][0] eq '=item') { # most common case $list_type = $self->_get_initial_item_type($paras->[0]); } elsif($paras->[0][0] eq '=back') { # Ignore empty lists by default if ($self->{'parse_empty_lists'}) { $list_type = 'empty'; } else { shift @$paras; return 1; } } elsif($paras->[0][0] eq '~end') { $self->whine( $para->[1]{'start_line'}, "=over is the last thing in the document?!" ); return 1; # But feh, ignore it. } else { $list_type = 'block'; } $para->[1]{'~type'} = $list_type; push @$curr_open, $para; # yes, we reuse the paragraph as a stack item my $content = join ' ', splice @$para, 2; my $overness; if($content =~ m/^\s*$/s) { $para->[1]{'indent'} = 4; } elsif($content =~ m/^\s*((?:\d*\.)?\d+)\s*$/s) { no integer; $para->[1]{'indent'} = $1; if($1 == 0) { $self->whine( $para->[1]{'start_line'}, "Can't have a 0 in =over $content" ); $para->[1]{'indent'} = 4; } } else { $self->whine( $para->[1]{'start_line'}, "=over should be: '=over' or '=over positive_number'" ); $para->[1]{'indent'} = 4; } DEBUG > 1 and print "=over found of type $list_type\n"; $self->{'content_seen'} ||= 1; $self->_handle_element_start((my $scratch = 'over-' . $list_type), $para->[1]); return; } sub _ponder_back { my ($self,$para,$curr_open,$paras) = @_; # TODO: fire off or or ?? my $content = join ' ', splice @$para, 2; if($content =~ m/\S/) { $self->whine( $para->[1]{'start_line'}, "=back doesn't take any parameters, but you said =back $content" ); } if(@$curr_open and $curr_open->[-1][0] eq '=over') { DEBUG > 1 and print "=back happily closes matching =over\n"; # Expected case: we're closing the most recently opened thing #my $over = pop @$curr_open; $self->{'content_seen'} ||= 1; $self->_handle_element_end( my $scratch = 'over-' . ( (pop @$curr_open)->[1]{'~type'} ) ); } else { DEBUG > 1 and print "=back found without a matching =over. Stack: (", join(', ', map $_->[0], @$curr_open), ").\n"; $self->whine( $para->[1]{'start_line'}, '=back without =over' ); return 1; # and ignore it } } sub _ponder_item { my ($self,$para,$curr_open,$paras) = @_; my $over; unless(@$curr_open and ($over = $curr_open->[-1])->[0] eq '=over') { $self->whine( $para->[1]{'start_line'}, "'=item' outside of any '=over'" ); unshift @$paras, ['=over', {'start_line' => $para->[1]{'start_line'}}, ''], $para ; return 1; } my $over_type = $over->[1]{'~type'}; if(!$over_type) { # Shouldn't happen1 die "Typeless over in stack, starting at line " . $over->[1]{'start_line'}; } elsif($over_type eq 'block') { unless($curr_open->[-1][1]{'~bitched_about'}) { $curr_open->[-1][1]{'~bitched_about'} = 1; $self->whine( $curr_open->[-1][1]{'start_line'}, "You can't have =items (as at line " . $para->[1]{'start_line'} . ") unless the first thing after the =over is an =item" ); } # Just turn it into a paragraph and reconsider it $para->[0] = '~Para'; unshift @$paras, $para; return 1; } elsif($over_type eq 'text') { my $item_type = $self->_get_item_type($para); # That kills the content of the item if it's a number or bullet. DEBUG and print " Item is of type ", $para->[0], " under $over_type\n"; if($item_type eq 'text') { # Nothing special needs doing for 'text' } elsif($item_type eq 'number' or $item_type eq 'bullet') { die "Unknown item type $item_type" unless $item_type eq 'number' or $item_type eq 'bullet'; # Undo our clobbering: push @$para, $para->[1]{'~orig_content'}; delete $para->[1]{'number'}; # Only a PROPER item-number element is allowed # to have a number attribute. } else { die "Unhandled item type $item_type"; # should never happen } # =item-text thingies don't need any assimilation, it seems. } elsif($over_type eq 'number') { my $item_type = $self->_get_item_type($para); # That kills the content of the item if it's a number or bullet. DEBUG and print " Item is of type ", $para->[0], " under $over_type\n"; my $expected_value = ++ $curr_open->[-1][1]{'~counter'}; if($item_type eq 'bullet') { # Hm, it's not numeric. Correct for this. $para->[1]{'number'} = $expected_value; $self->whine( $para->[1]{'start_line'}, "Expected '=item $expected_value'" ); push @$para, $para->[1]{'~orig_content'}; # restore the bullet, blocking the assimilation of next para } elsif($item_type eq 'text') { # Hm, it's not numeric. Correct for this. $para->[1]{'number'} = $expected_value; $self->whine( $para->[1]{'start_line'}, "Expected '=item $expected_value'" ); # Text content will still be there and will block next ~Para } elsif($item_type ne 'number') { die "Unknown item type $item_type"; # should never happen } elsif($expected_value == $para->[1]{'number'}) { DEBUG > 1 and print " Numeric item has the expected value of $expected_value\n"; } else { DEBUG > 1 and print " Numeric item has ", $para->[1]{'number'}, " instead of the expected value of $expected_value\n"; $self->whine( $para->[1]{'start_line'}, "You have '=item " . $para->[1]{'number'} . "' instead of the expected '=item $expected_value'" ); $para->[1]{'number'} = $expected_value; # correcting!! } if(@$para == 2) { # For the cases where we /didn't/ push to @$para if($paras->[0][0] eq '~Para') { DEBUG and print "Assimilating following ~Para content into $over_type item\n"; push @$para, splice @{shift @$paras},2; } else { DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n"; push @$para, ''; # Just so it's not contentless } } } elsif($over_type eq 'bullet') { my $item_type = $self->_get_item_type($para); # That kills the content of the item if it's a number or bullet. DEBUG and print " Item is of type ", $para->[0], " under $over_type\n"; if($item_type eq 'bullet') { # as expected! if( $para->[1]{'~_freaky_para_hack'} ) { DEBUG and print "Accomodating '=item * Foo' tolerance hack.\n"; push @$para, delete $para->[1]{'~_freaky_para_hack'}; } } elsif($item_type eq 'number') { $self->whine( $para->[1]{'start_line'}, "Expected '=item *'" ); push @$para, $para->[1]{'~orig_content'}; # and block assimilation of the next paragraph delete $para->[1]{'number'}; # Only a PROPER item-number element is allowed # to have a number attribute. } elsif($item_type eq 'text') { $self->whine( $para->[1]{'start_line'}, "Expected '=item *'" ); # But doesn't need processing. But it'll block assimilation # of the next para. } else { die "Unhandled item type $item_type"; # should never happen } if(@$para == 2) { # For the cases where we /didn't/ push to @$para if($paras->[0][0] eq '~Para') { DEBUG and print "Assimilating following ~Para content into $over_type item\n"; push @$para, splice @{shift @$paras},2; } else { DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n"; push @$para, ''; # Just so it's not contentless } } } else { die "Unhandled =over type \"$over_type\"?"; # Shouldn't happen! } $para->[0] .= '-' . $over_type; return; } sub _ponder_Plain { my ($self,$para) = @_; DEBUG and print " giving plain treatment...\n"; unless( @$para == 2 or ( @$para == 3 and $para->[2] eq '' ) or $para->[1]{'~cooked'} ) { push @$para, @{$self->_make_treelet( join("\n", splice(@$para, 2)), $para->[1]{'start_line'} )}; } # Empty paragraphs don't need a treelet for any reason I can see. # And precooked paragraphs already have a treelet. return; } sub _ponder_Verbatim { my ($self,$para) = @_; DEBUG and print " giving verbatim treatment...\n"; $para->[1]{'xml:space'} = 'preserve'; my $indent = $self->strip_verbatim_indent; if ($indent && ref $indent eq 'CODE') { my @shifted = (shift @{$para}, shift @{$para}); $indent = $indent->($para); unshift @{$para}, @shifted; } for(my $i = 2; $i < @$para; $i++) { foreach my $line ($para->[$i]) { # just for aliasing # Strip indentation. $line =~ s/^\Q$indent// if $indent && !($self->{accept_codes} && $self->{accept_codes}{VerbatimFormatted}); while( $line =~ # Sort of adapted from Text::Tabs -- yes, it's hardwired in that # tabs are at every EIGHTH column. For portability, it has to be # one setting everywhere, and 8th wins. s/^([^\t]*)(\t+)/$1.(" " x ((length($2)<<3)-(length($1)&7)))/e ) {} # TODO: whinge about (or otherwise treat) unindented or overlong lines } } # Now the VerbatimFormatted hoodoo... if( $self->{'accept_codes'} and $self->{'accept_codes'}{'VerbatimFormatted'} ) { while(@$para > 3 and $para->[-1] !~ m/\S/) { pop @$para } # Kill any number of terminal newlines $self->_verbatim_format($para); } elsif ($self->{'codes_in_verbatim'}) { push @$para, @{$self->_make_treelet( join("\n", splice(@$para, 2)), $para->[1]{'start_line'}, $para->[1]{'xml:space'} )}; $para->[-1] =~ s/\n+$//s; # Kill any number of terminal newlines } else { push @$para, join "\n", splice(@$para, 2) if @$para > 3; $para->[-1] =~ s/\n+$//s; # Kill any number of terminal newlines } return; } sub _ponder_Data { my ($self,$para) = @_; DEBUG and print " giving data treatment...\n"; $para->[1]{'xml:space'} = 'preserve'; push @$para, join "\n", splice(@$para, 2) if @$para > 3; return; } ########################################################################### sub _traverse_treelet_bit { # for use only by the routine above my($self, $name) = splice @_,0,2; my $scratch; $self->_handle_element_start(($scratch=$name), shift @_); foreach my $x (@_) { if(ref($x)) { &_traverse_treelet_bit($self, @$x); } else { $self->_handle_text($x); } } $self->_handle_element_end($scratch=$name); return; } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ sub _closers_for_all_curr_open { my $self = $_[0]; my @closers; foreach my $still_open (@{ $self->{'curr_open'} || return }) { my @copy = @$still_open; $copy[1] = {%{ $copy[1] }}; #$copy[1]{'start_line'} = -1; if($copy[0] eq '=for') { $copy[0] = '=end'; } elsif($copy[0] eq '=over') { $copy[0] = '=back'; } else { die "I don't know how to auto-close an open $copy[0] region"; } unless( @copy > 2 ) { push @copy, $copy[1]{'target'}; $copy[-1] = '' unless defined $copy[-1]; # since =over's don't have targets } DEBUG and print "Queuing up fake-o event: ", pretty(\@copy), "\n"; unshift @closers, \@copy; } return @closers; } #-------------------------------------------------------------------------- sub _verbatim_format { my($it, $p) = @_; my $formatting; for(my $i = 2; $i < @$p; $i++) { # work backwards over the lines DEBUG and print "_verbatim_format appends a newline to $i: $p->[$i]\n"; $p->[$i] .= "\n"; # Unlike with simple Verbatim blocks, we don't end up just doing # a join("\n", ...) on the contents, so we have to append a # newline to ever line, and then nix the last one later. } if( DEBUG > 4 ) { print "<<\n"; for(my $i = $#$p; $i >= 2; $i--) { # work backwards over the lines print "_verbatim_format $i: $p->[$i]"; } print ">>\n"; } for(my $i = $#$p; $i > 2; $i--) { # work backwards over the lines, except the first (#2) #next unless $p->[$i] =~ m{^#:([ \^\/\%]*)\n?$}s # and $p->[$i-1] !~ m{^#:[ \^\/\%]*\n?$}s; # look at a formatty line preceding a nonformatty one DEBUG > 5 and print "Scrutinizing line $i: $$p[$i]\n"; if($p->[$i] =~ m{^#:([ \^\/\%]*)\n?$}s) { DEBUG > 5 and print " It's a formatty line. ", "Peeking at previous line ", $i-1, ": $$p[$i-1]: \n"; if( $p->[$i-1] =~ m{^#:[ \^\/\%]*\n?$}s ) { DEBUG > 5 and print " Previous line is formatty! Skipping this one.\n"; next; } else { DEBUG > 5 and print " Previous line is non-formatty! Yay!\n"; } } else { DEBUG > 5 and print " It's not a formatty line. Ignoring\n"; next; } # A formatty line has to have #: in the first two columns, and uses # "^" to mean bold, "/" to mean underline, and "%" to mean bold italic. # Example: # What do you want? i like pie. [or whatever] # #:^^^^^^^^^^^^^^^^^ ///////////// DEBUG > 4 and print "_verbatim_format considers:\n<$p->[$i-1]>\n<$p->[$i]>\n"; $formatting = ' ' . $1; $formatting =~ s/\s+$//s; # nix trailing whitespace unless(length $formatting and $p->[$i-1] =~ m/\S/) { # no-op splice @$p,$i,1; # remove this line $i--; # don't consider next line next; } if( length($formatting) >= length($p->[$i-1]) ) { $formatting = substr($formatting, 0, length($p->[$i-1]) - 1) . ' '; } else { $formatting .= ' ' x (length($p->[$i-1]) - length($formatting)); } # Make $formatting and the previous line be exactly the same length, # with $formatting having a " " as the last character. DEBUG > 4 and print "Formatting <$formatting> on <", $p->[$i-1], ">\n"; my @new_line; while( $formatting =~ m{\G(( +)|(\^+)|(\/+)|(\%+))}g ) { #print "Format matches $1\n"; if($2) { #print "SKIPPING <$2>\n"; push @new_line, substr($p->[$i-1], pos($formatting)-length($1), length($1)); } else { #print "SNARING $+\n"; push @new_line, [ ( $3 ? 'VerbatimB' : $4 ? 'VerbatimI' : $5 ? 'VerbatimBI' : die("Should never get called") ), {}, substr($p->[$i-1], pos($formatting)-length($1), length($1)) ]; #print "Formatting <$new_line[-1][-1]> as $new_line[-1][0]\n"; } } my @nixed = splice @$p, $i-1, 2, @new_line; # replace myself and the next line DEBUG > 10 and print "Nixed count: ", scalar(@nixed), "\n"; DEBUG > 6 and print "New version of the above line is these tokens (", scalar(@new_line), "):", map( ref($_)?"<@$_> ":"<$_>", @new_line ), "\n"; $i--; # So the next line we scrutinize is the line before the one # that we just went and formatted } $p->[0] = 'VerbatimFormatted'; # Collapse adjacent text nodes, just for kicks. for( my $i = 2; $i > $#$p; $i++ ) { # work forwards over the tokens except for the last if( !ref($p->[$i]) and !ref($p->[$i + 1]) ) { DEBUG > 5 and print "_verbatim_format merges {$p->[$i]} and {$p->[$i+1]}\n"; $p->[$i] .= splice @$p, $i+1, 1; # merge --$i; # and back up } } # Now look for the last text token, and remove the terminal newline for( my $i = $#$p; $i >= 2; $i-- ) { # work backwards over the tokens, even the first if( !ref($p->[$i]) ) { if($p->[$i] =~ s/\n$//s) { DEBUG > 5 and print "_verbatim_format killed the terminal newline on #$i: {$p->[$i]}, after {$p->[$i-1]}\n"; } else { DEBUG > 5 and print "No terminal newline on #$i: {$p->[$i]}, after {$p->[$i-1]} !?\n"; } last; # we only want the next one } } return; } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ sub _treelet_from_formatting_codes { # Given a paragraph, returns a treelet. Full of scary tokenizing code. # Like [ '~Top', {'start_line' => $start_line}, # "I like ", # [ 'B', {}, "pie" ], # "!" # ] my($self, $para, $start_line, $preserve_space) = @_; my $treelet = ['~Top', {'start_line' => $start_line},]; unless ($preserve_space || $self->{'preserve_whitespace'}) { $para =~ s/\s+/ /g; # collapse and trim all whitespace first. $para =~ s/ $//; $para =~ s/^ //; } # Only apparent problem the above code is that N<< >> turns into # N<< >>. But then, word wrapping does that too! So don't do that! my @stack; my @lineage = ($treelet); DEBUG > 4 and print "Paragraph:\n$para\n\n"; # Here begins our frightening tokenizer RE. The following regex matches # text in four main parts: # # * Start-codes. The first alternative matches C< or C<<, the latter # followed by some whitespace. $1 will hold the entire start code # (including any space following a multiple-angle-bracket delimiter), # and $2 will hold only the additional brackets past the first in a # multiple-bracket delimiter. length($2) + 1 will be the number of # closing brackets we have to find. # # * Closing brackets. Match some amount of whitespace followed by # multiple close brackets. The logic to see if this closes anything # is down below. Note that in order to parse C<< >> correctly, we # have to use look-behind (?<=\s\s), since the match of the starting # code will have consumed the whitespace. # # * A single closing bracket, to close a simple code like C<>. # # * Something that isn't a start or end code. We have to be careful # about accepting whitespace, since perlpodspec says that any whitespace # before a multiple-bracket closing delimiter should be ignored. # while($para =~ m/\G (?: # Match starting codes, including the whitespace following a # multiple-delimiter start code. $1 gets the whole start code and # $2 gets all but one of the {2,}) | (\s?>) # $5: simple end-codes | ( # $6: stuff containing no start-codes or end-codes (?: [^A-Z\s>] | (?: [A-Z](?!<) ) | # whitespace is ok, but we don't want to eat the whitespace before # a multiple-bracket end code. # NOTE: we may still have problems with e.g. S<< >> (?: \s(?!\s*>{2,}) ) )+ ) ) /xgo ) { DEBUG > 4 and print "\nParagraphic tokenstack = (@stack)\n"; if(defined $1) { if(defined $2) { DEBUG > 3 and print "Found complex start-text code \"$1\"\n"; push @stack, length($2) + 1; # length of the necessary complex end-code string } else { DEBUG > 3 and print "Found simple start-text code \"$1\"\n"; push @stack, 0; # signal that we're looking for simple } push @lineage, [ substr($1,0,1), {}, ]; # new node object push @{ $lineage[-2] }, $lineage[-1]; } elsif(defined $4) { DEBUG > 3 and print "Found apparent complex end-text code \"$3$4\"\n"; # This is where it gets messy... if(! @stack) { # We saw " >>>>" but needed nothing. This is ALL just stuff then. DEBUG > 4 and print " But it's really just stuff.\n"; push @{ $lineage[-1] }, $3, $4; next; } elsif(!$stack[-1]) { # We saw " >>>>" but needed only ">". Back pos up. DEBUG > 4 and print " And that's more than we needed to close simple.\n"; push @{ $lineage[-1] }, $3; # That was a for-real space, too. pos($para) = pos($para) - length($4) + 1; } elsif($stack[-1] == length($4)) { # We found " >>>>", and it was exactly what we needed. Commonest case. DEBUG > 4 and print " And that's exactly what we needed to close complex.\n"; } elsif($stack[-1] < length($4)) { # We saw " >>>>" but needed only " >>". Back pos up. DEBUG > 4 and print " And that's more than we needed to close complex.\n"; pos($para) = pos($para) - length($4) + $stack[-1]; } else { # We saw " >>>>" but needed " >>>>>>". So this is all just stuff! DEBUG > 4 and print " But it's really just stuff, because we needed more.\n"; push @{ $lineage[-1] }, $3, $4; next; } #print "\nHOOBOY ", scalar(@{$lineage[-1]}), "!!!\n"; push @{ $lineage[-1] }, '' if 2 == @{ $lineage[-1] }; # Keep the element from being childless pop @stack; pop @lineage; } elsif(defined $5) { DEBUG > 3 and print "Found apparent simple end-text code \"$5\"\n"; if(@stack and ! $stack[-1]) { # We're indeed expecting a simple end-code DEBUG > 4 and print " It's indeed an end-code.\n"; if(length($5) == 2) { # There was a space there: " >" push @{ $lineage[-1] }, ' '; } elsif( 2 == @{ $lineage[-1] } ) { # Closing a childless element push @{ $lineage[-1] }, ''; # keep it from being really childless } pop @stack; pop @lineage; } else { DEBUG > 4 and print " It's just stuff.\n"; push @{ $lineage[-1] }, $5; } } elsif(defined $6) { DEBUG > 3 and print "Found stuff \"$6\"\n"; push @{ $lineage[-1] }, $6; } else { # should never ever ever ever happen DEBUG and print "AYYAYAAAAA at line ", __LINE__, "\n"; die "SPORK 512512!"; } } if(@stack) { # Uhoh, some sequences weren't closed. my $x= "..."; while(@stack) { push @{ $lineage[-1] }, '' if 2 == @{ $lineage[-1] }; # Hmmmmm! my $code = (pop @lineage)->[0]; my $ender_length = pop @stack; if($ender_length) { --$ender_length; $x = $code . ("<" x $ender_length) . " $x " . (">" x $ender_length); } else { $x = $code . "<$x>"; } } DEBUG > 1 and print "Unterminated $x sequence\n"; $self->whine($start_line, "Unterminated $x sequence", ); } return $treelet; } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ sub text_content_of_treelet { # method: $parser->text_content_of_treelet($lol) return stringify_lol($_[1]); } sub stringify_lol { # function: stringify_lol($lol) my $string_form = ''; _stringify_lol( $_[0] => \$string_form ); return $string_form; } sub _stringify_lol { # the real recursor my($lol, $to) = @_; for(my $i = 2; $i < @$lol; ++$i) { if( ref($lol->[$i] || '') and UNIVERSAL::isa($lol->[$i], 'ARRAY') ) { _stringify_lol( $lol->[$i], $to); # recurse! } else { $$to .= $lol->[$i]; } } return; } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ sub _dump_curr_open { # return a string representation of the stack my $curr_open = $_[0]{'curr_open'}; return '[empty]' unless @$curr_open; return join '; ', map {; ($_->[0] eq '=for') ? ( ($_->[1]{'~really'} || '=over') . ' ' . $_->[1]{'target'}) : $_->[0] } @$curr_open ; } ########################################################################### my %pretty_form = ( "\a" => '\a', # ding! "\b" => '\b', # BS "\e" => '\e', # ESC "\f" => '\f', # FF "\t" => '\t', # tab "\cm" => '\cm', "\cj" => '\cj', "\n" => '\n', # probably overrides one of either \cm or \cj '"' => '\"', '\\' => '\\\\', '$' => '\\$', '@' => '\\@', '%' => '\\%', '#' => '\\#', ); sub pretty { # adopted from Class::Classless # Not the most brilliant routine, but passable. # Don't give it a cyclic data structure! my @stuff = @_; # copy my $x; my $out = # join ",\n" . join ", ", map {; if(!defined($_)) { "undef"; } elsif(ref($_) eq 'ARRAY' or ref($_) eq 'Pod::Simple::LinkSection') { $x = "[ " . pretty(@$_) . " ]" ; $x; } elsif(ref($_) eq 'SCALAR') { $x = "\\" . pretty($$_) ; $x; } elsif(ref($_) eq 'HASH') { my $hr = $_; $x = "{" . join(", ", map(pretty($_) . '=>' . pretty($hr->{$_}), sort keys %$hr ) ) . "}" ; $x; } elsif(!length($_)) { q{''} # empty string } elsif( $_ eq '0' # very common case or( m/^-?(?:[123456789]\d*|0)(?:\.\d+)?$/s and $_ ne '-0' # the strange case that that RE lets thru ) ) { $_; } else { if( chr(65) eq 'A' ) { s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])> #<$pretty_form{$1} || '\\x'.(unpack("H2",$1))>eg; <$pretty_form{$1} || '\\x{'.sprintf("%x", ord($1)).'}'>eg; } else { # We're in some crazy non-ASCII world! s<([^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])> #<$pretty_form{$1} || '\\x'.(unpack("H2",$1))>eg; <$pretty_form{$1} || '\\x{'.sprintf("%x", ord($1)).'}'>eg; } qq{"$_"}; } } @stuff; # $out =~ s/\n */ /g if length($out) < 75; return $out; } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ # A rather unsubtle method of blowing away all the state information # from a parser object so it can be reused. Provided as a utility for # backward compatibility in Pod::Man, etc. but not recommended for # general use. sub reinit { my $self = shift; foreach (qw(source_dead source_filename doc_has_started start_of_pod_block content_seen last_was_blank paras curr_open line_count pod_para_count in_pod ~tried_gen_errata errata errors_seen Title)) { delete $self->{$_}; } } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 1; pbc.h000644000765000765 703111716253437 16350 0ustar00brucebruce000000000000parrot-5.9.0/compilers/imcc/* * Copyright (C) 2002-2009, Parrot Foundation. */ #ifndef PARROT_IMCC_PBC_H_GUARD #define PARROT_IMCC_PBC_H_GUARD /* HEADERIZER BEGIN: compilers/imcc/pbc.c */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ void e_pbc_close(ARGMOD(imc_info_t * imcc), void *param) __attribute__nonnull__(1) FUNC_MODIFIES(* imcc); int e_pbc_emit( ARGMOD(imc_info_t * imcc), void *param, ARGIN(const IMC_Unit *unit), ARGIN(const Instruction *ins)) __attribute__nonnull__(1) __attribute__nonnull__(3) __attribute__nonnull__(4) FUNC_MODIFIES(* imcc); void e_pbc_end_sub( ARGMOD(imc_info_t * imcc), void *param, ARGIN(IMC_Unit *unit)) __attribute__nonnull__(1) __attribute__nonnull__(3) FUNC_MODIFIES(* imcc); void e_pbc_new_sub( ARGMOD(imc_info_t * imcc), void *param, ARGIN(IMC_Unit *unit)) __attribute__nonnull__(1) __attribute__nonnull__(3) FUNC_MODIFIES(* imcc); int e_pbc_open(ARGMOD(imc_info_t * imcc)) __attribute__nonnull__(1) FUNC_MODIFIES(* imcc); PARROT_WARN_UNUSED_RESULT INTVAL IMCC_int_from_reg(ARGMOD(imc_info_t * imcc), ARGIN(const SymReg *r)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(* imcc); void imcc_pbc_add_libdep(ARGMOD(imc_info_t * imcc), ARGIN(STRING *libname)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(* imcc); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * IMCC_string_from__STRINGC( ARGMOD(imc_info_t * imcc), ARGIN(char *buf)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(* imcc); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * IMCC_string_from_reg( ARGMOD(imc_info_t * imcc), ARGIN(const SymReg *r)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(* imcc); #define ASSERT_ARGS_e_pbc_close __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc)) #define ASSERT_ARGS_e_pbc_emit __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit) \ , PARROT_ASSERT_ARG(ins)) #define ASSERT_ARGS_e_pbc_end_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit)) #define ASSERT_ARGS_e_pbc_new_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit)) #define ASSERT_ARGS_e_pbc_open __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc)) #define ASSERT_ARGS_IMCC_int_from_reg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(r)) #define ASSERT_ARGS_imcc_pbc_add_libdep __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(libname)) #define ASSERT_ARGS_IMCC_string_from__STRINGC __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(buf)) #define ASSERT_ARGS_IMCC_string_from_reg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(r)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: compilers/imcc/pbc.c */ #endif /* PARROT_IMCC_PBC_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ nci_test.c000644000765000765 4544612101554067 15312 0ustar00brucebruce000000000000parrot-5.9.0/src/* Copyright (C) 2001-2013, Parrot Foundation. =head1 NAME src/nci_test.c - shared library used for testing the Native Call Interface =head1 DESCRIPTION From this code a shared library can be compiled and linked with a command like: cc -shared -fpic nci_test.c -o libnci_test.so -g For non-Unix platforms the above command has to be modified appropriately. The resulting shared library should be copied to a location like: parrot/runtime/parrot/dynext/libnci_test.so At that location the shared library is loadable with the opcode 'loadlib'. The functions in the library are available with the opcode 'dlfunc'. The variables in the library are available with the opcode 'dlvar'. =head2 Functions The name of a test function is usually 'nci_'. E.g. the function 'nci_ip' takes a 'pointer' and returns a 'int'. =over 4 =cut */ #define PARROT_IN_EXTENSION #include #include #include #include "parrot/parrot.h" #ifdef __cplusplus extern "C" { #endif /* Declarations of structs */ typedef struct Nested { int y; } Nested; typedef struct Outer { int x; Nested *nested; } Outer; typedef struct Rect_Like { int x, y; int w, h; } Rect_Like; typedef struct Opaque { int x; } Opaque; /* Function declarations. *** If you add a new test function here, *** please update src/libnci_test.def and src/nci/extra_thunks.nci too. *** */ PARROT_DYNEXT_EXPORT int call_back(PARROT_INTERP, char *); PARROT_DYNEXT_EXPORT char nci_c(void); PARROT_DYNEXT_EXPORT char nci_csc(short, char); PARROT_DYNEXT_EXPORT double nci_d(void); PARROT_DYNEXT_EXPORT double nci_dd(double); PARROT_DYNEXT_EXPORT float nci_f(void); PARROT_DYNEXT_EXPORT float nci_fff(float, float); PARROT_DYNEXT_EXPORT int nci_i(void); PARROT_DYNEXT_EXPORT int nci_ib(int *); PARROT_DYNEXT_EXPORT int nci_iiii(int, int, int); PARROT_DYNEXT_EXPORT int nci_ip(void *); PARROT_DYNEXT_EXPORT int nci_isc(short, char); PARROT_DYNEXT_EXPORT long nci_l(void); PARROT_DYNEXT_EXPORT int * nci_p(void); PARROT_DYNEXT_EXPORT void * nci_pi(int); PARROT_DYNEXT_EXPORT void * nci_pii(int, int); PARROT_DYNEXT_EXPORT void * nci_piiii(int, int, int, int); PARROT_DYNEXT_EXPORT void nci_pip(int, ARGIN(const Rect_Like *)); PARROT_DYNEXT_EXPORT void * nci_pp(void *); PARROT_DYNEXT_EXPORT short nci_s(void); PARROT_DYNEXT_EXPORT short nci_ssc(short, char); PARROT_DYNEXT_EXPORT char * nci_t(void); PARROT_DYNEXT_EXPORT char * nci_tt(const char *); PARROT_DYNEXT_EXPORT void nci_v(void); PARROT_DYNEXT_EXPORT void nci_vP(void *); PARROT_DYNEXT_EXPORT void nci_vpii(ARGMOD(Outer *), int, int); PARROT_DYNEXT_EXPORT void nci_vv(void); PARROT_DYNEXT_EXPORT void nci_vp(ARGIN(const Opaque*)); PARROT_DYNEXT_EXPORT void * nci_pv(void); PARROT_DYNEXT_EXPORT void nci_vfff(float, float, float); PARROT_DYNEXT_EXPORT char * nci_cstring_cstring(const char *); /* Declarations for callback tests */ typedef void (*cb_C1_func)(const char*, void*); PARROT_DYNEXT_EXPORT void nci_cb_C1(cb_C1_func, void*); typedef void (*cb_C2_func)(int, void*); PARROT_DYNEXT_EXPORT void nci_cb_C2(cb_C2_func, void*); typedef void (*cb_C3_func)(void*, void*); PARROT_DYNEXT_EXPORT void nci_cb_C3(cb_C3_func, void*); typedef void (*cb_D1_func)(void*, const char*); PARROT_DYNEXT_EXPORT void nci_cb_D1(cb_D1_func, void*); typedef void (*cb_D2_func)(void*, int); PARROT_DYNEXT_EXPORT void nci_cb_D2(cb_D2_func, void*); typedef void (*cb_D3_func)(void*, void*); PARROT_DYNEXT_EXPORT void nci_cb_D3(cb_D3_func, void*); typedef void (*cb_D4_func)(void*, void*); PARROT_DYNEXT_EXPORT void nci_cb_D4(cb_D4_func, void*); /* Variable definitions */ /* Note that PARROT_DATA (i.e. extern) or static will not work with our nci test. We want only one symbol, exported as visible. */ PARROT_DYNEXT_EXPORT int int_cb_D4 = -55555; PARROT_DYNEXT_EXPORT int nci_dlvar_char = 22; PARROT_DYNEXT_EXPORT int nci_dlvar_short = 333; PARROT_DYNEXT_EXPORT int nci_dlvar_int = -4444; PARROT_DYNEXT_EXPORT long nci_dlvar_long = -7777777; PARROT_DYNEXT_EXPORT float nci_dlvar_float = -333.0; PARROT_DYNEXT_EXPORT double nci_dlvar_double = -55555.55555; PARROT_DYNEXT_EXPORT char nci_dlvar_cstring[] = "This is a C-string.\n"; /* Function definitions */ /* =item C Returns the value of the variable C, which is set to 22 by default. =cut */ PARROT_DYNEXT_EXPORT PARROT_PURE_FUNCTION char nci_c(void) { return nci_dlvar_char; } /* =item C Multiplies C and C together and returns the first byte of the result. =cut */ PARROT_DYNEXT_EXPORT PARROT_CONST_FUNCTION char nci_csc(short l1, char l2) { return l1 * l2; } /* =item C Multiplies the current value of C by 10.0, and returns the new value. =cut */ PARROT_DYNEXT_EXPORT double nci_d(void) { nci_dlvar_double *= 10.0; return nci_dlvar_double; } /* =item C Returns the value C multiplied by 2.0. =cut */ PARROT_DYNEXT_EXPORT PARROT_CONST_FUNCTION double nci_dd(double d) { return d * 2.0; } /* =item C Multiplies the value C by 10.0 and returns the new value. =cut */ PARROT_DYNEXT_EXPORT float nci_f(void) { nci_dlvar_float *= 10.0; return nci_dlvar_float; } /* =item C Returns the result of C / C. =cut */ PARROT_DYNEXT_EXPORT PARROT_CONST_FUNCTION float nci_fff(float l1, float l2) { return l1 / l2; } /* =item C Returns the current value of . =cut */ PARROT_DYNEXT_EXPORT PARROT_PURE_FUNCTION int nci_i(void) { return nci_dlvar_int; } /* =item C Returns the int product of C. =cut */ PARROT_DYNEXT_EXPORT PARROT_CONST_FUNCTION int nci_isc(short l1, char l2) { return l1 * l2; } /* =item C Performs a series of operations on values stored at pointer C

. =cut */ PARROT_DYNEXT_EXPORT int nci_ip(void *p) { typedef struct _dfi { double d; float f; int i; char *s; } dfi; const dfi * const sp = (const dfi*) p; puts(sp->s); fflush(stdout); return (int) (sp->d + sp->f + sp->i); } /* =item C Returns the value of C. =cut */ PARROT_DYNEXT_EXPORT PARROT_PURE_FUNCTION long nci_l(void) { return nci_dlvar_long; } /* =item C Returns the address of C. =cut */ PARROT_DYNEXT_EXPORT PARROT_CONST_FUNCTION int * nci_p(void) { return &nci_dlvar_int; } /* =item C Returns the value C

directly. =cut */ PARROT_DYNEXT_EXPORT PARROT_CONST_FUNCTION void * nci_pp(void *p) { return p; } /* =item C Prints three integers separated by whitespace to C. Returns 2. =cut */ PARROT_DYNEXT_EXPORT int nci_iiii(int i1, int i2, int i3) { fprintf(stderr, "%d %d %d\n", i1, i2, i3); fflush(stderr); return 2; } /* =item C writes the string C to stdout and returns the value 4711. =cut */ PARROT_DYNEXT_EXPORT int call_back(SHIM_INTERP, char *cstr) { puts(cstr); fflush(stdout); return 4711; } /* =item C Performs one from a series of tests, depending on the value given for C. =cut */ PARROT_DYNEXT_EXPORT void * nci_pi(int test) { switch (test) { case 0: { static struct { int i[2]; char c; } t = { {42, 100}, 'B' }; return &t; } case 1: { static struct { float f[2]; double d; } t = { {42.0, 100.0}, 47.11 }; return &t; } case 2: { static struct { char c; int i; } t = { 10, 20 }; return &t; } case 3: { static struct { const char *c; int i; } t = { "hello", 20 }; return &t; } case 4: { static struct _x { int i; int j; double d; } xx = { 100, 77, 200.0 }; static struct { char c; struct _x *x; } t = { 10, &xx }; return &t; } case 5: { static struct { int (*f)(PARROT_INTERP, char *); } t = { call_back }; return &t; } case 6: { static struct xt { int x; struct yt { int i; int j; } _y; int z; } _x = { 32, { 127, 12345 }, 33 }; return &_x; } case 7: { static struct xt { char x; struct yt { char i; int j; } _y; char z; } _x = { 32, { 127, 12345 }, 33 }; return &_x; } case 8: { static struct _z { int i; int j; } zz = { 100, 77 }; static struct xt { int x; struct yt { int i; int j; struct _z *z; } _y; } _x = { 32, { 127, 12345, &zz }, }; return &_x; } case 9: { static int i = 55555; return &i; } case 10: return NULL; default: fprintf(stderr, "unknown test number\n"); } return NULL; } /* =item C Returns the value of C. =cut */ PARROT_DYNEXT_EXPORT PARROT_PURE_FUNCTION short nci_s(void) { return nci_dlvar_short; } /* =item C Returns the product of C. =cut */ PARROT_DYNEXT_EXPORT PARROT_CONST_FUNCTION short nci_ssc(short l1, char l2) { return l1 * l2; } /* =item C Prints "ok" if C is not null, prints "got null" otherwise. =cut */ PARROT_DYNEXT_EXPORT void nci_vP(SHIM(void *pmc)) { /* TODO: * Disable this test until someone figures a way to check for * PMCNULL without using libparrot. if (!PMC_IS_NULL(pmc)) puts("ok"); else */ puts("got null"); } /* =back =head2 Functions used for pdd16 tests =over 4 =cut */ /* =item C Calls C function with the string "result" and the given C. No return value. =cut */ PARROT_DYNEXT_EXPORT void nci_cb_C1(cb_C1_func cb, void* user_data) { const char * const result = "succeeded"; /* call the cb synchronously */ (cb)(result, user_data); return; } /* =item C Calls the function C with the integer 77 and the given C. No return value. =cut */ PARROT_DYNEXT_EXPORT void nci_cb_C2(cb_C2_func cb, void* user_data) { /* call the cb synchronously */ (cb)(77, user_data); return; } /* =item C Calls function C with C<&int_cb_C3> and the givn C. No return value. =cut */ static int int_cb_C3 = 99; PARROT_DYNEXT_EXPORT void nci_cb_C3(cb_C3_func cb, void* user_data) { /* call the cb synchronously */ (cb)(&int_cb_C3, user_data); return; } /* =item C Calls function C with data C and the string "succeeded". No return value. =cut */ PARROT_DYNEXT_EXPORT void nci_cb_D1(cb_D1_func cb, void* user_data) { const char * const result = "succeeded"; /* call the cb synchronously */ (cb)(user_data, result); return; } /* =item C Calls function C with data C and the integer 88. No return value. =cut */ PARROT_DYNEXT_EXPORT void nci_cb_D2(cb_D2_func cb, void* user_data) { /* call the cb synchronously */ (cb)(user_data, 88); return; } /* =item C Calls function C with data C and C<&int_cb_D3>. No return value. =cut */ static int int_cb_D3 = 111; PARROT_DYNEXT_EXPORT void nci_cb_D3(cb_D3_func cb, void* user_data) { /* call the cb synchronously */ (cb)(user_data, &int_cb_D3); return; } /* =item C Calls function C with data C and C<&int_cb_D4> 10 times in a loop, incrementing C after every call. No return value. =cut */ PARROT_DYNEXT_EXPORT void nci_cb_D4(cb_D4_func times_ten, void* user_data) { int count; for (count = 0; count < 9; ++count) { (times_ten)(user_data, &int_cb_D4); ++int_cb_D4; } return; } /* =item C Prints a count integer and the coordinates of 4 rectangles. =cut */ PARROT_DYNEXT_EXPORT void nci_pip(int count, ARGIN(const Rect_Like *rects)) { int i; printf("Count: %d\n", count); for (i = 0; i < 4; ++i) printf("X: %d\nY: %d\nW: %d\nH: %d\n", rects[i].x, rects[i].y, rects[i].w, rects[i].h); } /* =item C Updates data in structure pointer C with the given data C and C. =cut */ PARROT_DYNEXT_EXPORT void nci_vpii(ARGMOD(Outer *my_data), int my_x, int my_y) { my_data->x = my_x; my_data->nested->y = my_y; } /* =item C Stores 4 integer values into an array structure, and returns the address of that structure. =cut */ static int my_array[4]; PARROT_DYNEXT_EXPORT void * nci_piiii(int alpha, int beta, int gamma, int delta) { static struct array_container { int x; int *array; } container; my_array[0] = alpha; my_array[1] = beta; my_array[2] = gamma; my_array[3] = delta; container.x = 4; container.array = my_array; return &container; } /* =item C Returns the address of global variable C whose value is set to the product of C. =cut */ PARROT_DYNEXT_EXPORT void * nci_pii(int fac1, int fac2) { nci_dlvar_int = fac1 * fac2; return &nci_dlvar_int; } /* =item C Returns the value of C. =cut */ PARROT_DYNEXT_EXPORT PARROT_CONST_FUNCTION char * nci_t(void) { return nci_dlvar_cstring; } /* =item C Returns "xx worked", where "xx" is replaced with the first two character values of C

, in reverse order. =cut */ static char s[] = "xx worked\n"; PARROT_DYNEXT_EXPORT char * nci_tt(const char *p) { s[0] = p[1]; s[1] = p[0]; return s; } /* =item C Multiplies the global variable C times 10. =cut */ PARROT_DYNEXT_EXPORT void nci_v(void) { nci_dlvar_int *= 10; } /* =item C Multiplies the global variable C by 3. =cut */ PARROT_DYNEXT_EXPORT void nci_vv(void) { nci_dlvar_int *= 3; } /* =item C Test that a previously generated opaque struct gets passed back to an NCI function correctly. =cut */ PARROT_DYNEXT_EXPORT void nci_vp(ARGIN(const Opaque *inOpaque)) { if (inOpaque) printf("got %d\n", inOpaque->x); else printf("got null\n"); } /* =item C Return the pointer to the global variable C. =cut */ PARROT_DYNEXT_EXPORT void * nci_pv(void) { return &nci_dlvar_int; } /* =item C Check that a float value f is has an error ratio of less than 0.01 when compared to a double value checkval =cut */ static void validate_float(float f, double checkval) { int valid; double error_ratio; error_ratio = (((double)f) - checkval) / checkval; valid = error_ratio <= 0.01 && error_ratio >= -0.01; printf("%i\n", valid); } /* =item C Checks that C<[ l1, l2, l3 ]> = C<[ 3456.54, 10.1999, 14245.567 ]> within an error of 0.01. =cut */ PARROT_DYNEXT_EXPORT void nci_vfff(float l1, float l2, float l3) { validate_float(l1, 3456.54); validate_float(l2, 10.1999); validate_float(l3, 14245.567); } /* =item C Copy the content of src to a static buffer, replacing 'l' with 'L' and return a pointer for the buffer. =cut */ PARROT_DYNEXT_EXPORT char * nci_cstring_cstring(const char * src) { static char buffer[64]; const int maxl = sizeof buffer - 1; int l = strlen(src); int i; if (l > maxl) l = maxl; for (i = 0; i < l; ++i) { char c = src[i]; if (c == 'l') c = 'L'; buffer[i] = c; } buffer[i] = '\0'; return buffer; } #ifdef TEST char l2 = 4; float f2 = 4.0; /* =item C Calls test functions C and C and prints their results. =cut */ int main(void) { short l1 = 3; float f, f1 = 3.0; int l = nci_ssc(l1, l2); printf("%d\n", l); f = nci_fff(f1, f2); printf("%f\n", f); return 0; } #endif #ifdef __cplusplus } #endif /* =back =head1 SEE ALSO F, F, F =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ stress2.rb000644000765000765 23611466337261 20370 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks#! ruby def buildarray() foo = Array.new 10000.times { |i| foo[i] = i } foo end 20.times { a = Array.new 10.times { |i| a[i] = buildarray } } 031-base.t000644000765000765 215211533177644 16350 0ustar00brucebruce000000000000parrot-5.9.0/t/configure#!perl # Copyright (C) 2001-2005, Parrot Foundation. use strict; use warnings; use lib qw( lib ); use Test::More tests => 5; =head1 NAME t/configure/031-base.t - tests Parrot::Configure::Step =head1 SYNOPSIS prove t/configure/031-base.t =head1 DESCRIPTION Regressions tests for the L abstract base class. =cut BEGIN { use Parrot::Configure::Step; } package Test::Parrot::Configure::Step; use base qw(Parrot::Configure::Step); sub _init { my $self = shift; my %data; $data{description} = q{foo}; $data{result} = q{}; return \%data; } package main; my $testpkg = 'Test::Parrot::Configure::Step'; can_ok( $testpkg, qw(new description result set_result) ); isa_ok( $testpkg->new, $testpkg ); { my $teststep = $testpkg->new; is( $teststep->result('baz'), q{}, "->set_result() returns the class" ); isa_ok( $teststep->set_result('baz'), $testpkg ); is( $teststep->result, 'baz', "->set_result() changed the result value" ); } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: oo2.pl000644000765000765 63111533177634 17472 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks#! perl # Copyright (C) 2004-2006, Parrot Foundation. use strict; use warnings; for my $i ( 1 .. 500000 ) { my $o = new Foo(); } my $o = new Foo(); print $o->[0], "\n"; package Foo; sub new { my $self = ref $_[0] ? ref shift : shift; return bless [ 10, 20 ], $self; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: time.t000644000765000765 423612101554067 14523 0ustar00brucebruce000000000000parrot-5.9.0/t/op#!./parrot # Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME t/op/time.t - Time and Sleep =head1 DESCRIPTION This PIR code implements time and sleep operations. =cut .sub main :main .include 'test_more.pir' plan(19) test_time_i() test_time_n() test_sleep_i() test_sleep_i_negative() test_sleep_n() test_sleep_n_negative() test_tm_pasm() .end .sub test_time_i $I0 = time $I2 = isge $I0, 0 ok($I2, "Current int time is greater than 0") $I1 = time $I2 = isge $I1, $I2 ok($I2, "Current int time is greater than older time") .end .sub test_time_n $N0 = time $I0 = isge $N0, 0.0 ok($I0, "Current num time is greater than 0.0") $N1 = time $I0 = isge $N1, $N0 ok($I0, "Current num time is greater than older time") .end .sub test_sleep_i $I0 = time sleep 1 $I1 = time $I2 = isgt $I1, $I0 ok($I2, "sleep_i increases time") $I2 = $I0 + 1 $I3 = isge $I1, $I2 ok($I3, "sleep_i slept for at least the amount of time specified") .end .sub test_sleep_i_negative push_eh cannot_sleep_negative sleep -1 pop_eh ok(0, "Guess what? Just time traveled") .return() cannot_sleep_negative: pop_eh ok(1, "Cannot sleep_i backwards") .end .sub test_sleep_n $N0 = time sleep 1.1 $N1 = time $I2 = isgt $N1, $N0 ok($I2, "sleep_n increases time") $N2 = $N0 + 1.0 $I2 = isge $N1, $N2 ok($I2, "sleep_n slept for at least the integer amount of time specified") .end .sub test_sleep_n_negative push_eh cannot_sleep_negative sleep -1.2 pop_eh ok(0, "Guess what? Just time traveled") .return() cannot_sleep_negative: pop_eh ok(1, "Cannot sleep_n backwards") .end .sub test_tm_pasm .include "tm.pasm" is(.TM_SEC, 0, "TM_SEC ok") is(.TM_MIN, 1, "TM_MIN ok") is(.TM_HOUR, 2, "TM_HOUR ok") is(.TM_MDAY, 3, "TM_MDAY ok") is(.TM_MON, 4, "TM_MON ok") is(.TM_YEAR, 5, "TM_YEAR ok") is(.TM_WDAY, 6, "TM_WDAY ok") is(.TM_YDAY, 7, "TM_YDAY ok") is(.TM_ISDST, 8, "TM_ISDST ok") .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: object-mro.t000644000765000765 1566611533177645 16033 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc#! perl # Copyright (C) 2001-2005, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Test tests => 6; =head1 NAME t/pmc/object-mro.t - Object Methods Resolution Order =head1 SYNOPSIS % prove t/pmc/object-mro.t =head1 DESCRIPTION These are tests for the C3 MRO order =cut pir_output_is( <<'CODE', <<'OUTPUT', "print mro diamond" ); # # A B A E # \ / \ / # C D # \ / # \ / # F .sub main :main .local pmc A, B, C, D, E, F, mro, p, it newclass A, "A" newclass B, "B" subclass C, A, "C" addparent C, B subclass D, A, "D" newclass E, "E" addparent D, E subclass F, C, "F" addparent F, D mro = F.'inspect'('all_parents') it = iter mro it = 0 loop: unless it goto ex p = shift it $S0 = p print $S0 print ' ' goto loop ex: say 'G' .end CODE F C D A B E G OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "print mro 1" ); # # example take from: http://www.python.org/2.3/mro.html # # class O: pass # class F(O): pass # class E(O): pass # class D(O): pass # class C(D,F): pass # class B(D,E): pass # class A(B,C): pass # # 6 # --- # Level 3 | O | (more general) # / --- \ # / | \ | # / | \ | # / | \ | # --- --- --- | # Level 2 3 | D | 4| E | | F | 5 | # --- --- --- | # \ \ _ / | | # \ / \ _ | | # \ / \ | | # --- --- | # Level 1 1 | B | | C | 2 | # --- --- | # \ / | # \ / \ / # --- # Level 0 0 | A | (more specialized) # --- # .sub main :main .local pmc A, B, C, D, E, F, O newclass O, "O" subclass F, O, "F" subclass E, O, "E" subclass D, O, "D" subclass C, D, "C" addparent C, F subclass B, D, "B" addparent B, E subclass A, B, "A" addparent A, C .local pmc mro, it, p mro = A.'inspect'('all_parents') it = iter mro it = 0 loop: unless it goto ex p = shift it $S0 = p print $S0 print ' ' goto loop ex: say 'G' .end CODE A B C D E F O G OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "print mro 2" ); # # example take from: http://www.python.org/2.3/mro.html # # class O: pass # class F(O): pass # class E(O): pass # class D(O): pass # class C(D,F): pass # class B(E,D): pass # class A(B,C): pass # # 6 # --- # Level 3 | O | # / --- \ # / | \ # / | \ # / | \ # --- --- --- # Level 2 2 | E | 4 | D | | F | 5 # --- --- --- # \ / \ / # \ / \ / # \ / \ / # --- --- # Level 1 1 | B | | C | 3 # --- --- # \ / # \ / # --- # Level 0 0 | A | # --- # .sub main :main .local pmc A, B, C, D, E, F, O newclass O, "O" subclass F, O, "F" subclass E, O, "E" subclass D, O, "D" subclass C, D, "C" addparent C, F subclass B, E, "B" addparent B, D subclass A, B, "A" addparent A, C .local pmc mro, it, p mro = A.'inspect'('all_parents') it = iter mro it = 0 loop: unless it goto ex p = shift it $S0 = p print $S0 print ' ' goto loop ex: say 'G' .end CODE A B E C D F O G OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "print mro 3" ); # # C # / \ # / \ # A B # \ / # \ / # D # .sub main :main .local pmc A, B, C, D newclass C, "C" subclass A, C, "A" subclass B, C, "B" subclass D, A, "D" addparent D, B .local pmc mro, it, p mro = D.'inspect'('all_parents') it = iter mro it = 0 loop: unless it goto ex p = shift it $S0 = p print $S0 print ' ' goto loop ex: say 'G' .end CODE D A B C G OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "print mro 4" ); # # TestObject # ^ # | # LifeForm # ^ ^ # / \ # Sentient BiPedal # ^ ^ # | | # Intelligent Humanoid # ^ ^ # \ / # Vulcan # # example taken from: L # # define class () end class; # define class () end class; # define class () end class; # define class () end class; # define class (, ) end class; # .sub main :main .local pmc TestObject, LifeForm, Sentient, BiPedal, Intelligent, Humanoid, Vulcan newclass TestObject, "TestObject" subclass LifeForm, TestObject, "LifeForm" subclass Sentient, LifeForm, "Sentient" subclass Intelligent, Sentient, "Intelligent" subclass BiPedal, LifeForm, "BiPedal" subclass Humanoid, BiPedal, "Humanoid" subclass Vulcan, Intelligent, "Vulcan" addparent Vulcan, Humanoid .local pmc mro, it, p mro = Vulcan.'inspect'('all_parents') it = iter mro it = 0 loop: unless it goto ex p = shift it $S0 = p print $S0 print ' ' goto loop ex: say 'R' .end CODE Vulcan Intelligent Sentient Humanoid BiPedal LifeForm TestObject R OUTPUT # ... now some tests which fail to compose the class pir_error_output_like( <<'CODE', <<'OUTPUT', "mro error 1" ); # # example take from: http://www.python.org/2.3/mro.html # # "Serious order disagreement" # From Guido # class O: pass # class X(O): pass # class Y(O): pass # class A(X,Y): pass # class B(Y,X): pass # try: # class Z(A,B): pass # creates Z(A,B) in Python 2.2 # except TypeError: # pass # Z(A,B) cannot be created in Python 2.3 # .sub main :main .local pmc O, X, Y, A, B, Z newclass O, "O" subclass X, O, "X" subclass Y, O, "Y" subclass A, X, "A" addparent A, Y subclass B, Y, "B" addparent B, X subclass Z, A, "Z" addparent Z, B .end CODE /ambiguous hierarchy/ OUTPUT # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: 034-step.t000644000765000765 2154311533177644 16441 0ustar00brucebruce000000000000parrot-5.9.0/t/configure#!perl # Copyright (C) 2001-2009, Parrot Foundation. use strict; use warnings; use Test::More tests => 15; use Carp; use Cwd; use File::Temp 0.13 qw/ tempdir /; use lib qw( lib t/configure/testlib ); use Parrot::Configure; use IO::CaptureOutput qw | capture |; my $cwd = cwd(); my $conf = Parrot::Configure->new; $conf->data->set( make => 'make' ); my $nonexistent = 'config/gen/makefiles/foobar'; eval { $conf->genfile( $nonexistent => 'CFLAGS', comment_type => '#', ); }; like( $@, qr/Can't open $nonexistent/, #' "Got expected error message when non-existent file provided as argument to genfile()." ); { my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or croak "Unable to change to temporary directory"; my $dummy = 'dummy'; open my $IN, '>', $dummy or croak "Unable to open temp file for writing"; print $IN qq{Hello world\n}; close $IN or croak "Unable to close temp file"; ok( $conf->genfile( $dummy => 'CFLAGS', file_type => 'makefile', ), "genfile() returned true value with 'file_type' option being set to 'makefile'" ); unlink $dummy or croak "Unable to delete file after testing"; chdir $cwd or croak "Unable to change back to starting directory"; } { my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or croak "Unable to change to temporary directory"; my $dummy = 'dummy'; open my $IN, '>', $dummy or croak "Unable to open temp file for writing"; print $IN qq{Hello world\n}; close $IN or croak "Unable to close temp file"; eval { $conf->genfile( $dummy => 'CFLAGS', file_type => 'makefile', comment_type => q{ image/svg+xml Parse Tree PIR Source PAST POST UserAgent.pir000644000765000765 3002112101554067 22237 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library/LWP# Copyright (C) 2010-2012, Parrot Foundation. =head1 NAME LWP - The World-Wide Web library for Parrot =head1 DESCRIPTION Simplified port of LWP::UserAgent (version 5.834) see http://search.cpan.org/dist/libwww-perl/ =head3 Class LWP;UserAgent =over 4 =cut .namespace ['LWP';'UserAgent'] .sub '' :init :load :anon load_bytecode 'URI.pbc' load_bytecode 'HTTP/Message.pbc' load_bytecode 'LWP/Protocol.pbc' $P0 = newclass ['LWP';'UserAgent'] $P0.'add_attribute'('def_headers') $P0.'add_attribute'('show_progress') $P0.'add_attribute'('progress_start') $P0.'add_attribute'('progress_lastp') $P0.'add_attribute'('progress_ani') $P0.'add_attribute'('max_redirect') $P0.'add_attribute'('proxy') $P0.'add_attribute'('no_proxy') .globalconst int RC_MOVED_PERMANENTLY = 301 .globalconst int RC_FOUND = 302 .globalconst int RC_SEE_OTHER = 303 .globalconst int RC_TEMPORARY_REDIRECT = 307 .globalconst int RC_UNAUTHORIZED = 401 .globalconst int RC_PROXY_AUTHENTICATION_REQUIRED = 407 .globalconst int RC_NOT_IMPLEMENTED = 501 .end .sub 'init' :vtable :method $P0 = new ['HTTP';'Headers'] $P0['User-Agent'] = 'libwww-parrot' setattribute self, 'def_headers', $P0 $P0 = box 7 setattribute self, 'max_redirect', $P0 $P0 = new 'Hash' setattribute self, 'proxy', $P0 $P0 = new 'ResizableStringArray' setattribute self, 'no_proxy', $P0 .end .sub 'send_request' :method .param pmc request .local string method method = request.'method'() .local pmc url url = request.'uri'() .local string scheme scheme = url.'scheme'() self.'progress'('begin', request) .local pmc proxy proxy = request.'proxy'() if null proxy goto L1 scheme = proxy.'scheme'() L1: .local pmc protocol, response $P0 =get_hll_global ['LWP';'Protocol'], 'create' protocol = $P0(scheme, self) unless null protocol goto L2 response = _new_response(request, RC_NOT_IMPLEMENTED, 'Not Implemented') goto L3 L2: response = protocol.'request'(request, proxy) setattribute response, 'request', request $P0 = get_hll_global ['HTTP';'Date'], 'time2str' $I0 = time $S0 = $P0($I0) response.'push_header'('Client-Date', $S0) L3: self.'progress'('end', response) .return (response) .end .sub 'prepare_request' :method .param pmc request $P0 = request.'method'() unless null $P0 goto L1 die "Method missing" L1: $P0 = request.'uri'() unless null $P0 goto L2 die "URL missing" L2: $S0 = $P0.'scheme'() unless $S0 == '' goto L3 die "URL must be absolute" L3: self.'_need_proxy'(request) $P0 = getattribute self, 'def_headers' $P1 = iter $P0 L4: unless $P1 goto L5 $S0 = shift $P1 $S1 = $P0[$S0] request.'push_header'($S0, $S1) goto L4 L5: .end .sub 'simple_request' :method .param pmc request unless null request goto L1 die "No request object passed in" L1: $I0 = isa request, ['HTTP';'Request'] if $I0 goto L2 die "You need a ['HTTP';'Request']" L2: self.'prepare_request'(request) .tailcall self.'send_request'(request) .end .sub 'request' :method .param pmc request .param pmc previous :optional .param int has_previous :opt_flag .local pmc response response = self.'simple_request'(request) unless has_previous goto L1 response.'previous'(previous) L1: .local int redirect $P0 = response.'redirect'() redirect = elements $P0 .local int max_redirect $P0 = getattribute self, 'max_redirect' max_redirect = $P0 unless redirect >= max_redirect goto L2 $S0 = 'Redirect loop detected (max_redirect = ' $S1 = max_redirect $S0 .= $S1 $S0 .= ')' response.'push_header'('Client-Warning', $S0) .return (response) L2: .local int code code = response.'code'() if code == RC_MOVED_PERMANENTLY goto L3 if code == RC_FOUND goto L3 if code == RC_SEE_OTHER goto L3 if code == RC_TEMPORARY_REDIRECT goto L3 goto L4 L3: .local pmc referral referral = clone request # These headers should never be forwarded referral.'remove_header'('Host') referral.'remove_header'('Cookie') # work in progress .local string referral_uri referral_uri = response.'get_header'('Location') $P0 = get_hll_global ['URI'], 'new_from_string' $P1 = $P0(referral_uri) $S0 = $P1.'scheme'() unless $S0 == '' goto L5 $P2 = new 'StringBuilder' $P3 = request.'uri'() $S0 = $P3.'scheme'() push $P2, $S0 push $P2, '://' $S0 = request.'get_header'('Host') push $P2, $S0 push $P2, referral_uri $P1 = $P0($P2) L5: setattribute referral, 'uri', $P1 # work in progress $I0 = self.'redirect_ok'(referral, response) if $I0 goto L6 .return (response) L6: .tailcall self.'request'(referral, response) L4: .local int proxy proxy = 0 .local string ch_header ch_header = 'WWW-Authenticate' if code == RC_UNAUTHORIZED goto L11 proxy = 1 ch_header = 'Proxy-Authenticate' if code == RC_PROXY_AUTHENTICATION_REQUIRED goto L11 goto L12 L11: .local string challenge challenge = response.'get_header'(ch_header) unless challenge == '' goto L13 response.'push_header'('Client-Warning', 'Missing Authenticate header') .return (response) L13: # work in progress print "# " say challenge L12: .return (response) .end =item get =cut .sub 'get' :method .param pmc args :slurpy .param pmc kv :slurpy :named .local pmc request $P0 = get_hll_global ['HTTP';'Request'], 'GET' request = $P0(args :flat, kv :flat :named) .tailcall self.'request'(request) .end =item head =cut .sub 'head' :method .param pmc args :slurpy .param pmc kv :slurpy :named .local pmc request $P0 = get_hll_global ['HTTP';'Request'], 'HEAD' request = $P0(args :flat, kv :flat :named) .tailcall self.'request'(request) .end =item post =cut .sub 'post' :method .param pmc args :slurpy .param pmc kv :slurpy :named .local pmc request $P0 = get_hll_global ['HTTP';'Request'], 'POST' request = $P0(args :flat, kv :flat :named) .tailcall self.'request'(request) .end =item put =cut .sub 'put' :method .param pmc args :slurpy .param pmc kv :slurpy :named .local pmc request $P0 = get_hll_global ['HTTP';'Request'], 'PUT' request = $P0(args :flat, kv :flat :named) .tailcall self.'request'(request) .end =item delete =cut .sub 'delete' :method .param pmc args :slurpy .param pmc kv :slurpy :named .local pmc request $P0 = get_hll_global ['HTTP';'Request'], 'DELETE' request = $P0(args :flat, kv :flat :named) .tailcall self.'request'(request) .end .sub 'progress' :method .param string status .param pmc msg .local pmc stderr stderr = getstderr $P0 = getattribute self, 'show_progress' if null $P0 goto L1 unless $P0 goto L1 unless status == 'begin' goto L2 print stderr, "** " $P0 = getattribute msg, 'method' print stderr, $P0 print stderr, " " $P0 = getattribute msg, 'uri' print stderr, $P0 print stderr, " ==> " $N1 = time $P0 = box $N1 setattribute self, 'progress_start', $P0 $P0 = box '' setattribute self, 'progress_lastp', $P0 $P0 = box 0 setattribute self, 'progress_ani', $P0 goto L1 L2: unless status == 'end' goto L3 $P0 = getattribute self, 'progress_start' $N1 = $P0 $N2 = time null $P0 setattribute self, 'progress_start', $P0 setattribute self, 'progress_lastp', $P0 setattribute self, 'progress_ani', $P0 $S0 = msg.'status_line'() print stderr, $S0 $N0 =$N2 - $N1 $I0 = $N0 unless $I0 goto L4 print stderr, " (" print stderr, $I0 print stderr, "s)" L4: print stderr, "\n" goto L1 L3: unless status == 'tick' goto L5 $P0 = getattribute self, 'progress_ani' inc $P0 $P0 %= 4 $P1 = split '', '-\|/' $S0 = $P1[$P0] print stderr, $S0 print stderr, "\b" goto L1 L5: $N0 = status $N0 *= 100 $P0 = new 'FixedFloatArray' set $P0, 1 $P0[0] = $N0 $S1 = sprintf '%3.0f%%', $P0 $P0 = getattribute self, 'progress_lastp' $S0 = $P0 if $S0 == $S1 goto L1 set $P0, $S1 print stderr, $S1 print stderr, "\b\b\b\b" L1: .end .sub 'redirect_ok' :method .param pmc new_request .param pmc response $P0 = response.'request'() $S0 = $P0.'method'() if $S0 == 'GET' goto L1 if $S0 == 'HEAD' goto L1 .return (0) L1: # work in progress .return (1) .end =item max_redirect =cut .sub 'max_redirect' :method .param pmc val setattribute self, 'max_redirect', val .end =item show_progress =cut .sub 'show_progress' :method .param pmc val setattribute self, 'show_progress', val .end =item agent =cut .sub 'agent' :method .param string val $P0 = getattribute self, 'def_headers' $P0['User-Agent'] = val .end .sub '_need_proxy' :method .param pmc req $P0 = req.'proxy'() unless null $P0 goto L1 .local pmc uri uri = req.'uri'() .local string scheme scheme = uri.'scheme'() $P0 = getattribute self, 'proxy' .local string proxy proxy = $P0[scheme] unless proxy goto L1 .local string host host = uri.'host'() $P0 = getattribute self, 'no_proxy' $P1 = iter $P0 L2: unless $P1 goto L3 $S0 = shift $P1 $I0 = index host, $S0 if $I0 < 0 goto L2 goto L1 L3: $P0 = get_hll_global ['URI'], 'new_from_string' $P0 = $P0(proxy) req.'proxy'($P0) L1: .end =item env_provy =cut .sub 'env_proxy' :method $P0 = new 'Env' $P1 = iter $P0 L1: unless $P1 goto L2 $S0 = shift $P1 $S1 = downcase $S0 $I0 = index $S1, '_proxy' if $I0 < 0 goto L1 $S2 = $P0[$S0] unless $S1 == 'no_proxy' goto L3 $P2 = split ',', $S2 $P3 = iter $P2 L4: unless $P3 goto L1 $S0 = shift $P3 $S0 = trim($S0) self.'no_proxy'($S0) goto L4 L3: $S3 = substr $S1, 0, $I0 # Ignore xxx_proxy variables if xxx isn't a supported protocol $P11 = new 'Key' set $P11, 'LWP' $P12 = new 'Key' set $P12, 'Protocol' push $P11, $P12 $P13 = new 'Key' set $P13, $S3 push $P11, $P13 $P10 = get_class $P11 if null $P10 goto L1 self.'proxy'($S3, $S2) goto L1 L2: .end .include 'cclass.pasm' .sub 'trim' :anon .param string str $I0 = length str $I0 = find_not_cclass .CCLASS_WHITESPACE, str, 0, $I0 str = substr str, $I0 $I0 = length str L1: dec $I0 unless $I0 > 0 goto L2 $I1 = is_cclass .CCLASS_WHITESPACE, str, $I0 if $I1 != 0 goto L1 L2: inc $I0 str = substr str, 0, $I0 .return (str) .end =item proxy =cut .sub 'proxy' :method .param string scheme .param string url $P0 = getattribute self, 'proxy' $P0[scheme] = url .end =item no_proxy =cut .sub 'no_proxy' :method .param pmc args :slurpy $I0 = elements args if $I0 goto L1 $P0 = new 'ResizableStringArray' setattribute self, 'no_proxy', $P0 goto L2 L1: $P0 = getattribute self, 'no_proxy' L3: unless args goto L2 $S0 = shift args push $P0, $S0 goto L3 L2: .end .sub '_new_response' .param pmc request .param pmc code .param pmc message .local pmc response response = new ['HTTP';'Response'] setattribute response, 'code', code setattribute response, 'message', message setattribute response, 'request', request $P0 = get_hll_global ['HTTP';'Date'], 'time2str' $I0 = time $S0 = $P0($I0) response.'push_header'('Client-Date', $S0) response.'push_header'('Client-Warning', "Internal response") response.'push_header'('Content-Type', 'text/plain') $S0 = code $S0 .= ' ' $S1 = message $S0 .= $S1 $S0 .= "\n" $P0 = box $S0 setattribute response, 'content', $P0 .return (response) .end =back =head1 AUTHOR Francois Perrad =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: test_c.in000644000765000765 65611567202622 17504 0ustar00brucebruce000000000000parrot-5.9.0/config/auto/stat/* Copyright (C) 2010, Parrot Foundation. seeing if struct stat has BSD extensions */ #include #include #include int main() { struct stat st; st.st_blocks = 22; st.st_blksize = 500; printf("OK: %d %d", st.st_blocks, st.st_blksize); return EXIT_SUCCESS; } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ pmclist.pmc000644000765000765 2622212171255037 16262 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2010-2012, Parrot Foundation. $Id$ =head1 NAME src/pmc/pmclist.pmc - List of PMCs =head1 DESCRIPTION A doubly linked list of PMCs, for when push, pop, shift, and unshift all want to be O(1). =head2 Vtable Functions =over 4 =cut */ BEGIN_PMC_HEADER_PREAMBLE PARROT_EXPORT void Parrot_pmc_list_insert_by_number(PARROT_INTERP, PMC *list, PMC *value); END_PMC_HEADER_PREAMBLE /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_DOES_NOT_RETURN static void throw_pop_empty(PARROT_INTERP) __attribute__nonnull__(1); PARROT_DOES_NOT_RETURN static void throw_shift_empty(PARROT_INTERP) __attribute__nonnull__(1); #define ASSERT_ARGS_throw_pop_empty __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_throw_shift_empty __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* It's a doubly linked list */ typedef struct PMC_List_Item { PMC *data; struct PMC_List_Item *prev; struct PMC_List_Item *next; } PMC_List_Item; pmclass PMCList auto_attrs { ATTR void *head; ATTR void *foot; ATTR INTVAL size; /* =item C Initializes the list. =cut */ VTABLE void init() { PObj_custom_mark_SET(SELF); PObj_custom_destroy_SET(SELF); SET_ATTR_head(INTERP, SELF, NULL); SET_ATTR_foot(INTERP, SELF, NULL); SET_ATTR_size(INTERP, SELF, 0); } /* =item C Free all the list cells. =cut */ VTABLE void destroy() { void *tmp; PMC_List_Item *aa; GET_ATTR_head(INTERP, SELF, tmp); aa = (PMC_List_Item*) tmp; while (aa != NULL) { PMC_List_Item * const bb = aa; aa = aa->next; free(bb); } } /* =item C Returns the size of the list. =cut */ VTABLE INTVAL get_integer() { INTVAL size; GET_ATTR_size(INTERP, SELF, size); return size; } VTABLE INTVAL elements() { INTVAL size; GET_ATTR_size(INTERP, SELF, size); return size; } /* =item C Removes and returns an item from the start of the array. =cut */ VTABLE PMC *shift_pmc() { INTVAL size; void *tmp; PMC_List_Item *head; PMC_List_Item *item; PMC *data; GET_ATTR_size(INTERP, SELF, size); if (0 >= size) throw_shift_empty(INTERP); GET_ATTR_head(INTERP, SELF, tmp); item = (PMC_List_Item*) tmp; data = item->data; size -= 1; SET_ATTR_size(INTERP, SELF, size); head = item->next; SET_ATTR_head(INTERP, SELF, head); if (head == NULL) { /* size == 0 */ SET_ATTR_foot(INTERP, SELF, NULL); } else { head->prev = NULL; } if (size == 1) { head->next = NULL; SET_ATTR_foot(INTERP, SELF, head); } free(item); return data; } /* =item C Extends the array by adding an element of value C<*value> to the end of the array. =cut */ VTABLE void push_pmc(PMC *value) { INTVAL size; void *tmp; PMC_List_Item *foot; PMC_List_Item *item; GET_ATTR_size(INTERP, SELF, size); GET_ATTR_foot(INTERP, SELF, tmp); foot = (PMC_List_Item*) tmp; item = (PMC_List_Item*) malloc(sizeof (PMC_List_Item)); item->next = NULL; item->prev = foot; item->data = value; if (foot) foot->next = item; size += 1; SET_ATTR_foot(INTERP, SELF, item); SET_ATTR_size(INTERP, SELF, size); if (size == 1) SET_ATTR_head(INTERP, SELF, item); return; } /* =item C Removes and returns the last element in the array. =cut */ VTABLE PMC *pop_pmc() { INTVAL size; void *tmp; PMC_List_Item *foot; PMC_List_Item *item; PMC *data; GET_ATTR_size(INTERP, SELF, size); if (0 >= size) throw_pop_empty(INTERP); GET_ATTR_foot(INTERP, SELF, tmp); item = (PMC_List_Item*) tmp; data = item->data; size -= 1; SET_ATTR_size(INTERP, SELF, size); foot = item->prev; SET_ATTR_foot(INTERP, SELF, foot); if (foot == NULL) { /* size == 0 */ SET_ATTR_head(INTERP, SELF, NULL); } else { foot->next = NULL; } if (size == 1) { foot->prev = NULL; SET_ATTR_head(INTERP, SELF, foot); } free(item); return data; } /* =item C Extends the array by adding an element of value C<*value> to the begin of the array. =cut */ VTABLE void unshift_pmc(PMC *value) { INTVAL size; void *tmp; PMC_List_Item *head; PMC_List_Item *item; GET_ATTR_size(INTERP, SELF, size); GET_ATTR_head(INTERP, SELF, tmp); head = (PMC_List_Item*) tmp; item = (PMC_List_Item*) malloc(sizeof (PMC_List_Item)); item->prev = NULL; item->next = head; item->data = value; if (head) head->prev = item; size += 1; SET_ATTR_head(INTERP, SELF, item); SET_ATTR_size(INTERP, SELF, size); if (size == 1) SET_ATTR_foot(INTERP, SELF, item); return; } /* =item C Creates and returns a copy of the list. =cut */ VTABLE PMC *clone() { PMC * const copy = Parrot_pmc_new(INTERP, SELF->vtable->base_type); void* tmp; PMC_List_Item *it; GET_ATTR_head(INTERP, SELF, tmp); it = (PMC_List_Item*) tmp; while (it != NULL) { VTABLE_push_pmc(INTERP, copy, it->data); it = it->next; } return copy; } /* =item C Returns the Parrot string representation C. =cut */ VTABLE STRING *get_repr() { PMC_List_Item *it; void* tmp; STRING *res = CONST_STRING(INTERP, "[ "); STRING * const space = CONST_STRING(INTERP, " "); GET_ATTR_head(INTERP, SELF, tmp); it = (PMC_List_Item*) tmp; while (it != NULL) { res = Parrot_str_concat(INTERP, res, VTABLE_get_repr(INTERP, it->data)); res = Parrot_str_concat(INTERP, res, space); it = it->next; } return Parrot_str_concat(INTERP, res, CONST_STRING(INTERP, "]")); } VTABLE STRING *get_string() { return VTABLE_get_repr(INTERP, SELF); } /* =item C This is used by freeze/thaw to visit the contents of the array. C<*info> is the visit info, (see F). =item C Used to archive the array. =item C Used to unarchive the array. =cut */ VTABLE void visit(PMC *info) { void* tmp; PMC_List_Item *it; GET_ATTR_head(INTERP, SELF, tmp); it = (PMC_List_Item*) tmp; while (it != NULL) { VISIT_PMC(INTERP, info, it->data); it = it->next; } SUPER(info); } VTABLE void freeze(PMC *info) { SUPER(info); VTABLE_push_integer(INTERP, info, VTABLE_get_integer(INTERP, SELF)); } VTABLE void thaw(PMC *info) { int n, i; SUPER(info); n = VTABLE_shift_integer(INTERP, info); SET_ATTR_size(INTERP, SELF, n); for (i = 0; i < n; ++i) VTABLE_push_pmc(INTERP, SELF, PMCNULL); } /* =item C Mark the stuff. =cut */ VTABLE void mark() { void* tmp; PMC_List_Item *it; GET_ATTR_head(INTERP, SELF, tmp); it = (PMC_List_Item*) tmp; while (it != NULL) { if (!PObj_is_PMC_TEST(it->data)) PANIC(INTERP, "PMCList: Pointer is not a valid PMC"); Parrot_gc_mark_PMC_alive(INTERP, it->data); it = it->next; } } /* =item METHOD PMC* shift() =item METHOD PMC* pop() Method forms to remove and return a PMC from the beginning or end of the array. =cut */ METHOD shift() { PMC * const value = VTABLE_shift_pmc(INTERP, SELF); RETURN(PMC *value); } METHOD pop() { PMC * const value = VTABLE_pop_pmc(INTERP, SELF); RETURN(PMC *value); } /* =item METHOD unshift(PMC* value) =item METHOD push(PMC* value) Method forms to add a PMC to the beginning or end of the array. =cut */ METHOD unshift(PMC* value) { VTABLE_unshift_pmc(INTERP, SELF, value); } METHOD push(PMC* value) { VTABLE_push_pmc(INTERP, SELF, value); } /* =item METHOD insert_by_number(PMC* value) Inserts an item into an ordered list by it's number value. =cut */ METHOD insert_by_number(PMC* value) { Parrot_pmc_list_insert_by_number(INTERP, SELF, value); } } /* =back =head2 Auxiliary functions =over 4 =item C Insert an item into a sorted list by its num value. =cut */ PARROT_EXPORT void Parrot_pmc_list_insert_by_number(PARROT_INTERP, PMC *list, PMC *value) { void *tmp; PMC_List_Item *item; FLOATVAL vkey; int size; GETATTR_PMCList_size(interp, list, size); GETATTR_PMCList_head(interp, list, tmp); item = (PMC_List_Item*) malloc(sizeof (PMC_List_Item)); item->data = value; item->next = (PMC_List_Item*) tmp; item->prev = NULL; vkey = VTABLE_get_number(interp, value); /* Find the list item to insert before */ while (item->next != NULL) { const FLOATVAL ikey = VTABLE_get_number(interp, item->next->data); if (ikey > vkey) break; item->prev = item->next; item->next = item->next->next; } if (item->next == NULL) { SETATTR_PMCList_foot(interp, list, item); } else { item->next->prev = item; } if (item->prev == NULL) { SETATTR_PMCList_head(interp, list, item); } else { item->prev->next = item; } SETATTR_PMCList_size(interp, list, size + 1); } /* =item C =item C Throws with the appropiate message. =cut */ PARROT_DOES_NOT_RETURN static void throw_shift_empty(PARROT_INTERP) { ASSERT_ARGS(throw_shift_empty) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS, "PMCList: Can't shift from an empty list!"); } PARROT_DOES_NOT_RETURN static void throw_pop_empty(PARROT_INTERP) { ASSERT_ARGS(throw_pop_empty) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS, "PMCList: Can't pop from an empty list!"); } /* =back =head1 See also F. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ filetype_parrot.vim000644000765000765 21711533177634 17716 0ustar00brucebruce000000000000parrot-5.9.0/editorau BufNewFile,BufRead *.pmc set ft=pmc cindent au BufNewFile,BufRead *.pasm set ft=pasm ai sw=4 au BufNewFile,BufRead *.pir set ft=pir ai sw=4 progs-03.t000644000765000765 500111567202625 16774 0ustar00brucebruce000000000000parrot-5.9.0/t/steps/inter#! perl # Copyright (C) 2007, Parrot Foundation. # inter/progs-03.t use strict; use warnings; use Test::More tests => 9; use Carp; use lib qw( lib t/configure/testlib ); use_ok('config::inter::progs'); use Parrot::Configure::Options qw( process_options ); use Parrot::Configure::Step::Test; use Parrot::Configure::Test qw( test_step_constructor_and_description ); use Tie::Filehandle::Preempt::Stdin; use IO::CaptureOutput qw| capture |; =for hints_for_testing Testing and refactoring of inter::progs should entail understanding of issues discussed in https://trac.parrot.org/parrot/ticket/854 =cut ########### ask ########## my ($args, $step_list_ref) = process_options( { argv => [q{--ask}], mode => q{configure}, } ); my $conf = Parrot::Configure::Step::Test->new; $conf->include_config_results( $args ); my $pkg = q{inter::progs}; $conf->add_steps($pkg); $conf->options->set( %{$args} ); my $step = test_step_constructor_and_description($conf); my @prompts; my $object; my ($stdout, $debug, $debug_validity); foreach my $p ( qw| cc cxx link ar ld ccflags linkflags arflags ldflags libs | ) { push @prompts, $conf->data->get($p); } push @prompts, q{n}; $object = tie *STDIN, 'Tie::Filehandle::Preempt::Stdin', @prompts; can_ok( 'Tie::Filehandle::Preempt::Stdin', ('READLINE') ); isa_ok( $object, 'Tie::Filehandle::Preempt::Stdin' ); capture( sub { my $ask = inter::progs::_prepare_for_interactivity($conf); my $cc; ($conf, $cc) = inter::progs::_get_programs($conf, $ask); $debug = inter::progs::_get_debug($conf, $ask); $debug_validity = inter::progs::_is_debug_setting_valid($debug); }, \$stdout); ok( defined $debug_validity, "'debug_validity' set as expected" ); capture( sub { $conf = inter::progs::_set_debug_and_warn($conf, $debug); }, \$stdout); ok( defined $conf, "Components of runstep() tested okay" ); $object = undef; untie *STDIN; pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME inter/progs-03.t - test inter::progs =head1 SYNOPSIS % prove t/steps/inter/progs-03.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file test inter::progs. =head1 AUTHOR James E Keenan =head1 SEE ALSO config::inter::progs, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: snprintf.pm000644000765000765 246011533177633 17142 0ustar00brucebruce000000000000parrot-5.9.0/config/auto# Copyright (C) 2001-2009, Parrot Foundation. =head1 NAME config/auto/snprintf.pm - Test for snprintf =head1 DESCRIPTION Tests if snprintf is present and if it's C99 compliant. =cut package auto::snprintf; use strict; use warnings; use base qw(Parrot::Configure::Step); sub _init { my $self = shift; my %data; $data{description} = q{Test snprintf}; $data{result} = q{}; return \%data; } sub runstep { my ( $self, $conf ) = @_; my $res = _probe_for_snprintf($conf); $self->_evaluate_snprintf($conf, $res); return 1; } sub _probe_for_snprintf { my $conf = shift; $conf->cc_gen('config/auto/snprintf/test_c.in'); $conf->cc_build(); my $res = $conf->cc_run() or die "Can't run the snprintf testing program: $!"; $conf->cc_clean(); return $res; } sub _evaluate_snprintf { my ($self, $conf, $res) = @_; if ( $res =~ /snprintf/ ) { $conf->data->set( HAS_SNPRINTF => 1 ); } if ( $res =~ /^C99 snprintf/ ) { $conf->data->set( HAS_C99_SNPRINTF => 1 ); } elsif ( $res =~ /^old snprintf/ ) { $conf->data->set( HAS_OLD_SNPRINTF => 1 ); } $conf->debug(" ($res) "); return 1; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: ch12_operator_reference.pod000644000765000765 1501411533177634 22720 0ustar00brucebruce000000000000parrot-5.9.0/docs/book/draft=pod =head1 PIR Operator Reference Z X This section is a quick reference to PIR instructions. For more details and the latest changes, see F or dive into the source code in F and F. =head3 = X<= (equal sign);= (assignment);instruction (PIR)> R = R Assign a value to a particular register, temporary register, or named variable. =head3 +, += X<+ (plus sign);+ (addition);instruction (PIR)> X<+ (plus sign);+= (addition assignment);instruction (PIR)> R = R + R R += R Add two numbers or PMCs. =head3 -, -= X<- (hyphen);- (subtraction);instruction (PIR)> X<- (hyphen);-= (subtraction assignment);instruction (PIR)> X<- (hyphen);- (negation);instruction (PIR)> R = R - R R -= R R = - R Subtract R from R. The unary "C<->" negates a number. =head3 *, *= X<* (asterisk);* (multiplication);instruction (PIR)> X<* (asterisk);*= (multiplication assignment);instruction (PIR)> R = R * R R *= R Multiply two numbers or PMCs. =head3 /, /= X X R = R / R R /= R Divide R by R. =head3 ** X<* (asterisk);** (exponentiation);instruction (PIR)> R = R ** R Raise R to the power of R. =head3 %, %= X<% (percent sign);% (modulus);instruction (PIR)> X<% (percent sign);%= (modulus assignment);instruction (PIR)> R = R % R R %= R Divide R by R and return the (C) remainder. =head3 ., .= X<. (dot);. (concatenation) instruction (PIR)> X<. (dot);.= (concatenation assignment) instruction (PIR)> R = R . R R .= R Concatenate two strings. The concat operator must be surrounded by whitespace. =head3 E X (left angle bracket);E (less than);instruction (PIR)> if R E R goto R

of the release manager guide (F<'/docs/project/release_manager_guide.pod'>). Specifically, this document assumes you have already ran C and (2) you are working with the 'parrot-docs4' repository in which to archive the previous Parrot documentation release.[2] =back =head2 Get the 'parrot.github.com' and supporting 'parrot-docsx' repositories The first step is to obtain the two repositories: (1) 'parrot.github.com' and (2) the relevant repository in which to archive the previous version of Parrot's documentation, here, 'parrot-docs4'. To do this, clone the two Parrot repositories with the following commands: =over 4 C C =back =head2 The 'parrot-docsx' repository C to the C directory and C the C branch of the repo: =over 4 C =back You may confirm the C branch with the following command: =over 4 C =back Next, make a new directory in which to house the old documentation. For example,[4] =over 4 C =back If you still have a copy of the previous release of Parrot's documentation, I all of the documents 'docs/' directory, to include the html-ized documentation, you can just copy the entire contents of C<'docs/'> to the newly created directory in the, in this example, C repository. If not, you will need to do the following: =over 4 =item 1 Obtain the C of the previous Parrot distribution at C; =item 2 unzip the distribution into a temporary working directory; =item 3 run C[3] on the distribution; =item 4 run C; and =item 5 copy the contents of the C directory to the newly created directory in the C repo. =back Once the contents of the C directory are in the newly created directory in C, it's time to commit and push the updates: =over 4 C C (or some such) =back And, lastly, =over 4 C =back You are done with the 'parrot-docsx' repository. =head2 The 'parrot.github.com' repository After completing the above, it's time to move the new docs, I the present release documentation, to the 'parrot.github.com' repository. To accomplish this, =over 4 =item 1 save, in some temporary location, the following four documents: F; F; and F; and F. =item 2 After saving the above files, the simplest way to proceed is to delete all of the files in 'parrot.github.com'. Since you will need to keep both the F<.git> directory and the F<.gitignore> file, C works nicely for this. It's a good idea to go ahead and commit the changes at this time, so execute, =over 4 C =back and =over 4 C (or some such) =back =item 3 Next, copy all of the files and directories in 'docs/' in the newly installed distribution of Parrot to 'parrot.github.com' and =item 4 Add and commit these changes to 'parrot.github.com'. =item 5 Copy the four files you saved earlier, I, F, F, F, and F, back to 'parrot.github.com'. =back Now, you need to hand-edit both F and F. Open F in your favorite editor and update the header and footer to reflect the present release version. That is, edit, for example, the line =over 4 Parrot 4.0.0-devel - Home =back to read =over 4 Parrot 4.1.0 - Home =back and also edit the line =over 4
Parrot version 4.0.0-devel =back to read =over 4
Parrot version 4.1.0 =back You also need to update the text accompanying the link to C<./releases.html>. Edit, again, for example, the line =over 4 Previous Parrot Documentation Releases (3.9.0 - 0.1.1) =back to read =over 4 Previous Parrot Documentation Releases (4.0.0 - 0.1.1) =back Save your edits.[5] Next, open F in your editor and make the following edits: =over 4 =item 1 Edit the header and footer, just as you did above in F. =item 2 Copy and paste a new list element to point to the earlier release you archived in the 'parrot-docs4' repository. For example, copy the line, =over 4
  • Release 3.9.0
    • =back and paste it in as the first element of the list. Edit it to read, =over 4
  • Release 4.0.0
    • =back =back Save your edits. Finally, you are now ready to commit and push your updates to 'parrot.github.com': =over 4 C C (or some such message) C =back It will take anywhere from one to ten (or, occasionally, even fifteen) minutes for 'parrot.github.com' to rebuild. Once it does, you need test your updates. You may do so by navigating your browser to 'http://parrot.github.com' and verifying your changes. Also, please ensure you test the link to the archived documents in the 'parrot-docs4' repository. If everything works correctly, congratulations, you're done with both the 'parrot.github.com' and the 'parrot-docs' repositories! =head1 FOOTNOTES [1] For the present, we have elected to retain this document, primarily, for historical purposes and as a reference document for future release managers. [2] If you are working with a release of Parrot's documentation greater than v4.x.x and you do not have, for example, a 'parrot-docs5' repository, you will need to contact an "owner" and ask him or her to create a new repository. You will, then, need to follow all of the steps outlined in Github's gh-pages guide at 'http://pages.github.com/' to set up the repository. [3] Here, you do NOT need to worry with any optimizations when configuring Parrot because you only need the previous documentation release. [4] Unless there is good reason to do otherwise, please name the newly created directory after the F of the Parrot distribution you are archiving in the repo. Here, in our example, C<4.0.0>. [5] Please note: The newly archived release will I be one less than the release on which you are presently working. That is, the release you just cut. =head1 COPYRIGHT Copyright (C) 2001-2012, Parrot Foundation. =cut extend.c000644000765000765 2014512101554067 14756 0ustar00brucebruce000000000000parrot-5.9.0/src/* Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME src/extend.c - Parrot extension interface =head1 DESCRIPTION These are utility functions which extension code may use, but which are typically not used by Parrot internally. These functions are for EXTENDING use only, not for EMBEDDING. Embedding should be handed through the embedding API with c files in directory src/embed/. Extending situations are things like NCI function libraries, dyn-pmc and dyn-op libraries which are loaded into Parrot and called from Parrot (as opposed to embedding, where an external program calls into Parrot). These functions assume the existance of an interpreter, memory management through GC and stackwalking, and the presence of an exception-handling infrastructure. =head2 Functions =over 4 =cut */ /* DO NOT CALL THESE FUNCTIONS WITHOUT LIBPARROT, OR FROM OUTSIDE LIBPARROT!! These functions presume that GC is available and is properly configured (setting the stacktop for stack walking, etc) and that there is an active exception-handling infrastructure. Calling these functions when there are no exception handlers available, including a default top-level handler, or when the GC is not properly initialized can lead to big problems. Be sure to understand the difference between an embedding and an extending situation. Using the wrong kind of function in the wrong situation, or combining some functions from the Embedding API with functions from the Extending API is a recipe for disaster. We (Parrot developers) will not be held responsible if you insist on making these kinds of mistakes. If there are utility functions that *YOU* as a user of parrot need from either the extending or the embedding API, please request them or attempt to write them yourself. Blindly mixing things from the wrong API, or calling a function in the wrong context will cause you problems. You have been warned. Notice that the "Extending API" is a loosely-defined concept which is currently understood to mean the sum of public APIs for various subsystems. This definition may change in the future, but this is what we mean by the phrase right now. The functions in this file do not belong to any particular subsystem, and are always part of the extending API. Functions named "Parrot_xxx_..." where "xxx" is a 2- or 3-letter subsystem abbreviation and which are marked with "PARROT_EXPORT" can generally be considered to be part of the public API. Subsystems which are properly arranged will typically have a folder src/xxx/, and an "api.c" file therein for holding API functions from that subsystem. Many of the bigger systems are arranged in this way (and the rest of the systems will be eventually). If so, that is the canonical source of information regarding API functions for that subsystem. Other documentation sources, such as the PDDs or other files in the docs/ directory may include other information about the extending API. */ #include "parrot/parrot.h" #include "parrot/extend.h" #include "parrot/events.h" #include "pmc/pmc_sub.h" #include "pmc/pmc_callcontext.h" /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void restore_context(PARROT_INTERP, ARGIN(Parrot_Context * const initialctx)) __attribute__nonnull__(1) __attribute__nonnull__(2); #define ASSERT_ARGS_restore_context __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(initialctx)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* HEADERIZER HFILE: include/parrot/extend.h */ /* =item C Returns the internal identifier that represents the named class. DEPRECATED. Use Parrot_pmc_get_type_str instead. =cut */ PARROT_EXPORT Parrot_Int Parrot_PMC_typenum(PARROT_INTERP, ARGIN_NULLOK(const char *_class)) { ASSERT_ARGS(Parrot_PMC_typenum) Parrot_Int retval = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, _class, 0)); return retval; } /* =item C Call a Parrot subroutine or method with the given function signature. The function signature holds one type character for each argument or return, these are: I ... Parrot_Int N ... Parrot_Float S ... Parrot_String P ... Parrot_PMC Returns come after the arguments, separated by an arrow, so "PN->S" takes a PMC and a float as arguments and returns a string. Pass the variables for the arguments and returns in the same order as the signature, with returns as reference to the variable (so it can be modified). Parrot_ext_call(interp, sub, "P->S", pmc_arg, &string_result); To call a method, pass the object for the method as the first argument, and mark it in the signature as "Pi" ("i" stands for "invocant"). Parrot_ext_call(interp, sub, "PiP->S", object_arg, pmc_arg, &string_result); =cut */ PARROT_EXPORT void Parrot_ext_call(PARROT_INTERP, ARGIN(Parrot_PMC sub_pmc), ARGIN(const char *signature), ...) { ASSERT_ARGS(Parrot_ext_call) va_list args; PMC *call_obj; const char *arg_sig, *ret_sig; PMC * old_call_obj = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); Parrot_pcc_split_signature_string(signature, &arg_sig, &ret_sig); va_start(args, signature); call_obj = Parrot_pcc_build_call_from_varargs(interp, PMCNULL, arg_sig, &args); Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, call_obj); call_obj = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); Parrot_pcc_fill_params_from_varargs(interp, call_obj, ret_sig, &args, PARROT_ERRORS_RESULT_COUNT_FLAG); va_end(args); Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_call_obj); } /* =item C Helper function to restore the caller context in Parrot_ext_try. =cut */ static void restore_context(PARROT_INTERP, ARGIN(Parrot_Context * const initialctx)) { ASSERT_ARGS(restore_context) Parrot_Context *curctx = CONTEXT(interp); if (curctx != initialctx) { Parrot_warn((interp), PARROT_WARNINGS_NONE_FLAG, "popping context in Parrot_ext_try"); do { Parrot_pop_context(interp); curctx = CONTEXT(interp); if (curctx == NULL) PANIC(interp, "cannot restore context"); } while (curctx != initialctx); } } /* =item C Executes the cfunction argument wrapped in a exception handler. If the function throws, the provided handler function is invoked =cut */ PARROT_EXPORT void Parrot_ext_try(PARROT_INTERP, ARGIN_NULLOK(void (*cfunction)(Parrot_Interp, ARGIN_NULLOK(void *))), ARGIN_NULLOK(void (*chandler)(Parrot_Interp, ARGIN_NULLOK(PMC *), ARGIN_NULLOK(void *))), ARGIN_NULLOK(void *data)) { ASSERT_ARGS(Parrot_ext_try) if (cfunction) { Parrot_runloop jmp; Parrot_Context * const initialctx = CONTEXT(interp); switch (setjmp(jmp.resume)) { case 0: /* try */ Parrot_ex_add_c_handler(interp, &jmp); (*cfunction)(interp, data); restore_context(interp, initialctx); Parrot_cx_delete_handler_local(interp); break; default: /* catch */ { PMC *exception = jmp.exception; restore_context(interp, initialctx); Parrot_cx_delete_handler_local(interp); if (chandler) (*chandler)(interp, exception, data); } } } } /* =back =head1 SEE ALSO See F and F. =head1 HISTORY Initial version by Dan Sugalski. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ debug.t000644000765000765 1105312101554067 16253 0ustar00brucebruce000000000000parrot-5.9.0/t/dynoplibs#!perl # Copyright (C) 2001-2007, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Test tests => 10; use Parrot::Config; use Parrot::Test::Util 'create_tempfile'; =head1 NAME t/op/debuginfo.t - Debugging Info =head1 SYNOPSIS % prove t/op/debuginfo.t =head1 DESCRIPTION Tests the various set and get operations for line, package and file info, as well as backtrace tests. =cut $ENV{TEST_PROG_ARGS} ||= ''; my $nolineno = $ENV{TEST_PROG_ARGS} =~ /--runcore=fast/ ? "\\(unknown file\\)\n-1" : "debug_\\d+\\.pasm\n\\d"; #SKIP: { #skip "disabled on fast-core",1 if $ENV{TEST_PROG_ARGS} =~ /--runcore=fast/; pasm_output_like( <<'CODE', <<"OUTPUT", "getline, getfile" ); .loadlib 'debug_ops' .pcc_sub :main main: getfile S0 getline I0 say S0 say I0 end CODE /$nolineno/ OUTPUT pir_output_like( <<'CODE', <<"OUTPUT", "debug_print" ); .loadlib 'debug_ops' .sub main :main debug_init $I0 = 1 $S0 = "foo" $N0 = 3.1 $P0 = new ['String'] $P0 = "bar" debug_print .end CODE / I0 = 1 N0 = 3.1 S0 = foo P0 = String=PMC[(]0x[a-f0-9]+ Str:"bar"[)] / OUTPUT open STDERR, ">>&STDOUT"; pir_output_like( <<'CODE', <<"OUTPUT", "debug_print without debugger" ); .loadlib 'debug_ops' .sub main :main push_eh eh debug_print goto finally eh: .get_results($P0) say $P0 finally: pop_eh .end CODE /Initialize debugger with debug_init before using debug_print/ OUTPUT pir_output_like( <<'CODE', <<"OUTPUT", "debug_backtrace" ); .loadlib 'debug_ops' .sub main :main debug_init backtrace say "ok" .end CODE /ok/ OUTPUT SKIP: { skip("This test is failing for no apparent reason on windows", 1); pir_stdin_output_like( <<'INPUT', <<'CODE', qr/[(]pdb[)] (print I0\n)?1/, "debug_break" ); print I0 quit INPUT .loadlib 'debug_ops' .sub main :main debug_init $I0 = 1 debug_break .end CODE } pir_error_output_like( <<'CODE', <<'OUTPUT', "debug backtrace - Null PMC access" ); .sub main :main print "ok 1\n" a() print "not ok 10\n" .end .sub a print "ok 2\n" b() print "not ok 9\n" .end .sub b print "ok 3\n" c() print "not ok 8\n" .end .sub c print "ok 4\n" d() print "not ok 7\n" .end .sub d print "ok 5\n" $P0 = null $P0() print "not ok 6\n" .end CODE /^ok 1 ok 2 ok 3 ok 4 ok 5 Null PMC access in invoke\(\) current instr\.: 'd' pc (\d+|-1) \(.*?:(\d+|-1)\) called from Sub 'c' pc (\d+|-1) \(.*?:(\d+|-1)\) called from Sub 'b' pc (\d+|-1) \(.*?:(\d+|-1)\) called from Sub 'a' pc (\d+|-1) \(.*?:(\d+|-1)\) called from Sub 'main' pc (\d+|-1) \(.*?:(\d+|-1)\)$/ OUTPUT pir_error_output_like( <<'CODE', <<'OUTPUT', "debug backtrace - method not found" ); .namespace ["Test1"] .sub main :main print "ok 1\n" foo() print "not ok 5\n" .end .sub foo print "ok 2\n" $P0 = new 'Integer' print "ok 3\n" $P0."nosuchmethod"() print "not ok 4\n" .end CODE /^ok 1 ok 2 ok 3 Method 'nosuchmethod' not found for invocant of class 'Integer' current instr.: 'parrot;Test1;foo' pc (\d+|-1) \(.*?:(\d+|-1)\) called from Sub 'parrot;Test1;main' pc (\d+|-1) \(.*?:(\d+|-1)\)$/ OUTPUT pir_error_output_like( <<'CODE', <<'OUTPUT', "debug backtrace - division by 0" ); .namespace ["Test2"] .sub main :main print "ok 1\n" foo() print "not ok 3\n" .end .sub foo :lex print "ok 2\n" $I1 = 0 div $I2, $I2, 0 print "not ok 3\n" .end CODE /^ok 1 ok 2 Divide by zero current instr.: 'parrot;Test2;foo' pc (\d+|-1) \(.*?:(\d+|-1)\) called from Sub 'parrot;Test2;main' pc (\d+|-1) \(.*?:(\d+|-1)\)$/ OUTPUT pir_error_output_like( <<'CODE', <<'OUTPUT', "debug backtrace - recursion 1" ); .sub main :main main() .end CODE /^maximum recursion depth exceeded current instr\.: 'main' pc (\d+|-1) \(.*?:(\d+|-1)\) called from Sub 'main' pc (\d+|-1) \(.*?:(\d+|-1)\) \.\.\. call repeated \d+ times/ OUTPUT pir_error_output_like( <<'CODE', <<'OUTPUT', "debug backtrace - recursion 2" ); .sub main :main rec(91) .end .sub rec .param int i if i == 0 goto END dec i rec(i) .return() END: $P0 = null $P0() .end CODE /^Null PMC access in invoke\(\) current instr\.: 'rec' pc (\d+|-1) \(.*?:(\d+|-1)\) called from Sub 'rec' pc (\d+|-1) \(.*?:(\d+|-1)\) \.\.\. call repeated 90 times called from Sub 'main' pc (\d+|-1) \(.*?:(\d+|-1)\)$/ OUTPUT $nolineno = $ENV{TEST_PROG_ARGS} =~ /--runcore=fast/ ? '\(\(unknown file\):-1\)' : '\(xyz.pir:126\)'; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: rotest.pmc000644000765000765 133312101554067 16614 0ustar00brucebruce000000000000parrot-5.9.0/src/dynpmc/* * Copyright (C) 2006-2012, Parrot Foundation. */ /* * Sample class used to verify read-only variant * generation. For testing only. */ pmclass ROTest dynpmc provides scalar extends Integer auto_attrs { VTABLE void set_integer_native(INTVAL value) :read { UNUSED(INTERP) UNUSED(SELF) UNUSED(value) } VTABLE INTVAL get_integer() :write { UNUSED(INTERP) UNUSED(SELF) return 42; } METHOD reader() { RETURN(INTVAL 43); } METHOD writer(INTVAL ignored) :write { UNUSED(ignored); RETURN(INTVAL 44); } } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ pod2man.pm000644000765000765 265012101554066 16627 0ustar00brucebruce000000000000parrot-5.9.0/config/auto# Copyright (C) 2008-2012, Parrot Foundation. =head1 NAME config/auto/pod2man - Check whether pod2man works =head1 DESCRIPTION Determines whether F exists on the system and where. More specifically, we look for the F associated with the instance of F with which F was invoked. =cut package auto::pod2man; use strict; use warnings; use base qw(Parrot::Configure::Step); use Parrot::Configure::Utils ':auto'; sub _init { my $self = shift; my %data; $data{description} = q{Is pod2man installed}; $data{result} = q{}; return \%data; } sub runstep { my ( $self, $conf ) = @_; my $slash = $conf->data->get('slash'); my $cmd = $conf->data->get('scriptdirexp_provisional') . $slash . q{pod2man}; my $content = capture_output("$cmd docs/parrot.pod") || undef; return 1 unless defined( $self->_initial_content_check($conf, $content) ); $conf->data->set( has_pod2man => 1, pod2man => $cmd ); return 1; } sub _initial_content_check { my $self = shift; my ($conf, $content) = @_; if (! defined $content) { $conf->data->set( has_pod2man => 0, ); $self->set_result('no'); return; } else { $self->set_result('yes'); return 1; } } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: Tester.pir000644000765000765 2622611567202624 23473 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library/Test/Builder =head1 NAME Test::Builder::Tester - Parrot extension for testing test modules =head1 SYNOPSIS # load this library load_bytecode 'Test/Builder/Tester.pbc' # grab the subroutines you want to use .local pmc plan .local pmc test_out .local pmc test_diag .local pmc test_test plan = get_hll_global [ 'Test'; 'Builder'; 'Tester' ], 'plan' test_out = get_hll_global [ 'Test'; 'Builder'; 'Tester' ], 'test_out' test_diag = get_hll_global [ 'Test'; 'Builder'; 'Tester' ], 'test_diag' test_test = get_hll_global [ 'Test'; 'Builder'; 'Tester' ], 'test_test' # create a new Test::Builder object .local pmc tb_args .local pmc test tb_args = new 'Hash' test = new [ 'Test'; 'Builder' ], tb_args # set your test plan plan( 4 ) # test a passing test test_out( 'ok 1 - hi' ) test.'ok'( 1, 'hi' ) test_test( 'passing test') # test a test with some diagnostics test_out( 'ok 3 - A message' ) test_diag( "some\nlines" ) test.ok( 1, 'A message' ) test.diag( 'some' ) test.diag( 'lines' ) test_test( 'passing test with diagnostics' ) # clean up test.'finish'() =head1 DESCRIPTION Test::Builder::Tester is a pure-Parrot library for testing testing modules built on L. It allows you to describe the TAP output that they will produce, showing any differences in description, directive, and diagnostics. This is a procedural library. =head1 FUNCTIONS This module defines the following public functions: =over 4 =cut .namespace [ 'Test'; 'Builder'; 'Tester'; 'Output' ] .sub _initialize :load .local pmc tbto_class newclass tbto_class, [ 'Test'; 'Builder'; 'Tester'; 'Output' ] addattribute tbto_class, 'output' addattribute tbto_class, 'diagnostics' .end .sub init :vtable :method .local pmc output .local pmc diagnostics output = new 'ResizablePMCArray' diagnostics = new 'ResizablePMCArray' setattribute self, "output", output setattribute self, "diagnostics", diagnostics .end .sub get_output :method .local pmc output getattribute output, self, "output" .return( output ) .end .sub get_diagnostics :method .local pmc diagnostics getattribute diagnostics, self, "diagnostics" .return( diagnostics ) .end .sub write :method .param string message .local pmc message_string message_string = new 'String' set message_string, message .local pmc output output = self.'get_output'() push output, message_string .end .sub diag :method .param string message .local pmc message_string message_string = new 'String' set message_string, message .local pmc diagnostics diagnostics = self.'get_diagnostics'() push diagnostics, message_string .end .sub output :method .local pmc output output = self.'get_output'() unless_null output, JOIN_LINES .return( '' ) JOIN_LINES: .local string output_string output_string = join "\n", output set output, 0 .return( output_string ) .end .sub diagnostics :method .local pmc diagnostics diagnostics = self.'get_diagnostics'() unless_null diagnostics, JOIN_LINES .return( '' ) JOIN_LINES: .local string diag_string diag_string = join "\n", diagnostics diagnostics = 0 .return( diag_string ) .end .namespace [ 'Test'; 'Builder'; 'Tester' ] .sub _initialize :load load_bytecode 'Test/Builder.pbc' .local pmc test .local pmc output .local pmc test_output .local pmc expect_out .local pmc expect_diag .local pmc default_test .local pmc args # set the default output for the Test::Builder singleton test_output = new [ 'Test'; 'Builder'; 'Tester'; 'Output' ] args = new 'Hash' set args['output'], test_output default_test = new [ 'Test'; 'Builder' ], args default_test.'plan'( 'no_plan' ) test_output.'output'() # create the Test::Builder object that this uses .local pmc tb_create tb_create = get_hll_global [ 'Test'; 'Builder' ], 'create' args = new 'Hash' output = new [ 'Test'; 'Builder'; 'Output' ], args .local pmc results, testplan results = new 'ResizablePMCArray' testplan = new 'String' testplan = '' set args['output'], output test = tb_create( args ) expect_out = new 'ResizablePMCArray' expect_diag = new 'ResizablePMCArray' set_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_test', test set_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_default_test', default_test set_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_test_output', test_output set_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_expect_out', expect_out set_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_expect_diag', expect_diag .end =item C Sets the number of tests you plan to run, where C is an int. =cut .sub plan .param int tests .local pmc test test = get_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_test' test.'plan'( tests ) .end .sub line_num .end =item C Sets the expectation for a test to pass. C is the optional description of the test. =cut .sub test_pass .param string description :optional .param int have_desc :opt_flag set_output( 'ok', description ) .end =item C Sets the expectation for a test to fail. C is the optional description of the test. =cut .sub test_fail .param string description :optional set_output( 'not ok', description ) .end .sub set_output .param string test_type .param string description .local pmc test .local pmc results .local int result_count .local pmc next_result test = get_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_default_test' results = test.'results'() result_count = results inc result_count next_result = new 'String' set next_result, result_count .local pmc line_string line_string = new 'String' line_string = concat line_string, test_type line_string = concat line_string, ' ' line_string = concat line_string, next_result .local int string_defined string_defined = length description unless string_defined goto SET_EXPECT_OUTPUT line_string = concat line_string, ' - ' line_string = concat line_string, description SET_EXPECT_OUTPUT: .local pmc expect_out expect_out = get_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_expect_out' push expect_out, line_string .end =item C Sets the expected output for this test to a string. This should be a line of TAP output containing a combination of test number, status, description, and directive. =cut .sub test_out .param string line .local pmc line_string line_string = new 'String' set line_string, line .local pmc expect_out expect_out = get_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_expect_out' push expect_out, line_string .end =item C Sets the expected diagnostic output for this test to a string. This should be a line of TAP output containing a test directive. =cut .sub test_err .param string line .local pmc line_string line_string = new 'String' set line_string, line .local pmc expect_diag expect_diag = get_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_expect_diag' push expect_diag, line_string .end =item C Sets the expected diagnostic output for this test to a string. This should be a line of TAP output containing a test directive. This and C are effectively the same. =cut .sub test_diag .param string line .local pmc line_string line_string = new 'String' set line_string, line .local pmc expect_diag expect_diag = get_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_expect_diag' push expect_diag, line_string .end =item C Compares all of the expected test output and diagnostic output with the actual test output. This reports success or failure, using the giving string for the test description, and prints a diagnostic message with the divergent test output or diagnostic output. =cut .sub test_test .param string description .local int string_defined string_defined = length description if string_defined goto FETCH_GLOBALS description = '' FETCH_GLOBALS: .local pmc test .local pmc expect_out .local pmc expect_diag .local pmc test_output test = get_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_test' expect_out = get_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_expect_out' expect_diag = get_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_expect_diag' test_output = get_hll_global [ 'Test'; 'Builder'; 'Tester' ], '_test_output' .local string received_out_string .local string received_diag_string .local string expected_out_string .local string expected_diag_string received_out_string = test_output.'output'() received_diag_string = test_output.'diagnostics'() MAKE_EXPECTED_OUTPUT_STRING: .local int num_lines num_lines = expect_out ne num_lines, 0, JOIN_EO_STRING goto MAKE_EXPECTED_DIAG_STRING JOIN_EO_STRING: expected_out_string = join "\n", expect_out expect_out = 0 MAKE_EXPECTED_DIAG_STRING: num_lines = expect_diag ne num_lines, 0, JOIN_DIAG_STRING goto COMPARE_OUT_STRINGS JOIN_DIAG_STRING: expected_diag_string = join "\n", expect_diag expect_diag = 0 .local int diag_matches .local int output_matches diag_matches = 1 output_matches = 1 COMPARE_OUT_STRINGS: eq received_out_string, expected_out_string, COMPARE_DIAG_STRINGS output_matches = 0 goto FAIL_TEST COMPARE_DIAG_STRINGS: eq received_diag_string, expected_diag_string, PASS_TEST diag_matches = 0 goto FAIL_TEST PASS_TEST: test.'ok'( 1, description ) .return( 1 ) FAIL_TEST: test.'ok'( 0, description ) eq output_matches, 1, REPORT_DIAG_MISMATCH REPORT_OUTPUT_MISMATCH: .local string diagnostic diagnostic = "output mismatch\nhave: " diagnostic = concat diagnostic, received_out_string diagnostic = concat diagnostic, "\nwant: " diagnostic = concat diagnostic, expected_out_string diagnostic = concat diagnostic, "\n" test.'diag'( diagnostic ) eq diag_matches, 1, RETURN REPORT_DIAG_MISMATCH: diagnostic = "diagnostic mismatch\nhave: '" diagnostic = concat diagnostic, received_diag_string diagnostic = concat diagnostic, "'\nwant: '" diagnostic = concat diagnostic, expected_diag_string diagnostic = concat diagnostic, "'\n" test.'diag'( diagnostic ) RETURN: .return( 0 ) .end =back =head1 AUTHOR Written and maintained by chromatic, C<< chromatic at wgz dot org >>, based on the Perl 6 port he wrote, based on the original Perl 5 version written by Mark Fowler. Please send patches, feedback, and suggestions to the Perl 6 internals mailing list. =head1 COPYRIGHT Copyright (C) 2005-2008, Parrot Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: pdd07_codingstd.pod000644000765000765 7140412101554066 20101 0ustar00brucebruce000000000000parrot-5.9.0/docs/pdds# Copyright (C) 2001-2010, Parrot Foundation. =head1 PDD 7: Conventions and Guidelines for Parrot Source Code =head2 Abstract This document describes the various rules, guidelines and advice for those wishing to contribute to the source code of Parrot, in such areas as code structure, naming conventions, comments etc. =head2 Synopsis Not applicable. =head2 Description One of the criticisms of Perl 5 is that its source code is impenetrable to newcomers, due to such things as inconsistent or obscure variable naming conventions, lack of comments in the source code, and so on. We don't intend to make the same mistake when writing Parrot. Hence this document. We define three classes of conventions: =over 4 =item I<"must"> Items labelled I are mandatory; and code will not be accepted (apart from in exceptional circumstances) unless it obeys them. =item I<"should"> Items labelled I are strong guidelines that should normally be followed unless there is a sensible reason to do otherwise. =item I<"may"> Items labelled I are tentative suggestions to be used at your discretion. =back Note that since Parrot is substantially implemented in C, these rules apply to C language source code unless otherwise specified. =head2 Implementation =head3 Language Standards and Portability =over 4 =item * C code must generally depend on only those language and library features specified by the ISO C89 standard. In addition, C code may assume that any pointer value can be coerced to an integral type (no smaller than typedef C in Parrot), then back to its original type, without loss. Also C code may assume that there is a single NULL pointer representation and that it consists of a number, usually 4 or 8, of '\0' chars in memory. C code that makes assumptions beyond these must depend on the configuration system, either to not compile an entire non-portable source where it will not work, or to provide an appropriate #ifdef macro. =item * Perl code must be written for Perl 5.8.0 and all later versions. Perl code may use features not available in Perl 5.8.0 only if it is not vital to Parrot, and if it uses C<$^O> and C<$]> to degrade or fail gracefully when it is run where the features it depends on are not available. =back =head3 Code Formatting The following I apply: =over 4 =item * Source line width is limited to 100 characters. Exceptions can be made for technical requirements, but not for style reasons. And please bear in mind that very long lines I be hard to read. =item * Indentation must consist only of spaces. (Tab characters just complicate things.) =item * C and Perl code must be indented four columns per nesting level. =item * Preprocessor #directives must be indented two columns per nesting level, with two exceptions: neither PARROT_IN_CORE nor the outermost _GUARD #ifdefs cause the level of indenting to increase. =item * Labels (including case labels) must be outdented two columns relative to the code they label. =item * Closing braces for control structures must line up vertically with the start of the control structures; e.g. C<}> that closes an C must line up with the C. =item * Long lines, when split, must use at least one extra level of indentation on the continued line. =item * Cuddled Cs are forbidden: i.e. avoid C<} else {> . =item * C macro parameters must be parenthesized in macro bodies, to allow expressions passed as arguments; e.g.: #define POBJ_FLAG(n) ((UINTVAL)1 << (n)) =back The following I apply: =over 4 =item * In function definitions, the function name must be on the left margin, with the return type on the previous line. =item * In function declarations (e.g. in header files), the function name must be on the same line as the return type. =item * Pointer types should be written with separation between the star and the base type, e.g. C, but not C. =item * To distinguish keywords from function calls visually, there should be at least one space between a C keyword and any subsequent open parenthesis, e.g. C. There should be no space between a function name and the following open parenthesis, e.g. C =item * Use patterns of formatting to indicate patterns of semantics. Similar items should look similar, as the language permits. Note that some dimensions of similarity are incidental, not worth emphasizing; e.g. "these are all ints". =item * Binary operators (except C<.> and C<< -> >>) should have at least one space on either side; there should be no space between unary operators and their operands; parentheses should not have space immediately after the opening parenthesis nor immediately before the closing parenthesis; commas should have at least one space after, but not before; e.g.: x = (a-- + b) * f(c, d / e.f) =item * Use vertical alignment for clarity of parallelism. Compare this (bad): foo = 1 + 100; x = 100 + 1; whatever = 100 + 100; ... to this (good): foo = 1 + 100; x = 100 + 1; whatever = 100 + 100; =item * Do not routinely put single statements in statement blocks. (Note that formatting consistency trumps this rule. For example, a long C/C chain is easier to read if all (or none) of the conditional code is in blocks.) =item * Return values should not be parenthesized without need. It may be necessary to parenthesize a long return expression so that a smart editor will properly indent it. =item * When assigning inside a conditional, use extra parentheses, e.g. C or C. =item * When splitting a long line at a binary operator (other than comma), the split should be I the operator, so that the continued line looks like one, e.g.: something_long_here = something_very_long + something_else_also_long - something_which_also_could_be_long; =item * When splitting a long line inside parentheses (or brackets), the continuation should be indented to the right of the innermost unclosed punctuation, e.g.: z = foo(bar + baz(something_very_long_here * something_else_very_long), corge); =back =head3 Code Structure The following I apply: =over 4 =item * C code must use C-style comments only, i.e. C. (Not all C compilers handle C++-style comments.) =item * Structure types must have tags. =item * Functions must have prototypes in scope at the point of use. Prototypes for extern functions must appear only in header files. If static functions are defined before use, their definitions serve as prototypes. =item * Parameters in function prototypes must be named. These names should match the parameters in the function definition. =item * Variable names must be included for all function parameters in the function declarations. =item * Header files must be wrapped with guard macros to prevent header redefinition. The guard macro must begin with C, followed by unique and descriptive text identifying the header file (usually the directory path and filename), and end with a C<_GUARD> suffix. The matching C<#endif> must have the guard macro name in a comment, to prevent confusion. For example, a file named F might look like: #ifndef PARROT_FOO_H_GUARD #define PARROT_FOO_H_GUARD #include "parrot/config.h" #ifdef PARROT_HAS_FEATURE_FOO # define FOO_TYPE bar typedef struct foo { ... } foo_t; #endif /* PARROT_HAS_FEATURE_FOO */ #endif /* PARROT_FOO_H_GUARD */ =back The following I apply =over 4 =item * Structure types should have typedefs with the same name as their tags, e.g.: typedef struct Foo { ... } Foo; =item * Avoid double negatives, e.g. C<#ifndef NO_FEATURE_FOO>. =item * Do not compare directly against NULL, 0, or FALSE. Instead, write a boolean test, e.g. C. However, the sense of the expression being checked must be a boolean. Specifically, C and its brethren are three-state returns. if ( !strcmp(x,y) ) # BAD, checks for if x and y match, but looks # like it is checking that they do NOT match. if ( strcmp(x,y) == 0 ) # GOOD, checks proper return value if ( STREQ(x,y) ) # GOOD, uses boolean wrapper macro (Note: C values should be checked for nullity with the C macro, unfortunately leading to violations of the double-negative rule.) =item * Avoid dependency on "FIXME" and "TODO" labels: use the external bug tracking system. If a bug must be fixed soon, use "XXX" B put a ticket in the bug tracking system. This means that each "XXX" should have a Trac ticket number next to it. =back =head3 Smart Editor Style Support All developers using Emacs must ensure that their Emacs instances load the elisp source file F before opening Parrot source files. See L for instructions. All source files must end with an editor instruction coda: =over 4 =item * C source files, and files largely consisting of C (e.g. yacc, lex, PMC, and opcode source files), must end with this coda: /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4: */ =item * Make source files must end with this coda: # Local Variables: # mode: makefile # End: # vim: ft=make: =item * Perl source files must end with this coda: # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: B: Files with C<__END__> or C<__DATA__> blocks do not require the coda. This is at least until there is some consensus as to how solve the issue of using editor hints in files with such blocks. =item * PIR source files should end with this coda: # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: =back {{ XXX - Proper formatting and syntax coloring of C code under Emacs requires that Emacs know about typedefs. We should provide a simple script to update a list of typedefs, and parrot.el should read it or contain it. }} =head3 Portability Parrot runs on many, many platforms, and will no doubt be ported to ever more bizarre and obscure ones over time. You should never assume an operating system, processor architecture, endian-ness, size of standard type, or anything else that varies from system to system. Since most of Parrot's development uses GNU C, you might accidentally depend on a GNU feature without noticing. To avoid this, know what features of gcc are GNU extensions, and use them only when they're protected by #ifdefs. =head3 Defensive Programming =head4 Use Parrot data structures instead of C strings and arrays C arrays, including strings, are very sharp tools without safety guards, and Parrot is a large program maintained by many people. Therefore: Don't use a C when a Parrot STRING would suffice. Don't use a C array when a Parrot array PMC would suffice. If you do use a C or C array, check and recheck your code for even the slightest possibility of buffer overflow or memory leak. Note that efficiency of some low-level operations may be a reason to break this rule. Be prepared to justify your choices to a jury of your peers. =head4 Pass only C to C and C Pass only values in the range of C (and the special value -1, a.k.a. C) to the isxxx() and toxxx() library functions. Passing signed characters to these functions is a very common error and leads to incorrect behavior at best and crashes at worst. And under most of the compilers Parrot targets, C I signed. =head4 The C keyword on arguments Use the C keyword as often as possible on pointers. It lets the compiler know when you intend to modify the contents of something. For example, take this definition: int strlen(const char *p); The C qualifier tells the compiler that the argument will not be modified. The compiler can then tell you that this is an uninitialized variable: char *p; int n = strlen(p); Without the C, the compiler has to assume that C is actually initializing the contents of C

    . =head4 The C keyword on variables If you're declaring a temporary pointer, declare it C, with the const to the right of the C<*>, to indicate that the pointer should not be modified. Wango * const w = get_current_wango(); w->min = 0; w->max = 14; w->name = "Ted"; This prevents you from modifying C inadvertently. new_wango = w++; /* Error */ If you're not going to modify the target of the pointer, put a C to the left of the type, as in: const Wango * const w = get_current_wango(); if (n < wango->min || n > wango->max) { /* do something */ } =head4 Localizing variables Declare variables in the innermost scope possible. if (foo) { int i; for (i = 0; i < n; i++) do_something(i); } Don't reuse unrelated variables. Localize as much as possible, even if the variables happen to have the same names. if (foo) { int i; for (i = 0; i < n; i++) do_something(i); } else { int i; for (i = 14; i > 0; i--) do_something_else(i * i); } You could hoist the C outside the test, but then you'd have an C that's visible after it's used, which is confusing at best. =head3 Naming Conventions =over 4 =item Filenames Filenames must be assumed to be case-insensitive, in the sense that you may not have two different files called F and F. Normal source-code filenames should be all lower-case; filenames with upper-case letters in them are reserved for notice-me-first files such as F, and for files which need some sort of pre-processing applied to them or which do the preprocessing - e.g. a script F might read F and output F. The characters making up filenames must be chosen from the ASCII set A-Z,a-z,0-9 plus .-_ An underscore should be used to separate words rather than a hyphen (-). A file should not normally have more than a single '.' in it, and this should be used to denote a suffix of some description. The filename must still be unique if the main part is truncated to 8 characters and any suffix truncated to 3 characters. Ideally, filenames should restricted to 8.3 in the first place, but this is not essential. Each subsystem I should supply the following files. This arrangement is based on the assumption that each subsystem will -- as far as is practical -- present an opaque interface to all other subsystems within the core, as well as to extensions and embeddings. =over 4 =item C This contains all the declarations needed for external users of that API (and nothing more), i.e. it defines the API. It is permissible for the API to include different or extra functionality when used by other parts of the core, compared with its use in extensions and embeddings. In this case, the extra stuff within the file is enabled by testing for the macro C. =item C This contains declarations used internally by that subsystem, and which must only be included within source files associated the subsystem. This file defines the macro C so that code knows when it is being used within that subsystem. The file will also contain all the 'convenience' macros used to define shorter working names for functions without the perl prefix (see below). =item C This file contains the declaration of a single structure containing the private global variables used by the subsystem (see the section on globals below for more details). =item C etc. All other source files associated with the subsystem will have the prefix C. =back =item Names of code entities Code entities such as variables, functions, macros etc. (apart from strictly local ones) should all follow these general guidelines. =over 4 =item * Multiple words or components should be separated with underscores rather than using tricks such as capitalization, e.g. C rather than C or (gasp) C. =item * The names of entities should err on the side of verbosity, e.g. C in preference to C. Avoid cryptic abbreviations wherever possible. =item * All entities should be prefixed with the name of the subsystem in which they appear, e.g. C, C. =item * Functions with external visibility should be of the form C, and should only use typedefs with external visibility (or types defined in C89). Generally these functions should not be used inside the core, but this is not a hard and fast rule. =item * Variables and structure names should be all lower-case, e.g. C. =item * Structure elements should be all lower-case, and the first component of the name should incorporate the structure's name or an abbreviation of it. =item * Typedef names should be lower-case except for the first letter, e.g. C. The exception to this is when the first component is a short abbreviation, in which case the whole first component may be made uppercase for readability purposes, e.g. C rather than C. Structures should generally be typedefed. =item * Macros should have their first component uppercase, and the majority of the remaining components should be likewise. Where there is a family of macros, the variable part can be indicated in lowercase, e.g. C, C, .... =item * A macro which defines a flag bit should be suffixed with C<_FLAG>, e.g. C (although you probably want to use an C instead.) =item * A macro which tests a flag bit should be suffixed with C<_TEST>, e.g. C =item * A macro which sets a flag bit should be suffixed with C<_SET>, e.g. C =item * A macro which clears a flag bit should be suffixed with C<_CLEAR>, e.g. C =item * A macro defining a mask of flag bits should be suffixed with C<_MASK>, e.g. C (but see notes on extensibility below). =item * Macros can be defined to cover common flag combinations, in which case they should have C<_SETALL>, C<_CLEARALL>, C<_TESTALL> or C<_TESTANY> suffixes as appropriate, to indicate aggregate bits, e.g. C. =item * A macro defining an auto-configuration value should be prefixed with C, e.g. C, C. =item * A macro indicating the compilation 'location' should be prefixed with C, e.g. C, C, C. Individual include file visitations should be marked with C for file C =item * A macro indicating major compilation switches should be prefixed with C, e.g. C, C. =item * A macro that may declare stuff and thus needs to be at the start of a block should be prefixed with C, e.g. C. Note that macros which implicitly declare and then use variables are strongly discouraged, unless it is essential for portability or extensibility. The following are in decreasing preference style-wise, but increasing preference extensibility-wise. { Stack sp = GETSTACK; x = POPSTACK(sp) ... /* sp is an auto variable */ { DECL_STACK(sp); x = POPSTACK(sp); ... /* sp may or may not be auto */ { DECL_STACK; x = POPSTACK; ... /* anybody's guess */ =back =item Global Variables Global variables must never be accessed directly outside the subsystem in which they are used. Some other method, such as accessor functions, must be provided by that subsystem's API. (For efficiency the 'accessor functions' may occasionally actually be macros, but then the rule still applies in spirit at least). All global variables needed for the internal use of a particular subsystem should all be declared within a single struct called C for subsystem C. This structure's declaration is placed in the file C. Then somewhere a single compound structure will be declared which has as members the individual structures from each subsystem. Instances of this structure are then defined as a one-off global variable, or as per-thread instances, or whatever is required. [Actually, three separate structures may be required, for global, per-interpreter and per-thread variables.] Within an individual subsystem, macros are defined for each global variable of the form C (the name being deliberately clunky). So we might for example have the following macros: /* perl_core.h or similar */ #ifdef HAS_THREADS # define GLOBALS_BASE (aTHX_->globals) #else # define GLOBALS_BASE (Parrot_globals) #endif /* pmc_private.h */ #define GLOBAL_foo GLOBALS_BASE.pmc.foo #define GLOBAL_bar GLOBALS_BASE.pmc.bar ... etc ... =back =head3 Code Comments The importance of good code documentation cannot be stressed enough. To make your code understandable by others (and indeed by yourself when you come to make changes a year later), the following conventions apply to all source files. =over 4 =item Developer files Each source file (e.g. a F, F pair), should contain inline Pod documentation containing information on the implementation decisions associated with the source file. (Note that this is in contrast to PDDs, which describe design decisions). In addition, more discussive documentation can be placed in F<*.pod> files in the F directory. This is the place for mini-essays on how to avoid overflows in unsigned arithmetic, or on the pros and cons of differing hash algorithms, and why the current one was chosen, and how it works. In principle, someone coming to a particular source file for the first time should be able to read the inline documentation file and gain an immediate overview of what the source file is for, the algorithms it implements, etc. The Pod documentation should follow the layout: =over 4 =item Title =head1 Foo =item Synopsis When appropriate, some simple examples of usage. =item Description A description of the contents of the file, how the implementation works, data structures and algorithms, and anything that may be of interest to your successors, e.g. benchmarks of differing hash algorithms, essays on how to do integer arithmetic. =item See Also Links to pages and books that may contain useful information relevant to the stuff going on in the code -- e.g. the book you stole the hash function from. =back Don't include author information in individual files. Author information can be added to the CREDITS file. (Languages are an exception to this rule, and may follow whatever convention they choose.) Don't include Pod sections for License or Copyright in individual files. =item Per-section comments If there is a collection of functions, structures or whatever which are grouped together and have a common theme or purpose, there should be a general comment at the start of the section briefly explaining their overall purpose. (Detailed essays should be left to the developer file). If there is really only one section, then the top-of-file comment already satisfies this requirement. =item Per-entity comments Every non-local named entity, be it a function, variable, structure, macro or whatever, must have an accompanying comment explaining its purpose. This comment must be in the special format described below, in order to allow automatic extraction by tools - for example, to generate per API man pages, B style utilities and so on. Often the comment need only be a single line explaining its purpose, but sometimes more explanation may be needed. For example, "return an Integer Foo to its allocation pool" may be enough to demystify the function C Each comment should be of the form /* =item C Description. =cut */ This inline Pod documentation is transformed to HTML with: $ make html =item Optimizations Whenever code has deliberately been written in an odd way for performance reasons, you should point this out - if nothing else, to avoid some poor schmuck trying subsequently to replace it with something 'cleaner'. /* The loop is partially unrolled here as it makes it a lot faster. * See the file in docs/dev for the full details */ =item General comments While there is no need to go mad commenting every line of code, it is immensely helpful to provide a "running commentary" every 10 lines or so if nothing else, this makes it easy to quickly locate a specific chunk of code. Such comments are particularly useful at the top of each major branch, e.g. if (FOO_bar_BAZ(**p+*q) <= (r-s[FOZ & FAZ_MASK]) || FLOP_2(z99)) { /* we're in foo mode: clean up lexicals */ ... (20 lines of gibberish) ... } else if (...) { /* we're in bar mode: clean up globals */ ... (20 more lines of gibberish) ... } else { /* we're in baz mode: self-destruct */ .... } =item Copyright notice The first line of every file (or the second line if the first line is a I line such as C<#!/usr/bin/perl>) should be a copyright notice, in the comment style appropriate to the file type. It should list the first year the file was created and the last year the file was modified. (This isn't necessarily the current year, the file might not have been modified this year.) /* Copyright (C) 2001-2008, Parrot Foundation. */ For files that were newly added this year, just list the current year. /* Copyright (C) 2009, Parrot Foundation. */ =back =head3 Extensibility Over the lifetime of Parrot, the source code will undergo many major changes never envisaged by its original authors. To this end, your code should balance out the assumptions that make things possible, fast or small, with the assumptions that make it difficult to change things in future. This is especially important for parts of the code which are exposed through APIs -- the requirements of source or binary compatibility for such things as extensions can make it very hard to change things later on. For example, if you define suitable macros to set/test flags in a struct, then you can later add a second word of flags to the struct without breaking source compatibility. (Although you might still break binary compatibility if you're not careful.) Of the following two methods of setting a common combination of flags, the second doesn't assume that all the flags are contained within a single field: foo->flags |= (FOO_int_FLAG | FOO_num_FLAG | FOO_str_FLAG); FOO_valid_value_SETALL(foo); Similarly, avoid using a C (or C<{char*,length}>) if it is feasible to later use a C at the same point: c.f. UTF-8 hash keys in Perl 5. Of course, private code hidden behind an API can play more fast and loose than code which gets exposed. =head3 Performance We want Parrot to be fast. Very fast. But we also want it to be portable and extensible. Based on the 90/10 principle, (or 80/20, or 95/5, depending on who you speak to), most performance is gained or lost in a few small but critical areas of code. Concentrate your optimization efforts there. Note that the most overwhelmingly important factor in performance is in choosing the correct algorithms and data structures in the first place. Any subsequent tweaking of code is secondary to this. Also, any tweaking that is done should as far as possible be platform independent, or at least likely to cause speed-ups in a wide variety of environments, and do no harm elsewhere. If you do put an optimization in, time it on as many architectures as you can, and be suspicious of it if it slows down on any of them! Perhaps it will be slow on other architectures too (current and future). Perhaps it wasn't so clever after all? If the optimization is platform specific, you should probably put it in a platform-specific function in a platform-specific file, rather than cluttering the main source with zillions of #ifdefs. And remember to document it. =head2 Exemptions Not all files can strictly fall under these guidelines as they are automatically generated by other tools, or are external files included in the Parrot repository for convenience. Such files include the C header and source files automatically generated by (f)lex and yacc/bison, and some of the Perl modules under the F directory. To exempt a file (or directory of files) from checking by the coding standards tests, one must edit the appropriate exemption list within C (in either of the methods C or C). One can use wildcards in the list to exempt, for example, all files under a given directory. =head2 References None. =cut __END__ Local Variables: fill-column:78 End: vim: expandtab shiftwidth=4: number_8_8_be.pbc000644000765000765 1106012101554067 20207 0ustar00brucebruce000000000000parrot-5.9.0/t/native_pbcþPBC   >BYTECODE_t/op/number_1.pasm0¼FIXUP_t/op/number_1.pasmìCONSTANT_t/op/number_1.pasmôšPIC_idx_t/op/number_1.pasmŽ`BYTECODE_t/op/number_1.pasm_DBîX¼·uuu uuuuu uu u u u u uuuuu uuuuuuuÆÉÆÉÆÉÆÉÆÉÆÉÆÉÆÉÆÉÆ ÉÆ ÉÆ ÉÆ ÉÆ ÉÆÉÆÉÆÉÆÉÆÉÆÉÆÉÆÉÆÉÆÉÆÉÆÉ(null)špþPBC   #ÿÿÿÿÿÿÿŸparrot 3I!parrot"ÿÿÿÿÿÿÿœGnBÐn@PnAnBnAPn@nAÐnBPnAnB0n@0nApn@Ðs nAðnB°nBpn?ðnA0nBðn@pnA°nBn@n@°n@ðnCÿÿÿÿÿàst/op/number_1.pasmp0þPBC  ·(null)(null)!parrotÿÿÿÿÿÿÿÿ(null)s(null)`[XP  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPimcc.y000644000765000765 17702612101554066 16603 0ustar00brucebruce000000000000parrot-5.9.0/compilers/imcc%{ /* * imcc.y * * Intermediate Code Compiler for Parrot. * * Copyright (C) 2002 Melvin Smith * Copyright (C) 2002-2010, Parrot Foundation. * * Grammar of the PIR language parser. * * */ /* =pod =head1 NAME compilers/imcc/imcc.y - Intermediate Code Compiler for Parrot. =head1 DESCRIPTION This file contains the grammar of the PIR language parser. =cut */ #include #include #include #define _PARSER #define PARSER_MAIN #include "imc.h" #include "parrot/dynext.h" #include "pmc/pmc_callcontext.h" #include "pbc.h" #include "parser.h" #include "optimizer.h" #include "instructions.h" #include "symreg.h" /* prevent declarations of malloc() and free() in the generated parser. */ #define YYMALLOC #define YYFREE(Ptr) do { /* empty */; } while (YYID (0)) #ifndef YYENABLE_NLS # define YYENABLE_NLS 0 #endif #ifndef YYLTYPE_IS_TRIVIAL # define YYLTYPE_IS_TRIVIAL 0 #endif /* HEADERIZER HFILE: compilers/imcc/imc.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void add_pcc_named_arg( ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call), ARGMOD(SymReg *name), ARGMOD(SymReg *value)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*cur_call) FUNC_MODIFIES(*name) FUNC_MODIFIES(*value); static void add_pcc_named_arg_var( ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call), ARGMOD(SymReg *name), ARGMOD(SymReg *value)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*cur_call) FUNC_MODIFIES(*name) FUNC_MODIFIES(*value); static void add_pcc_named_param( ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call), ARGMOD(SymReg *name), ARGMOD(SymReg *value)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*cur_call) FUNC_MODIFIES(*name) FUNC_MODIFIES(*value); static void add_pcc_named_result( ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call), ARGMOD(SymReg *name), ARGMOD(SymReg *value)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*cur_call) FUNC_MODIFIES(*name) FUNC_MODIFIES(*value); static void add_pcc_named_return( ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call), ARGMOD(SymReg *name), ARGMOD(SymReg *value)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*cur_call) FUNC_MODIFIES(*name) FUNC_MODIFIES(*value); static void adv_named_set(ARGMOD(imc_info_t *imcc), ARGIN(const char *name)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*imcc); static void adv_named_set_u( ARGMOD(imc_info_t *imcc), ARGIN(const char *name)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*imcc); static void begin_return_or_yield(ARGMOD(imc_info_t *imcc), int yield) __attribute__nonnull__(1) FUNC_MODIFIES(*imcc); static void clear_state(ARGMOD(imc_info_t *imcc)) __attribute__nonnull__(1) FUNC_MODIFIES(*imcc); static void do_loadlib(ARGMOD(imc_info_t *imcc), ARGIN(const char *lib)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*imcc); PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static Instruction* func_ins( ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(SymReg *lhs), ARGIN(const char *op), ARGMOD(SymReg **r), int n, int keyv, int emit) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) __attribute__nonnull__(5) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*unit) FUNC_MODIFIES(*r); PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static Instruction * iINDEXFETCH( ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(SymReg *r0), ARGIN(SymReg *r1), ARGIN(SymReg *r2)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) __attribute__nonnull__(5) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*unit); PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static Instruction * iINDEXSET( ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(SymReg *r0), ARGIN(SymReg *r1), ARGIN(SymReg *r2)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) __attribute__nonnull__(5) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*unit); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static Instruction * iLABEL( ARGMOD(imc_info_t *imcc), ARGMOD_NULLOK(IMC_Unit *unit), ARGMOD(SymReg *r0)) __attribute__nonnull__(1) __attribute__nonnull__(3) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*unit) FUNC_MODIFIES(*r0); PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static const char * inv_op(ARGIN(const char *op)) __attribute__nonnull__(1); PARROT_IGNORABLE_RESULT PARROT_CANNOT_RETURN_NULL static Instruction * iSUBROUTINE( ARGMOD(imc_info_t *imcc), ARGMOD_NULLOK(IMC_Unit *unit), ARGMOD(SymReg *r)) __attribute__nonnull__(1) __attribute__nonnull__(3) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*unit) FUNC_MODIFIES(*r); PARROT_IGNORABLE_RESULT PARROT_CAN_RETURN_NULL static Instruction * MK_I( ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(const char *fmt), int n, ...) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*unit); PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static Instruction* mk_pmc_const_named( ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(const char *name), ARGMOD(SymReg *left), ARGIN(const char *constant)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) __attribute__nonnull__(5) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*unit) FUNC_MODIFIES(*left); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static SymReg * mk_sub_address_fromc( ARGMOD(imc_info_t *imcc), ARGIN(const char *name)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*imcc); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static SymReg * mk_sub_address_u( ARGMOD(imc_info_t *imcc), ARGIN(const char *name)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*imcc); static void set_lexical( ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *r), ARGMOD(SymReg *name)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*imcc) FUNC_MODIFIES(*r) FUNC_MODIFIES(*name); #define ASSERT_ARGS_add_pcc_named_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(cur_call) \ , PARROT_ASSERT_ARG(name) \ , PARROT_ASSERT_ARG(value)) #define ASSERT_ARGS_add_pcc_named_arg_var __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(cur_call) \ , PARROT_ASSERT_ARG(name) \ , PARROT_ASSERT_ARG(value)) #define ASSERT_ARGS_add_pcc_named_param __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(cur_call) \ , PARROT_ASSERT_ARG(name) \ , PARROT_ASSERT_ARG(value)) #define ASSERT_ARGS_add_pcc_named_result __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(cur_call) \ , PARROT_ASSERT_ARG(name) \ , PARROT_ASSERT_ARG(value)) #define ASSERT_ARGS_add_pcc_named_return __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(cur_call) \ , PARROT_ASSERT_ARG(name) \ , PARROT_ASSERT_ARG(value)) #define ASSERT_ARGS_adv_named_set __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(name)) #define ASSERT_ARGS_adv_named_set_u __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(name)) #define ASSERT_ARGS_begin_return_or_yield __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc)) #define ASSERT_ARGS_clear_state __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc)) #define ASSERT_ARGS_do_loadlib __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(lib)) #define ASSERT_ARGS_func_ins __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit) \ , PARROT_ASSERT_ARG(lhs) \ , PARROT_ASSERT_ARG(op) \ , PARROT_ASSERT_ARG(r)) #define ASSERT_ARGS_iINDEXFETCH __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit) \ , PARROT_ASSERT_ARG(r0) \ , PARROT_ASSERT_ARG(r1) \ , PARROT_ASSERT_ARG(r2)) #define ASSERT_ARGS_iINDEXSET __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit) \ , PARROT_ASSERT_ARG(r0) \ , PARROT_ASSERT_ARG(r1) \ , PARROT_ASSERT_ARG(r2)) #define ASSERT_ARGS_iLABEL __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(r0)) #define ASSERT_ARGS_inv_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(op)) #define ASSERT_ARGS_iSUBROUTINE __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(r)) #define ASSERT_ARGS_MK_I __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit) \ , PARROT_ASSERT_ARG(fmt)) #define ASSERT_ARGS_mk_pmc_const_named __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit) \ , PARROT_ASSERT_ARG(name) \ , PARROT_ASSERT_ARG(left) \ , PARROT_ASSERT_ARG(constant)) #define ASSERT_ARGS_mk_sub_address_fromc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(name)) #define ASSERT_ARGS_mk_sub_address_u __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(name)) #define ASSERT_ARGS_set_lexical __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(r) \ , PARROT_ASSERT_ARG(name)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ #define YYDEBUG 1 #define YYERROR_VERBOSE 1 /* Warning: parser is probably not reentrant */ /* * Choosing instructions for Parrot is pretty easy since many are * polymorphic. */ /* =over 4 =item C build and emitb instruction by INS. fmt may contain: op %s, %s # comment or just op NOTE: Most usage of this function is with imcc->cur_unit, but there are some exceptions. Thus, we can't easily factorize that piece of code. =cut */ PARROT_IGNORABLE_RESULT PARROT_CAN_RETURN_NULL static Instruction * MK_I(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(const char *fmt), int n, ...) { ASSERT_ARGS(MK_I) char opname[64]; char *p; const char *q; va_list ap; SymReg *r[IMCC_MAX_FIX_REGS]; int i; for (p = opname, q = fmt; *q && *q != ' ';) *p++ = *q++; *p = '\0'; if (!*q) fmt = NULL; else fmt = ++q; #ifdef OPDEBUG fprintf(stderr, "op '%s' format '%s' (%d)\n", opname, fmt?:"", n); #endif va_start(ap, n); i = 0; for (i = 0; i < n; ++i) { r[i] = va_arg(ap, SymReg *); } va_end(ap); return INS(imcc, unit, opname, fmt, r, n, imcc->keyvec, 1); } /* =item C =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static Instruction* mk_pmc_const_named(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(const char *name), ARGMOD(SymReg *left), ARGIN(const char *constant)) { ASSERT_ARGS(mk_pmc_const_named) SymReg *rhs; SymReg *r[3]; char *const_name; const int ascii = (*constant == '\'' || *constant == '"'); char *unquoted_name = mem_sys_strdup(name + 1); size_t name_length = strlen(unquoted_name) - 1; unquoted_name[name_length] = 0; if (left->type == VTADDRESS) { /* IDENTIFIER */ if (imcc->state->pasm_file) { IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Ident as PMC constant", " %s\n", left->name); } left->type = VTIDENTIFIER; left->set = 'P'; } r[0] = left; if (ascii) { /* strip delimiters */ const_name = mem_sys_strdup(constant + 1); const_name[strlen(const_name) - 1] = 0; } else { const_name = mem_sys_strdup(constant); } if ((strncmp(unquoted_name, "Sub", name_length) == 0) || (strncmp(unquoted_name, "Coroutine", name_length) == 0)) { rhs = mk_const(imcc, const_name, 'p'); if (!ascii) rhs->type |= VT_ENCODED; rhs->usage |= U_FIXUP | U_SUBID_LOOKUP; } else if (strncmp(unquoted_name, "LexInfo", name_length) == 0) { rhs = mk_const(imcc, const_name, 'l'); if (!ascii) rhs->type |= VT_ENCODED; rhs->usage |= U_FIXUP | U_LEXINFO_LOOKUP; } else { rhs = mk_const(imcc, const_name, 'P'); } r[1] = rhs; rhs->pmc_type = Parrot_pmc_get_type_str(imcc->interp, Parrot_str_new(imcc->interp, unquoted_name, name_length)); mem_sys_free(unquoted_name); mem_sys_free(const_name); return INS(imcc, unit, "set_p_pc", "", r, 2, 0, 1); } /* =item C =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static Instruction* func_ins(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(SymReg *lhs), ARGIN(const char *op), ARGMOD(SymReg **r), int n, int keyv, int emit) { ASSERT_ARGS(func_ins) int i; /* shift regs up by 1 */ for (i = n - 1; i >= 0; --i) r[i+1] = r[i]; r[0] = lhs; /* shift keyvec */ keyv <<= 1; return INS(imcc, unit, op, "", r, n+1, keyv, emit); } /* =item C =cut */ static void clear_state(ARGMOD(imc_info_t *imcc)) { ASSERT_ARGS(clear_state) imcc -> nargs = 0; imcc -> keyvec = 0; } /* =item C =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL Instruction * INS_LABEL(ARGMOD(imc_info_t *imcc), ARGMOD_NULLOK(IMC_Unit *unit), ARGMOD(SymReg *r0), int emit) { ASSERT_ARGS(INS_LABEL) Instruction * const ins = _mk_instruction("", "%s:", 1, &r0, 0); ins->type = ITLABEL; r0->first_ins = ins; if (emit) emitb(imcc, unit, ins); return ins; } /* =item C =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static Instruction * iLABEL(ARGMOD(imc_info_t *imcc), ARGMOD_NULLOK(IMC_Unit *unit), ARGMOD(SymReg *r0)) { ASSERT_ARGS(iLABEL) Instruction * const i = INS_LABEL(imcc, unit, r0, 1); i->line = imcc->line; clear_state(imcc); return i; } /* =item C =cut */ PARROT_IGNORABLE_RESULT PARROT_CANNOT_RETURN_NULL static Instruction * iSUBROUTINE(ARGMOD(imc_info_t *imcc), ARGMOD_NULLOK(IMC_Unit *unit), ARGMOD(SymReg *r)) { ASSERT_ARGS(iSUBROUTINE) Instruction * const i = iLABEL(imcc, unit, r); i->type |= ITPCCPARAM; r->type = (r->type & VT_ENCODED) ? VT_PCC_SUB|VT_ENCODED : VT_PCC_SUB; r->pcc_sub = mem_gc_allocate_zeroed_typed(imcc->interp, pcc_sub_t); imcc->cur_call = r; i->line = imcc->line; add_namespace(imcc, unit); return i; } /* =item C substr or X = P[key] =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static Instruction * iINDEXFETCH(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(SymReg *r0), ARGIN(SymReg *r1), ARGIN(SymReg *r2)) { ASSERT_ARGS(iINDEXFETCH) imcc -> keyvec |= KEY_BIT(2); return MK_I(imcc, unit, "set %s, %s[%s]", 3, r0, r1, r2); } /* =item C substr or P[key] = X =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static Instruction * iINDEXSET(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(SymReg *r0), ARGIN(SymReg *r1), ARGIN(SymReg *r2)) { ASSERT_ARGS(iINDEXSET) if (r0->set == 'P') { imcc->keyvec |= KEY_BIT(1); MK_I(imcc, unit, "set %s[%s], %s", 3, r0, r1, r2); } else IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "unsupported indexed set op\n"); return NULL; } /* =item C =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static const char * inv_op(ARGIN(const char *op)) { ASSERT_ARGS(inv_op) int n; return get_neg_op(op, &n); } /* =item C =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL Instruction * IMCC_create_itcall_label(ARGMOD(imc_info_t *imcc)) { ASSERT_ARGS(IMCC_create_itcall_label) char name[128]; SymReg *r; Instruction *i; snprintf(name, sizeof (name), "%cpcc_sub_call_%d", IMCC_INTERNAL_CHAR, imcc->cnr++); r = mk_pcc_sub(imcc, name, 0); i = iLABEL(imcc, imcc->cur_unit, r); i->type = ITCALL | ITPCCSUB; imcc->cur_call = r; return i; } /* =item C =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static SymReg * mk_sub_address_fromc(ARGMOD(imc_info_t *imcc), ARGIN(const char *name)) { ASSERT_ARGS(mk_sub_address_fromc) /* name is a quoted sub name */ SymReg *r; char *name_copy; /* interpolate only if the first character is a double-quote */ if (*name == '"') { STRING *unescaped = Parrot_str_unescape(imcc->interp, name, '"', NULL); name_copy = Parrot_str_to_cstring(imcc->interp, unescaped); } else { name_copy = mem_sys_strdup(name); name_copy[strlen(name) - 1] = 0; } r = mk_sub_address(imcc, name_copy + 1); mem_sys_free(name_copy); return r; } /* =item C =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static SymReg * mk_sub_address_u(ARGMOD(imc_info_t *imcc), ARGIN(const char *name)) { ASSERT_ARGS(mk_sub_address_u) SymReg * const r = mk_sub_address(imcc, name); r->type |= VT_ENCODED; return r; } /* =item C =cut */ void IMCC_itcall_sub(ARGMOD(imc_info_t *imcc), ARGIN(SymReg *sub)) { ASSERT_ARGS(IMCC_itcall_sub) imcc->cur_call->pcc_sub->sub = sub; if (imcc->cur_obj) { if (imcc->cur_obj->set != 'P') IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "object isn't a PMC"); imcc->cur_call->pcc_sub->object = imcc->cur_obj; imcc->cur_obj = NULL; } } /* =item C =cut */ static void begin_return_or_yield(ARGMOD(imc_info_t *imcc), int yield) { ASSERT_ARGS(begin_return_or_yield) Instruction *i; Instruction * const ins = imcc->cur_unit->instructions; char name[128]; if (!ins || !ins->symregs[0] || !(ins->symregs[0]->type & VT_PCC_SUB)) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "yield or return directive outside pcc subroutine\n"); ins->symregs[0]->pcc_sub->yield = yield; snprintf(name, sizeof (name), yield ? "%cpcc_sub_yield_%d" : "%cpcc_sub_ret_%d", IMCC_INTERNAL_CHAR, imcc->cnr++); imcc->sr_return = mk_pcc_sub(imcc, name, 0); i = iLABEL(imcc, imcc->cur_unit, imcc->sr_return); i->type = yield ? ITPCCSUB | ITLABEL | ITPCCYIELD : ITPCCSUB | ITLABEL ; imcc->asm_state = yield ? AsmInYield : AsmInReturn; } /* =item C =cut */ static void set_lexical(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *r), ARGMOD(SymReg *name)) { ASSERT_ARGS(set_lexical) r->usage |= U_LEXICAL; if (name == r->reg) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "register %s already declared as lexical %s", r->name, name->name); /* chain all names in r->reg */ name->reg = r->reg; r->reg = name; name->usage |= U_LEXICAL; r->use_count++; } /* =item C =cut */ static void add_pcc_named_arg(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call), ARGMOD(SymReg *name), ARGMOD(SymReg *value)) { ASSERT_ARGS(add_pcc_named_arg) name->type |= VT_NAMED; add_pcc_arg(imcc, cur_call, name); add_pcc_arg(imcc, cur_call, value); } /* =item C =cut */ static void add_pcc_named_arg_var(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call), ARGMOD(SymReg *name), ARGMOD(SymReg *value)) { ASSERT_ARGS(add_pcc_named_arg_var) name->type |= VT_NAMED; add_pcc_arg(imcc, cur_call, name); add_pcc_arg(imcc, cur_call, value); } /* =item C =cut */ static void add_pcc_named_result(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call), ARGMOD(SymReg *name), ARGMOD(SymReg *value)) { ASSERT_ARGS(add_pcc_named_result) name->type |= VT_NAMED; add_pcc_result(imcc, cur_call, name); add_pcc_result(imcc, cur_call, value); } /* =item C =cut */ static void add_pcc_named_param(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call), ARGMOD(SymReg *name), ARGMOD(SymReg *value)) { ASSERT_ARGS(add_pcc_named_param) name->type |= VT_NAMED; add_pcc_arg(imcc, cur_call, name); add_pcc_arg(imcc, cur_call, value); } /* =item C =cut */ static void add_pcc_named_return(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call), ARGMOD(SymReg *name), ARGMOD(SymReg *value)) { ASSERT_ARGS(add_pcc_named_return) name->type |= VT_NAMED; add_pcc_result(imcc, cur_call, name); add_pcc_result(imcc, cur_call, value); } /* =item C =item C Sets the name of the current named argument. C is the Unicode version of this function. =cut */ static void adv_named_set(ARGMOD(imc_info_t *imcc), ARGIN(const char *name)) { ASSERT_ARGS(adv_named_set) if (imcc->adv_named_id) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Named parameter with more than one name.\n"); imcc->adv_named_id = mk_const(imcc, name, 'S'); } static void adv_named_set_u(ARGMOD(imc_info_t *imcc), ARGIN(const char *name)) { ASSERT_ARGS(adv_named_set_u) if (imcc->adv_named_id) IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Named parameter with more than one name.\n"); imcc->adv_named_id = mk_const(imcc, name, 'U'); } /* =item C =cut */ static void do_loadlib(ARGMOD(imc_info_t *imcc), ARGIN(const char *lib)) { ASSERT_ARGS(do_loadlib) STRING * const s = Parrot_str_unescape(imcc->interp, lib + 1, '"', NULL); PMC * const lib_pmc = Parrot_dyn_load_lib(imcc->interp, s, NULL); if (PMC_IS_NULL(lib_pmc) || !VTABLE_get_bool(imcc->interp, lib_pmc)) { IMCC_fataly(imcc, EXCEPTION_LIBRARY_ERROR, "loadlib directive could not find library `%S'", s); } /* store non-dynoplib library deps here, dynoplibs are treated separately for now */ /* TODO: This is very ugly and heavily nested. Can we avoid this? */ if (!STRING_equal(imcc->interp, VTABLE_get_string(imcc->interp, Parrot_pmc_getprop(imcc->interp, lib_pmc, Parrot_str_new_constant(imcc->interp, "_type"))), Parrot_str_new_constant(imcc->interp, "Ops"))) imcc_pbc_add_libdep(imcc, s); } /* HEADERIZER STOP */ %} %union { IdList * idlist; int t; char * s; SymReg * sr; Instruction *i; } /* We need precedence for a few tokens to resolve a couple of conflicts */ %nonassoc LOW_PREC %nonassoc '\n' %nonassoc PARAM %token SOL HLL %token GOTO ARG IF UNLESS PNULL SET_RETURN SET_YIELD %token ADV_FLAT ADV_SLURPY ADV_OPTIONAL ADV_OPT_FLAG ADV_NAMED ADV_ARROW %token ADV_INVOCANT ADV_CALL_SIG %token NAMESPACE DOT_METHOD %token SUB SYM LOCAL LEXICAL CONST ANNOTATE %token GLOBAL_CONST %token PLUS_ASSIGN MINUS_ASSIGN MUL_ASSIGN DIV_ASSIGN CONCAT_ASSIGN %token BAND_ASSIGN BOR_ASSIGN BXOR_ASSIGN FDIV FDIV_ASSIGN MOD_ASSIGN %token SHR_ASSIGN SHL_ASSIGN SHR_U_ASSIGN %token SHIFT_LEFT SHIFT_RIGHT INTV FLOATV STRINGV PMCV LOG_XOR %token RELOP_EQ RELOP_NE RELOP_GT RELOP_GTE RELOP_LT RELOP_LTE %token RESULT RETURN TAILCALL YIELDT GET_RESULTS %token POW SHIFT_RIGHT_U LOG_AND LOG_OR %token COMMA ESUB DOTDOT %token PCC_BEGIN PCC_END PCC_CALL PCC_SUB PCC_BEGIN_RETURN PCC_END_RETURN %token PCC_BEGIN_YIELD PCC_END_YIELD INVOCANT %token MAIN LOAD INIT IMMEDIATE POSTCOMP METHOD ANON OUTER NEED_LEX %token MULTI SUBTAG VTABLE_METHOD LOADLIB SUB_INSTANCE_OF SUBID %token NS_ENTRY %token LABEL %token EMIT EOM %token IREG NREG SREG PREG IDENTIFIER REG MACRO ENDM %token STRINGC INTC FLOATC USTRINGC %token PARROT_OP %type type hll_def return_or_yield comma_or_goto %type program %type class_namespace %type constdef sub emit pcc_ret pcc_yield %type compilation_units compilation_unit pmc_const pragma %type relop any_string assign_op bin_op un_op %type labels _labels label statement sub_call %type pcc_sub_call %type sub_param pcc_arg pcc_result pcc_args pcc_results sub_param_type_def %type pcc_returns pcc_yields pcc_return pcc_call arg arglist the_sub multi_type %type subtags %type argtype_list argtype paramtype_list paramtype %type pcc_return_many %type proto sub_proto sub_proto_list multi subtag multi_types outer %type vtable instanceof subid %type method ns_entry_name %type instruction assignment conditional_statement labeled_inst opt_label op_assign %type if_statement unless_statement %type func_assign get_results %type opt_invocant %type annotate_directive %type target targetlist reg const stringc var result pcc_set_yield %type keylist keylist_force _keylist key maybe_ns nslist _nslist %type vars _vars var_or_i _var_or_i label_op sub_label_op sub_label_op_c %type pasmcode pasmline pasm_inst %type pasm_args %type var_returns %token VAR %token LINECOMMENT %token FILECOMMENT %type id_list id_list_id %nonassoc CONCAT DOT /* %locations */ %pure_parser %parse-param {void *yyscanner} %lex-param {void *yyscanner} %parse-param {imc_info_t *imcc} %lex-param {imc_info_t *imcc} %start program /* In effort to make the grammar readable but not militaristic, please space indent code blocks on 10 col boundaries and keep indentation same for all code blocks in a rule. Indent rule tokens | and ; to 4th col and sub rules 6th col */ %% program: compilation_units { if (yynerrs) YYABORT; $$ = 0; } ; compilation_units: compilation_unit | compilation_units compilation_unit ; compilation_unit: class_namespace { $$ = $1; } | constdef { $$ = $1; } | sub { $$ = $1; imc_close_unit(imcc, imcc->cur_unit); imcc->cur_unit = 0; } | emit { $$ = $1; imc_close_unit(imcc, imcc->cur_unit); imcc->cur_unit = 0; } | MACRO '\n' { $$ = 0; } | pragma { $$ = 0; } | '\n' { $$ = 0; } ; pragma: hll_def '\n' { $$ = 0; } | LOADLIB STRINGC '\n' { $$ = 0; do_loadlib(imcc, $2); mem_sys_free($2); } ; annotate_directive: ANNOTATE STRINGC COMMA const { /* We'll want to store an entry while emitting instructions, so just * store annotation like it's an instruction. */ SymReg * const key = mk_const(imcc, $2, 'S'); $$ = MK_I(imcc, imcc->cur_unit, ".annotate", 2, key, $4); mem_sys_free($2); } ; hll_def: HLL STRINGC { STRING * const hll_name = Parrot_str_unescape(imcc->interp, $2 + 1, '"', NULL); Parrot_pcc_set_HLL(imcc->interp, CURRENT_CONTEXT(imcc->interp), Parrot_hll_register_HLL(imcc->interp, hll_name)); imcc->cur_namespace = NULL; mem_sys_free($2); $$ = 0; } ; constdef: CONST { imcc->is_def = 1; } type IDENTIFIER '=' const { mk_const_ident(imcc, $4, $3, $6, 1); mem_sys_free($4); imcc->is_def = 0; } ; pmc_const: CONST { imcc->is_def = 1; } STRINGC var_or_i '=' any_string { $$ = mk_pmc_const_named(imcc, imcc->cur_unit, $3, $4, $6); mem_sys_free($3); mem_sys_free($6); imcc->is_def = 0; } ; any_string: STRINGC | USTRINGC ; pasmcode: pasmline | pasmcode pasmline ; pasmline: labels pasm_inst '\n' { $$ = 0; } | MACRO '\n' { $$ = 0; } | FILECOMMENT { $$ = 0; } | LINECOMMENT { $$ = 0; } | class_namespace { $$ = $1; } | pmc_const | pragma ; pasm_inst: { clear_state(imcc); } PARROT_OP pasm_args { $$ = INS(imcc, imcc->cur_unit, $2, 0, imcc->regs, imcc->nargs, imcc -> keyvec, 1); mem_sys_free($2); } | PCC_SUB { imc_close_unit(imcc, imcc->cur_unit); imcc->cur_unit = imc_open_unit(imcc, IMC_PASM); } sub_proto LABEL { $$ = iSUBROUTINE(imcc, imcc->cur_unit, mk_sub_label(imcc, $4)); imcc->cur_call->pcc_sub->pragma = $3; mem_sys_free($4); } | PNULL var { $$ = MK_I(imcc, imcc->cur_unit, "null", 1, $2); } | LEXICAL STRINGC COMMA REG { char *name = mem_sys_strdup($2 + 1); SymReg *r = mk_pasm_reg(imcc, $4); SymReg *n; name[strlen(name) - 1] = 0; n = mk_const(imcc, name, 'S'); set_lexical(imcc, r, n); $$ = 0; mem_sys_free(name); mem_sys_free($2); mem_sys_free($4); } | /* none */ { $$ = 0;} ; pasm_args: vars ; emit: /* EMIT and EOM tokens are used when compiling a .pasm file. */ EMIT { imcc->cur_unit = imc_open_unit(imcc, IMC_PASM); } opt_pasmcode EOM { /* if (optimizer_level & OPT_PASM) imc_compile_unit(interp, imcc->cur_unit); emit_flush(interp); */ $$ = 0; } ; opt_pasmcode: /* empty */ | pasmcode ; class_namespace: NAMESPACE maybe_ns '\n' { int re_open = 0; $$ = 0; if (imcc->state->pasm_file && imcc->cur_namespace) { imc_close_unit(imcc, imcc->cur_unit); re_open = 1; } imcc->cur_namespace = $2; if (re_open) imcc->cur_unit = imc_open_unit(imcc, IMC_PASM); } ; maybe_ns: '[' nslist ']' { $$ = $2; } | '[' ']' { $$ = NULL; } ; nslist: { imcc->nkeys = 0; } _nslist { $$ = link_keys(imcc, imcc->nkeys, imcc->keys, 0); } ; _nslist: stringc { imcc->keys[imcc->nkeys++] = $1; } | _nslist ';' stringc { imcc->keys[imcc->nkeys++] = $3; $$ = imcc->keys[0]; } ; sub: SUB { imcc->cur_unit = imc_open_unit(imcc, IMC_PCCSUB); } sub_label_op_c { iSUBROUTINE(imcc, imcc->cur_unit, $3); } sub_proto '\n' { imcc->cur_call->pcc_sub->pragma = $5; if (!imcc->cur_unit->instructions->symregs[0]->subid) { imcc->cur_unit->instructions->symregs[0]->subid = imcc->cur_unit->instructions->symregs[0]; } } sub_body ESUB { $$ = 0; imcc->cur_call = NULL; } ; sub_param: PARAM { imcc->is_def = 1; } sub_param_type_def '\n' { if (/* IMCC_INFO(interp)->cur_unit->last_ins->op || */ !(imcc->cur_unit->last_ins->type & ITPCCPARAM)) { SymReg *r; Instruction *i; char name[128]; snprintf(name, sizeof (name), "%cpcc_params_%d", IMCC_INTERNAL_CHAR, imcc->cnr++); r = mk_symreg(imcc, name, 0); r->type = VT_PCC_SUB; r->pcc_sub = mem_gc_allocate_zeroed_typed(imcc->interp, pcc_sub_t); i = iLABEL(imcc, imcc->cur_unit, r); imcc->cur_call = r; i->type = ITPCCPARAM; } if (imcc->adv_named_id) { add_pcc_named_param(imcc, imcc->cur_call, imcc->adv_named_id, $3); imcc->adv_named_id = NULL; } else add_pcc_arg(imcc, imcc->cur_call, $3); } { imcc->is_def = 0; } ; sub_param_type_def: type IDENTIFIER paramtype_list { if ($3 & VT_OPT_FLAG && $1 != 'I') { const char *type; switch ($1) { case 'N': type = "num"; break; case 'S': type = "string"; break; case 'P': type = "pmc"; break; default: type = "strange"; break; } IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, ":opt_flag parameter must be of type 'int', not '%s'", type); } if ($3 & VT_NAMED && !($3 & VT_FLAT) && !imcc->adv_named_id) adv_named_set(imcc, $2); $$ = mk_ident(imcc, $2, $1, VTIDENTIFIER); $$->type |= $3; mem_sys_free($2); } ; multi: MULTI '(' multi_types ')' { $$ = 0; } ; multi_types: /* empty */ { add_pcc_multi(imcc, imcc->cur_call, NULL); } | multi_types COMMA multi_type { $$ = 0; add_pcc_multi(imcc, imcc->cur_call, $3); } | multi_type { $$ = 0; add_pcc_multi(imcc, imcc->cur_call, $1); } ; multi_type: INTV { $$ = mk_const(imcc, "INTVAL", 'S'); } | FLOATV { $$ = mk_const(imcc, "FLOATVAL", 'S'); } | PMCV { $$ = mk_const(imcc, "PMC", 'S'); } | STRINGV { $$ = mk_const(imcc, "STRING", 'S'); } | IDENTIFIER { SymReg *r; if (strcmp($1, "_") != 0) r = mk_const(imcc, $1, 'S'); else { r = mk_const(imcc, "PMC", 'S'); } mem_sys_free($1); $$ = r; } | STRINGC { SymReg *r; if (strcmp($1, "\"_\"") == 0 || strcmp($1, "'_'") == 0) r = mk_const(imcc, "PMC", 'S'); else { r = mk_const(imcc, $1, 'S'); } mem_sys_free($1); $$ = r; } | '[' keylist ']' { $$ = $2; } ; subtag: SUBTAG '(' subtags ')' { $$ = 0; } ; subtags: subtags COMMA STRINGC { SymReg * const r = mk_const(imcc, $3, 'S'); add_pcc_flag_str(imcc, imcc->cur_call, r); mem_sys_free($3); $$ = r; } | STRINGC { SymReg * const r = mk_const(imcc, $1, 'S'); add_pcc_flag_str(imcc, imcc->cur_call, r); mem_sys_free($1); $$ = r; } ; outer: OUTER '(' STRINGC ')' { $$ = 0; imcc->cur_unit->outer = mk_sub_address_fromc(imcc, $3); mem_sys_free($3); } | OUTER '(' IDENTIFIER ')' { $$ = 0; imcc->cur_unit->outer = mk_const(imcc, $3, 'S'); mem_sys_free($3); } ; vtable: VTABLE_METHOD { $$ = P_VTABLE; imcc->cur_unit->vtable_name = NULL; imcc->cur_unit->is_vtable_method = 1; } | VTABLE_METHOD '(' STRINGC ')' { $$ = P_VTABLE; imcc->cur_unit->vtable_name = $3; imcc->cur_unit->is_vtable_method = 1; } ; method: METHOD { $$ = P_METHOD; imcc->cur_unit->method_name = NULL; imcc->cur_unit->is_method = 1; } | METHOD '(' any_string ')' { $$ = P_METHOD; imcc->cur_unit->method_name = $3; imcc->cur_unit->is_method = 1; } ; ns_entry_name: NS_ENTRY { $$ = P_NSENTRY; imcc->cur_unit->ns_entry_name = NULL; imcc->cur_unit->has_ns_entry_name = 1; } | NS_ENTRY '(' any_string ')' { $$ = P_NSENTRY; imcc->cur_unit->ns_entry_name = $3; imcc->cur_unit->has_ns_entry_name = 1; } ; instanceof: SUB_INSTANCE_OF '(' STRINGC ')' { $$ = 0; imcc->cur_unit->instance_of = $3; } ; subid: SUBID { $$ = 0; imcc->cur_unit->subid = NULL; } | SUBID '(' any_string ')' { SymReg *r = mk_const(imcc, $3, 'S'); $$ = 0; imcc->cur_unit->subid = r; imcc->cur_unit->instructions->symregs[0]->subid = r; mem_sys_free($3); } ; sub_body: /* empty */ | statements ; pcc_sub_call: PCC_BEGIN '\n' { char name[128]; SymReg *r; Instruction *i; snprintf(name, sizeof (name), "%cpcc_sub_call_%d", IMCC_INTERNAL_CHAR, imcc->cnr++); $$ = r = mk_pcc_sub(imcc, name, 0); /* this mid rule action has the semantic value of the * sub SymReg. * This is used below to append args & results */ i = iLABEL(imcc, imcc->cur_unit, r); imcc->cur_call = r; i->type = ITPCCSUB; } pcc_args opt_invocant pcc_call opt_label pcc_results PCC_END { $$ = 0; imcc->cur_call = NULL; } ; opt_label: /* empty */ { $$ = NULL; imcc->cur_call->pcc_sub->label = 0; } | label '\n' { $$ = NULL; imcc->cur_call->pcc_sub->label = 1; } ; opt_invocant: /* empty */ { $$ = NULL; } | INVOCANT var '\n' { $$ = NULL; imcc->cur_call->pcc_sub->object = $2; } ; sub_proto: /* empty */ { $$ = 0; } | sub_proto_list ; sub_proto_list: proto { $$ = $1; } | sub_proto_list proto { $$ = $1 | $2; } ; proto: LOAD { $$ = P_LOAD; /* SymReg * const r = mk_const(imcc, "load", 'S'); add_pcc_flag_str(imcc, imcc->cur_call, r); $$ = r; */ } | INIT { $$ = P_INIT; /* SymReg * const r = mk_const(imcc, "load", 'S'); add_pcc_flag_str(imcc, imcc->cur_call, r); $$ = r; */ } | MAIN { $$ = P_MAIN; } | IMMEDIATE { $$ = P_IMMEDIATE; } | POSTCOMP { $$ = P_POSTCOMP; } | ANON { $$ = P_ANON; } | NEED_LEX { $$ = P_NEED_LEX; } | multi | subtag | outer | vtable | method | ns_entry_name | instanceof | subid ; pcc_call: PCC_CALL var COMMA var '\n' { add_pcc_sub(imcc->cur_call, $2); add_pcc_cc(imcc->cur_call, $4); } | PCC_CALL var '\n' { add_pcc_sub(imcc->cur_call, $2); } pcc_args: /* empty */ { $$ = 0; } | pcc_args pcc_arg '\n' { if (imcc->adv_named_id) { add_pcc_named_param(imcc, imcc->cur_call, imcc->adv_named_id, $2); imcc->adv_named_id = NULL; } else add_pcc_arg(imcc, imcc->cur_call, $2); } ; pcc_arg: ARG arg { $$ = $2; } ; pcc_results: /* empty */ { $$ = 0; } | pcc_results pcc_result '\n' { if ($2) add_pcc_result(imcc, imcc->cur_call, $2); } ; pcc_result: RESULT target paramtype_list { $$ = $2; $$->type |= $3; } | LOCAL { imcc->is_def = 1; } type id_list_id { IdList * const l = $4; SymReg *ignored; ignored = mk_ident(imcc, l->id, $3, VTIDENTIFIER); UNUSED(ignored); imcc->is_def = 0; $$ = 0; } ; paramtype_list: /* empty */ { $$ = 0; } | paramtype_list paramtype { $$ = $1 | $2; } ; paramtype: ADV_SLURPY { $$ = VT_FLAT; } | ADV_OPTIONAL { $$ = VT_OPTIONAL; } | ADV_OPT_FLAG { $$ = VT_OPT_FLAG; } | ADV_NAMED { $$ = VT_NAMED; } | ADV_NAMED '(' STRINGC ')' { adv_named_set(imcc, $3); $$ = VT_NAMED; mem_sys_free($3); } | ADV_NAMED '(' USTRINGC ')' { adv_named_set_u(imcc, $3); $$ = VT_NAMED; mem_sys_free($3); } | ADV_CALL_SIG { $$ = VT_CALL_SIG; } ; pcc_ret: PCC_BEGIN_RETURN '\n' { begin_return_or_yield(imcc, 0); } pcc_returns PCC_END_RETURN { $$ = 0; imcc->asm_state = AsmDefault; } | pcc_return_many { imcc->asm_state = AsmDefault; $$ = 0; } ; pcc_yield: PCC_BEGIN_YIELD '\n' { begin_return_or_yield(imcc, 1); } pcc_yields PCC_END_YIELD { $$ = 0; imcc->asm_state = AsmDefault; } ; pcc_returns: /* empty */ { $$ = 0; } | pcc_returns '\n' { if ($1) add_pcc_result(imcc, imcc->sr_return, $1); } | pcc_returns pcc_return '\n' { if ($2) add_pcc_result(imcc, imcc->sr_return, $2); } ; pcc_yields: /* empty */ { $$ = 0; } | pcc_yields '\n' { if ($1) add_pcc_result(imcc, imcc->sr_return, $1); } | pcc_yields pcc_set_yield '\n' { if ($2) add_pcc_result(imcc, imcc->sr_return, $2); } ; pcc_return: SET_RETURN var argtype_list { $$ = $2; $$->type |= $3; } ; pcc_set_yield: SET_YIELD var argtype_list { $$ = $2; $$->type |= $3; } ; pcc_return_many: return_or_yield '(' { if (imcc->asm_state == AsmDefault) begin_return_or_yield(imcc, $1); } var_returns ')' { imcc->asm_state = AsmDefault; $$ = 0; } ; return_or_yield: RETURN { $$ = 0; } | YIELDT { $$ = 1; } ; var_returns: /* empty */ { $$ = 0; } | arg { if (imcc->adv_named_id) { add_pcc_named_return(imcc, imcc->sr_return, imcc->adv_named_id, $1); imcc->adv_named_id = NULL; } else add_pcc_result(imcc, imcc->sr_return, $1); } | STRINGC ADV_ARROW var { SymReg * const name = mk_const(imcc, $1, 'S'); add_pcc_named_return(imcc, imcc->sr_return, name, $3); } | var_returns COMMA arg { if (imcc->adv_named_id) { add_pcc_named_return(imcc, imcc->sr_return, imcc->adv_named_id, $3); imcc->adv_named_id = NULL; } else add_pcc_result(imcc, imcc->sr_return, $3); } | var_returns COMMA STRINGC ADV_ARROW var { SymReg * const name = mk_const(imcc, $3, 'S'); add_pcc_named_return(imcc, imcc->sr_return, name, $5); } ; statements: statement | statements statement ; /* This is ugly. Because 'instruction' can start with PARAM and in the * 'pcc_sub' rule, 'pcc_params' is followed by 'statement', we get a * shift/reduce conflict on PARAM between reducing to the dummy * { clear_state(); } rule and shifting the PARAM to be used as part * of the 'pcc_params' (which is what we want). However, yacc syntax * doesn't propagate precedence to the dummy rules, so we have to * split out the action just so that we can assign it a precedence. */ helper_clear_state: { clear_state(imcc); } %prec LOW_PREC ; statement: sub_param { $$ = 0; } | helper_clear_state instruction { $$ = $2; } | MACRO '\n' { $$ = 0; } | FILECOMMENT { $$ = 0; } | LINECOMMENT { $$ = 0; } | annotate_directive { $$ = $1; } ; labels: /* none */ { $$ = NULL; } | _labels ; _labels: _labels label | label ; label: LABEL { Instruction * const i = iLABEL(imcc, imcc->cur_unit, mk_local_label(imcc, $1)); mem_sys_free($1); $$ = i; } ; instruction: labels labeled_inst '\n' { $$ = $2; } | error '\n' { if (yynerrs >= PARROT_MAX_RECOVER_ERRORS) { IMCC_warning(imcc, "Too many errors. Correct some first.\n"); YYABORT; } yyerrok; } ; id_list : id_list_id { IdList* const l = $1; l->next = NULL; $$ = l; } | id_list COMMA id_list_id { IdList* const l = $3; l->next = $1; $$ = l; } ; id_list_id : IDENTIFIER { IdList* const l = mem_gc_allocate_n_zeroed_typed(imcc->interp, 1, IdList); l->id = $1; $$ = l; } ; labeled_inst: assignment | conditional_statement | LOCAL { imcc->is_def = 1; } type id_list { IdList *l = $4; while (l) { IdList *l1; mk_ident(imcc, l->id, $3, VTIDENTIFIER); l1 = l; l = l->next; mem_sys_free(l1->id); mem_sys_free(l1); } imcc->is_def = 0; $$ = 0; } | LEXICAL STRINGC COMMA target { SymReg *n; char *name = mem_sys_strdup($2 + 1); name[strlen(name) - 1] = 0; n = mk_const(imcc, name, 'S'); set_lexical(imcc, $4, n); $$ = 0; mem_sys_free($2); mem_sys_free(name); } | LEXICAL USTRINGC COMMA target { SymReg *n = mk_const(imcc, $2, 'U'); set_lexical(imcc, $4, n); $$ = 0; mem_sys_free($2); } | CONST { imcc->is_def = 1; } type IDENTIFIER '=' const { mk_const_ident(imcc, $4, $3, $6, 0); imcc->is_def = 0; mem_sys_free($4); } | pmc_const | GLOBAL_CONST { imcc->is_def = 1; } type IDENTIFIER '=' const { mk_const_ident(imcc, $4, $3, $6, 1); imcc->is_def = 0; mem_sys_free($4); } | TAILCALL sub_call { $$ = NULL; imcc->cur_call->pcc_sub->tailcall = 1; imcc->cur_call = NULL; } | GOTO label_op { $$ = MK_I(imcc, imcc->cur_unit, "branch", 1, $2); } | PARROT_OP vars { $$ = INS(imcc, imcc->cur_unit, $1, 0, imcc->regs, imcc->nargs, imcc->keyvec, 1); mem_sys_free($1); } | PNULL var { $$ = MK_I(imcc, imcc->cur_unit, "null", 1, $2); } | sub_call { $$ = 0; imcc->cur_call = NULL; } | pcc_sub_call { $$ = 0; } | pcc_ret | pcc_yield | /* none */ { $$ = 0;} ; type: INTV {$$ = 'I'; } | FLOATV { $$ = 'N'; } | STRINGV { $$ = 'S'; } | PMCV { $$ = 'P'; } ; assignment: target '=' var { $$ = MK_I(imcc, imcc->cur_unit, "set", 2, $1, $3); } | target '=' un_op var { $$ = MK_I(imcc, imcc->cur_unit, $3, 2, $1, $4); } | target '=' var bin_op var { $$ = MK_I(imcc, imcc->cur_unit, $4, 3, $1, $3, $5); } | target '=' var '[' keylist ']' { $$ = iINDEXFETCH(imcc, imcc->cur_unit, $1, $3, $5); } | target '[' keylist ']' '=' var { $$ = iINDEXSET(imcc, imcc->cur_unit, $1, $3, $6); } /* Subroutine call the short way */ | target '=' sub_call { add_pcc_result(imcc, $3->symregs[0], $1); imcc->cur_call = NULL; $$ = 0; } | '(' { $$ = IMCC_create_itcall_label(imcc); } targetlist ')' '=' the_sub '(' arglist ')' { IMCC_itcall_sub(imcc, $6); imcc->cur_call = NULL; } | get_results | op_assign | func_assign | target '=' PNULL { $$ = MK_I(imcc, imcc->cur_unit, "null", 1, $1); } ; /* C++ hates implicit casts from string constants to char *, so be explicit */ un_op: '!' { $$ = (char *)"not"; } | '~' { $$ = (char *)"bnot"; } | '-' { $$ = (char *)"neg"; } ; bin_op: '-' { $$ = (char *)"sub"; } | '+' { $$ = (char *)"add"; } | '*' { $$ = (char *)"mul"; } | '/' { $$ = (char *)"div"; } | '%' { $$ = (char *)"mod"; } | FDIV { $$ = (char *)"fdiv"; } | POW { $$ = (char *)"pow"; } | CONCAT { $$ = (char *)"concat"; } | RELOP_EQ { $$ = (char *)"iseq"; } | RELOP_NE { $$ = (char *)"isne"; } | RELOP_GT { $$ = (char *)"isgt"; } | RELOP_GTE { $$ = (char *)"isge"; } | RELOP_LT { $$ = (char *)"islt"; } | RELOP_LTE { $$ = (char *)"isle"; } | SHIFT_LEFT { $$ = (char *)"shl"; } | SHIFT_RIGHT { $$ = (char *)"shr"; } | SHIFT_RIGHT_U { $$ = (char *)"lsr"; } | LOG_AND { $$ = (char *)"and"; } | LOG_OR { $$ = (char *)"or"; } | LOG_XOR { $$ = (char *)"xor"; } | '&' { $$ = (char *)"band"; } | '|' { $$ = (char *)"bor"; } | '~' { $$ = (char *)"bxor"; } ; get_results: GET_RESULTS { $$ = IMCC_create_itcall_label(imcc); $$->type &= ~ITCALL; $$->type |= ITRESULT; } '(' targetlist ')' { $$ = 0; } ; op_assign: target assign_op var { $$ = MK_I(imcc, imcc->cur_unit, $2, 2, $1, $3); } | target CONCAT_ASSIGN var { if ($1->set == 'P') $$ = MK_I(imcc, imcc->cur_unit, "concat", 2, $1, $3); else $$ = MK_I(imcc, imcc->cur_unit, "concat", 3, $1, $1, $3); } ; assign_op: PLUS_ASSIGN { $$ = (char *)"add"; } | MINUS_ASSIGN { $$ = (char *)"sub"; } | MUL_ASSIGN { $$ = (char *)"mul"; } | DIV_ASSIGN { $$ = (char *)"div"; } | MOD_ASSIGN { $$ = (char *)"mod"; } | FDIV_ASSIGN { $$ = (char *)"fdiv"; } | BAND_ASSIGN { $$ = (char *)"band"; } | BOR_ASSIGN { $$ = (char *)"bor"; } | BXOR_ASSIGN { $$ = (char *)"bxor"; } | SHR_ASSIGN { $$ = (char *)"shr"; } | SHL_ASSIGN { $$ = (char *)"shl"; } | SHR_U_ASSIGN { $$ = (char *)"lsr"; } ; func_assign: target '=' PARROT_OP pasm_args { $$ = func_ins(imcc, imcc->cur_unit, $1, $3, imcc -> regs, imcc -> nargs, imcc -> keyvec, 1); mem_sys_free($3); } ; the_sub: IDENTIFIER { $$ = mk_sub_address(imcc, $1); mem_sys_free($1); } | STRINGC { $$ = mk_sub_address_fromc(imcc, $1); mem_sys_free($1); } | USTRINGC { $$ = mk_sub_address_u(imcc, $1); mem_sys_free($1); } | target { $$ = $1; if ($1->set != 'P') IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Sub isn't a PMC"); } | target DOT sub_label_op { /* disallow bareword method names; SREG name constants are fine */ const char * const name = $3->name; if (!($3->type & VTREG)) { if (*name != '\'' || *name != '\"') IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Bareword method name '%s' not allowed in PIR", $3->name); } imcc->cur_obj = $1; $$ = $3; } | target DOT USTRINGC { imcc->cur_obj = $1; $$ = mk_const(imcc, $3, 'U'); mem_sys_free($3); } | target DOT STRINGC { imcc->cur_obj = $1; $$ = mk_const(imcc, $3, 'S'); mem_sys_free($3); } | target DOT target { imcc->cur_obj = $1; $$ = $3; } ; sub_call: the_sub { $$ = IMCC_create_itcall_label(imcc); IMCC_itcall_sub(imcc, $1); } '(' arglist ')' { $$ = $2; } ; arglist: /* empty */ { $$ = 0; } | arglist COMMA arg { $$ = 0; if (imcc->adv_named_id) { add_pcc_named_arg(imcc, imcc->cur_call, imcc->adv_named_id, $3); imcc->adv_named_id = NULL; } else add_pcc_arg(imcc, imcc->cur_call, $3); } | arg { $$ = 0; if (imcc->adv_named_id) { add_pcc_named_arg(imcc, imcc->cur_call, imcc->adv_named_id, $1); imcc->adv_named_id = NULL; } else add_pcc_arg(imcc, imcc->cur_call, $1); } | arglist COMMA STRINGC ADV_ARROW var { $$ = 0; add_pcc_named_arg(imcc, imcc->cur_call, mk_const(imcc, $3, 'S'), $5); mem_sys_free($3); } | var ADV_ARROW var { $$ = 0; add_pcc_named_arg_var(imcc, imcc->cur_call, $1, $3); } | STRINGC ADV_ARROW var { $$ = 0; add_pcc_named_arg(imcc, imcc->cur_call, mk_const(imcc, $1, 'S'), $3); mem_sys_free($1); } ; arg: var argtype_list { $$ = $1; $$->type |= $2; } ; argtype_list: /* empty */ { $$ = 0; } | argtype_list argtype { $$ = $1 | $2; } ; argtype: ADV_FLAT { $$ = VT_FLAT; } | ADV_NAMED { $$ = VT_NAMED; } | ADV_CALL_SIG { $$ = VT_CALL_SIG; } | ADV_NAMED '(' USTRINGC ')' { adv_named_set_u(imcc, $3); mem_sys_free($3); $$ = 0; } | ADV_NAMED '(' STRINGC ')' { adv_named_set(imcc, $3); mem_sys_free($3); $$ = 0; } ; result: target paramtype_list { $$ = $1; $$->type |= $2; } ; targetlist: targetlist COMMA result { $$ = 0; if (imcc->adv_named_id) { add_pcc_named_result(imcc, imcc->cur_call, imcc->adv_named_id, $3); imcc->adv_named_id = NULL; } else add_pcc_result(imcc, imcc->cur_call, $3); } | targetlist COMMA STRINGC ADV_ARROW target { add_pcc_named_result(imcc, imcc->cur_call, mk_const(imcc, $3, 'S'), $5); mem_sys_free($3); } | result { $$ = 0; if (imcc->adv_named_id) { add_pcc_named_result(imcc, imcc->cur_call, imcc->adv_named_id, $1); imcc->adv_named_id = NULL; } else add_pcc_result(imcc, imcc->cur_call, $1); } | STRINGC ADV_ARROW target { add_pcc_named_result(imcc, imcc->cur_call, mk_const(imcc, $1, 'S'), $3); mem_sys_free($1); } | /* empty */ { $$ = 0; } ; conditional_statement: if_statement { $$ = $1; } | unless_statement { $$ = $1; } ; unless_statement: UNLESS var relop var GOTO label_op { $$ = MK_I(imcc, imcc->cur_unit, inv_op($3), 3, $2, $4, $6); } | UNLESS PNULL var GOTO label_op { $$ = MK_I(imcc, imcc->cur_unit, "unless_null", 2, $3, $5); } | UNLESS var comma_or_goto label_op { $$ = MK_I(imcc, imcc->cur_unit, "unless", 2, $2, $4); } ; if_statement: IF var comma_or_goto label_op { $$ = MK_I(imcc, imcc->cur_unit, "if", 2, $2, $4); } | IF var relop var GOTO label_op { $$ = MK_I(imcc, imcc->cur_unit, $3, 3, $2, $4, $6); } | IF PNULL var GOTO label_op { $$ = MK_I(imcc, imcc->cur_unit, "if_null", 2, $3, $5); } ; comma_or_goto: COMMA { $$ = 0; } | GOTO { $$ = 0; } ; relop: RELOP_EQ { $$ = (char *)"eq"; } | RELOP_NE { $$ = (char *)"ne"; } | RELOP_GT { $$ = (char *)"gt"; } | RELOP_GTE { $$ = (char *)"ge"; } | RELOP_LT { $$ = (char *)"lt"; } | RELOP_LTE { $$ = (char *)"le"; } ; target: VAR | reg ; vars: /* empty */ { $$ = NULL; } | _vars { $$ = $1; } ; _vars: _vars COMMA _var_or_i { $$ = imcc->regs[0]; } | _var_or_i ; _var_or_i: var_or_i { imcc->regs[imcc->nargs++] = $1; } | target '[' keylist ']' { imcc -> regs[imcc->nargs++] = $1; imcc -> keyvec |= KEY_BIT(imcc->nargs); imcc -> regs[imcc->nargs++] = $3; $$ = $1; } | '[' keylist_force ']' { imcc -> regs[imcc->nargs++] = $2; $$ = $2; } ; sub_label_op_c: sub_label_op | STRINGC { $$ = mk_sub_address_fromc(imcc, $1); mem_sys_free($1); } | USTRINGC { $$ = mk_sub_address_u(imcc, $1); mem_sys_free($1); } ; sub_label_op: IDENTIFIER { $$ = mk_sub_address(imcc, $1); mem_sys_free($1); } | PARROT_OP { $$ = mk_sub_address(imcc, $1); mem_sys_free($1); } ; label_op: IDENTIFIER { $$ = mk_label_address(imcc, $1); mem_sys_free($1); } | PARROT_OP { $$ = mk_label_address(imcc, $1); mem_sys_free($1); } ; var_or_i: label_op | var ; var: target | const ; keylist: { imcc->nkeys = 0; } _keylist { $$ = link_keys(imcc, imcc->nkeys, imcc->keys, 0); } ; keylist_force: { imcc->nkeys = 0; } _keylist { $$ = link_keys(imcc, imcc->nkeys, imcc->keys, 1); } ; _keylist: key { imcc->keys[imcc->nkeys++] = $1; } | _keylist ';' key { imcc->keys[imcc->nkeys++] = $3; $$ = imcc->keys[0]; } ; key: var { $$ = $1; } ; reg: IREG { $$ = mk_symreg(imcc, $1, 'I'); } | NREG { $$ = mk_symreg(imcc, $1, 'N'); } | SREG { $$ = mk_symreg(imcc, $1, 'S'); } | PREG { $$ = mk_symreg(imcc, $1, 'P'); } | REG { $$ = mk_pasm_reg(imcc, $1); mem_sys_free($1); } ; stringc: STRINGC { $$ = mk_const(imcc, $1, 'S'); mem_sys_free($1); } | USTRINGC { $$ = mk_const(imcc, $1, 'U'); mem_sys_free($1); } ; const: INTC { $$ = mk_const(imcc, $1, 'I'); mem_sys_free($1); } | FLOATC { $$ = mk_const(imcc, $1, 'N'); mem_sys_free($1); } | stringc { $$ = $1; } ; /* The End */ %% /* I need this prototype somewhere... */ char *yyget_text(yyscan_t yyscanner); /* I do not like this function, but, atm, it is the only way I can * make the code in yyerror work without segfault on some specific * cases. */ /* int yyholds_char(yyscan_t yyscanner); */ int yyerror(void *yyscanner, ARGMOD(imc_info_t *imcc), const char *s) { /* If the error occurr in the end of the buffer (I mean, the last * token was already read), yyget_text will return a pointer * outside the bison buffer, and thus, not "accessible" by * us. This means it may segfault. */ const char * const chr = yyget_text((yyscan_t)yyscanner); /* IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, s); */ /* --- This was called before, not sure if I should call some similar function that does not die like this one. */ /* Basically, if current token is a newline, it mean the error was * before the newline, and thus, line is the line *after* the * error. Instead of duplicating code for both cases (the 'newline' and * non-newline case, do the test twice; efficiency is not important when * we have an error anyway. */ if (!at_eof(yyscanner)) { IMCC_warning(imcc, "error:imcc:%s", s); /* don't print the current token if it is a newline */ if (*chr != '\n') IMCC_warning(imcc, " ('%s')", chr); IMCC_print_inc(imcc); } /* scanner is at EOF; just to be sure, don't print "current" token */ else { IMCC_warning(imcc, "error:imcc:%s", s); IMCC_print_inc(imcc); } return 0; } /* =back */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ ubuntu_packaging_guide.pod000644000765000765 635712101554066 22331 0ustar00brucebruce000000000000parrot-5.9.0/docs/project# Copyright (C) 2007-2012, Parrot Foundation. =pod =head1 NAME docs/project/ubuntu_packaging_guide.pod - The Ubuntu Packaging Guide. =head1 DESCRIPTION This is a quick set of instructions for packaging Parrot for Ubuntu. =head1 Ubuntu Packaging Guide See the Ubuntu Packaging Guide (https://wiki.ubuntu.com/PackagingGuide) and the guide to the Person Package Archive (PPA) (https://help.launchpad.net/Packaging/PPA) for more details. This guide assumes that you're running in a chroot environment set up as in: L, and also assumes that you've already built the corresponding Debian package for the release as documented in L. To package Parrot for Ubuntu: =over 4 =item 0. Download the latest tarball. =item 1. Compile it and run the tests, just to be sure the tarball is sound (especially useful if you're running in a chroot environment different than your usual dev environment). =item 2. Create a new directory. (The name is irrelevant, but we'll use F<~/udeb/parrot> for the sake of illustration.) Create a fresh extract of the tarball in the F<~/udeb/parrot> directory. The directory should be named F (it will be by default). Copy the original tarball into F<~/udeb/parrot>, naming it F (note the "_" in place of dash). =item 3. Integrate any new change entries from F into F, preserving chronological order. Copy the F directory from the Parrot source tree into the fresh tarball extract. cp -r /ports/debian ~/udeb/parrot/parrot-[version]/. Then copy the unique Ubuntu files (F and F) from F into the new F directory. cp /ports/ubuntu/* ~/udeb/parrot/parrot-[version]/debian/. =item 4. Add a new entry to the F file in F<~/udeb/parrot/parrot-[version]/debian/> for the Ubuntu package. Copy the first line from the Debian changelog. Add C after the Debian version to indicate the Ubuntu revision of the package, and for PPA uploads also add C<~ppa#>. Instead of the Debian branch ('unstable') use the target Ubuntu distribution ('intrepid'). parrot (0.5.1-1ubuntu1) intrepid; urgency=low The changelog entry for the Ubuntu release is generally: * Synchronize with Debian unstable. Add any custom changes for Ubuntu packaging (rare). The final line gives the maintainer's name, email address, and the date. The date must be in RFC822 format, and can be generated by running C. (Note that two spaces are required between the email and the date.) -- Your Name Sun, 30 Dec 2007 17:21:45 +0000 =item 5. Install all dependencies: $ sudo /usr/lib/pbuilder/pbuilder-satisfydepends =item 6. Build the source packages. From F<~/udeb/parrot/parrot_[version]/>, run: $ debuild -S -sa =item 7. Update Parrot's PPA with the new release (configured in ChrootSetup). From F<~/udeb/parrot/> run: $ dput parrot-ppa parrot_[version]_source.changes =item 8. Commit the Ubuntu F file to the F directory in the repository. (At the moment, we're keeping the Debian packages as the primary.) =back =cut task.pmc000644000765000765 3463312171255037 15556 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME src/pmc/task.pmc - A concurrent task =head1 DESCRIPTION The Task PMC represents a concurrent running "green thread". =head2 Functions =over 4 =cut */ #include "parrot/scheduler_private.h" #include "pmc/pmc_scheduler.h" #include "pmc/pmc_proxy.h" /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* HEADERIZER END: static */ pmclass Task provides invokable auto_attrs { ATTR UINTVAL id; /* Unique identifier for this task */ ATTR FLOATVAL birthtime; /* The creation time stamp of the task */ ATTR Parrot_Interp interp; /* The interpreter that created the task */ ATTR PMC *code; /* An (optional) code for the task */ ATTR PMC *data; /* Additional data for the task */ ATTR INTVAL killed; /* Dead tasks don't get run */ ATTR PMC *mailbox; /* List of incoming messages */ ATTR Parrot_mutex mailbox_lock; ATTR PMC *waiters; /* Tasks waiting on this one */ ATTR Parrot_mutex waiters_lock; ATTR PMC *shared; /* List of variables shared with this task */ ATTR PMC *partner; /* Copy of this task on the other side of a GC barrier, meaning in another thread */ /* =item C Initialize a concurrency task object. =cut */ VTABLE void init() { Parrot_Task_attributes * const core_struct = PARROT_TASK(SELF); Parrot_Scheduler_attributes * const sched_data = PARROT_SCHEDULER(interp->scheduler); /* Set flags for custom GC mark. */ PObj_custom_mark_SET(SELF); /* Set up the core struct. */ core_struct->birthtime = Parrot_floatval_time(); core_struct->code = PMCNULL; core_struct->data = PMCNULL; core_struct->interp = INTERP; core_struct->killed = 0; core_struct->mailbox = PMCNULL; /* Created lazily on demand */ core_struct->waiters = PMCNULL; /* Created lazily on demand */ core_struct->shared = Parrot_pmc_new(INTERP, enum_class_ResizablePMCArray); core_struct->partner = NULL; /* Set by Parrot_thread_create_local_task */ MUTEX_INIT(core_struct->mailbox_lock); MUTEX_INIT(core_struct->waiters_lock); /* Assign a unique ID */ /* TODO: Fix collisions. */ core_struct->id = sched_data->next_task_id; sched_data->next_task_id += 1; /* By default, all flags are clear. */ TASK_active_CLEAR(SELF); TASK_in_preempt_CLEAR(SELF); TASK_recv_block_CLEAR(SELF); } /* =item C Initializes a new Task with a C PMC with any or all of the keys: =over 4 =item C The time at which this Task was created. =item C An C PMC related to this task. =item C Some data that will be passed to C when invoked. =back =cut */ VTABLE void init_pmc(PMC *data) { Parrot_Task_attributes * const core_struct = PARROT_TASK(SELF); SELF.init(); if (VTABLE_isa(INTERP, data, CONST_STRING(INTERP, "Sub"))) { core_struct->code = data; } else if (VTABLE_isa(INTERP, data, CONST_STRING(INTERP, "Hash"))) { PMC * elem = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP, "birthtime")); if (! PMC_IS_NULL(elem)) core_struct->birthtime = VTABLE_get_number(INTERP, elem); elem = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP, "code")); if (! PMC_IS_NULL(elem)) core_struct->code = elem; elem = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP, "data")); if (! PMC_IS_NULL(elem)) core_struct->data = elem; } else { Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "Task initializer must be a Hash or Sub"); } } /* =item C Invokes whatever is in the Task's associated code. If the Task's data attribute is not null, pass it to the code as the first argument. =cut */ VTABLE opcode_t *invoke(void *next) { Parrot_Task_attributes * const task = PARROT_TASK(SELF); Parrot_Scheduler_attributes * const sdata = PARROT_SCHEDULER(interp->scheduler); PMC * const active_tasks = sdata->all_tasks; PARROT_ASSERT(! PMC_IS_NULL(task->code)); /* If a task is pre-empted, this will be set again. */ TASK_in_preempt_CLEAR(SELF); if (! task->killed) { const INTVAL current_depth = Parrot_pcc_get_recursion_depth(interp, CURRENT_CONTEXT(interp)); /* Add the task to the set of active Tasks */ PMC * const task_id = Parrot_pmc_new(interp, enum_class_Integer); VTABLE_set_integer_native(interp, task_id, task->id); VTABLE_set_pmc_keyed(interp, active_tasks, task_id, SELF); TASK_active_SET(SELF); /* Actually run the task */ Parrot_ext_call(interp, task->code, "P->", task->data); /* Restore recursion_depth since Parrot_Sub_invoke increments recursion_depth which would not be decremented anymore if the sub is preempted */ Parrot_pcc_set_recursion_depth(interp, CURRENT_CONTEXT(interp), current_depth); } /* Fixed possibly racy read with write in send TASK_recv_block_CLEAR(partner) */ if (task->killed || !TASK_in_preempt_TEST(SELF)) { /* The task is done. */ /* Remove it from the set of active Tasks */ INTVAL i, n = 0; PMC * const task_id = Parrot_pmc_new(interp, enum_class_Integer); VTABLE_set_integer_native(interp, task_id, task->id); TASK_active_CLEAR(SELF); VTABLE_delete_keyed(interp, active_tasks, task_id); task->killed = 1; /* schedule any waiters. */ if (!PMC_IS_NULL(task->waiters)) n = VTABLE_get_integer(interp, task->waiters); for (i = 0; i < n; ++i) { PMC * const wtask = VTABLE_get_pmc_keyed_int(interp, task->waiters, i); Parrot_cx_schedule_task(interp, wtask); } if (task->partner) { /* TODO how can we know if the partner's still alive? */ Parrot_Task_attributes * const partner_task = PARROT_TASK(task->partner); LOCK(partner_task->waiters_lock); if (!PMC_IS_NULL(partner_task->waiters)) { Parrot_block_GC_mark_locked(partner_task->interp); partner_task->killed = 1; n = VTABLE_get_integer(interp, partner_task->waiters); for (i = 0; i < n; ++i) { PMC * const wtask = VTABLE_get_pmc_keyed_int(interp, partner_task->waiters, i); Parrot_cx_schedule_immediate(partner_task->interp, wtask); } Parrot_unblock_GC_mark_locked(partner_task->interp); } else partner_task->killed = 1; UNLOCK(partner_task->waiters_lock); } } return (opcode_t*) next; } /* =item C Create a copy of the task, resetting status, ID, and birthtime. =cut */ VTABLE PMC *clone() { /* Create the new task PMC, of the same type of this one (we may * have been subclassed). */ PMC * const copy = Parrot_pmc_new(INTERP, SELF->vtable->base_type); Parrot_Task_attributes * const new_struct = PARROT_TASK(copy); const Parrot_Task_attributes * const old_struct = PARROT_TASK(SELF); new_struct->code = VTABLE_clone(INTERP, old_struct->code); new_struct->data = VTABLE_clone(INTERP, old_struct->data); new_struct->shared = VTABLE_clone(INTERP, old_struct->shared); return copy; } /* =item C Gets the value of an attribute for this task. =cut */ VTABLE PMC *get_attr_str(STRING *name) { Parrot_Task_attributes * const core_struct = PARROT_TASK(SELF); PMC * value = PMCNULL; if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "birthtime"))) { value = Parrot_pmc_new(INTERP, enum_class_Float); VTABLE_set_number_native(INTERP, value, core_struct->birthtime); } else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "code"))) { value = core_struct->code; } else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "data"))) { value = core_struct->data; } return value; } /* =item C Sets the value of an attribute for this task. =cut */ VTABLE void set_attr_str(STRING *name, PMC *value) { Parrot_Task_attributes * const core_struct = PARROT_TASK(SELF); if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "birthtime"))) { core_struct->birthtime = VTABLE_get_number(INTERP, value); } else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "code"))) { core_struct->code = value; } else if (STRING_equal(INTERP, name, CONST_STRING(INTERP, "data"))) { core_struct->data = value; } } /* =item C Add value to the list of PMCs shared with this task. =cut */ VTABLE void push_pmc(PMC *value) { VTABLE_push_pmc(interp, PARROT_TASK(SELF)->shared, value); return; } /* =item C Return a proxy for the last shared PMC. =cut */ VTABLE PMC *pop_pmc() { return VTABLE_pop_pmc(interp, PARROT_TASK(SELF)->shared); } /* =item C Mark any referenced strings and PMCs. =cut */ VTABLE void mark() { if (PARROT_TASK(SELF)) { Parrot_Task_attributes * const core_struct = PARROT_TASK(SELF); Parrot_gc_mark_PMC_alive(INTERP, core_struct->code); Parrot_gc_mark_PMC_alive(INTERP, core_struct->data); Parrot_gc_mark_PMC_alive(INTERP, core_struct->mailbox); Parrot_gc_mark_PMC_alive(INTERP, core_struct->waiters); Parrot_gc_mark_PMC_alive(INTERP, core_struct->shared); /* don't mark our partner, since it belongs to another GC */ } } /* =item C This is used by freeze/thaw to visit the contents of the task. C<*info> is the visit info, (see F). =cut */ VTABLE void visit(PMC *info) { /* 1) visit code block */ VISIT_PMC_ATTR(INTERP, info, SELF, Task, code); VISIT_PMC_ATTR(INTERP, info, SELF, Task, data); VISIT_PMC_ATTR(INTERP, info, SELF, Task, mailbox); VISIT_PMC_ATTR(INTERP, info, SELF, Task, waiters); } /* =item C Used to archive the task. =cut */ VTABLE void freeze(PMC *info) { const Parrot_Task_attributes * const core_struct = PARROT_TASK(SELF); VTABLE_push_float(INTERP, info, core_struct->birthtime); } /* =item C Used to unarchive the task. =cut */ VTABLE void thaw(PMC *info) { const FLOATVAL birthtime = VTABLE_shift_float(INTERP, info); /* Allocate the task's core data struct and set custom flags. */ SELF.init(); /* Set the task's birthtime to the frozen birthtime */ PARROT_TASK(SELF)->birthtime = birthtime; } /* =item C Called after the task has been thawed. =cut */ VTABLE void thawfinish(PMC *info) { UNUSED(INTERP) UNUSED(SELF) UNUSED(info) /* Parrot_Task_attributes * const core_struct = PARROT_TASK(SELF); */ } /* =back =head2 Methods =over 4 =item METHOD send(PMC *message) Send a message to this task. =cut */ METHOD send(PMC *message) { Parrot_Task_attributes * const tdata = PARROT_TASK(SELF); LOCK(tdata->mailbox_lock); if (PMC_IS_NULL(tdata->mailbox)) { tdata->mailbox = Parrot_pmc_new(interp, enum_class_PMCList); PARROT_GC_WRITE_BARRIER(interp, SELF); } VTABLE_push_pmc(interp, tdata->mailbox, message); UNLOCK(tdata->mailbox_lock); if (tdata->partner) { PMC * const partner = tdata->partner; Parrot_Task_attributes * const pdata = PARROT_TASK(partner); LOCK(tdata->mailbox_lock); Parrot_block_GC_mark_locked(pdata->interp); if (TASK_recv_block_TEST(partner)) { /* Was: racy write with read in invoke task->killed || in_preempt */ /* TASK_recv_block_CLEAR(partner); */ Parrot_cx_schedule_immediate(pdata->interp, partner); TASK_recv_block_CLEAR(partner); } Parrot_unblock_GC_mark_locked(pdata->interp); UNLOCK(tdata->mailbox_lock); } else { if (TASK_recv_block_TEST(SELF)) { TASK_recv_block_CLEAR(SELF); Parrot_cx_schedule_task(interp, SELF); } } } /* METHOD receive() { } */ /* =item METHOD code(PMC * code :optional) Read or write optional code, an C PMC related to this task. =item METHOD data(PMC * data :optional) Reads or writes optional task-specific data, that will be passed to C when invoked. =cut */ METHOD code(PMC * code :optional, INTVAL has_code :opt_flag) { Parrot_Task_attributes * const tdata = PARROT_TASK(SELF); if (has_code) { tdata->code = code; PARROT_GC_WRITE_BARRIER(INTERP, SELF); } code = tdata->code; RETURN(PMC *code); } METHOD data(PMC * data :optional, INTVAL has_data :opt_flag) { Parrot_Task_attributes * const tdata = PARROT_TASK(SELF); if (has_data) { tdata->data = data; PARROT_GC_WRITE_BARRIER(INTERP, SELF); } data = tdata->data; RETURN(PMC *data); } /* =item METHOD kill() Kill this task. =cut */ METHOD kill() { Parrot_Task_attributes * const tdata = PARROT_TASK(SELF); tdata->killed = 1; } } /* =back =head1 SEE ALSO F. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ libffi.c000644000765000765 5632112101554067 15500 0ustar00brucebruce000000000000parrot-5.9.0/src/nci/* Copyright (C) 2010, Parrot Foundation. =head1 NAME src/nci/libffi.c - LibFFI Native Call Interface frame builder =head1 DESCRIPTION This file implements a native call frame (thunk) factory using libffi. =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" #include "pmc/pmc_nci.h" #include "pmc/pmc_unmanagedstruct.h" #include "pmc/pmc_managedstruct.h" #if (INTVAL_SIZE == 4) # define ffi_type_parrot_intval ffi_type_sint32 #elif(INTVAL_SIZE == 8) # define ffi_type_parrot_intval ffi_type_sint64 #else # error "unhandled INTVAL_SIZE value" #endif #if (NUMVAL_SIZE == 4) # define ffi_type_parrot_numval ffi_type_float #elif(NUMVAL_SIZE == 8) # define ffi_type_parrot_numval ffi_type_double #elif(NUMVAL_SIZE == 12) # define ffi_type_parrot_numval ffi_type_longdouble #elif(NUMVAL_SIZE == 16) # if PARROT_HAS_LONGLONG # if (LONGLONG_SIZE == 8) # define ffi_type_parrot_numval ffi_type_sint64 # else # error "unhandled long long size" # endif # endif #else # error "unhandled NUMVAL_SIZE value" #endif #if PARROT_HAS_LONGLONG # if (LONGLONG_SIZE == 8) # define ffi_type_slonglong ffi_type_sint64 # else # error "unhandled long long size" # endif #endif typedef struct ffi_thunk_t { ffi_cif cif; ffi_type **arg_types; ffi_cif pcc_arg_cif; ffi_type **pcc_arg_types; ffi_cif pcc_ret_cif; ffi_type **pcc_ret_types; } ffi_thunk_t; typedef union parrot_var_t { INTVAL i; FLOATVAL n; STRING *s; PMC *p; } parrot_var_t; typedef union nci_var_t { float f; double d; long double ld; char c; short s; int i; long l; #if PARROT_HAS_LONGLONG long long ll; #endif Parrot_Int1 i8; Parrot_Int2 i16; Parrot_Int4 i32; #if PARROT_HAS_INT64 Parrot_Int8 i64; #endif void *p; INTVAL I; FLOATVAL N; STRING *S; PMC *P; } nci_var_t; /* HEADERIZER HFILE: include/parrot/nci.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_CANNOT_RETURN_NULL static PMC * build_ffi_thunk(PARROT_INTERP, PMC *user_data, ARGIN(PMC *sig)) __attribute__nonnull__(1) __attribute__nonnull__(3); static void call_ffi_thunk(PARROT_INTERP, ARGMOD(PMC *nci_pmc), ARGMOD(PMC *self)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*nci_pmc) FUNC_MODIFIES(*self); PARROT_CANNOT_RETURN_NULL static PMC * clone_ffi_thunk(PARROT_INTERP, PMC *thunk, ARGIN(void *_thunk_data)) __attribute__nonnull__(1) __attribute__nonnull__(3); static void free_ffi_thunk(PARROT_INTERP, void *thunk_func, ARGFREE(void *thunk_data)) __attribute__nonnull__(1); PARROT_CANNOT_RETURN_NULL static PMC * init_thunk_pmc(PARROT_INTERP, ARGMOD(ffi_thunk_t *thunk_data)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*thunk_data); PARROT_CAN_RETURN_NULL static ffi_type * nci_to_ffi_type(PARROT_INTERP, PARROT_DATA_TYPE nci_t); #define ASSERT_ARGS_build_ffi_thunk __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(sig)) #define ASSERT_ARGS_call_ffi_thunk __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(nci_pmc) \ , PARROT_ASSERT_ARG(self)) #define ASSERT_ARGS_clone_ffi_thunk __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(_thunk_data)) #define ASSERT_ARGS_free_ffi_thunk __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_init_thunk_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(thunk_data)) #define ASSERT_ARGS_nci_to_ffi_type __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Register the LibFFI frame builder with the NCI subsystem. =cut */ void Parrot_nci_libffi_register(PARROT_INTERP) { ASSERT_ARGS(Parrot_nci_libffi_register) PMC *iglobals = interp->iglobals; PMC *nci_framebuilder_callback = Parrot_pmc_new(interp, enum_class_UnManagedStruct); PMC *nci_framebuilder_userdata = PMCNULL; if (PMC_IS_NULL(iglobals)) PANIC(interp, "iglobals isn't created yet"); SETATTR_UnManagedStruct_ptr(interp, nci_framebuilder_callback, (void *)build_ffi_thunk); VTABLE_set_pmc_keyed_int(interp, iglobals, IGLOBALS_NCI_FB_CB, nci_framebuilder_callback); VTABLE_set_pmc_keyed_int(interp, iglobals, IGLOBALS_NCI_FB_UD, nci_framebuilder_userdata); Parrot_warn_experimental(interp, "NCI_FB_CB and NCI_DB_UD in iglobals are experimental"); } /* =item C Properly encapsulate C in a C. =cut */ PARROT_CANNOT_RETURN_NULL static PMC * init_thunk_pmc(PARROT_INTERP, ARGMOD(ffi_thunk_t *thunk_data)) { ASSERT_ARGS(init_thunk_pmc) PMC *thunk = Parrot_pmc_new(interp, enum_class_ManagedStruct); SETATTR_ManagedStruct_ptr(interp, thunk, (void *)call_ffi_thunk); SETATTR_ManagedStruct_custom_clone_func(interp, thunk, clone_ffi_thunk); SETATTR_ManagedStruct_custom_clone_priv(interp, thunk, thunk_data); SETATTR_ManagedStruct_custom_free_func(interp, thunk, free_ffi_thunk); SETATTR_ManagedStruct_custom_free_priv(interp, thunk, thunk_data); return thunk; } /* =item C Build a C-encapsulated C from C. Suitable for use as C. =cut */ PARROT_CANNOT_RETURN_NULL static PMC * build_ffi_thunk(PARROT_INTERP, SHIM(PMC *user_data), ARGIN(PMC *sig)) { ASSERT_ARGS(build_ffi_thunk) ffi_thunk_t *thunk_data = mem_gc_allocate_zeroed_typed(interp, ffi_thunk_t); PMC *thunk = init_thunk_pmc(interp, thunk_data); STRING *pcc_ret_sig, *pcc_params_sig; Parrot_nci_sig_to_pcc(interp, sig, &pcc_params_sig, &pcc_ret_sig); /* generate Parrot_pcc_fill_params_from_c_args dynamic call infrastructure */ { INTVAL argc = Parrot_str_length(interp, pcc_params_sig) + 3; ffi_type **arg_t = thunk_data->pcc_arg_types = mem_gc_allocate_n_zeroed_typed(interp, argc, ffi_type *); int i; arg_t[0] = &ffi_type_pointer; /* interp */ arg_t[1] = &ffi_type_pointer; /* call object */ arg_t[2] = &ffi_type_pointer; /* pcc signature */ for (i = 3; i < argc; i++) arg_t[i] = &ffi_type_pointer; /* INSP pointer */ if (ffi_prep_cif(&thunk_data->pcc_arg_cif, FFI_DEFAULT_ABI, argc, &ffi_type_void, arg_t) != FFI_OK) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_JIT_ERROR, "invalid ffi signature"); } /* generate target function dynamic call infrastructure */ { INTVAL argc = VTABLE_elements(interp, sig) - 1; ffi_type *ret_t = nci_to_ffi_type(interp, (PARROT_DATA_TYPE)VTABLE_get_integer_keyed_int(interp, sig, 0)); ffi_type **arg_t = thunk_data->arg_types = mem_gc_allocate_n_zeroed_typed(interp, argc, ffi_type *); int i; for (i = 0; i < argc; i++) arg_t[i] = nci_to_ffi_type(interp, (PARROT_DATA_TYPE)VTABLE_get_integer_keyed_int(interp, sig, i + 1)); if (ffi_prep_cif(&thunk_data->cif, FFI_DEFAULT_ABI, argc, ret_t, arg_t) != FFI_OK) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_JIT_ERROR, "invalid ffi signature"); } /* generate Parrot_pcc_build_call_from_c_args dynamic call infrastructure */ { INTVAL retc = Parrot_str_length(interp, pcc_ret_sig) + 3; ffi_type **ret_t = thunk_data->pcc_ret_types = mem_gc_allocate_n_zeroed_typed(interp, retc, ffi_type *); int i = 0; ret_t[0] = &ffi_type_pointer; /* interp */ ret_t[1] = &ffi_type_pointer; /* callsig object */ ret_t[2] = &ffi_type_pointer; /* pcc signature */ for (i = 3; i < retc; i++) { switch ((char)Parrot_str_indexed(interp, pcc_ret_sig, i - 3)) { case 'I': ret_t[i] = &ffi_type_parrot_intval; break; case 'N': ret_t[i] = &ffi_type_parrot_numval; break; case 'S': case 'P': ret_t[i] = &ffi_type_pointer; break; default: Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_JIT_ERROR, "invalid pcc signature"); } } if (FFI_OK != ffi_prep_cif(&thunk_data->pcc_ret_cif, FFI_DEFAULT_ABI, retc, &ffi_type_pointer, ret_t)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_JIT_ERROR, "invalid ffi signature"); } return thunk; } /* =item C Convert an NCI type specification into the corresponding LibFFI type. =cut */ PARROT_CAN_RETURN_NULL static ffi_type * nci_to_ffi_type(SHIM_INTERP, PARROT_DATA_TYPE nci_t) { ASSERT_ARGS(nci_to_ffi_type) switch (nci_t) { case enum_type_void: return &ffi_type_void; case enum_type_float: return &ffi_type_float; case enum_type_double: return &ffi_type_double; case enum_type_longdouble: return &ffi_type_longdouble; case enum_type_FLOATVAL: return &ffi_type_parrot_numval; case enum_type_char: return &ffi_type_schar; case enum_type_short: return &ffi_type_sshort; case enum_type_int: return &ffi_type_sint; case enum_type_long: return &ffi_type_slong; #if PARROT_HAS_LONGLONG case enum_type_longlong: return &ffi_type_slonglong; #endif case enum_type_int8: return &ffi_type_sint8; case enum_type_int16: return &ffi_type_sint16; case enum_type_int32: return &ffi_type_sint32; #if PARROT_HAS_INT64 case enum_type_int64: return &ffi_type_sint64; #endif case enum_type_INTVAL: return &ffi_type_parrot_intval; case enum_type_STRING: case enum_type_ptr: case enum_type_PMC: return &ffi_type_pointer; default: if (nci_t & enum_type_ref_flag) return &ffi_type_pointer; else return NULL; } } /* =item C =cut */ PARROT_INLINE static void prep_pcc_ret_arg(PARROT_INTERP, PARROT_DATA_TYPE t, parrot_var_t *pv, void **rv, void *val) { switch (t) { case enum_type_float: pv->n = *(float *)val; *rv = &pv->n; break; case enum_type_double: pv->n = *(double *)val; *rv = &pv->n; break; case enum_type_longdouble: pv->n = *(long double *)val; *rv = &pv->n; break; case enum_type_FLOATVAL: pv->n = *(FLOATVAL *)val; *rv = &pv->n; break; case enum_type_char: pv->i = *(char *)val; *rv = &pv->i; break; case enum_type_short: pv->i = *(short *)val; *rv = &pv->i; break; case enum_type_int: pv->i = *(int *)val; *rv = &pv->i; break; case enum_type_long: pv->i = *(long *)val; *rv = &pv->i; break; #if PARROT_HAS_LONGLONG case enum_type_longlong: pv->i = *(long long *)val; *rv = &pv->i; break; #endif case enum_type_int8: pv->i = *(Parrot_Int1 *)val; *rv = &pv->i; break; case enum_type_int16: pv->i = *(Parrot_Int2 *)val; *rv = &pv->i; break; case enum_type_int32: pv->i = *(Parrot_Int4 *)val; *rv = &pv->i; break; #if PARROT_HAS_INT64 case enum_type_int64: pv->i = *(Parrot_Int8 *)val; *rv = &pv->i; break; #endif case enum_type_INTVAL: pv->i = *(INTVAL *)val; *rv = &pv->i; break; case enum_type_STRING: pv->s = *(STRING **)val; *rv = &pv->s; break; case enum_type_PMC: pv->p = *(PMC **)val; *rv = &pv->p; break; case enum_type_ptr: if (*(void **)val) { pv->p = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, pv->p, *(void **)val); } else { pv->p = PMCNULL; } *rv = &pv->p; break; default: Parrot_ex_throw_from_c_args(interp, NULL, 0, "Impossible NCI signature code"); } } /* =item C Call the native function described in C using the precomputed thunk contained in C. =cut */ static void call_ffi_thunk(PARROT_INTERP, ARGMOD(PMC *nci_pmc), ARGMOD(PMC *self)) { ASSERT_ARGS(call_ffi_thunk) Parrot_NCI_attributes *nci = PARROT_NCI(nci_pmc); ffi_thunk_t *thunk; PMC *call_object = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); parrot_var_t *pcc_arg; /* values of pcc arguments */ nci_var_t *nci_val; /* values of nci arguments */ void **nci_arg; /* pointers for pass-by-ref arguments */ void **nci_arg_ptr = NULL; /* pointers to arguments for libffi */ void *return_data; /* Holds return data from FFI call */ int i; { void *v; GETATTR_ManagedStruct_custom_free_priv(interp, self, v); thunk = (ffi_thunk_t *)v; } /* dynamic call to Parrot_pcc_fill_params_from_c_args */ { INTVAL pcc_argc = Parrot_str_length(interp, nci->pcc_params_signature); char *pcc_sig = Parrot_str_to_cstring(interp, nci->pcc_params_signature); void **pcc_arg_ptr, **call_arg; ffi_arg ffi_ret_dummy; pcc_arg = mem_gc_allocate_n_zeroed_typed(interp, pcc_argc, parrot_var_t); pcc_arg_ptr = mem_gc_allocate_n_zeroed_typed(interp, pcc_argc, void *); call_arg = mem_gc_allocate_n_zeroed_typed(interp, pcc_argc + 3, void*); /* setup Parrot_pcc_fill_params_from_c_args required arguments */ call_arg[0] = &interp; call_arg[1] = &call_object; call_arg[2] = &pcc_sig; /* TODO: eliminate PCC signature parsing somehow */ for (i = 0; i < pcc_argc; i++) { switch (pcc_sig[i]) { case 'I': pcc_arg_ptr[i] = &pcc_arg[i].i; break; case 'N': pcc_arg_ptr[i] = &pcc_arg[i].n; break; case 'S': pcc_arg_ptr[i] = &pcc_arg[i].s; break; case 'P': pcc_arg_ptr[i] = &pcc_arg[i].p; break; default: PARROT_ASSERT(!"Impossible PCC signature"); break; } call_arg[i + 3] = &pcc_arg_ptr[i]; } ffi_call(&thunk->pcc_arg_cif, FFI_FN(Parrot_pcc_fill_params_from_c_args), &ffi_ret_dummy, call_arg); mem_gc_free(interp, call_arg); mem_gc_free(interp, pcc_arg_ptr); Parrot_str_free_cstring(pcc_sig); } if (nci->arity) { nci_val = mem_gc_allocate_n_zeroed_typed(interp, nci->arity, nci_var_t); nci_arg = mem_gc_allocate_n_zeroed_typed(interp, nci->arity, void *); nci_arg_ptr = mem_gc_allocate_n_zeroed_typed(interp, nci->arity, void *); for (i = 0; i < nci->arity; i++) { PARROT_DATA_TYPE t = (PARROT_DATA_TYPE) VTABLE_get_integer_keyed_int(interp, nci->signature, i + 1); switch (t & ~enum_type_ref_flag) { case enum_type_char: nci_val[i].c = pcc_arg[i].i; nci_arg_ptr[i] = &nci_val[i].c; break; case enum_type_short: nci_val[i].s = pcc_arg[i].i; nci_arg_ptr[i] = &nci_val[i].s; break; case enum_type_int: nci_val[i].i = pcc_arg[i].i; nci_arg_ptr[i] = &nci_val[i].i; break; case enum_type_long: nci_val[i].l = pcc_arg[i].i; nci_arg_ptr[i] = &nci_val[i].l; break; #if PARROT_HAS_LONGLONG case enum_type_longlong: nci_val[i].ll = pcc_arg[i].i; nci_arg_ptr[i] = &nci_val[i].ll; break; #endif case enum_type_int8: nci_val[i].i8 = pcc_arg[i].i; nci_arg_ptr[i] = &nci_val[i].i8; break; case enum_type_int16: nci_val[i].i16 = pcc_arg[i].i; nci_arg_ptr[i] = &nci_val[i].i16; break; case enum_type_int32: nci_val[i].i32 = pcc_arg[i].i; nci_arg_ptr[i] = &nci_val[i].i32; break; #if PARROT_HAS_INT64 case enum_type_int64: nci_val[i].i64 = pcc_arg[i].i; nci_arg_ptr[i] = &nci_val[i].i64; break; #endif case enum_type_INTVAL: nci_val[i].I = pcc_arg[i].i; nci_arg_ptr[i] = &nci_val[i].I; break; case enum_type_float: nci_val[i].f = pcc_arg[i].n; nci_arg_ptr[i] = &nci_val[i].f; break; case enum_type_double: nci_val[i].d = pcc_arg[i].n; nci_arg_ptr[i] = &nci_val[i].d; break; case enum_type_longdouble: nci_val[i].ld = pcc_arg[i].n; nci_arg_ptr[i] = &nci_val[i].ld; break; case enum_type_FLOATVAL: nci_val[i].N = pcc_arg[i].n; nci_arg_ptr[i] = &nci_val[i].N; break; case enum_type_STRING: nci_val[i].S = pcc_arg[i].s; nci_arg_ptr[i] = &nci_val[i].S; break; case enum_type_PMC: nci_val[i].P = pcc_arg[i].p; nci_arg_ptr[i] = &nci_val[i].P; break; case enum_type_ptr: nci_val[i].p = PMC_IS_NULL(pcc_arg[i].p) ? NULL : VTABLE_get_pointer(interp, pcc_arg[i].p); nci_arg_ptr[i] = &nci_val[i].p; break; default: PARROT_ASSERT("Unhandled NCI signature"); break; } if (t & enum_type_ref_flag) { nci_arg[i] = nci_arg_ptr[i]; nci_arg_ptr[i] = &nci_arg[i]; } } } mem_gc_free(interp, pcc_arg); return_data = mem_sys_allocate(thunk->cif.rtype->size); ffi_call(&thunk->cif, FFI_FN(nci->orig_func), return_data, nci_arg_ptr); /* dynamic call to Parrot_pcc_build_call_from_c_args */ if (thunk->pcc_ret_cif.nargs > 3) { PMC *ffi_ret_unused; INTVAL pcc_retc = Parrot_str_length(interp, nci->pcc_return_signature); char *pcc_ret_sig = Parrot_str_to_cstring(interp, nci->pcc_return_signature); void **call_arg = mem_gc_allocate_n_zeroed_typed(interp, pcc_retc + 3, void *); parrot_var_t *pcc_retv = mem_gc_allocate_n_zeroed_typed(interp, pcc_retc, parrot_var_t); PARROT_DATA_TYPE arg_t; int j; i = 0; call_arg[0] = &interp; call_arg[1] = &call_object; call_arg[2] = &pcc_ret_sig; /* populate return slot (non-existent if void) */ if (enum_type_void != (arg_t = (PARROT_DATA_TYPE)VTABLE_get_integer_keyed_int(interp, nci->signature, 0))) { prep_pcc_ret_arg(interp, arg_t, &pcc_retv[i], &call_arg[i + 3], return_data); i++; } /* also return call-by-reference arguments (if any) */ for (j = 1; i < pcc_retc; j++) { arg_t = (PARROT_DATA_TYPE)VTABLE_get_integer_keyed_int(interp, nci->signature, j); if (arg_t & enum_type_ref_flag) { prep_pcc_ret_arg(interp, (PARROT_DATA_TYPE)(arg_t & ~enum_type_ref_flag), &pcc_retv[i], &call_arg[i + 3], nci_arg[j - 1]); i++; } } ffi_call(&thunk->pcc_ret_cif, FFI_FN(Parrot_pcc_build_call_from_c_args), &ffi_ret_unused, call_arg); Parrot_str_free_cstring(pcc_ret_sig); mem_gc_free(interp, call_arg); mem_gc_free(interp, pcc_retv); } if (nci->arity) { mem_gc_free(interp, nci_val); mem_gc_free(interp, nci_arg); mem_gc_free(interp, nci_arg_ptr); } mem_gc_free(interp, return_data); } /* =item C Clone a C containing a C. Suitable to be used by C as a C callback. The C argument is currently unused. =cut */ PARROT_CANNOT_RETURN_NULL static PMC * clone_ffi_thunk(PARROT_INTERP, SHIM(PMC *thunk), ARGIN(void *_thunk_data)) { ASSERT_ARGS(clone_ffi_thunk) ffi_thunk_t *thunk_data = (ffi_thunk_t *)_thunk_data; ffi_thunk_t *clone_data = mem_gc_allocate_zeroed_typed(interp, ffi_thunk_t); PMC *clone = init_thunk_pmc(interp, clone_data); memcpy(clone_data, thunk_data, sizeof (ffi_thunk_t)); clone_data->pcc_arg_types = mem_gc_allocate_n_zeroed_typed(interp, thunk_data->pcc_arg_cif.nargs, ffi_type *); mem_copy_n_typed(clone_data->pcc_arg_types, thunk_data->pcc_arg_types, thunk_data->pcc_arg_cif.nargs, ffi_type *); clone_data->arg_types = mem_gc_allocate_n_zeroed_typed(interp, thunk_data->cif.nargs, ffi_type *); mem_copy_n_typed(clone_data->arg_types, thunk_data->arg_types, thunk_data->cif.nargs, ffi_type *); return clone; } /* =item C Free an C. Suitable to be used by C as a C callback. =cut */ static void free_ffi_thunk(PARROT_INTERP, SHIM(void *thunk_func), ARGFREE(void *thunk_data)) { ASSERT_ARGS(free_ffi_thunk) ffi_thunk_t *thunk = (ffi_thunk_t *)thunk_data; if (thunk->arg_types) mem_gc_free(interp, thunk->arg_types); if (thunk->pcc_arg_types) mem_gc_free(interp, thunk->pcc_arg_types); mem_gc_free(interp, thunk); } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ ch03_compiler_tools.pod000644000765000765 3464511533177634 21602 0ustar00brucebruce000000000000parrot-5.9.0/docs/book/pct=pod =head1 Parrot Compiler Tools Z Parrot is able to natively compile and execute code in two low-level languages, PASM and PIR. These two languages, which are very similar to one another, are very close to the machine and analogous to assembly languages from hardware processors and other virtual machines. While they do expose the power of the PVM in a very direct way, PASM and PIR are not designed to be used for writing large or maintainable programs. For these tasks, higher level languages such as Perl 6, Python 3, Tcl, Ruby, and PHP are preferred instead, and the ultimate goal of Parrot is to support these languages and more. The question is, how do we get programs written in these languages running on Parrot? The answer is PCT. PCT is a set of classes and tools that enable the easy creation of compilers for high level languages (HLLs) that will run on Parrot. PCT is itself written in PIR, and compiles HLL code down to PIR for compilation and execution on Parrot, but allows the compiler designer to do most work in a high-level dialect of the Perl 6 language. The result is a flexible, dynamic language that can be used for creating other flexible, dynamic languages. =head2 History The Parrot Virtual Machine was originally conceived of as the engine for executing the new Perl 6 language, when specifications for that were first starting to be drafted. However, as time went on it was decided that Parrot would benefit from having a clean abstraction layer between its internals and the Perl 6 language syntax. This clean abstraction layer brought with it the side effect that Parrot could be used to host a wide variety of dynamic languages, not just Perl 6. And beyond just hosting them, it could facilitate their advancement, interaction, and code sharing. The end result is that Parrot is both powerful enough to support one of the most modern and powerful dynamic languages, Perl 6, but well-encapsulated enough to host other languages as well. Parrot would be more powerful and feature-full than any single language, and would provide all that power and all those features to any languages that wanted them. Perl 6, under the project name Rakudo N, is still one of the primary users of Parrot and therefore one of the primary drivers in its development. However, compilers for other dynamic languages such as Python 3, Ruby, Tcl, are under active development. Several compilers exist which are not being as actively developed, and many compilers exist for new languages and toy languages which do not exist anywhere else. =head2 Capabilities and Benefits Parrot exposes a rich interface for high level languages to use, including several important features: a robust exceptions system, compilation into platform-independent bytecode, a clean extension and embedding interface, just-in-time compilation to machine code, native library interface mechanisms, garbage collection, support for objects and classes, and a robust concurrency model. Designing a new language or implementing a new compiler for an old language is easier with all of these features designed, implemented, tested, and supported in a VM already. In fact, the only tasks required of compiler implementers who target the Parrot platform is the creation of the parser and the language runtime. Parrot also has a number of other benefits for compiler writers to tap into: =over 4 =item * Write Once and Share All HLLs on Parrot ultimately compile down to Parrot's platform-independent bytecode which Parrot can execute natively. This means at the lowest level Parrot supports interoperability between programs written in multiple high level languages. Find a library you want to use in Perl's CPAN N? Have a web framework you want to use that's written in Ruby? A mathematics library that only has C bindings? Want to plug all of these things into a web application you are writing in PHP? Parrot supports this and more. =item * Native Library Support Parrot has a robust system for interfacing with external native code libraries, such as those commonly written in C, C++, Fortran and other compiled languages. Where previously every interpreter would need to maintain its own bindings and interfaces to libraries, Parrot enables developers to write library bindings once and use them seamlessly from any language executing on Parrot. Want to use Tcl's Tk libraries, along with Python's image manipulation libraries in a program you are writing in Perl? Parrot supports that. =back =head2 Compilation and Hosting For language hosting and interoperability to work, languages developers need to write compilers that convert source code written in high level languages to Parrot's bytecode. This process is analogous to how a compiler such as GCC converts C or C++ into machine code -- though instead of targeting machine code for a specific hardware platform, compilers written in Parrot produce Parrot code which can run on any hardware platform that can run Parrot. Creating a compiler for Parrot written directly in PIR is possible. Creating a compiler in C using the common tools lex and yacc is also possible. Neither of these options are really as good, as fast, or as powerful as writing a compiler using PCT. PCT is a suite of compiler tools that helps to abstract and automate the process of writing a new compiler on Parrot. Lexical analysis, parsing, optimization, resource allocation, and code generation are all handled internally by PCT and the compiler designer does not need to be concerned with any of it. =head2 PCT Overview The X Parrot Compiler Tools (PCT) enable the creation of high-level language compilers and runtimes. Though the Perl 6 development team originally created these tools to aide in the development of the Rakudo Perl 6 implementation, several other Parrot-hosted compilers also use PCT to great effect. Writing a compiler using Perl 6 syntax and dynamic language tools is much easier than writing a compiler in C, C, and C. PCT is broken down into three separate tools: =over 4 =item * Not Quite Perl (NQP) NQP a subset of the Perl 6 language that requires no runtime library to execute. =item * Perl Grammar Engine (PGE) PGE is an implementation of Perl 6's powerful regular expression and grammar tools. =item * HLLCompiler The HLLCompiler compiler helps to manage and encapsulate the compilation process. An HLLCompiler object, once created, enables the user to use the compiler interactively from the commandline, in batch mode from code files, or at runtime using a runtime eval. =back =head2 Grammars and Action Files A PCT-based compiler requires three basic files: the main entry point file which is typically written in PIR, the grammar specification file which uses PGE, and the grammar actions file which is in NQP. These are just the three mandatory components, most languages are also going to require additional files for runtime libraries and other features as well. =over 4 =item * The main file The main file is (often) a PIR program which contains the C<:main> function that creates and executes the compiler object. This program instantiates a C subclass, loads any necessary support libraries, and initializes any compiler- or languages-specific data. The main file tends to be short. The guts of the compiler logic is in the grammar and actions files. Runtime support and auxiliary functions often appear in other files, by convention. This separation of concerns tends to make compilers easier to maintain. =item * A grammar file The high-level language's grammar appears in a F<.pg> file. This file subclasses the C class and implements all of the necessary rules -- written using PGE -- to parse the language. =item * An actions file Actions contains methods -- written in NQP -- on the C object which receive parse data from the grammar rules and construct an X Abstract Syntax Tree (AST).N =back PCT's workflow is customizable, but simple. The compiler passes the source code of the HLL into the grammar engine. The grammar engine parses this code and returns a X special Match object which represents a parsed version of the code. The compiler then passes this match object to the action methods, which convert it in stages into PAST. The compiler finally converts this PAST into PIR code, which it can save to a file, convert to bytecode, or execute directly. =head3 C The only way creating a new language compiler could be easier is if these files created themselves. PCT includes a tool to do just that: C. This program automatically creates a new directory in F for your new language, the necessary three files, starter files for libraries, a F script to automate the build process, and a basic test harness to demonstrate that your language works as expects. These generated files are all stubs which will require extensive editing to implement a full language, but they are a well-understood and working starting point. With this single command you can create a working compiler. It's up to you to fill the details. C prefers to run from within a working Parrot repository. It requires a single argument, the name of the new project to create. There are no hard-and-fast rules about names, but the Parrot developers reccomend that Parrot-based implementations of existing languages use unique names. Consider the names of Perl 5 distributions: Active Perl and Strawberry Perl. Python implementations are IronPython (running on the CLR) and Jython (running on the JVM). The Ruby-on-Parrot compiler isn't just "Ruby": it's Cardinal. The Tcl compiler on Parrot is Partcl. An entirely new language has no such constraints. From the Parrot directory, invoke C like: $ cd languages/ $ perl ../tools/dev/mk_language_shell.pl =head3 Parsing Fundamentals An important part of a compiler is the parser and lexical analyzer. The lexical analyzer converts the HLL input file into individual tokens. A token may consist of an individual punctuation ("+"), an identifier ("myVar"), a keyword ("while"), or any other artifact that stands on its own as a single unit. The parser attempts to match a stream of these input tokens against a given pattern, or grammar. The matching process orders the input tokens into an abstract syntax tree which the other portions of the compiler can process. X X X X Parsers come in top-down and bottom-up varieties. Top-down parsers start with a top-level rule which represents the entire input. It attempts to match various combination of subrules until it has consumed the entire input. Bottom-down parsers start with individual tokens from the lexical analyzer and attempt to combine them together into larger and larger patterns until they produce a top-level token. PGE is a top-down parser, although it also contains a bottom-up I parser to make processing token clusters such as mathematical expressions more efficient. =head2 Driver Programs The driver program for the new compiler must create instances of the various necessary classes that run the parser. It must also include the standard function libraries, create global variables, and handle commandline options. PCT provides several useful command-line options, but driver programs may need to override several behaviors. PCT programs can run in two ways. An interactive mode runs one statement at a time in the console. A file mode loads and runs an entire file at once. A driver program may specificy information about the interactive prompt and environment, as well as help and error messages. =head3 C class The C class implements a compiler object. This object contains references to language-specific parser grammar and actions files, as well as the steps involved in the compilation process. The stub compiler created by C might resemble: .sub 'onload' :anon :load :init load_bytecode 'PCT.pbc' $P0 = get_hll_global ['PCT'], 'HLLCompiler' $P1 = $P0.'new'() $P1.'language'('MyCompiler') $P1.'parsegrammar'('MyCompiler::Grammar') $P1.'parseactions'('MyCompiler::Grammar::Actions') .end .sub 'main' :main .param pmc args $P0 = compreg 'MyCompiler' $P1 = $P0.'command_line'(args) .end The C<:onload> function creates the driver object as an instance of C, sets the necessary options, and registers the compiler with Parrot. The C<:main> function drives parsing and execution begin. It calls the C opcode to retrieve the registered compiler object for the language "MyCompiler" and invokes that compiler object using the options received from the commandline. The C opcode hides some of Parrot's magic; you can use it multiple times in a program to compile and run different languages. You can create multiple instances of a compiler object for a single language (such as for runtime C) or you can create compiler objects for multiple languages for easy interoperability. The Rakudo Perl 6 C function uses this mechanism to allow runtime eval of code snippets in other languages: eval("puts 'Konnichiwa'", :lang); =head3 C methods The previous example showed the use of several HLLCompiler methods: C, C, and C. These three methods are the bare minimum interface any PCT-based compiler should provide. The C method takes a string argument that is the name of the compiler. The HLLCompiler object uses this name to register the compiler object with Parrot. The C method creates a reference to the grammar file that you write with PGE. The C method takes the class name of the NQP file used to create the AST-generator for the compiler. If your compiler needs additional features, there are several other available methods: =over 4 =item * C The C method allows you to specify a custom prompt to display to users in interactive mode. =item * C The C method allows you to specify a banner message that displays at the beginning of interactive mode. =back =cut # Local variables: # c-file-style: "parrot" # End: # vim: expandtab shiftwidth=4: ack.pir_output000644000765000765 2111466337261 21047 0ustar00brucebruce000000000000parrot-5.9.0/examples/shootoutAck(3, 7) = 1021 iter.t000644000765000765 1552211533177644 15610 0ustar00brucebruce000000000000parrot-5.9.0/t/library#!./parrot # Copyright (C) 2006-2008, Parrot Foundation. .const int TESTS = 47 .sub 'main' :main $P0 = new 'Env' $P0 = $P0['TEST_VERBOSE'] unless null $P0 goto set_verbose $P0 = new 'Integer' $P0 = 0 set_verbose: set_global 'TEST_VERBOSE', $P0 import: .include 'test_more.pir' 'plan'( TESTS ) 'load'() 'object_init'() 'FixedPMCArray_empty'() 'FixedPMCArray_3elem'() 'ResizablePMCArray_empty'() 'ResizablePMCArray_3elem'() .end # test library loading .sub 'load' T1: push_eh err_load_bytecode $S0 = 'Iter.pbc' load_bytecode $S0 pop_eh $S1 = 'loaded ' $S1 .= $S0 'ok'(1, $S1) goto end err_load_bytecode: $S1 = "cannot load " $S1 .= $S0 'ok'(0, $S1) end end: .end # test object initialization .sub 'object_init' T1: $P99 = new 'FixedPMCArray' $P99 = 0 .local pmc iter iter = new 'Iter' $I0 = 0 if null iter goto test_iter_new $I0 = 1 test_iter_new: 'ok'($I0, 'created Iter') T2: push_eh err_start_noargs iter.'start'() pop_eh 'ok'(0, 'start requires an aggregate') goto T3 err_start_noargs: ok(1, 'start requires an aggregate') T3: iter.'start'($P99) 'ok'(1, ".'start'() runs without exception") T4: iter.'start'($P99) 'ok'(1, ".'start'() runs again without exception") .end # test empty FixedPMCArray .sub 'FixedPMCArray_empty' T1: $P99 = new 'FixedPMCArray' $P99 = 0 .local pmc iter iter = new 'Iter' iter.'start'($P99) .local int is_exhausted .local int index index = 0 .local pmc value is_exhausted = iter.'exhausted'() 'is'(is_exhausted, 0, ".'exhausted'() returns false") T2: value = iter.'value'() $I0 = isnull value 'ok'($I0, ".'value'() returns PMCNULL") T3: # index = 0 iter.'next'() 'ok'(1, ".'next'() runs without exception") T4: is_exhausted = iter.'exhausted'() 'is'(is_exhausted, 1, ".'exhausted'() returns true") T5: value = iter.'value'() $I0 = isnull value 'ok'($I0, ".'value'() returns PMCNULL") T6: iter.'next'() 'ok'(1, ".'next'() runs without exception after iter exhaustion") .end # test FixedPMCArray with three elements .sub 'FixedPMCArray_3elem' T1: $P99 = new 'FixedPMCArray' $P99 = 3 $P99[0] = 'a' $P99[1] = 'b' $P99[2] = 'c' .local pmc iter iter = new 'Iter' iter.'start'($P99) .local int is_exhausted .local int index index = 0 .local pmc value is_exhausted = iter.'exhausted'() 'is'(is_exhausted, 0, ".'exhausted'() returns false") T2: value = iter.'value'() $I0 = isnull value 'ok'($I0, ".'value'() returns PMCNULL") T3: # index = 0 iter.'next'() 'ok'(1, ".'next'() runs without exception") T4: is_exhausted = iter.'exhausted'() 'is'(is_exhausted, 0, ".'exhausted'() returns false") T5: value = iter.'value'() $P0 = $P99[index] 'is'(value, $P0, ".'next'() and .'value'()") inc index T6: # index = 1 iter.'next'() 'ok'(1, ".'next'() runs without exception") T7: is_exhausted = iter.'exhausted'() 'is'(is_exhausted, 0, ".'exhausted'() returns false") T8: value = iter.'value'() $P0 = $P99[index] 'is'(value, $P0, ".'next'() and .'value'()") inc index T9: # index = 2 iter.'next'() 'ok'(1, ".'next'() runs without exception") T10: is_exhausted = iter.'exhausted'() 'is'(is_exhausted, 0, ".'exhausted'() returns false") T11: value = iter.'value'() $P0 = $P99[index] 'is'(value, $P0, ".'next'() and .'value'()") inc index T12: # exhausted iter.'next'() 'ok'(1, ".'next'() runs without exception") T13: is_exhausted = iter.'exhausted'() 'is'(is_exhausted, 1, ".'exhausted'() returns true") T14: $P0 = iter.'value'() $I0 = isnull $P0 'is'($I0, 1, ".'value'() returns PMCNULL") T15: iter.'next'() 'ok'(1, ".'next'() runs without exception after iter exhaustion") .end # test empty ResizablePMCArray .sub 'ResizablePMCArray_empty' T1: $P99 = new 'ResizablePMCArray' $P99 = 0 .local pmc iter iter = new 'Iter' iter.'start'($P99) .local int is_exhausted .local int index index = 0 .local pmc value is_exhausted = iter.'exhausted'() 'is'(is_exhausted, 0, ".'exhausted'() returns false") T2: value = iter.'value'() $I0 = isnull value 'ok'($I0, ".'value'() returns PMCNULL") T3: # index = 0 iter.'next'() 'ok'(1, ".'next'() runs without exception") T4: is_exhausted = iter.'exhausted'() 'is'(is_exhausted, 1, ".'exhausted'() returns true") T5: value = iter.'value'() $I0 = isnull value 'ok'($I0, ".'value'() returns PMCNULL") T6: iter.'next'() 'ok'(1, ".'next'() runs without exception after iter exhaustion") .end # test ResizablePMCArray with three elements .sub 'ResizablePMCArray_3elem' T1: $P99 = new 'ResizablePMCArray' $P99 = 3 $P99[0] = 'a' $P99[1] = 'b' $P99[2] = 'c' .local pmc iter iter = new 'Iter' iter.'start'($P99) .local int is_exhausted .local int index index = 0 .local pmc value is_exhausted = iter.'exhausted'() 'is'(is_exhausted, 0, ".'exhausted'() returns false") T2: value = iter.'value'() $I0 = isnull value 'ok'($I0, ".'value'() returns PMCNULL") T3: # index = 0 iter.'next'() 'ok'(1, ".'next'() runs without exception") T4: is_exhausted = iter.'exhausted'() 'is'(is_exhausted, 0, ".'exhausted'() returns false") T5: value = iter.'value'() $P0 = $P99[index] 'is'(value, $P0, ".'next'() and .'value'()") inc index T6: # index = 1 iter.'next'() 'ok'(1, ".'next'() runs without exception") T7: is_exhausted = iter.'exhausted'() 'is'(is_exhausted, 0, ".'exhausted'() returns false") T8: value = iter.'value'() $P0 = $P99[index] 'is'(value, $P0, ".'next'() and .'value'()") inc index T9: # index = 2 iter.'next'() 'ok'(1, ".'next'() runs without exception") T10: is_exhausted = iter.'exhausted'() 'is'(is_exhausted, 0, ".'exhausted'() returns false") T11: value = iter.'value'() $P0 = $P99[index] 'is'(value, $P0, ".'next'() and .'value'()") inc index T12: # exhausted iter.'next'() 'ok'(1, ".'next'() runs without exception") T13: is_exhausted = iter.'exhausted'() 'is'(is_exhausted, 1, ".'exhausted'() returns true") T14: $P0 = iter.'value'() $I0 = isnull $P0 'is'($I0, 1, ".'value'() returns PMCNULL") T15: iter.'next'() 'ok'(1, ".'next'() runs without exception after iter exhaustion") .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: cpu-01.t000644000765000765 442111533177646 16272 0ustar00brucebruce000000000000parrot-5.9.0/t/steps/auto#! perl # Copyright (C) 2007, Parrot Foundation. # auto/cpu-01.t use strict; use warnings; use Test::More tests => 14; use Carp; use lib qw( lib t/configure/testlib ); use_ok('config::auto::cpu'); use Parrot::Configure::Options qw( process_options ); use Parrot::Configure::Step::Test; use Parrot::Configure::Test qw( test_step_constructor_and_description ); use IO::CaptureOutput qw( capture ); ########### --verbose ########### my ($args, $step_list_ref) = process_options( { argv => [ q{--verbose} ], mode => q{configure}, } ); my $conf = Parrot::Configure::Step::Test->new; $conf->include_config_results( $args ); my ($pkg, $step); my $serialized = $conf->pcfreeze(); $pkg = q{auto::cpu}; $conf->add_steps($pkg); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); { $conf->data->set('cpuarch' => 'foobar'); my ($ret, $stdout); capture( sub { $ret = $step->runstep($conf); }, \$stdout, ); ok($ret, "runstep() returned true value" ); ok(! $step->result(), "Got (default) false result as expected"); like($stdout, qr/cpu hints = 'auto::cpu::foobar::auto'/s, "Got expected verbose output"); like($stdout, qr/no cpu specific hints/s, "Got expected verbose output"); } $conf->replenish($serialized); $conf->options->set( 'verbose' => undef ); ########### mock cpuarch ########### ($args, $step_list_ref) = process_options( { argv => [ ], mode => q{configure}, } ); $conf->add_steps($pkg); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); $conf->data->set('cpuarch' => 'foobar'); my $ret = $step->runstep($conf); ok($ret, "runstep() returned true value" ); ok(! $step->result(), "Got (default) false result as expected"); pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME auto/cpu-01.t - test auto::cpu =head1 SYNOPSIS % prove t/steps/auto/cpu-01.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file test auto::cpu. =head1 AUTHOR James E Keenan =head1 SEE ALSO config::auto::cpu, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: Base64.pir000644000765000765 1604412101554067 21464 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library/MIME =head1 NAME MIME::Base64 - Encoding and decoding of base64 strings =head1 SYNOPSIS # load this library load_bytecode 'MIME/Base64.pbc' =head1 DESCRIPTION MIME::Base64 is inspired by the Perl5 module MIME::Base64. =head1 METHODS This module defines the following subroutines: =over 4 =item C Encode data by calling the encode_base64() function. The first argument is the string to encode. The returned encoded string is broken into lines of no more than 76 characters each. Note: Unicode stored as MIME::Base64 is inherently endian-dependent. =item C Decode a base64 string by calling the decode_base64() function. This function takes as first argument the string to decode, as optional second argument the encoding string for the decoded data. It returns the decoded data. Any character not part of the 65-character base64 subset is silently ignored. Characters occurring after a '=' padding character are never decoded. =back =cut .include "iterator.pasm" .namespace [ "MIME"; "Base64" ] .sub init :load # Base64 encoded strings are made of printable 8bit long chars, # of which each carries 6 bit worth of information .local string printables printables = ascii:"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" # TODO: find saner names .local pmc six_to_eight, eight_to_six six_to_eight = new 'FixedIntegerArray' six_to_eight = 64 # 2 ** 6 eight_to_six = new 'FixedIntegerArray' eight_to_six = 256 # 2 ** 8 # TODO: find easier way to initialize with undef or so eight_to_six[0] = 0 .local int i i = 1 START_2: if i >= 256 goto END_2 eight_to_six[i] = -1 inc i goto START_2 END_2: .local int six, eight .local string tmp six = 0 START_1: tmp = substr printables, six, 1 eight = ord tmp eight_to_six[eight] = six six_to_eight[six] = eight inc six if six < 64 goto START_1 set_global 'eight_to_six', eight_to_six set_global 'six_to_eight', six_to_eight .end .sub encode_base64 .param string plain .local string base64 .local pmc six_to_eight six_to_eight = get_global 'six_to_eight' .local int len, len_mod_3 .local pmc bb # For unicode we cannot use chr/ord. This breaks endianness. # GH 813 and #814 len = bytelength plain bb = new ['ByteBuffer'], len bb = plain len_mod_3 = len % 3 # Fill up with with null bytes if len_mod_3 == 0 goto END_1 push bb, 0 if len_mod_3 == 2 goto END_1 push bb, 0 END_1: base64 = '' .local int i, j .local int eight_0, eight_1, eight_2 .local int six_0, six_1, six_2, six_3 .local int tmp_int_1, tmp_int_2 .local string s_tmp_1 i = 0 j = 0 START_3: if i >= len goto END_3 # read 3*8 bits eight_0 = bb[i] inc i eight_1 = bb[i] inc i eight_2 = bb[i] inc i # d[i]>>2; shr six_0, eight_0, 2 # ((d[i]&3)<<4) | (d[i+1]>>4) band tmp_int_1, eight_0, 3 shl tmp_int_1, 4 shr tmp_int_2, eight_1, 4 bor six_1, tmp_int_1, tmp_int_2 # ((d[i+1]&15)<<2) | (d[i+2]>>6) band tmp_int_1, eight_1, 15 shl tmp_int_1, 2 shr tmp_int_2, eight_2, 6 bor six_2, tmp_int_1, tmp_int_2 # d[i+2]&63 band six_3, eight_2, 63 # write 4*6 bits, encoded as 4*8 bits, # output is larger than input tmp_int_1 = six_to_eight[six_0] s_tmp_1 = chr tmp_int_1 base64 = concat base64, s_tmp_1 tmp_int_1 = six_to_eight[six_1] s_tmp_1 = chr tmp_int_1 base64 = concat base64, s_tmp_1 tmp_int_1 = six_to_eight[six_2] s_tmp_1 = chr tmp_int_1 base64 = concat base64, s_tmp_1 tmp_int_1 = six_to_eight[six_3] s_tmp_1 = chr tmp_int_1 base64 = concat base64, s_tmp_1 inc j if j == 19 goto line_split goto START_3 line_split: base64 = concat base64, "\n" j = 0 goto START_3 END_3: # padding with '=' if len_mod_3 == 0 goto END_2 base64 = replace base64, -1, 1, ascii:"=" if len_mod_3 == 2 goto END_2 base64 = replace base64, -2, 1, ascii:"=" END_2: .return( base64 ) .end .sub decode_base64 .param string base64 .param string enc :optional .param int has_enc :opt_flag .local string result, base64_cleaned .local int enc_num base64_cleaned = '' if has_enc goto HAS_ENC enc = 'ascii' HAS_ENC: .local pmc eight_to_six, bb eight_to_six = get_global 'eight_to_six' .local int i, len .local int tmp_int_1, tmp_int_2 # Get rid of non-base64 chars len = length base64 i = 0 START_5: .local string s_tmp_1 if i >= len goto END_5 tmp_int_1 = ord base64, i inc i tmp_int_2 = eight_to_six[tmp_int_1] if tmp_int_2 == -1 goto START_5 s_tmp_1 = chr tmp_int_1 base64_cleaned = concat base64_cleaned, s_tmp_1 goto START_5 END_5: .local int len_mod_4 len = length base64_cleaned len_mod_4 = len % 4 # make sure that there are dummy bits beyond base64_cleaned = concat base64_cleaned, ascii:"\0\0\0" bb = new ['ByteBuffer'] .local int eight_0, eight_1, eight_2 .local int six_0, six_1, six_2, six_3 i = 0 START_2: if i >= len goto END_2 # read 4*6 bits tmp_int_1 = ord base64_cleaned, i six_0 = eight_to_six[tmp_int_1] inc i tmp_int_1 = ord base64_cleaned, i six_1 = eight_to_six[tmp_int_1] inc i tmp_int_1 = ord base64_cleaned, i six_2 = eight_to_six[tmp_int_1] inc i tmp_int_1 = ord base64_cleaned, i six_3 = eight_to_six[tmp_int_1] inc i # (f64[t.charAt(i)]<<2) | (f64[t.charAt(i+1)]>>4) shl tmp_int_1, six_0, 2 shr tmp_int_2, six_1, 4 bor eight_0, tmp_int_1, tmp_int_2 # (f64[t.charAt(i+1)]&15)<<4) | (f64[t.charAt(i+2)]>>2) band tmp_int_1, six_1, 15 shl tmp_int_1, 4 shr tmp_int_2, six_2, 2 bor eight_1, tmp_int_1, tmp_int_2 # (f64[t.charAt(i+2)]&3)<<6) | (f64[t.charAt(i+3)]) band tmp_int_1, six_2, 3 shl tmp_int_1, 6 bor eight_2, tmp_int_1, six_3 # write 3*8 bits # output is larger than input push bb, eight_0 push bb, eight_1 push bb, eight_2 goto START_2 END_2: # cut padded '=' if len_mod_4 == 0 goto END_3 if len_mod_4 == 1 goto END_3 len = elements bb dec len bb = len if len_mod_4 == 3 goto END_3 dec len bb = len END_3: result = bb.'get_string'(enc) .return( result ) .end =head1 SEE ALSO L L =head1 AUTHOR Written and maintained by Bernhard Schmalhofer, C<< Bernhard dot Schmalhofer at gmx dot de >>, based on the Perl 5 Module MIME::Base64 by Gisle Aas and on the article on de.selfhtml.org. =head1 COPYRIGHT Copyright (C) 2006-2012, Parrot Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: File.pm000644000765000765 1621712101554066 20246 0ustar00brucebruce000000000000parrot-5.9.0/compilers/opsc/src/Ops#! nqp # Copyright (C) 2001-2012, Parrot Foundation. # XXX Better to put this into docs/ somewhere. =begin =head1 NAME Ops::File - Ops To C Code Generation =head1 SYNOPSIS use Ops::File; =head1 DESCRIPTION C takes one or more files of op functions and creates real C code for them. This class is used by F. =head2 Op Functions For ops that have trivial bodies (such as just a call to some other function and a C statement), opcode functions are in the format: inline op opname (args) :flags { ... body of function ... } Note that currently the C op type is ignored. Alternately, for opcode functions that have more internal complexity the format is: op opname (args) :flags { ... body of function ... } There may be more than one C. In both cases the closing brace B be on its own line. When specifying multiple flags, each flag gets its own prefixing colon. =head2 Op Arguments Op arguments are a comma-separated list of direction and type pairs. Argument direction is one of: in the argument passes a value into the op out the argument passes a value out of the op inout the argument passes a value into and out of the op inconst the argument passes a constant value into the op invar the argument passes a variable value into the op Argument direction is used to determine the life times of symbols and their related register allocations. When an argument is passed into an op a register is read from, when it's passed out of an op a register is written to. Argument type is one of: INT the argument is an integer NUM the argument is an numeric STR the argument is an string PMC the argument is an PMC KEY the argument is an aggregate PMC key INTKEY the argument is an aggregate PMC integer key LABEL the argument is an integer branch offset or address The size of the return offset is determined from the op function's signature. =head2 Op Flags The flags are of two types: =over 4 =item 1 class The classification of ops is intended to facilitate the selection of suitable ops for a Parrot safe mode. =item 2 behavior The presence (or absence) of certain flags will change how the op behaves. For example, the lack of the C flag will cause the op to be implicitly terminated with C. (See next section). The :deprecated flag will generate a diagnostic to standard error at runtime when a deprecated opcode is invoked and C has been set. =back =head2 Op Body (Macro Substitutions) In the following macro descriptions, C and C are the current and next position within the Parrot code. =over 4 =item C Transforms to C. This is used for branches. =item C Transforms to C, where C is the size of an op. =item C Transforms to C. This is used for absolute jumps. =item C Transforms to C. This is used to give a relative address. =item C Transforms to C, the position of the next op. =item C Transforms to C, an absolute address. =item C Transforms to C, the size of an op. =item C Transforms to C. Halts run loop, and resets the current position to the start of the Parrot code, without resuming. =item C Transforms to C and restarts at C. =item C Transforms to C and restarts at C. =item C<$n> Transforms to the op function's nth argument. C<$0> is the opcode itself. =back Note that, for ease of parsing, if the argument to one of the above notations in a ops file contains parentheses, then double the enclosing parentheses and add a space around the argument, like so: goto OFFSET(( (void*)interp->happy_place )) =head2 Class Methods =over 4 =end class Ops::File is Hash; pir::load_bytecode('config.pbc'); =begin =item C Returns a new instance initialized by calling C on each of the specified op files. =item C Returns a new instance initialized by compiling C<$str> as the contents of an ops file. =end method new(*@files, :$oplib, :$core!, :$nolines, :$quiet? = 0) { self := @files; self := $core; self := list(); # Ops self:= ''; self:= pir::compreg__Ps('Ops'); self:= 0; self := $quiet; if $core { self := $oplib; self.set_oplib($oplib); } else { self := @files[0]; } self._set_version(); for @files { self.read_ops( $_, $nolines ) } self._calculate_op_codes(); self; } method new_str($str, :$oplib) { self := list(); # Ops self := ''; self := pir::compreg__Ps('Ops'); self := $oplib; self.set_oplib($oplib); self._set_version(); self.compile_ops($str); self; } =begin =back =head2 Instance Methods =over 4 =item C Reads in the specified .ops file, gathering information about the ops. =end method read_ops($file, $nolines) { $Ops::Compiler::Actions::OPLIB := self; self || say("# Parsing $file..."); my $start_time := pir::time__N(); my $buffer := transcode_slurp($file); my $start_ops := +self; self.compile_ops($buffer, :experimental( $file ~~ /experimental\.ops/)); my $end_ops := +self; pir::sprintf(my $time, "%.3f", [pir::time__N() - $start_time] ); self || say("# Parsed $file in $time seconds; found "~ ($end_ops - $start_ops) ~" ops."); } method compile_ops($str, :$experimental? = 0) { my $compiler := self; my $past := $compiler.compile($str, :target('past')); for @($past) { $_.experimental($experimental); $_.deprecated($_.flags ?? 1 !! 0); self.push($_); #say($_.full_name ~ " is number " ~ self); self++; } for @( $past ) { self := self ~ $_; } $past; } method get_parse_tree($str) { my $compiler := pir::compreg__Ps('Ops'); $compiler.compile($str, :target('parse')); } method preamble() { self }; method ops() { self }; method oplib() { self }; method version() { self; } # unused. Replaced by cpp macros from pbcversion.h method bytecode_major() { self } method bytecode_minor() { self } method _calculate_op_codes() { my $code := 0; for self -> $op { $op := $code++; } } method _set_version() { my $config := _config(); self := +$config; self := +$config; self := [ +self, +self, ]; } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: ft=perl6 expandtab shiftwidth=4: extend.pod000644000765000765 102412101554066 15431 0ustar00brucebruce000000000000parrot-5.9.0/docs# Copyright (C) 2005-2012, Parrot Foundation. =head1 NAME extend.pod - Parrot extension system =head1 SYNOPSIS #include "parrot/extend.h" int main(int argc, char *argv[]) { } =head1 DESCRIPTION This document, briefly, describes Parrot's extension system. =head1 FILES =over 4 =item F =item F =back =head1 DESCRIPTION =head2 Data Structures TODO =head2 Constants TODO =head2 Functions TODO =head1 SEE ALSO F and F for the implementation. =cut appc_command_line_options.pod000644000765000765 1305611533177634 23441 0ustar00brucebruce000000000000parrot-5.9.0/docs/book/draft=pod =head1 Command-Line Options Z X X X Since Parrot is both an assembler and a bytecode interpreter, it has options to control both behaviors. Some options may have changed by the time you read this, especially options related to debugging and optimization. The document F should have the latest details. Or just run F. =head2 General Usage Z parrot [options] file [arguments] The R is either an F<.pir> or F<.pasm> source file or a Parrot bytecode file. Parrot creates an C object to hold the command-line R and stores it in C on program start. =head2 Assembler Options Z =over 4 =item -a, --pasm X Assume PASM input on C. When Parrot runs a source file with a F<.pasm> extension, it parses the file as pure PASM code. This switch turns on PASM parsing (instead of the default PIR parsing) when a source file is read from C. =item -c,--pbc Assume PBC file on C. When Parrot runs a bytecode file with a F<.pbc> extension, it immediately executes the file. This option tells Parrot to immediately execute a bytecode file piped in on C. =item -d,--debug [R] Turn on debugging output. The C<-d> switch takes an optional argument, which is a hex value of debug bits. The individual bits are shown in Table 11-3. When R isn't specified, the default debugging level is 0001. If R is separated from the C<-d> switch by whitespace, it has to start with a number. =begin table picture Debug bits Z =headrow =row =cell Description =cell Debug bit =bodyrows =row =cell DEBUG_PARROT =cell 0001 =row =cell DEBUG_LEXER =cell 0002 =row =cell DEBUG_PARSER =cell 0004 =row =cell DEBUG_IMC =cell 0008 =row =cell DEBUG_CFG =cell 0010 =row =cell DEBUG_OPT1 =cell 0020 =row =cell DEBUG_OPT2 =cell 0040 =row =cell DEBUG_PBC =cell 1000 =row =cell DEBUG_PBC_CONST =cell 2000 =row =cell DEBUG_PBC_FIXUP =cell 4000 =end table X X To produce a huge output on C, turn on all the debugging bits: $ parrot -d 0ffff ... =item --help-debug Show debug option bits. =item -h,--help Print a short summary of options to C and exit. =item -o R Act like an assembler. With this switch Parrot won't run code unless it's combined with the C<-r> switch. If the name of R ends with a F<.pbc> extension, Parrot writes a Parrot bytecode file. If R ends with a F<.pasm> extension, Parrot writes a PASM source file, even if the input file was also PASM. This can be handy to check various optimizations when you run Parrot with the C<-Op> switch. =item -r,--run-pbc Immediately execute bytecode. This is the default unless C<-o> is present. The combination of C<-r> C<-o> C writes a bytecode file and executes the generated PBC. =item -v,--verbose One C<-v> switch (C C<-v>) shows which files are worked on and prints a summary of register usage and optimization statistics. Two C<-v> switches (C C<-v> C<-v>) also prints a line for each individual processing step. =item -y,--yydebug Turn on C for F/F. =item -E,--pre-process-only Show output of macro expansions and quit. =item -V,--version Print the program version to C and exit. =item -Ox Turn on optimizations. The flags currently implemented are shown in Table 11-4. X X =begin table picture Optimizations Z =headrow =row =cell Flag =cell Meaning =bodyrows =row =cell C<-O0> =cell No optimization (default). =row =cell C<-O1> =cell Optimizations without life info (e.g. branches and constants). =row =cell C<-O2> =cell Optimizations with life info. =row =cell C<-Oc> =cell Optimize function call sequence. =row =cell C<-Op> =cell Rearrange PASM registers with the most-used first. =end table =back =head2 Runcore Options Z X X X X The interpreter options are mainly for selecting which run-time core to use for interpreting bytecode. The current default is the I if it's available. Otherwise the I is used. =over 4 =item -R slow Run with the I =item -R bounds Activate bounds checking. This also runs with the I as a side effect. =item -R fast Run with the I. =item -R gcdebug Performs a full GC run before every op dispatch (good for debugging GC problems) =item -p,--profile Activate profiling. This prints a summary of opcode usage and execution times after the program stops. It also runs within the I. =item -t,--trace Trace execution. This also turns on the I. =item -w,--warnings Turn on warnings. =item -G,--no-gc Turn off GC. This is for debugging only. =item -.,--wait Wait for a keypress before running. =item --leak-test,--destroy-at-end Cleanup up allocated memory when the final interpreter is destroyed. C destroys created interpreters (e.g. threads) on exit but doesn't normally free all memory for the last terminating interpreter, since the operating system will do this anyway. This can create false positives when C is run with a memory leak detector. To prevent this, use this option. =back =cut # Local variables: # c-file-style: "parrot" # End: # vim: expandtab shiftwidth=4: foo-07.t000644000765000765 141311606346660 15451 0ustar00brucebruce000000000000parrot-5.9.0/t/dynpmc#!./parrot # Copyright (C) 2011, Parrot Foundation. .sub main :main .include 'test_more.pir' plan(3) .include "iglobals.pasm" .local pmc config_hash, interp .local pmc d, l, r interp = getinterp config_hash = interp[.IGLOBALS_CONFIG_HASH] $S0 = config_hash['gmp'] unless $S0 goto no_bigint $P0 = loadlib "foo_group" ok(1, 'inherited add - loadlib') l = new "Foo" l = 42 r = new 'BigInt' r = 0x7ffffff d = new 'Undef' add d, l, r is(d, 134217769, 'inherited add') $S0 = typeof d is($S0, 'BigInt', 'inherited add - typeof') .return() no_bigint: skip( 3, 'No BigInt Lib configured' ) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: lexpad.pmc000644000765000765 3430712101554067 16065 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2007-2012, Parrot Foundation. =head1 NAME src/pmc/lexpad.pmc - LexPad PMC =head1 DESCRIPTION These are the vtable functions for the lexpad PMC. =head2 Functions =over 4 =cut */ /* * LexPad provides a Hash interface for lexical fetch/store * needed * * struct_val ... Context *ctx * pmc_val ... LexInfo */ /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_INLINE PARROT_CAN_RETURN_NULL static HashBucket * register_bucket(PARROT_INTERP, ARGMOD(PMC *info), ARGIN(STRING *name)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*info); static INTVAL register_number_for_get(PARROT_INTERP, ARGMOD(PMC *info), ARGIN(STRING *name), INTVAL reg_type) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*info); static INTVAL register_number_for_set(PARROT_INTERP, ARGMOD(PMC *info), ARGMOD(STRING *name), INTVAL reg_type) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*info) FUNC_MODIFIES(*name); PARROT_DOES_NOT_RETURN static void throw_lexical_not_found(PARROT_INTERP, ARGIN(STRING *name)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_DOES_NOT_RETURN static void throw_wrong_register_type(PARROT_INTERP, ARGIN(STRING *name)) __attribute__nonnull__(1) __attribute__nonnull__(2); #define ASSERT_ARGS_register_bucket __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(info) \ , PARROT_ASSERT_ARG(name)) #define ASSERT_ARGS_register_number_for_get __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(info) \ , PARROT_ASSERT_ARG(name)) #define ASSERT_ARGS_register_number_for_set __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(info) \ , PARROT_ASSERT_ARG(name)) #define ASSERT_ARGS_throw_lexical_not_found __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(name)) #define ASSERT_ARGS_throw_wrong_register_type __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(name)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C =item C Helper functions for common exceptions. =cut */ PARROT_DOES_NOT_RETURN static void throw_wrong_register_type(PARROT_INTERP, ARGIN(STRING *name)) { ASSERT_ARGS(throw_wrong_register_type) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LEX_NOT_FOUND, "Lexical '%Ss' is of wrong register type in lexical lookup", name); } PARROT_DOES_NOT_RETURN static void throw_lexical_not_found(PARROT_INTERP, ARGIN(STRING *name)) { ASSERT_ARGS(throw_lexical_not_found) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LEX_NOT_FOUND, "Lexical '%Ss' not found", name); } /* =item C Helper for register_number_ functions. =cut */ PARROT_INLINE PARROT_CAN_RETURN_NULL static HashBucket * register_bucket(PARROT_INTERP, ARGMOD(PMC *info), ARGIN(STRING *name)) { ASSERT_ARGS(register_bucket) const Hash * const hash = (const Hash *)VTABLE_get_pointer(interp, info); return hash->entries ? Parrot_hash_get_bucket(interp, hash, name) : NULL; } /* =item C Locates the register number for getting the specified name and type of lexical. =cut */ static INTVAL register_number_for_get(PARROT_INTERP, ARGMOD(PMC *info), ARGIN(STRING *name), INTVAL reg_type) { ASSERT_ARGS(register_number_for_get) const HashBucket * const b = register_bucket(interp, info, name); if (!b) return -1; if (((INTVAL)b->value & 3) != reg_type) throw_wrong_register_type(interp, name); return ((INTVAL)b->value) >> 2; } /* =item C Locates the register number for setting the specified name and type of lexical. =cut */ static INTVAL register_number_for_set(PARROT_INTERP, ARGMOD(PMC *info), ARGMOD(STRING *name), INTVAL reg_type) { ASSERT_ARGS(register_number_for_set) const HashBucket * const b = register_bucket(interp, info, name); if (!b) throw_lexical_not_found(interp, name); if (((INTVAL)b->value & 3) != reg_type) throw_wrong_register_type(interp, name); return ((INTVAL)b->value) >> 2; } pmclass LexPad provides hash no_ro auto_attrs { ATTR PMC *lexinfo; ATTR PMC *ctx; VTABLE void init() { UNUSED(SELF) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "Cannot create a LexPad PMC without an initializer"); } /* =item C Initialize the LexPad PMC and remember the associate lexinfo. =item C Initialize the LexPad PMC and remember the associate context. =item C Returns the number of elements in the hash. =item C =item C Returns whether a lexical C exists in the hash. =item C =item C Return the lexical with the given name, or NULL (not PMCNULL), if the lexical doesn't exist. =item C =item C Set the lexical with the given name to value. If the lexical name doesn't exist, it is created. =item C Return the LexInfo PMC, if any or a Null PMC. =cut */ VTABLE void init_pmc(PMC *lexinfo) { SET_ATTR_lexinfo(INTERP, SELF, lexinfo); } VTABLE void set_pointer(void *ctx) { SET_ATTR_ctx(INTERP, SELF, (PMC *)ctx); } VTABLE INTVAL elements() { PMC *info; GET_ATTR_lexinfo(INTERP, SELF, info); return Parrot_hash_size(INTERP, (Hash *)VTABLE_get_pointer(INTERP, info)); } VTABLE INTVAL exists_keyed_str(STRING *name) { PMC *info; const Hash *hash; GET_ATTR_lexinfo(INTERP, SELF, info); hash = (const Hash *)VTABLE_get_pointer(INTERP, info); return hash->entries ? (Parrot_hash_get_bucket(INTERP, hash, name) != 0) : 0; } VTABLE INTVAL exists_keyed(PMC *name) { STRING * const s = VTABLE_get_string(INTERP, name); return SELF.exists_keyed_str(s); } VTABLE PMC *get_pmc_keyed_str(STRING *name) { PMC *info; PMC *ctx; INTVAL reg; GET_ATTR_lexinfo(INTERP, SELF, info); reg = register_number_for_get(INTERP, info, name, REGNO_PMC); if (reg < 0) return PMCNULL; GET_ATTR_ctx(INTERP, SELF, ctx); return CTX_REG_PMC(INTERP, ctx, reg); } VTABLE INTVAL get_integer_keyed_str(STRING *name) { PMC *info; PMC *ctx; INTVAL reg; GET_ATTR_lexinfo(INTERP, SELF, info); reg = register_number_for_get(INTERP, info, name, REGNO_INT); if (reg < 0) throw_lexical_not_found(INTERP, name); GET_ATTR_ctx(INTERP, SELF, ctx); return CTX_REG_INT(INTERP, ctx, reg); } VTABLE FLOATVAL get_number_keyed_str(STRING *name) { PMC *info; PMC *ctx; INTVAL reg; GET_ATTR_lexinfo(INTERP, SELF, info); reg = register_number_for_get(INTERP, info, name, REGNO_NUM); if (reg < 0) throw_lexical_not_found(INTERP, name); GET_ATTR_ctx(INTERP, SELF, ctx); return CTX_REG_NUM(INTERP, ctx, reg); } VTABLE STRING *get_string_keyed_str(STRING *name) { PMC *info; PMC *ctx; INTVAL reg; GET_ATTR_lexinfo(INTERP, SELF, info); reg = register_number_for_get(INTERP, info, name, REGNO_STR); if (reg < 0) throw_lexical_not_found(INTERP, name); GET_ATTR_ctx(INTERP, SELF, ctx); return CTX_REG_STR(INTERP, ctx, reg); } VTABLE PMC *get_pmc_keyed(PMC *name) { STRING * const s = VTABLE_get_string(INTERP, name); return SELF.get_pmc_keyed_str(s); } VTABLE INTVAL get_integer_keyed(PMC *name) { STRING * const s = VTABLE_get_string(INTERP, name); return SELF.get_integer_keyed_str(s); } VTABLE FLOATVAL get_number_keyed(PMC *name) { STRING * const s = VTABLE_get_string(INTERP, name); return SELF.get_number_keyed_str(s); } VTABLE STRING *get_string_keyed(PMC *name) { STRING * const s = VTABLE_get_string(INTERP, name); return SELF.get_string_keyed_str(s); } VTABLE void set_pmc_keyed_str(STRING *name, PMC *value) { PMC *info; PMC *ctx; INTVAL reg; GET_ATTR_lexinfo(INTERP, SELF, info); reg = register_number_for_set(INTERP, info, name, REGNO_PMC); GET_ATTR_ctx(INTERP, SELF, ctx); CTX_REG_PMC(INTERP, ctx, reg) = value; PARROT_GC_WRITE_BARRIER(INTERP, ctx); } VTABLE void set_integer_keyed_str(STRING *name, INTVAL value) { PMC *info; PMC *ctx; INTVAL reg; GET_ATTR_lexinfo(INTERP, SELF, info); reg = register_number_for_set(INTERP, info, name, REGNO_INT); GET_ATTR_ctx(INTERP, SELF, ctx); CTX_REG_INT(INTERP, ctx, reg) = value; } VTABLE void set_number_keyed_str(STRING *name, FLOATVAL value) { PMC *info; PMC *ctx; INTVAL reg; GET_ATTR_lexinfo(INTERP, SELF, info); reg = register_number_for_set(INTERP, info, name, REGNO_NUM); GET_ATTR_ctx(INTERP, SELF, ctx); CTX_REG_NUM(INTERP, ctx, reg) = value; } VTABLE void set_string_keyed_str(STRING *name, STRING *value) { PMC *info; PMC *ctx; INTVAL reg; GET_ATTR_lexinfo(INTERP, SELF, info); reg = register_number_for_set(INTERP, info, name, REGNO_STR); GET_ATTR_ctx(INTERP, SELF, ctx); CTX_REG_STR(INTERP, ctx, reg) = value; PARROT_GC_WRITE_BARRIER(INTERP, ctx); } VTABLE void set_pmc_keyed(PMC *name, PMC *value) { STRING * const s = VTABLE_get_string(INTERP, name); SELF.set_pmc_keyed_str(s, value); } VTABLE void set_integer_keyed(PMC *name, INTVAL value) { STRING * const s = VTABLE_get_string(INTERP, name); SELF.set_integer_keyed_str(s, value); } VTABLE void set_number_keyed(PMC *name, FLOATVAL value) { STRING * const s = VTABLE_get_string(INTERP, name); SELF.set_number_keyed_str(s, value); } VTABLE void set_string_keyed(PMC *name, STRING *value) { STRING * const s = VTABLE_get_string(INTERP, name); SELF.set_string_keyed_str(s, value); } METHOD get_lexinfo() { PMC *lexinfo; GET_ATTR_lexinfo(INTERP, SELF, lexinfo); RETURN(PMC *lexinfo); } /* =item C Get iterator for declared lexicals. =cut */ VTABLE PMC *get_iter() { PMC *info; PMC *ctx; PMC *info_iter; PMC *value_map = Parrot_pmc_new(INTERP, enum_class_Hash); Hash * hash; GET_ATTR_lexinfo(INTERP, SELF, info); GET_ATTR_ctx(INTERP, SELF, ctx); info_iter = VTABLE_get_iter(INTERP, info); hash = (Hash *)VTABLE_get_pointer(interp, info); while (VTABLE_get_bool(INTERP, info_iter)) { STRING * const name = VTABLE_shift_string(INTERP, info_iter); HashBucket * const b = Parrot_hash_get_bucket(INTERP, hash, name); INTVAL reg_type = (INTVAL)b->value & 3; INTVAL reg_idx = ((INTVAL)b->value) >> 2; PMC * value; switch (reg_type) { case REGNO_PMC: value = CTX_REG_PMC(INTERP, ctx, reg_idx); VTABLE_set_pmc_keyed_str(INTERP, value_map, name, value); break; case REGNO_INT: { const INTVAL ivalue = CTX_REG_INT(INTERP, ctx, reg_idx); value = Parrot_pmc_box_integer(INTERP, ivalue); VTABLE_set_pmc_keyed_str(INTERP, value_map, name, value); break; } case REGNO_STR: { STRING * const svalue = CTX_REG_STR(INTERP, ctx, reg_idx); value = Parrot_pmc_box_string(INTERP, svalue); VTABLE_set_pmc_keyed_str(INTERP, value_map, name, value); break; } case REGNO_NUM: { FLOATVAL fvalue = CTX_REG_NUM(INTERP, ctx, reg_idx); value = Parrot_pmc_box_number(INTERP, fvalue); VTABLE_set_pmc_keyed_str(INTERP, value_map, name, value); break; } default: throw_wrong_register_type(INTERP, name); } } return VTABLE_get_iter(INTERP, value_map); } /* =item C Returns a number based on the type of the variable named name. =over 4 =item * -1 = Not Found =item * 0 = Integer =item * 1 = Num =item * 2 = String =item * 3 = PMC =back =cut */ METHOD INTVAL register_type(STRING *name) { PMC *info; HashBucket *b; INTVAL ret = -1; GET_ATTR_lexinfo(INTERP, SELF, info); b = register_bucket(INTERP, info, name); if (b) ret = (INTVAL) b->value & 3; RETURN(INTVAL ret); } } /* =back =head1 SEE ALSO F, F. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ 32_array_ops_sprintf.pir000644000765000765 161712101554066 22763 0ustar00brucebruce000000000000parrot-5.9.0/examples/tutorial# Copyright (C) 2007-2012, Parrot Foundation. =pod =head1 DESCRIPTION A tutorial lesson about Parrot's arrays (continued). =head1 USING SPRINTF WITH ARRAYS C is a function common to most programmers as part of the C standard library that allows the creation of a string from a given format and a list of operators. Parrot's C operator extends the format options of the regular sprintf function and allows arguments to be taken from inside an array PMC. =cut .sub main :main .local pmc myarray myarray = new ['ResizablePMCArray'] $P0 = new ['Integer'] $P0 = 42 push myarray, $P0 $P1 = new ['Float'] $P1 = 10.5 push myarray, $P1 $S0 = sprintf "int %#Px num %+2.2Pf\n", myarray print $S0 # prints "int 0x2a num +10.50" print "\n" .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: releasecheck.pl000644000765000765 362711631440405 20252 0ustar00brucebruce000000000000parrot-5.9.0/tools/release#! perl # Copyright (C) 2011, Parrot Foundation. use strict; use warnings; use Archive::Tar; use Carp; use Cwd; use File::Copy; use File::Temp qw( tempdir ); use lib qw( ./lib ); use Parrot::Config; my $cwd = cwd(); opendir my $DIRH, $cwd or croak "Unable to open directory handle"; my @tarballs = grep { m/parrot-.*\.tar\.gz$/ } readdir $DIRH; closedir $DIRH or croak "Unable to close directory handle"; croak "Should find exactly one gzipped tarball" unless @tarballs == 1; my $tb = $tarballs[0]; my $distro = ''; if ($tb =~ m/(parrot-\d+\.\d+\.\d+(?:-devel)?)\.tar\.gz$/ ) { $distro = $1; } else { croak "Unable to extract distro from $tb"; } print "Performing releasecheck on $tb\n"; { my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or croak "Unable to change to temporary directory"; print "Changing to temporary directory\n"; my $ctarball = "$tdir/$tb"; copy "$cwd/$tb" => $ctarball or croak "Unable to copy $tb"; my $tar = Archive::Tar->new; $tar->read($ctarball); $tar->extract(); chdir $distro or croak "Unable to chdir to $distro"; print "Reconfiguring\n"; system(qq{$^X Configure.pl --silent}) and croak "Unable to configure"; print "Rebuilding\n"; my $make = $PConfig{make}; my $silent = $make =~ 'nmake' ? '/S' : '--silent'; system(qq{$make $silent}) and croak "Unable to build"; print "Retesting\n"; system(qq{$make test}) and croak "'$make test' did not complete successfully"; print "Rereleasing\n"; system(qq{$make release $silent}) and croak "Unable to release"; print "Recleaning\n"; system(qq{$make realclean $silent}) and croak "Unable to realclean"; chdir $cwd or croak "Unable to change dir back"; print "Leaving temporary directory\n"; } print "Completed releasecheck on $tb\n"; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: sha256.pir000644000765000765 3560111606346660 22147 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library/Digest# Copyright (C) 2010, Parrot Foundation. # # Parrot SHA-2 library; Gerd Pokorra # modified by Nolan Lum # # Based on sha256.c, from sha256sum # written by David Madore # # Functions that are from the SHA-2 family to compute SHA-224 and SHA-256 # message digest according to the NIST specification FIPS 180-3: # http://csrc.nist.gov/publications/fips/fips180-3/fips180-3_final.pdf # # NIST = National Institute of Standards and Technology # FIPS = Federal Information Processing Standards # This is the start of the implementation and sha224 is not done yet! =head1 NAME sha256.pir - calculates message digest checksums =head1 SYNOPSIS load_bytecode "Digest/sha256.pbc" $P0 = sha256sum("foo") sha256_print($P0) or load_bytecode "Digest/sha256.pbc" $P0 = sha256sum("bar") $S0 = sha256_hex($P0) or using the object oriented interface: load_bytecode "Digest/sha256.pbc" $P0 = new ['Digest';"SHA256"] $P0."sha_sum"("blah") $P0."sha_print"() =head1 DESCRIPTION This is a pure Parrot sha256 hash routine. =head1 SUBROUTINES =head2 sha256sum Pass in a string, returns an Integer array with the result. =head2 sha256_hex Pass it the Integer array from sha256sum to get the checksum as string. =head2 sha256_print Pass it the Integer array to print the checksum. =head1 BUGS Still has some limitations on input buffer size, largely due to memory consumption which should be resolved soon. =cut .HLL 'parrot' #.loadlib 'bit_ops' ########################################################################### # Export function entries to globals .sub onload :load .local pmc f f = get_hll_global ['Digest'], '_sha256sum' set_global "sha256sum", f f = get_hll_global ['Digest'], '_sha256_hex' set_global "sha256_hex", f f = get_hll_global ['Digest'], '_sha256_print' set_global "sha256_print", f .end .namespace ['Digest';'SHA256'] # Create Object Oriented interface .sub '' :init :load :anon $P0 = newclass ['Digest';'SHA256'] $P0.'add_attribute'('context') .end =head2 C Pass in a string, returns an Integer array with the resulting SHA256, and stores the result in an attribute. =cut .sub 'sha_sum' :method .param string str $P0 = sha256sum (str) setattribute self, 'context', $P0 .return ($P0) .end =head2 C Uses the Integer array from _sha256sum to return the checksum as string. =cut .sub 'sha_hex' :method $P0 = getattribute self, 'context' $S0 = sha256_hex($P0) .return ($S0) .end =head2 C Uses the Integer array from _sha256sum to print the checksum. Returns the checksum as a string. =cut .sub 'sha_print' :method $P0 = getattribute self, 'context' $S0 = sha256_hex($P0) say $S0 .return ($S0) .end ########################################################################### # Main backend entry point .namespace ["Digest"] .sub _sha256sum .param string str .local pmc context context = new 'FixedIntegerArray' context = 8 .local pmc buffer buffer = _sha256_create_buffer (str) _sha256_init (context) _sha256_process_buffer (context, buffer) .return (context) .end ########################################################################### # Some helper macros .macro add_no_carry(x, y) .x += .y .x &= 0xFFFFFFFF .endm ########################################################################### # Create the data buffer, padding as necessary. .sub _sha256_create_buffer .param string str .local pmc buffer buffer = new 'FixedIntegerArray' .local int counter .local int subcounter .local int slow_counter .local int word, len len = length str $I1 = len - 1 # Work out how many words to allocate .local int words words = len + 8 words |= 63 inc words words /= 4 buffer = words word = 0 counter = 0 subcounter = 0 slow_counter = 0 create_buffer_loop: $I5 = counter + subcounter if $I5 > len goto create_buffer_break # pad character, which goes last (append the bit "1" to the end of the # message) $I4 = 0x80 if $I5 > $I1 goto string_char $I4 = ord str, $I5 string_char: word <<= 8 word |= $I4 inc subcounter if subcounter != 4 goto create_buffer_loop buffer[slow_counter] = word word = 0 counter += 4 subcounter = 0 inc slow_counter goto create_buffer_loop create_buffer_break: # Check for a partial word if subcounter == 0 goto complete subcounter = 4 - subcounter $I0 = 8*subcounter word <<= $I0 buffer[slow_counter] = word complete: # The length of the string go into the last two words (64 bits) $I0 = len << 3 dec words buffer[words] = $I0 $I0 = len >>> 29 dec words buffer[words] = $I0 .return (buffer) .end ########################################################################### # Pass in the Interger array and return the final checksum as a string .sub _sha256_hex .param pmc context $S0 = sprintf "%08lx%08lx%08lx%08lx%08lx%08lx%08lx%08lx", context .return ($S0) .end ########################################################################### # Convenience subroutine to print the Message Digest # - Pass in the Integer array # - Retrieve the final checksum as a string # - Print the Message Digest .sub _sha256_print .param pmc context $S0 = _sha256_hex (context) print $S0 .return ($S0) .end ########################################################################### # Set the start constants of the SHA256 algorithm .sub _sha256_init .param pmc context # Initial constants context[0] = 0x6a09e667 context[1] = 0xbb67ae85 context[2] = 0x3c6ef372 context[3] = 0xa54ff53a context[4] = 0x510e527f context[5] = 0x9b05688c context[6] = 0x1f83d9ab context[7] = 0x5be0cd19 .end ########################################################################### .sub _Ch .param pmc context .local int E, F, G, result E = context[4] F = context[5] G = context[6] # Ch(x,y,z) = ( x and y ) xor ( not(x) and z ) = z xor ( x and ( y xor z ) # here as: Ch(E,F,G) = G xor ( E and ( F xor G ) result = bxor F, G result = band E, result result = bxor G, result .return (result) .end ########################################################################### .sub _Maj .param pmc context .local int A, B, C, extension, result A = context[0] B = context[1] C = context[2] # Maj(x,y,z) = ( x and y ) xor ( x and z ) xor ( y and z ) # = ( x and y ) or ( z and ( x or y ) ) # here as: Maj(A,B,C) = ( A and B ) or ( C and ( A or B ) ) result = bor A, B result = band C, result extension = band A, B result = bor extension, result .return (result) .end ########################################################################### .sub _rotate_right # circular right shift operation, where x is a 32-bit word and n is an # integer .param int x .param int n .local int result, extension extension = x >>> n extension &= 0xFFFFFFFF n = 32 - n result = x << n result &= 0xFFFFFFFF # Maintain 32-bits result |= extension .return (result) .end ########################################################################### .sub _Sigma_0 .param pmc context .local int A, intermediate, result A = context[0] intermediate = _rotate_right( A, 2 ) result = _rotate_right( A, 13 ) result = bxor intermediate, result intermediate = _rotate_right( A, 22 ) result = bxor intermediate, result result &= 0xFFFFFFFF .return (result) .end ########################################################################### .sub _Sigma_1 .param pmc context .local int E, intermediate, result E = context[4] intermediate = _rotate_right( E, 6 ) result = _rotate_right( E, 11 ) result = bxor intermediate, result intermediate = _rotate_right( E, 25 ) result = bxor intermediate, result result &= 0xFFFFFFFF .return (result) .end ########################################################################### .sub _sigma0 .param int value .local int intermediate, result intermediate = _rotate_right( value, 7 ) result = _rotate_right( value, 18 ) result = bxor intermediate, result intermediate = value >>> 3 result = bxor intermediate, result result &= 0xFFFFFFFF .return (result) .end ########################################################################### .sub _sigma1 .param int value .local int intermediate, result intermediate = _rotate_right( value, 17 ) result = _rotate_right( value, 19 ) result = bxor intermediate, result intermediate = value >>> 10 result = bxor intermediate, result result &= 0xFFFFFFFF .return (result) .end ########################################################################### .sub _sha256_process_block .param pmc context .param pmc block .local int a_save, b_save, c_save, d_save, e_save, f_save, g_save, h_save a_save = context[0] b_save = context[1] c_save = context[2] d_save = context[3] e_save = context[4] f_save = context[5] g_save = context[6] h_save = context[7] # 64 round constants as 32-bit words .local pmc K K = new 'FixedIntegerArray' K = 64 K[0] = 0x428a2f98 K[1] = 0x71374491 K[2] = 0xb5c0fbcf K[3] = 0xe9b5dba5 K[4] = 0x3956c25b K[5] = 0x59f111f1 K[6] = 0x923f82a4 K[7] = 0xab1c5ed5 K[8] = 0xd807aa98 K[9] = 0x12835b01 K[10] = 0x243185be K[11] = 0x550c7dc3 K[12] = 0x72be5d74 K[13] = 0x80deb1fe K[14] = 0x9bdc06a7 K[15] = 0xc19bf174 K[16] = 0xe49b69c1 K[17] = 0xefbe4786 K[18] = 0x0fc19dc6 K[19] = 0x240ca1cc K[20] = 0x2de92c6f K[21] = 0x4a7484aa K[22] = 0x5cb0a9dc K[23] = 0x76f988da K[24] = 0x983e5152 K[25] = 0xa831c66d K[26] = 0xb00327c8 K[27] = 0xbf597fc7 K[28] = 0xc6e00bf3 K[29] = 0xd5a79147 K[30] = 0x06ca6351 K[31] = 0x14292967 K[32] = 0x27b70a85 K[33] = 0x2e1b2138 K[34] = 0x4d2c6dfc K[35] = 0x53380d13 K[36] = 0x650a7354 K[37] = 0x766a0abb K[38] = 0x81c2c92e K[39] = 0x92722c85 K[40] = 0xa2bfe8a1 K[41] = 0xa81a664b K[42] = 0xc24b8b70 K[43] = 0xc76c51a3 K[44] = 0xd192e819 K[45] = 0xd6990624 K[46] = 0xf40e3585 K[47] = 0x106aa070 K[48] = 0x19a4c116 K[49] = 0x1e376c08 K[50] = 0x2748774c K[51] = 0x34b0bcb5 K[52] = 0x391c0cb3 K[53] = 0x4ed8aa4a K[54] = 0x5b9cca4f K[55] = 0x682e6ff3 K[56] = 0x748f82ee K[57] = 0x78a5636f K[58] = 0x84c87814 K[59] = 0x8cc70208 K[60] = 0x90befffa K[61] = 0xa4506ceb K[62] = 0xbef9a3f7 K[63] = 0xc67178f2 .local pmc W W = new 'FixedIntegerArray' W = 64 .local int counter, Wtmp, Wcur counter = 0 COPY_LOOP: # Copy data directly Wcur = block[counter] W[counter] = Wcur inc counter if counter < 16 goto COPY_LOOP EXPAND_LOOP: Wtmp = counter - 2 Wtmp = W[Wtmp] Wtmp = _sigma1(Wtmp) Wcur = Wtmp Wtmp = counter - 7 Wtmp = W[Wtmp] .add_no_carry(Wcur, Wtmp) Wtmp = counter - 15 Wtmp = W[Wtmp] Wtmp = _sigma0(Wtmp) .add_no_carry(Wcur, Wtmp) Wtmp = counter - 16 Wtmp = W[Wtmp] .add_no_carry(Wcur, Wtmp) W[counter] = Wcur inc counter if counter < 64 goto EXPAND_LOOP # Perform 64 rounds of hash computation. counter = 0 .local int T1, T2, tmp ROUND_LOOP: T1 = context[7] tmp = _Sigma_1(context) .add_no_carry(T1, tmp) tmp = _Ch(context) .add_no_carry(T1, tmp) tmp = K[counter] .add_no_carry(T1, tmp) tmp = W[counter] .add_no_carry(T1, tmp) T2 = _Sigma_0(context) tmp = _Maj(context) .add_no_carry(T2, tmp) tmp = context[6] # h = g; context[7] = tmp tmp = context[5] # g = f; context[6] = tmp tmp = context[4] # f = e; context[5] = tmp tmp = context[3] # e = d + T1; .add_no_carry(tmp, T1) context[4] = tmp tmp = context[2] # d = c; context[3] = tmp tmp = context[1] # c = b; context[2] = tmp tmp = context[0] # b = a; context[1] = tmp tmp = T1 # a = T1 + T2; .add_no_carry(tmp, T2) context[0] = tmp inc counter if counter < 64 goto ROUND_LOOP # Combine with the old state. tmp = context[0] .add_no_carry(tmp, a_save) context[0] = tmp tmp = context[1] .add_no_carry(tmp, b_save) context[1] = tmp tmp = context[2] .add_no_carry(tmp, c_save) context[2] = tmp tmp = context[3] .add_no_carry(tmp, d_save) context[3] = tmp tmp = context[4] .add_no_carry(tmp, e_save) context[4] = tmp tmp = context[5] .add_no_carry(tmp, f_save) context[5] = tmp tmp = context[6] .add_no_carry(tmp, g_save) context[6] = tmp tmp = context[7] .add_no_carry(tmp, h_save) context[7] = tmp .end ########################################################################### .sub _sha256_process_buffer .param pmc context .param pmc buffer .local int idx, i2, len, tmp .local pmc part part = new 'FixedIntegerArray' part = 16 idx = 0 i2 = 0 len = elements buffer BLOCK_LOOP: tmp = idx + i2 tmp = buffer[tmp] part[i2] = tmp inc i2 if i2 < 16 goto BLOCK_LOOP _sha256_process_block (context, part) idx += 16 i2 = 0 if idx < len goto BLOCK_LOOP .end ## Functions that could be used for debugging ########################################################################### .sub _print_integer_in_hex_format .param int hex_num $P0 = new 'FixedIntegerArray' $P0 = 1 $P0[0] = hex_num $S0 = sprintf "%08lx", $P0 print 'value in hex-format: ' say $S0 #say '' .end ########################################################################### .sub _print_round .param pmc context $S0 = sprintf "%08X %08X %08X %08X %08X %08X %08X %08X", context say $S0 .end ########################################################################### .sub _print_message .param pmc buffer .local int idx, i2, len, tmp .local pmc part part = new 'FixedIntegerArray' part = 16 idx = 0 i2 = 0 len = elements buffer AGAIN: tmp = idx + i2 tmp = buffer[tmp] part[i2] = tmp inc i2 if i2 < 16 goto AGAIN sprintf $S0, " 0: %08x\n 1: %08x\n 2: %08x\n 3: %08x\n 4: %08x\n 5: %08x\n 6: %08x\n 7: %08x\n 8: %08x\n 9: %08x\n10: %08x\n11: %08x\n12: %08x\n13: %08x\n14: %08x\n15: %08x\n", part say $S0 idx += 16 i2 = 0 if idx < len goto AGAIN .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: 27-self.t000644000765000765 67212101554067 17131 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx/t/nqp#!./parrot-nqp plan(3); class Foo { method foo() { 1 }; method uno() { self.foo(); }; method des() { if 1 { self.foo(); } }; method tres($a) { if 1 { self.foo(); } }; }; ok(Foo.new.uno, "Can access self within method"); ok(Foo.new.des, "Can access self within sub-block"); ok(Foo.new.tres(42), "Can access self within method with signature"); pipe.c000644000765000765 4125312101554067 15036 0ustar00brucebruce000000000000parrot-5.9.0/src/io/* Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME src/io/pipe.c - IO_VTABLE and helpers for Pipes =head1 DESCRIPTION This file implements the IO_VTABLE for pipes and helper functions. =head2 IO_VTABLE Functions =over 4 =cut */ #include "parrot/parrot.h" #include "io_private.h" #include "pmc/pmc_filehandle.h" /* HEADERIZER HFILE: src/io/io_private.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void io_pipe_adv_position(PARROT_INTERP, ARGMOD(PMC *handle), size_t offset) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); static INTVAL io_pipe_close(PARROT_INTERP, ARGMOD(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); static INTVAL io_pipe_flush(PARROT_INTERP, ARGMOD(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); PARROT_CAN_RETURN_NULL PARROT_WARN_UNUSED_RESULT static const STR_VTABLE * io_pipe_get_encoding(PARROT_INTERP, ARGIN(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2); static INTVAL io_pipe_get_flags(PARROT_INTERP, ARGIN(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2); static PIOHANDLE io_pipe_get_piohandle(PARROT_INTERP, ARGIN(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2); static PIOOFF_T io_pipe_get_position(PARROT_INTERP, ARGMOD(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); static INTVAL io_pipe_is_eof(PARROT_INTERP, ARGMOD(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); static INTVAL io_pipe_is_open(PARROT_INTERP, ARGMOD(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); static INTVAL io_pipe_open(PARROT_INTERP, ARGMOD(PMC *handle), ARGIN(STRING *path), INTVAL flags, ARGIN(STRING *mode)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(5) FUNC_MODIFIES(*handle); static INTVAL io_pipe_read_b(PARROT_INTERP, ARGMOD(PMC *handle), ARGOUT(char *buffer), size_t byte_length) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*handle) FUNC_MODIFIES(*buffer); static PIOOFF_T io_pipe_seek(PARROT_INTERP, ARGMOD(PMC *handle), PIOOFF_T offset, INTVAL whence) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); static void io_pipe_set_eof(PARROT_INTERP, ARGMOD(PMC *handle), INTVAL is_set) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); static void io_pipe_set_flags(PARROT_INTERP, ARGIN(PMC *handle), INTVAL flags) __attribute__nonnull__(1) __attribute__nonnull__(2); static void io_pipe_set_position(PARROT_INTERP, ARGMOD(PMC *handle), PIOOFF_T pos) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); static PIOOFF_T io_pipe_tell(PARROT_INTERP, ARGMOD(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); static size_t io_pipe_total_size(PARROT_INTERP, ARGIN(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2); static INTVAL io_pipe_write_b(PARROT_INTERP, ARGMOD(PMC *handle), ARGIN(char *buffer), size_t byte_length) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*handle); #define ASSERT_ARGS_io_pipe_adv_position __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_close __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_flush __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_get_encoding __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_get_flags __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_get_piohandle __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_get_position __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_is_eof __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_is_open __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_open __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle) \ , PARROT_ASSERT_ARG(path) \ , PARROT_ASSERT_ARG(mode)) #define ASSERT_ARGS_io_pipe_read_b __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle) \ , PARROT_ASSERT_ARG(buffer)) #define ASSERT_ARGS_io_pipe_seek __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_set_eof __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_set_flags __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_set_position __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_tell __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_total_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_pipe_write_b __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle) \ , PARROT_ASSERT_ARG(buffer)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Set up the Pipe IO_VTABLE. =cut */ void io_pipe_setup_vtable(PARROT_INTERP, ARGMOD_NULLOK(IO_VTABLE *vtable), INTVAL idx) { ASSERT_ARGS(io_pipe_setup_vtable) if (vtable == NULL) vtable = IO_EDITABLE_IO_VTABLE(interp, idx); vtable->number = idx; vtable->flags = PIO_VF_DEFAULT_READ_BUF /* Use read buffers by default */ | PIO_VF_MULTI_READABLE /* Can read multiple times without hanging */ | PIO_VF_FLUSH_ON_CLOSE; /* Flush handle on close */ vtable->name = "Pipe"; vtable->read_b = io_pipe_read_b; vtable->write_b = io_pipe_write_b; vtable->flush = io_pipe_flush; vtable->is_eof = io_pipe_is_eof; vtable->set_eof = io_pipe_set_eof; vtable->tell = io_pipe_tell; vtable->seek = io_pipe_seek; vtable->adv_position = io_pipe_adv_position; vtable->set_position = io_pipe_set_position; vtable->get_position = io_pipe_get_position; vtable->open = io_pipe_open; vtable->is_open = io_pipe_is_open; vtable->close = io_pipe_close; vtable->get_encoding = io_pipe_get_encoding; vtable->set_flags = io_pipe_set_flags; vtable->get_flags = io_pipe_get_flags; vtable->total_size = io_pipe_total_size; vtable->get_piohandle = io_pipe_get_piohandle; } /* =item C Read up to C bytes from the pipe. =cut */ static INTVAL io_pipe_read_b(PARROT_INTERP, ARGMOD(PMC *handle), ARGOUT(char *buffer), size_t byte_length) { ASSERT_ARGS(io_pipe_read_b) const PIOHANDLE os_handle = io_filehandle_get_os_handle(interp, handle); const size_t bytes_read = Parrot_io_internal_read(interp, os_handle, buffer, byte_length); if (bytes_read == 0) { INTVAL flags; GETATTR_FileHandle_flags(interp, handle, flags); flags |= PIO_F_EOF; SETATTR_FileHandle_flags(interp, handle, flags); } return bytes_read; } /* =item C Write bytes to the pipe. =cut */ static INTVAL io_pipe_write_b(PARROT_INTERP, ARGMOD(PMC *handle), ARGIN(char *buffer), size_t byte_length) { ASSERT_ARGS(io_pipe_write_b) const PIOHANDLE os_handle = io_filehandle_get_os_handle(interp, handle); return Parrot_io_internal_write(interp, os_handle, buffer, byte_length); } /* =item C Flush the pipe. =cut */ static INTVAL io_pipe_flush(PARROT_INTERP, ARGMOD(PMC *handle)) { ASSERT_ARGS(io_pipe_flush) /* TODO: In read mode, don't do what this does. */ PIOHANDLE os_handle = io_filehandle_get_os_handle(interp, handle); return Parrot_io_internal_flush(interp, os_handle); } /* =item C Determine if the pipe thinks it's at the end of input. =item C Do nothing. =cut */ static INTVAL io_pipe_is_eof(PARROT_INTERP, ARGMOD(PMC *handle)) { ASSERT_ARGS(io_pipe_is_eof) INTVAL flags; GETATTR_FileHandle_flags(interp, handle, flags); if (flags & PIO_F_EOF) return 1; return 0; } static void io_pipe_set_eof(PARROT_INTERP, ARGMOD(PMC *handle), INTVAL is_set) { ASSERT_ARGS(io_pipe_set_eof) if (is_set) PARROT_FILEHANDLE(handle)->flags |= PIO_F_EOF; else PARROT_FILEHANDLE(handle)->flags &= ~PIO_F_EOF; } /* =item C Pipes don't keep track of position. Throw an exception. =cut */ static PIOOFF_T io_pipe_tell(PARROT_INTERP, ARGMOD(PMC *handle)) { ASSERT_ARGS(io_pipe_tell) const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); IO_VTABLE_UNIMPLEMENTED(interp, vtable, "tell"); return (PIOOFF_T)0; } /* =item C Pipes don't seek. Throw an exception. =cut */ static PIOOFF_T io_pipe_seek(PARROT_INTERP, ARGMOD(PMC *handle), PIOOFF_T offset, INTVAL whence) { ASSERT_ARGS(io_pipe_seek) const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); IO_VTABLE_UNIMPLEMENTED(interp, vtable, "seek"); UNUSED(offset); UNUSED(whence); return 0; } /* =item C Pipes don't keep track of position. Ignore. =cut */ static void io_pipe_adv_position(PARROT_INTERP, ARGMOD(PMC *handle), size_t offset) { ASSERT_ARGS(io_pipe_adv_position) UNUSED(handle); UNUSED(offset); /* Pipes don't keep track of file position internally. Ignore this. */ } /* =item C Pipes don't keep track of position. Ignore. =cut */ static void io_pipe_set_position(PARROT_INTERP, ARGMOD(PMC *handle), PIOOFF_T pos) { ASSERT_ARGS(io_pipe_set_position) UNUSED(handle); UNUSED(pos); /* Pipes don't keep track of file position internally. Ignore. */ } /* =item C Pipes don't keep track of position. Return 0. =cut */ static PIOOFF_T io_pipe_get_position(PARROT_INTERP, ARGMOD(PMC *handle)) { ASSERT_ARGS(io_pipe_get_position) /* Pipes don't keep track of file position internally. Return 0 */ return (PIOOFF_T)0; } /* =item C Open the pipe with the command in C. =cut */ static INTVAL io_pipe_open(PARROT_INTERP, ARGMOD(PMC *handle), ARGIN(STRING *path), INTVAL flags, ARGIN(STRING *mode)) { ASSERT_ARGS(io_pipe_open) const int f_read = (flags & PIO_F_READ) != 0; const int f_write = (flags & PIO_F_WRITE) != 0; INTVAL pid; PIOHANDLE os_handle; /* Hack! If we're opening in file mode, turn this FileHandle into a file and use that vtable instead. */ if ((flags & PIO_F_PIPE) == 0) { const IO_VTABLE * const vtable = Parrot_io_get_vtable(interp, IO_VTABLE_FILEHANDLE, NULL); VTABLE_set_pointer_keyed_int(interp, handle, IO_PTR_IDX_VTABLE, (void *)vtable); return vtable->open(interp, handle, path, flags, mode); } if (f_read == f_write) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Invalid pipe mode: %X", flags); os_handle = Parrot_io_internal_open_pipe(interp, path, flags, &pid); /* Save the pid of the child, we'll wait for it when closing */ VTABLE_set_integer_keyed_int(interp, handle, 0, pid); if (flags & PIO_F_BINARY) SETATTR_FileHandle_encoding(interp, handle, Parrot_str_new(interp, "binary", 0)); SETATTR_FileHandle_os_handle(interp, handle, os_handle); SETATTR_FileHandle_flags(interp, handle, flags); SETATTR_FileHandle_filename(interp, handle, path); SETATTR_FileHandle_mode(interp, handle, mode); SETATTR_FileHandle_file_pos(interp, handle, 0); return 1; } /* =item C Determine if the pipe is currently open. =cut */ static INTVAL io_pipe_is_open(PARROT_INTERP, ARGMOD(PMC *handle)) { ASSERT_ARGS(io_pipe_is_open) const PIOHANDLE os_handle = io_filehandle_get_os_handle(interp, handle); return os_handle != PIO_INVALID_HANDLE; } /* =item C Close the pipe. =cut */ static INTVAL io_pipe_close(PARROT_INTERP, ARGMOD(PMC *handle)) { ASSERT_ARGS(io_pipe_close) const PIOHANDLE os_handle = io_filehandle_get_os_handle(interp, handle); if (os_handle == PIO_INVALID_HANDLE) return -1; else { INTVAL pid; INTVAL status; INTVAL result = Parrot_io_internal_close(interp, os_handle); io_filehandle_set_os_handle(interp, handle, PIO_INVALID_HANDLE); GETATTR_FileHandle_process_id(interp, handle, pid); status = Parrot_proc_waitpid(interp, pid); SETATTR_FileHandle_exit_status(interp, handle, status); io_pipe_set_flags(interp, handle, 0); return result; } } /* =item C Get the encoding used by the pipe. =cut */ PARROT_CAN_RETURN_NULL PARROT_WARN_UNUSED_RESULT static const STR_VTABLE * io_pipe_get_encoding(PARROT_INTERP, ARGIN(PMC *handle)) { ASSERT_ARGS(io_pipe_get_encoding) STRING *encoding_str; GETATTR_FileHandle_encoding(interp, handle, encoding_str); if (!STRING_IS_NULL(encoding_str)) return Parrot_find_encoding_by_string(interp, encoding_str); return NULL; } /* =item C Set flags on the Pipe. =cut */ static void io_pipe_set_flags(PARROT_INTERP, ARGIN(PMC *handle), INTVAL flags) { ASSERT_ARGS(io_pipe_set_flags) PARROT_FILEHANDLE(handle)->flags = flags; } /* =item C Get the flags from the pipe. =cut */ static INTVAL io_pipe_get_flags(PARROT_INTERP, ARGIN(PMC *handle)) { ASSERT_ARGS(io_pipe_get_flags) return PARROT_FILEHANDLE(handle)->flags; } /* =item C Pipes have an unknown total size. =cut */ static size_t io_pipe_total_size(PARROT_INTERP, ARGIN(PMC *handle)) { ASSERT_ARGS(io_pipe_total_size) return PIO_UNKNOWN_SIZE; } /* =item C Get the stream descriptor for the pipe. =cut */ static PIOHANDLE io_pipe_get_piohandle(PARROT_INTERP, ARGIN(PMC *handle)) { ASSERT_ARGS(io_pipe_get_piohandle) return io_filehandle_get_os_handle(interp, handle); } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ pir.t000644000765000765 2726511567202625 15613 0ustar00brucebruce000000000000parrot-5.9.0/t/examples#!perl # Copyright (C) 2005-2009, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Test tests => 18; use Parrot::Config; =head1 NAME t/examples/pir.t - Test examples in F =head1 SYNOPSIS % prove t/examples/pir.t =head1 DESCRIPTION Test the examples in F. =head1 SEE ALSO F =head1 AUTHOR Bernhard Schmalhofer - =cut # Set up expected output for examples my %expected = ( 'circle.pir' => << 'END_EXPECTED', ******************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************** END_EXPECTED 'euclid.pir' => << 'END_EXPECTED', Algorithm E (Euclid's algorithm) The greatest common denominator of 96 and 64 is 32. END_EXPECTED 'hanoi.pir' => << 'END_EXPECTED', Using default size 3 for tower. | | ==== | | ====== | | == | | | | ====== | ==== | == | | | == | ====== | ==== | | | | == | | ==== | ====== | | | | == | ==== | ====== | | | | ==== == | | ====== | | == | | ==== | | ====== END_EXPECTED 'io.pir' => << 'END_EXPECTED', test4 test5 test1 test2 test3 END_EXPECTED 'local_label.pir' => << 'END_EXPECTED', Branching to '$ok' in macro 'TEST1' Branched to '$ok' in macro 'TEST1' After .TEST1 () Branching to '$ok' in macro 'TEST2' Branched to '$ok' in macro 'TEST2' Branched to 'non_local' in sub 'example' END_EXPECTED 'mandel.pir' => << 'END_EXPECTED', ................::::::::::::::::::::::::::::::::::::::::::::............... ...........::::::::::::::::::::::::::::::::::::::::::::::::::::::.......... ........::::::::::::::::::::::::::::::::::,,,,,,,:::::::::::::::::::....... .....:::::::::::::::::::::::::::::,,,,,,,,,,,,,,,,,,,,,,:::::::::::::::.... ...::::::::::::::::::::::::::,,,,,,,,,,,,;;;!:H!!;;;,,,,,,,,:::::::::::::.. :::::::::::::::::::::::::,,,,,,,,,,,,,;;;;!!/>&*|& !;;;,,,,,,,::::::::::::: ::::::::::::::::::::::,,,,,,,,,,,,,;;;;;!!//)|.*#|>/!;;;;;,,,,,,::::::::::: ::::::::::::::::::,,,,,,,,,,,,;;;;;;!!!!//>|: !:|//!!;;;;;,,,,,::::::::: :::::::::::::::,,,,,,,,,,;;;;;;;!!/>>I>>)||I# H&))>////*!;;,,,,:::::::: ::::::::::,,,,,,,,,,;;;;;;;;;!!!!/>H: #| IH&*I#/;;,,,,::::::: ::::::,,,,,,,,,;;;;;!!!!!!!!!!//>|.H: #I>!!;;,,,,:::::: :::,,,,,,,,,;;;;!/||>///>>///>>)|H %|&/;;,,,,,::::: :,,,,,,,,;;;;;!!//)& :;I*,H#&||&/ *)/!;;,,,,,:::: ,,,,,,;;;;;!!!//>)IH:, ## #&!!;;,,,,,:::: ,;;;;!!!!!///>)H%.** * )/!;;;,,,,,:::: &)/!!;;;,,,,,:::: ,;;;;!!!!!///>)H%.** * )/!;;;,,,,,:::: ,,,,,,;;;;;!!!//>)IH:, ## #&!!;;,,,,,:::: :,,,,,,,,;;;;;!!//)& :;I*,H#&||&/ *)/!;;,,,,,:::: :::,,,,,,,,,;;;;!/||>///>>///>>)|H %|&/;;,,,,,::::: ::::::,,,,,,,,,;;;;;!!!!!!!!!!//>|.H: #I>!!;;,,,,:::::: ::::::::::,,,,,,,,,,;;;;;;;;;!!!!/>H: #| IH&*I#/;;,,,,::::::: :::::::::::::::,,,,,,,,,,;;;;;;;!!/>>I>>)||I# H&))>////*!;;,,,,:::::::: ::::::::::::::::::,,,,,,,,,,,,;;;;;;!!!!//>|: !:|//!!;;;;;,,,,,::::::::: ::::::::::::::::::::::,,,,,,,,,,,,,;;;;;!!//)|.*#|>/!;;;;;,,,,,,::::::::::: :::::::::::::::::::::::::,,,,,,,,,,,,,;;;;!!/>&*|& !;;;,,,,,,,::::::::::::: ...::::::::::::::::::::::::::,,,,,,,,,,,,;;;!:H!!;;;,,,,,,,,:::::::::::::.. .....:::::::::::::::::::::::::::::,,,,,,,,,,,,,,,,,,,,,,:::::::::::::::.... ........::::::::::::::::::::::::::::::::::,,,,,,,:::::::::::::::::::....... ...........::::::::::::::::::::::::::::::::::::::::::::::::::::::.......... END_EXPECTED 'substr.pir' => << 'END_EXPECTED', H He Hel Hell Hello Hello Hello W Hello Wo Hello Wor Hello Worl Hello World Hello Worl Hello Wor Hello Wo Hello W Hello Hello Hell Hel He H END_EXPECTED 'sudoku.pir' => << 'END_EXPECTED', +---------+---------+---------+ | 1 . . | . . . | . . . | | . . 2 | 7 4 . | . . . | | . . . | 5 . . | . . 4 | +---------+---------+---------+ | . 3 . | . . . | . . . | | 7 5 . | . . . | . . . | | . . . | . . 9 | 6 . . | +---------+---------+---------+ | . 4 . | . . 6 | . . . | | . . . | . . . | . 7 1 | | . . . | . . 1 | . 3 . | +---------+---------+---------+ init ok +---------+---------+---------+ | 1 8 4 | 9 6 3 | 7 2 5 | | 5 6 2 | 7 4 8 | 3 1 9 | | 3 9 7 | 5 1 2 | 8 6 4 | +---------+---------+---------+ | 2 3 9 | 6 5 7 | 1 4 8 | | 7 5 6 | 1 8 4 | 2 9 3 | | 4 1 8 | 2 3 9 | 6 5 7 | +---------+---------+---------+ | 9 4 1 | 3 7 6 | 5 8 2 | | 6 2 3 | 8 9 5 | 4 7 1 | | 8 7 5 | 4 2 1 | 9 3 6 | +---------+---------+---------+ solved END_EXPECTED 'make_hello_pbc.pir' => << 'END_EXPECTED', Hello, World END_EXPECTED ); # expected output of a quine is the quine itself # TODO currently broken # $expected{'quine_ord.pir'} = Parrot::Test::slurp_file("examples/pir/quine_ord.pir"); my %skips = ( ); while ( my ( $example, $expected ) = each %expected ) { my $skip = $skips{$example}; if ($skip) { my ( $cond, $reason ) = @{$skip}; if ( eval "$cond" ) { Test::More->builder->skip("$example $reason"); next; } } example_output_is( "examples/pir/$example", $expected ); } my $PARROT = ".$PConfig{slash}$PConfig{test_prog}"; # For testing life.pir, the number of generations should be small, # because users should not get bored. { my $life_fn = "examples$PConfig{slash}pir$PConfig{slash}life.pir"; my $sum = `$PARROT $life_fn 4`; like( $sum, qr/4 generations in/, 'life ran for 4 generations' ); } # readline.pir expects something on standard input { my $readline_pir_fn = "examples$PConfig{slash}pir$PConfig{slash}readline.pir"; my $readline_tmp_fn = "test_readline.tmp"; open( my $tmp, '>', $readline_tmp_fn ); print $tmp join( "\n", 'first line', '', 'last line' ); close $tmp; my $out = `$PARROT $readline_pir_fn < $readline_tmp_fn`; is( $out, << 'END_EXPECTED', 'print until first empty line' ); first line END_EXPECTED unlink($readline_tmp_fn); } # uniq.pir expects a file that it can uniquify { my $uniq_pir_fn = "examples$PConfig{slash}pir$PConfig{slash}uniq.pir"; my $uniq_tmp_fn = "test_uniq.tmp"; open( my $tmp, '>', $uniq_tmp_fn ); print $tmp join( "\n", qw( a a a b b c d d d ) ); print $tmp "\n"; close $tmp; my $out = `$PARROT $uniq_pir_fn $uniq_tmp_fn`; is( $out, << 'END_EXPECTED', 'uniq' ); a b c d END_EXPECTED $out = `$PARROT $uniq_pir_fn -c $uniq_tmp_fn`; is( $out, << 'END_EXPECTED', 'uniq -c' ); 3 a 2 b 1 c 3 d END_EXPECTED $out = `$PARROT $uniq_pir_fn -d $uniq_tmp_fn`; is( $out, << 'END_EXPECTED', 'uniq -d' ); a b d END_EXPECTED $out = `$PARROT $uniq_pir_fn -u $uniq_tmp_fn`; is( $out, << 'END_EXPECTED', 'uniq -u' ); c END_EXPECTED unlink($uniq_tmp_fn); } ## Added test this way, so we can have more interesting tests. pir_output_is( <<'CODE', < and C. More information about these functions can be found at L, among other locations. =cut package auto::env; use strict; use warnings; use base qw(Parrot::Configure::Step); use Parrot::Configure::Utils ':auto'; sub _init { my $self = shift; my %data; $data{description} = q{Does your C library have setenv / unsetenv}; $data{result} = q{}; return \%data; } sub runstep { my ( $self, $conf ) = ( shift, shift ); my ( $setenv, $unsetenv ) = ( 0, 0 ); $conf->cc_gen('config/auto/env/test_setenv_c.in'); eval { $conf->cc_build(); }; unless ( $@ || $conf->cc_run() !~ /ok/ ) { $setenv = 1; } $conf->cc_clean(); $conf->cc_gen('config/auto/env/test_unsetenv_c.in'); eval { $conf->cc_build(); }; unless ( $@ || $conf->cc_run() !~ /ok/ ) { $unsetenv = 1; } $conf->cc_clean(); $self->_evaluate_env($conf, $setenv, $unsetenv); return 1; } sub _evaluate_env { my ($self, $conf, $setenv, $unsetenv) = @_; $conf->data->set( setenv => $setenv, unsetenv => $unsetenv ); if ( $setenv && $unsetenv ) { $conf->debug(" (both) "); $self->set_result('both'); } elsif ($setenv) { $conf->debug(" (setenv) "); $self->set_result('setenv'); } elsif ($unsetenv) { $conf->debug(" (unsetenv) "); $self->set_result('unsetenv'); } else { $conf->debug(" (no) "); $self->set_result('no'); } } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: events.pod000644000765000765 774711533177634 16260 0ustar00brucebruce000000000000parrot-5.9.0/docs/dev# Copyright (C) 2001-2006, Parrot Foundation. =head1 NAME docs/dev/events.pod - Design Notes for Events =head1 VERSION This document describes the current state, which might not be the final implementation. =head1 Overview Parrot has to deal with asynchronous events (from timers, signals, async IO, notifications, and so on). This document describes the current implementation. =head1 Prelims As there is currently no good test if a threading library is included at link time, its assumed, that platforms having B link against B. =head1 DESCRIPTION On construction of the first interpreter (the one with no B) two threads are started: The B, which manages the static global B and the B which is responsible for signal and IO related events. =head2 Events Events can be either timed (they are due after some elapsed time) or untimed. For the former there is one API call: B =head2 The B The B holds the B mutex first. When there is no event entry in the B, the B waits on the event condition until an event arrives. When there is an event with a timed entry, a timed wait is performed. (Waiting on the condition releases the mutex, so that other threads can insert events into the B.) When an event arrives (or the timeout was reached) the B pops off all events and places the queue entries into the interpreter's B. This also enables event checking in the interpreter's run-core. When the popped off entry is a timed event and has a repeat interval, the entry is duplicated and reinserted with the interval added to the current time. =head2 B All signals that should be handled inside Parrot are blocked in all threads and only enabled in the B. The signal handler functions just sets an atomic flag, that this signal arrived and returns. This finally interrupts the select(2) loop in the B. =head2 The B The B sleeps in a select(2) loop, which is interrupted when either a signal arrives or when one of the file descriptors has a ready condition. Additionally the file descriptor set contains the reader end of an internal pipe, which is used by other threads to communicate with the B. Signal events like SIGINT are broadcasted to all running interpreters, which then throw an appropriate exception. =head2 The interpreter event checking code We cannot interrupt the interpreter at arbitrary points and run some different code (e.g. a PASM subroutine handling timer events). So when an event is put into the interpreter's B the opcode dispatch table for the interpreter is changed. Plain function cores get a function table with all entries filled with the B opcode. This opcode pops off and finally handles the event. The same scheme works for the CGOTO core, where the address table is replaced. The switched core does an explicit check if events are to be handled. Prederefed and especially the CGP core don't have an opcode dispatch table that is checked during running the opcodes. When an event is scheduled, the event handler replaces backward branches in the opcode image with the B opcode. After all events are popped off and handled, the opcode dispatch table is restored to its original, and the B reexecutes the same instruction again, which is now the real one and thus normal execution flow continues. This scheme has zero overhead in the absence of scheduled events for all cores except switched. =head1 Missing =over 4 =item Synchronous event API Sync events could be placed directly into the interpreter's task queue. =item Async IO That depends probably on the underlying OS, i.e. if it does async IO or we have to do it. =item Event priorities =item A lot more =back =head1 Author Leopold Toetsch C =cut # vim: expandtab shiftwidth=2 tw=70: 83_external_libraries.pir000644000765000765 202512101554066 23075 0ustar00brucebruce000000000000parrot-5.9.0/examples/tutorial# Copyright (C) 2007-2012, Parrot Foundation. =pod =head1 DESCRIPTION A tutorial lesson about Parrot's external C function call. =head1 EXTERNAL C FUNCTION CALL There is a vast wealth of libraries written for a variety of tasks, and Parrot can tap into most of them using an interface called NCI. NCI allows Parrot to make calls to low-level compiled functions from pre-compiled libraries. The C opcode loads in a compiled library as a Library PMC. The C opcode takes a reference to that library PMC and the name of a function and returns an NCI subroutine PMC that can be invoked like a normal Parrot subroutine. =cut .sub main :main .local pmc library library = loadlib "libnci_test" unless library goto NOT_LOADED # calling a function in the library .local pmc function dlfunc function, library, "nci_c", "c" ( $I0 ) = function() print $I0 print "\n" end NOT_LOADED: say "not loaded" .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: resizablefloatarray.pmc000644000765000765 1412312101554067 20647 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME src/pmc/resizablefloatarray.pmc - resizable array for floating point numbers only =head1 DESCRIPTION This class, C, implements an array of resizable size, which stores FLOATVALs. It uses Float PMCs to do all necessary conversions. =head2 Functions =over 4 =cut */ /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* HEADERIZER END: static */ pmclass ResizableFloatArray extends FixedFloatArray auto_attrs provides array { ATTR INTVAL resize_threshold; /* max size before array needs resizing */ /* =item C Returns the floating-point value of the element at index C. =cut */ VTABLE FLOATVAL get_number_keyed_int(INTVAL key) { FLOATVAL *float_array; INTVAL size; if (key < 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "ResizableFloatArray: index out of bounds!"); GET_ATTR_size(INTERP, SELF, size); if (key >= size) return 0.0; GET_ATTR_float_array(INTERP, SELF, float_array); return float_array[key]; } /* =item C Sets the floating-point value of the element at index C to C. =cut */ VTABLE void set_number_keyed_int(INTVAL key, FLOATVAL value) { FLOATVAL *float_array; INTVAL size; if (key < 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "ResizableFloatArray: index out of bounds!"); GET_ATTR_size(INTERP, SELF, size); if (key >= size) SELF.set_integer_native(key+1); GET_ATTR_float_array(INTERP, SELF, float_array); float_array[key] = value; } /* =item C Resizes the array to C elements. When growing, if the new size stays smaller than twice the old size, grow to twice the old size; otherwise, grow to the new size. When shrinking, if the new size is smaller than half the old size, shrink to one and half times the new size (which is less than or equal to three quarters of the old size). =cut */ VTABLE void set_integer_native(INTVAL size) { FLOATVAL *float_array; INTVAL resize_threshold; if (size < 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "ResizableFloatArray: Can't resize to negative value!"); GET_ATTR_float_array(INTERP, SELF, float_array); GET_ATTR_resize_threshold(INTERP, SELF, resize_threshold); if (!float_array) { /* empty - used fixed routine */ if (size < 8) { SUPER(8); SET_ATTR_size(INTERP, SELF, size); SET_ATTR_resize_threshold(INTERP, SELF, 8); } else { SUPER(size); SET_ATTR_resize_threshold(INTERP, SELF, size); } } else if (size <= resize_threshold){ /* we could shrink here if necessary */ SET_ATTR_size(INTERP, SELF, size); return; } else { INTVAL cur = resize_threshold; if (cur < 8192) cur = size < 2 * cur ? 2 * cur : size; else { const INTVAL needed = size - cur; cur += needed + 4096; cur &= ~0xfff; } SET_ATTR_float_array(INTERP, SELF, mem_gc_realloc_n_typed(INTERP, float_array, cur, FLOATVAL)); SET_ATTR_size(INTERP, SELF, size); SET_ATTR_resize_threshold(INTERP, SELF, cur); } } /* =item C Creates and returns a copy of the array. =cut */ VTABLE PMC *clone() { INTVAL size; PMC * const copy = SUPER(); /* copy trimmed extra space */ GET_ATTR_size(INTERP, SELF, size); SET_ATTR_resize_threshold(INTERP, copy, size); return copy; } /* =item C Adds C to the end of the array. =cut */ VTABLE void push_float(FLOATVAL value) { const INTVAL nextix = SELF.elements(); SELF.set_number_keyed_int(nextix, value); } /* =item C Removes and returns the last element in the array. =cut */ VTABLE FLOATVAL pop_float() { FLOATVAL value; INTVAL size; GET_ATTR_size(INTERP, SELF, size); if (size == 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "ResizableFloatArray: Can't pop from an empty array!"); value = SELF.get_number_keyed_int(size-1); SELF.set_integer_native(size - 1); return value; } /* =item C Removes and returns an item from the start of the array. =cut */ VTABLE FLOATVAL shift_float() { FLOATVAL value, *float_array; INTVAL size; GET_ATTR_size(INTERP, SELF, size); if (size == 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "ResizableFloatArray: Can't shift from an empty array!"); GET_ATTR_float_array(INTERP, SELF, float_array); value = float_array[0]; SET_ATTR_size(INTERP, SELF, --size); memmove(float_array, float_array + 1, size * sizeof (FLOATVAL)); return value; } /* =item C Add and integer to the start of the array. =cut */ VTABLE void unshift_float(FLOATVAL value) { INTVAL size; FLOATVAL *float_array; GET_ATTR_size(INTERP, SELF, size); SELF.set_integer_native(size + 1); GET_ATTR_float_array(INTERP, SELF, float_array); memmove(float_array + 1, float_array, size * sizeof (FLOATVAL)); float_array[0] = value; } } /* =back =head1 SEE ALSO F. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ mops.rb000644000765000765 470112101554066 16612 0ustar00brucebruce000000000000parrot-5.9.0/examples/mops#! ruby =pod Copyright (C) 2001-2003, Parrot Foundation. =head1 NAME examples/mops/mops.c - Calculate M ops/s =head1 SYNOPSIS % ruby examples/mops/mops.rb =head1 DESCRIPTION A Ruby implementation of the F example program, for speed comparisons. Calculates a value for M ops/s (million operations per second) using integer arithmetic. Prints out: =over 4 =item * the number of look iterations, =item * the estimated number of ops performed, =item * the elapsed time, and =item * the number of M op/s. =back =cut i2 = 0 # set I2, 0 i3 = 1 # set I3, 1 i4 = 10000000 # set I4, 10000000 # puts "Iterations: #{i4}" # print "Iterations: " # print I4 # print "\n" # i1 = 2 # set I1, 2 i5 = i4 * i1 # mul I5, I4, I1 # puts "Estimated ops: #{i5}" # print "Estimated ops: " # print I5 # print "\n" # n1 = Time.now() # time N1 # while i4 != 0 # REDO: i4 = i4 - i3 # sub I4, I4, I3 end # if I4, REDO # # DONE: n5 = Time.now() # time N5 # n2 = n5 - n1 # sub N2, N5, N1 # puts "Elapsed time: #{n2}" # print "Elapsed time: " # print N2 # print "\n" # n1 = i5 # iton N1, I5 n1 = n1 / n2 # div N1, N1, N2 n2 = 1000000.0 # set N2, 1000000.0 n1 = n1 / n2 # div N1, N1, N2 # puts "M op/s: #{n1}" # print "M op/s: " # print N1 # print "\n" # exit(0) # end =pod =head1 SEE ALSO F, F, F, F, F, F, F, F, F. =cut Pg.pir000644000765000765 2156311533177636 20274 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library# Copyright (C) 2006-2008, Parrot Foundation. =head1 NAME Pg.pir - OO interface to libpq =head1 SYNOPSIS .local pmc pg, con, res pg = new 'Pg' con = pg.'connectdb'('dbname = db') res = con.'exec'('SELECT * from tab') n = res.'ntuples'() m = res.'nfields'() ... val = res.'getvalue'(i, j) =head1 ABSTRACT The Pg library provides an OO interface to libpq functions - the C interface to PostgreSQL. See "Chapter 28. libpq - C Library" for details or the tests in F. =head1 AUTHOR Leopold "leo" Toetsch =head1 DESCRIPTION Pg.pir is a thin wrapper around F - the NCI functions of the C library. It's roughly divided into 3 parts, represented by 'Pg', 'Pg;Conn', and 'Pg;Result' classes. =cut ## TODO generate includes from libpq-fe.h ## .include 'postgres.pasm' .HLL 'parrot' .const int CONNECTION_OK = 0 .sub __load :load .local pmc cl load_bytecode 'postgres.pbc' cl = newclass 'Pg' # Pg connection constructor # XXX the hasa 'con' is suboptimal cl = newclass ['Pg'; 'Conn'] # Pg connection class addattribute cl, 'con' cl = newclass ['Pg'; 'Result'] # Pg Result class addattribute cl, 'res' .end =head2 Connection Construction =over =item con = Pg::connectdb('var=val var=val ...') A method that returns a new connection object. =back =cut .namespace ['Pg'] .sub connectdb :method .param string args .local pmc con, connectdb, o_con connectdb = get_global 'PQconnectdb' con = connectdb(args) $P0 = get_class ['Pg';'Conn'] .local pmc init_data init_data = new 'Hash' init_data['con'] = con o_con = new $P0, init_data # verify success .local int ok ok = o_con.'status'() if ok == CONNECTION_OK goto is_ok con = new 'Undef' init_data['con'] = con o_con = new $P0, init_data is_ok: .return (o_con) .end .namespace ['Pg'; 'Conn'] =head2 Connection Methods =over =item __init(con) Object initializer. Takes a C structure. =cut .sub init_pmc :vtable :method .param pmc init .local pmc con con = init['con'] setattribute self, 'con', con .end .sub get_bool :vtable :method .local pmc con con = getattribute self, 'con' $I0 = isa con, 'Undef' $I1 = not $I0 .return ($I1) .end =item c = res.'PGconn'() Return the raw PGconn structure. You probably don't need this function except for calling PQ* code directly. =cut .sub PGconn :method .local pmc con con = getattribute self, 'con' .return (con) .end =item $I0 = con.'status'() Return the connection status. =cut .sub 'status' :method .local pmc con, st con = getattribute self, 'con' st = get_root_global ['parrot';'Pg'], 'PQstatus' $I0 = st(con) .return ($I0) .end =item con.'finish'() Finish the connection. The connection attribute is set to .undef thereafter and inaccessible then. =cut .sub 'finish' :method .local pmc con, finish con = getattribute self, 'con' # XXX this really is looking ugly # XXX and what happens if Pg is loaded from another HLL? finish = get_root_global ['parrot';'Pg'], 'PQfinish' finish(con) con = new 'Undef' setattribute self, 'con', con .end =item res = con.'exec'(str) Execute the SQL command and return a Pg;Result object. =cut # result creation helper .sub mk_res .param pmc res .local pmc o_res $P0 = get_class ['Pg';'Result'] o_res = new $P0 setattribute o_res, 'res', res .return (o_res) .end .sub 'exec' :method .param string cmd .local pmc con, exec, res con = getattribute self, 'con' exec = get_root_global ['parrot';'Pg'], 'PQexec' res = exec(con, cmd) .tailcall mk_res(res) .end .include "datatypes.pasm" =item res = con.'execParams'(str, val, ...) Execute the SQL command and return a Pg;Result object. All values are considered being text - there's no provision to use binary data. =cut # helper to create the char* array .sub mk_struct .param pmc values .local int i, n .local pmc str, vals n = elements values str = new 'OrderedHash' push str, .DATATYPE_CSTR push str, n push str, 0 vals = new 'ManagedStruct' assign vals, str i = 0 loop: if i >= n goto done $S0 = values[i] vals[0; i] = $S0 inc i goto loop done: .return (n, vals) .end .sub 'execParams' :method .param string cmd .param pmc values :slurpy .local pmc con, exec, res, nil, vals .local int n con = getattribute self, 'con' exec = get_root_global ['parrot';'Pg'], 'PQexecParams' nil = new 'ManagedStruct' (n, vals) = mk_struct(values) # we don't handle binary res = exec(con, cmd, n, nil, vals, nil, nil, 0) .tailcall mk_res(res) .end =item res = con.'prepare'(name, query, nparams) Prepare a query for execution with B =cut .sub 'prepare' :method .param string name .param string query .param int nparams .local pmc con, f, res, nil con = getattribute self, 'con' f = get_root_global ['parrot';'Pg'], 'PQprepare' nil = new 'ManagedStruct' res = f(con, name, query, nparams, nil) .tailcall mk_res(res) .end =item res = con.'execPrepared'(name, val, ...) Execute a prepared query. =cut .sub 'execPrepared' :method .param string name .param pmc values :slurpy .local pmc con, f, res, nil, vals .local int n con = getattribute self, 'con' f = get_root_global ['parrot';'Pg'], 'PQexecPrepared' nil = new 'ManagedStruct' (n, vals) = mk_struct(values) res = f(con, name, n, vals, nil, nil, 0) .tailcall mk_res(res) .end =item $P0 = con.'setNoticeReceiver'(cb, arg) Install a notice receiver callback. The callback will be called as .sub 'notice' .param pmc arg .param pmc res =cut .sub 'setNoticeReceiver' :method .param pmc the_sub .param pmc arg .local pmc con, cb, f cb = new_callback the_sub, arg, "vUp" f = get_root_global ['parrot';'Pg'], 'PQsetNoticeReceiver' con = getattribute self, 'con' $P0 = f(con, cb, arg) .return ($P0) .end =back =cut .namespace ['Pg'; 'Result'] =head2 Result Methods =over =item __finalize() Object finalizer. Calls self.'clear'(). =cut .sub __finalize :method self.'clear'() .end =item r = res.'PGresult'() Return the raw PGresult structure. You probably don't need this function except for calling PQ* code directly. =cut .sub PGresult :method .local pmc res res = getattribute self, 'res' return (res) .end =item $I0 = res.'resultStatus'() Return the status of the result. =cut .sub 'resultStatus' :method .local pmc res, st res = getattribute self, 'res' st = get_root_global ['parrot';'Pg'], 'PQresultStatus' $I0 = st(res) .return ($I0) .end =item res.'clear'() Clear the result structure. You don't have to explicitly call this method. If a result object is no longer alive, the GC will call __finalize(), which wil clear the object. =cut .sub 'clear' :method .local pmc res, clear res = getattribute self, 'res' if null res goto done clear = get_root_global ['parrot';'Pg'], 'PQclear' clear(res) null res setattribute self, 'res', res done: .end =item $I0 = res.'ntuples'() Return the amount of tuples in the result. =item $I0 = res.'nfields'() Return the amount of fields in the result. =item $S0 = res.'fname'(c) Return the name of the c-th field in the result. =item $I0 = res.'fnumber'(col_name) Return the number of the field or -1. =cut .sub 'ntuples' :method .local pmc res, nt res = getattribute self, 'res' nt = get_root_global ['parrot';'Pg'], 'PQntuples' $I0 = nt(res) .return ($I0) .end .sub 'nfields' :method .local pmc res, nf res = getattribute self, 'res' nf = get_root_global ['parrot';'Pg'], 'PQnfields' $I0 = nf(res) .return ($I0) .end .sub 'fname' :method .param int c .local pmc res, f res = getattribute self, 'res' f = get_root_global ['parrot';'Pg'], 'PQfname' $S0 = f(res, c) .return ($S0) .end .sub 'fnumber' :method .param string c .local pmc res, f res = getattribute self, 'res' f = get_root_global ['parrot';'Pg'], 'PQfnumber' $I0 = f(res, c) .return ($I0) .end =item v = res.'getvalue'(r, c) Return result value from row r and column c. =item $I0 = res.'getisnull'(r, c) Return true if the result value at (r,c) is NULL. =cut .sub 'getvalue' :method .param int r .param int c .local pmc res, gv res = getattribute self, 'res' gv = get_root_global ['parrot';'Pg'], 'PQgetvalue' $S0 = gv(res, r, c) .return ($S0) .end .sub 'getisnull' :method .param int r .param int c .local pmc res, f res = getattribute self, 'res' f = get_root_global ['parrot';'Pg'], 'PQgetisnull' $I0 = f(res, r, c) .return ($I0) .end =back =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: 24-module.t000644000765000765 37412101554066 17460 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx/t/nqp#!./parrot-nqp # check module plan(3); XYZ::foo('ok 1'); XYZ::sayfoo(); module XYZ { our $value := 'ok 2'; our sub foo($x) { $value := $x; } our sub sayfoo() { say($value // 'ok 1'); } sayfoo(); } XYZ::foo('ok 3'); XYZ::sayfoo(); lex-03.t000644000765000765 476111533177646 16455 0ustar00brucebruce000000000000parrot-5.9.0/t/steps/inter#! perl # Copyright (C) 2007, Parrot Foundation. # inter/lex-03.t use strict; use warnings; use Test::More tests => 9; use Carp; use Data::Dumper; use lib qw( lib t/configure/testlib ); use_ok('config::inter::lex'); use Parrot::Configure::Options qw( process_options ); use Parrot::Configure::Step::Test; use Parrot::Configure::Test qw( test_step_constructor_and_description ); use Tie::Filehandle::Preempt::Stdin; use IO::CaptureOutput qw | capture |; ########## ask; maintainer; prompt flex ########## my ($args, $step_list_ref) = process_options( { argv => [ q{--ask}, q{--maintainer} ], mode => q{configure}, } ); my $conf = Parrot::Configure::Step::Test->new; $conf->include_config_results( $args ); my @prompts = q{flex}; my $object = tie *STDIN, 'Tie::Filehandle::Preempt::Stdin', @prompts; can_ok( 'Tie::Filehandle::Preempt::Stdin', ('READLINE') ); isa_ok( $object, 'Tie::Filehandle::Preempt::Stdin' ); my $pkg = q{inter::lex}; $conf->add_steps($pkg); my $serialized = $conf->pcfreeze(); $conf->options->set( %{$args} ); my $step = test_step_constructor_and_description($conf); { my $rv; my $stdout; capture ( sub {$rv = $step->runstep($conf)}, \$stdout); my $possible_results = qr/^( no\slex\sprogram\swas\sfound | lex\sprogram\sdoes\snot\sexist\sor\sdoes\snot\sunderstand\s--version | could\snot\sunderstand\sflex\sversion\srequirement | found\sflex\sversion.*?but\sat\sleast.*?is\srequired | flex )/x; my @dump_msg = ( Dumper( $step->result() ) =~ /'(.*?)'/ ); like( $step->result(), $possible_results, "Response to prompt led to acceptable result: " . $dump_msg[0] ); if ( $dump_msg[0] eq q{no lex program was found} ) { ok( !$stdout, "No lex program => no prompts" ); } else { ok( $stdout, "prompts were captured" ); } } $object = undef; $conf->replenish($serialized); pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME inter/lex-03.t - test inter::lex =head1 SYNOPSIS % prove t/steps/inter/lex-03.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file test inter::lex. In this test the C<--ask>, C<--maintainer> and C<--lex=flex> options are provided. =head1 AUTHOR James E Keenan =head1 SEE ALSO config::inter::lex, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: missingheaderfile.in000644000765000765 17511567202625 24465 0ustar00brucebruce000000000000parrot-5.9.0/t/tools/dev/headerizer/testlibThis file has a valid HEADERIZER HFILE directive but no corresponding header file. /* HEADERIZER HFILE: missingheaderfile */ Ops.pm000644000765000765 257211533177636 20143 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/Docs/Section# Copyright (C) 2004, Parrot Foundation. =head1 NAME Parrot::Docs::Section::Ops - Parrot ops documentation section =head1 SYNOPSIS use Parrot::Docs::Section::Ops; =head1 DESCRIPTION A documentation section describing the Parrot ops. =head2 Class Methods =over =cut package Parrot::Docs::Section::Ops; use strict; use warnings; use base qw( Parrot::Docs::Section ); =item C Returns a new section. =cut sub new { my $self = shift; my $dist = Parrot::Distribution->new; my $dir = $dist->existing_directory_with_name('src/ops'); my $dyndir = $dist->existing_directory_with_name('src/dynoplibs'); my @core_ops = (); my @dynamic_ops = (); # Filter for only the .ops source files foreach my $file ( $dir->files_with_suffix('ops') ) { push( @core_ops, $self->new_item( '', $dist->relative_path($file) ) ); } foreach my $dynfile ( $dyndir->files_with_suffix('ops') ) { push( @dynamic_ops, $self->new_item( '', $dist->relative_path($dynfile) ) ); } return $self->SUPER::new( 'Opcodes', 'ops.html', '', $self->new_group( 'Opcode Libraries', '', @core_ops ), $self->new_group( 'Dynamic Opcode Libraries', '', @dynamic_ops ), ); } =back =cut 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: 05-gen_c.t000644000765000765 2252611533177646 17727 0ustar00brucebruce000000000000parrot-5.9.0/t/tools/pmc2cutils#! perl # Copyright (C) 2006-2007, Parrot Foundation. # 05-gen_c.t use strict; use warnings; BEGIN { use FindBin qw($Bin); use Cwd qw(cwd realpath); realpath($Bin) =~ m{^(.*\/parrot)\/[^/]*\/[^/]*\/[^/]*$}; our $topdir = $1; if ( defined $topdir ) { print "\nOK: Parrot top directory located\n"; } else { $topdir = realpath($Bin) . "/../../.."; } unshift @INC, qq{$topdir/lib}; } use Test::More tests => 52; use Carp; use File::Basename; use File::Copy; use FindBin; use_ok('Parrot::Pmc2c::Pmc2cMain'); use IO::CaptureOutput qw| capture |; use_ok('Cwd'); use_ok( 'File::Temp', qw| tempdir | ); my ( %opt, @include, @args ); my $dump_file; my $self; my $rv; my $cwd = cwd(); my @include_orig = ( qq{$main::topdir}, qq{$main::topdir/src/pmc}, ); my ( $tie, $msg, @lines ); # basic test: @args holds default.pmc { my $tdir = tempdir( CLEANUP => 1 ); ok( chdir $tdir, 'changed to temp directory for testing' ); my $temppmcdir = qq{$tdir/src/pmc}; for ( qq{$tdir/src}, qq{$tdir/include}, qq{$tdir/include/pmc}, $temppmcdir ) { ok( mkdir($_), "created $_ under tempdir" ); } my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/resizablepmcarray.pmc" ); my $pmcfilecount = scalar(@pmcfiles); my $copycount; foreach my $pmcfile (@pmcfiles) { my $basename = basename($pmcfile); my $rv = copy( $pmcfile, qq{$temppmcdir/$basename} ); $copycount++ if $rv; } is( $copycount, $pmcfilecount, "all src/pmc/*.pmc files copied to tempdir" ); my @include = ( $tdir, $temppmcdir, @include_orig ); @args = ( qq{$temppmcdir/default.pmc}, ); $self = Parrot::Pmc2c::Pmc2cMain->new( { include => \@include, opt => \%opt, args => [@args], bin => $Bin, } ); isa_ok( $self, q{Parrot::Pmc2c::Pmc2cMain} ); $dump_file = $self->dump_vtable("$main::topdir/src/vtable.tbl"); ok( -e $dump_file, "dump_vtable created vtable.dump" ); ok( $self->dump_pmc(), "dump_pmc succeeded" ); ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" ); $rv = $self->gen_c(); ok( $rv, "gen_c completed successfully; args: default.pmc" ); ok( chdir $cwd, "changed back to original directory" ); } # @args holds default.pmc and one other .pmc { my $tdir = tempdir( CLEANUP => 1 ); ok( chdir $tdir, 'changed to temp directory for testing' ); my $pmcdir = q{src/pmc}; ok( ( mkdir qq{$tdir/src} ), "created src/ under tempdir" ); ok( ( mkdir qq{$tdir/include} ), "created include/ under tempdir" ); ok( ( mkdir qq{$tdir/include/pmc} ), "created include/pmc/ under tempdir" ); my $temppmcdir = qq{$tdir/src/pmc}; ok( ( mkdir $temppmcdir ), "created src/pmc/ under tempdir" ); my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/resizablepmcarray.pmc" ); my $pmcfilecount = scalar(@pmcfiles); my $copycount; foreach my $pmcfile (@pmcfiles) { my $basename = basename($pmcfile); my $rv = copy( $pmcfile, qq{$temppmcdir/$basename} ); $copycount++ if $rv; } is( $copycount, $pmcfilecount, "all src/pmc/*.pmc files copied to tempdir" ); my @include = ( $tdir, $temppmcdir, @include_orig ); @args = ( qq{$temppmcdir/default.pmc}, qq{$temppmcdir/resizablepmcarray.pmc}, ); $self = Parrot::Pmc2c::Pmc2cMain->new( { include => \@include, opt => \%opt, args => [@args], bin => $Bin, } ); isa_ok( $self, q{Parrot::Pmc2c::Pmc2cMain} ); $dump_file = $self->dump_vtable("$main::topdir/src/vtable.tbl"); ok( -e $dump_file, "dump_vtable created vtable.dump" ); #create a dump for default.pmc Parrot::Pmc2c::Pmc2cMain->new( { include => \@include, opt=>\%opt, args=>[qq{$temppmcdir/default.pmc}], bin=>$Bin } )->dump_pmc(); ok( $self->dump_pmc(), "dump_pmc succeeded" ); ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" ); ok( -f qq{$temppmcdir/resizablepmcarray.dump}, "resizablepmcarray.dump created as expected" ); $rv = $self->gen_c(); ok( $rv, "gen_c completed successfully; args: default.pmc and resizablepmcarray.pmc" ); ok( chdir $cwd, "changed back to original directory" ); } # failure case: calling gen_c() without first having called dump_pmc() { my $tdir = tempdir( CLEANUP => 1 ); ok( chdir $tdir, 'changed to temp directory for testing' ); my $pmcdir = q{src/pmc}; ok( ( mkdir qq{$tdir/src} ), "created src/ under tempdir" ); ok( ( mkdir qq{$tdir/include} ), "created include/ under tempdir" ); ok( ( mkdir qq{$tdir/include/pmc} ), "created include/pmc/ under tempdir" ); my $temppmcdir = qq{$tdir/src/pmc}; ok( ( mkdir $temppmcdir ), "created src/pmc/ under tempdir" ); my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/resizablepmcarray.pmc" ); my $pmcfilecount = scalar(@pmcfiles); my $copycount; foreach my $pmcfile (@pmcfiles) { my $basename = basename($pmcfile); my $rv = copy( $pmcfile, qq{$temppmcdir/$basename} ); $copycount++ if $rv; } is( $copycount, $pmcfilecount, "src/pmc/*.pmc files copied to tempdir" ); my @include = ( $tdir, $temppmcdir, @include_orig ); @args = ( qq{$temppmcdir/default.pmc}, qq{$temppmcdir/resizablepmcarray.pmc}, ); $self = Parrot::Pmc2c::Pmc2cMain->new( { include => \@include, opt => \%opt, args => [@args], bin => $Bin, } ); isa_ok( $self, q{Parrot::Pmc2c::Pmc2cMain} ); $dump_file = $self->dump_vtable("$main::topdir/src/vtable.tbl"); ok( -e $dump_file, "dump_vtable created vtable.dump" ); ### $self->dump_pmc(); { my $stdout; capture( sub { eval { $rv = $self->gen_c(); } }, \$stdout ); like( $@, qr<^cannot find file '.*/src/pmc/default.dump' in path>, "gen_c() predictably failed because dump_pmc() was not called first" ); } ok( chdir $cwd, "changed back to original directory" ); } # @args holds default.pmc and one class.pmc { my $tdir = tempdir( CLEANUP => 1 ); ok( chdir $tdir, 'changed to temp directory for testing' ); my $pmcdir = q{src/pmc}; ok( ( mkdir qq{$tdir/src} ), "created src/ under tempdir" ); ok( ( mkdir qq{$tdir/include} ), "created include/ under tempdir" ); ok( ( mkdir qq{$tdir/include/pmc} ), "created include/pmc/ under tempdir" ); my $temppmcdir = qq{$tdir/src/pmc}; ok( ( mkdir $temppmcdir ), "created src/pmc/ under tempdir" ); my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/class.pmc" ); my $pmcfilecount = scalar(@pmcfiles); my $copycount; foreach my $pmcfile (@pmcfiles) { my $basename = basename($pmcfile); my $rv = copy( $pmcfile, qq{$temppmcdir/$basename} ); $copycount++ if $rv; } is( $copycount, $pmcfilecount, "all src/pmc/*.pmc files copied to tempdir" ); my @include = ( $tdir, $temppmcdir, @include_orig ); @args = ( qq{$temppmcdir/default.pmc}, qq{$temppmcdir/class.pmc}, ); $self = Parrot::Pmc2c::Pmc2cMain->new( { include => \@include, opt => \%opt, args => [@args], bin => $Bin, } ); isa_ok( $self, q{Parrot::Pmc2c::Pmc2cMain} ); $dump_file = $self->dump_vtable("$main::topdir/src/vtable.tbl"); ok( -e $dump_file, "dump_vtable created vtable.dump" ); #create dumps for dependencies of boolean for my $pmc ( qq{$temppmcdir/default.pmc}, qq{$temppmcdir/class.pmc} ) { Parrot::Pmc2c::Pmc2cMain->new( { include => \@include, opt=>\%opt, args=>[$pmc], bin=>$Bin } )->dump_pmc(); } ok( $self->dump_pmc(), "dump_pmc succeeded" ); ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" ); ok( -f qq{$temppmcdir/class.dump}, "class.dump created as expected" ); $rv = $self->gen_c(); ok( $rv, "gen_c completed successfully; args: default.pmc and class.pmc" ); ok( chdir $cwd, "changed back to original directory" ); } pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME 05-gen_c.t - test C =head1 SYNOPSIS % prove t/tools/pmc2cutils/05-gen_c.t =head1 DESCRIPTION The files in this directory test the publicly callable methods of F. By doing so, they test the functionality of the F utility. That functionality has largely been extracted into the methods of F. F<05-gen_c.t> tests the C method. F calls this method when it calls in C. So as not to pollute the Parrot build directories with files created during the testing process, all functions which create or modify files should be called within a temporary directory. =head1 AUTHOR James E Keenan =head1 SEE ALSO Parrot::Pmc2c, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: 04-unless.t000644000765000765 65012101554066 17477 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx/t/nqp#!./parrot-nqp # check control structure 'unless' say('1..6'); unless 0 { say("ok 1 # on one line"); } say("ok 2 # statements following unless are okay"); unless 0 { say("ok 3 # multi-line unless"); } unless 1 { print("not "); } say("ok 4 # testing conditional"); say("ok 5 # postfix statement modifier form (false)") unless 0; print("not ") unless 1; say("ok 6 # postfix statement modifier form (true)"); unicode.h000644000765000765 726211567202625 20210 0ustar00brucebruce000000000000parrot-5.9.0/src/string/encoding/* unicode.h * Copyright (C) 2001-2006, Parrot Foundation. * Overview: * Unicode support header * Data Structure and Algorithms: * History: * Notes: * References: */ #ifndef PARROT_UNICODE_H_GUARD #define PARROT_UNICODE_H_GUARD typedef unsigned char utf8_t; typedef Parrot_UInt2 utf16_t; typedef Parrot_Int4 utf32_t; #define UNICODE_SURROGATE_FIRST 0xD800 #define UNICODE_SURROGATE_LAST 0xDFFF #define UNICODE_SURROGATE_SHIFT 10 #define UNICODE_SURROGATE_MASK 0x3FF #define UNICODE_HIGH_SURROGATE_FIRST 0xD800 #define UNICODE_LOW_SURROGATE_FIRST 0xDC00 #define UNICODE_IS_SURROGATE(c) ((c) >= UNICODE_SURROGATE_FIRST && \ (c) <= UNICODE_SURROGATE_LAST) #define UNICODE_IS_HIGH_SURROGATE(c) (((c) & ~UNICODE_SURROGATE_MASK) == \ UNICODE_HIGH_SURROGATE_FIRST) #define UNICODE_IS_LOW_SURROGATE(c) (((c) & ~UNICODE_SURROGATE_MASK) == \ UNICODE_LOW_SURROGATE_FIRST) #define UNICODE_IS_INVARIANT(c) ((c) < 0x80) #define UNICODE_IS_NON_CHARACTER(c) (((c) & 0xFFFE) == 0xFFFE || \ ((c) >= 0xFDD0 && (c) <= 0xFDEF)) #define UNICODE_IS_INVALID(c) ((c) >= UNICODE_SURROGATE_FIRST && \ ((c) <= 0xFDEF ? \ (c) <= UNICODE_SURROGATE_LAST || \ (c) >= 0xFDD0 : \ ((c) & 0xFFFE) == 0xFFFE || \ (c) > 0x10FFFF)) #define UNICODE_HIGH_SURROGATE(c) \ (((c) >> UNICODE_SURROGATE_SHIFT) + \ (UNICODE_HIGH_SURROGATE_FIRST - (0x10000 >> UNICODE_SURROGATE_SHIFT))) #define UNICODE_LOW_SURROGATE(c) \ (((c) & UNICODE_SURROGATE_MASK) | UNICODE_LOW_SURROGATE_FIRST) #define UNICODE_DECODE_SURROGATE(high, low) \ (((high) << UNICODE_SURROGATE_SHIFT) + (low) - \ ((UNICODE_HIGH_SURROGATE_FIRST << UNICODE_SURROGATE_SHIFT) + \ UNICODE_LOW_SURROGATE_FIRST - 0x10000)) #define UNISKIP(uv) ((uv) < 0x80 ? 1 : \ (uv) < 0x800 ? 2 : \ (uv) < 0x10000 ? 3 : 4) #define UTF16SKIP(c) (UNICODE_IS_HIGH_SURROGATE(c) ? 2 : 1) /* The following table is from Unicode 3.1. Code Points 1st Byte 2nd Byte 3rd Byte 4th Byte U+0000..U+007F 00..7F U+0080..U+07FF C2..DF 80..BF U+0800..U+0FFF E0 A0..BF 80..BF U+1000..U+FFFF E1..EF 80..BF 80..BF U+10000..U+3FFFF F0 90..BF 80..BF 80..BF U+40000..U+FFFFF F1..F3 80..BF 80..BF 80..BF U+100000..U+10FFFF F4 80..8F 80..BF 80..BF */ #define UTF8_IS_START(c) ((c) >= 0xC2 && (c) <= 0xF4) #define UTF8_IS_CONTINUATION(c) (((c) & 0xC0) == 0x80) #define UTF8_IS_CONTINUED(c) ((c) & 0x80) #define UTF8_START_MARK(len) ((0xFF00 >> (len)) & 0xFF) #define UTF8_START_MASK(len) (0x7F >> (len)) #define UTF8_CONTINUATION_MARK 0x80 #define UTF8_ACCUMULATION_SHIFT 6 #define UTF8_CONTINUATION_MASK 0x3F #define UTF8_ACCUMULATE(old, new) (((old) << UTF8_ACCUMULATION_SHIFT) | \ ((new) & UTF8_CONTINUATION_MASK)) #define UTF8_IS_OVERLONG(c1, c2) (((c1) == 0xE0 && (c2) < 0xA0) || \ ((c1) == 0xF0 && (c2) < 0x90)) extern const char Parrot_utf8skip[256]; #define UTF8SKIP(c) Parrot_utf8skip[c] #define UTF8_MAXLEN 4 #define UTF16_MAXLEN 4 #endif /* PARROT_UNICODE_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ primes2_i.pir000644000765000765 233111533177634 21062 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks# Copyright (C) 2001-2008, Parrot Foundation. =head1 NAME examples/benchmarks/primes2.pir - Calculate prime numbers < 10000 =head1 SYNOPSIS % time ./parrot examples/benchmarks/primes2.pir =head1 DESCRIPTION Calculates all the prime numbers up to 10000 and prints out the number of primes and the last one found. Use integer registers. =cut .sub main :main .local int i, max, i6, i7 i = 0 max = 10000 i6 = 0 i7 = 0 LOOP: $I0 = isprime(i) unless $I0 goto NOTPRIME i7 = i inc i6 NOTPRIME: inc i if i == max goto DONE goto LOOP DONE: print "N primes calculated to " print i print " is " say i6 print "last is: " say i7 .end .sub isprime .param int input .local int n if input < 1 goto FALSE n = input - 1 LOOP: if n <= 1 goto DONE $I1 = input % n unless $I1 goto FALSE dec n goto LOOP DONE: .return(1) FALSE: .return(0) .end =head1 SEE ALSO F, F, F, F, F, F. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: sub.h000644000765000765 2412012101554067 16425 0ustar00brucebruce000000000000parrot-5.9.0/include/parrot/* sub.h * Copyright (C) 2001-2008, Parrot Foundation. * Data Structure and Algorithms: * Subroutine, coroutine, closure and continuation structures * and related routines. */ #ifndef PARROT_SUB_H_GUARD #define PARROT_SUB_H_GUARD #include "parrot/parrot.h" /* * Subroutine flags */ typedef enum { /* runtime usage flags */ SUB_FLAG_CORO_FF = PObj_private0_FLAG, SUB_FLAG_C_HANDLER = PObj_private0_FLAG, /* C exceptions only */ SUB_FLAG_TAILCALL = PObj_private2_FLAG, SUB_FLAG_GENERATOR = PObj_private3_FLAG, /* unused old python pmcs */ /* compile/loadtime usage flags */ /* from packfile */ SUB_FLAG_IS_OUTER = PObj_private1_FLAG, SUB_FLAG_PF_ANON = PObj_private3_FLAG, SUB_FLAG_PF_MAIN = PObj_private4_FLAG, SUB_FLAG_PF_LOAD = PObj_private5_FLAG, SUB_FLAG_PF_IMMEDIATE = PObj_private6_FLAG, SUB_FLAG_PF_POSTCOMP = PObj_private7_FLAG, SUB_FLAG_PF_MASK = SUB_FLAG_PF_ANON | SUB_FLAG_PF_LOAD | SUB_FLAG_PF_IMMEDIATE | SUB_FLAG_PF_POSTCOMP } sub_flags_enum; #define SUB_FLAG_get_FLAGS(o) (PObj_get_FLAGS(o)) #define SUB_FLAG_flag_TEST(flag, o) (SUB_FLAG_get_FLAGS(o) & SUB_FLAG_ ## flag) #define SUB_FLAG_flag_SET(flag, o) (SUB_FLAG_get_FLAGS(o) |= SUB_FLAG_ ## flag) #define SUB_FLAG_flag_CLEAR(flag, o) (SUB_FLAG_get_FLAGS(o) &= ~(UINTVAL)(SUB_FLAG_ ## flag)) #define SUB_FLAG_flags_SETTO(o, f) SUB_FLAG_get_FLAGS(o) = (f) #define SUB_FLAG_flags_CLEARALL(o) SUB_FLAG_flags_SETTO((o), 0) #define SUB_FLAG_TAILCALL_TEST(o) SUB_FLAG_flag_TEST(TAILCALL, (o)) #define SUB_FLAG_TAILCALL_ISSET(o) SUB_FLAG_flag_TEST(TAILCALL, (o)) #define SUB_FLAG_TAILCALL_NOTSET(o) (!SUB_FLAG_flag_TEST(TAILCALL, (o))) #define SUB_FLAG_TAILCALL_SET(o) SUB_FLAG_flag_SET(TAILCALL, (o)) #define SUB_FLAG_TAILCALL_CLEAR(o) SUB_FLAG_flag_CLEAR(TAILCALL, (o)) #define SUB_FLAG(n) ((UINTVAL)1 << (n)) typedef enum { SUB_COMP_FLAG_BIT_0 = SUB_FLAG(0), SUB_COMP_FLAG_BIT_1 = SUB_FLAG(1), SUB_COMP_FLAG_VTABLE = SUB_COMP_FLAG_BIT_1, SUB_COMP_FLAG_BIT_2 = SUB_FLAG(2), SUB_COMP_FLAG_METHOD = SUB_COMP_FLAG_BIT_2, SUB_COMP_FLAG_BIT_3 = SUB_FLAG(3), SUB_COMP_FLAG_BIT_4 = SUB_FLAG(4), SUB_COMP_FLAG_BIT_5 = SUB_FLAG(5), SUB_COMP_FLAG_BIT_6 = SUB_FLAG(6), SUB_COMP_FLAG_BIT_7 = SUB_FLAG(7), SUB_COMP_FLAG_BIT_8 = SUB_FLAG(8), SUB_COMP_FLAG_BIT_9 = SUB_FLAG(9), SUB_COMP_FLAG_BIT_10 = SUB_FLAG(10), SUB_COMP_FLAG_PF_INIT = SUB_COMP_FLAG_BIT_10, SUB_COMP_FLAG_BIT_11 = SUB_FLAG(11), SUB_COMP_FLAG_NSENTRY = SUB_COMP_FLAG_BIT_11, SUB_COMP_FLAG_BIT_12 = SUB_FLAG(12), SUB_COMP_FLAG_BIT_13 = SUB_FLAG(13), SUB_COMP_FLAG_BIT_14 = SUB_FLAG(14), SUB_COMP_FLAG_BIT_15 = SUB_FLAG(15), SUB_COMP_FLAG_BIT_16 = SUB_FLAG(16), SUB_COMP_FLAG_BIT_17 = SUB_FLAG(17), SUB_COMP_FLAG_BIT_18 = SUB_FLAG(18), SUB_COMP_FLAG_BIT_19 = SUB_FLAG(19), SUB_COMP_FLAG_BIT_20 = SUB_FLAG(20), SUB_COMP_FLAG_BIT_21 = SUB_FLAG(21), SUB_COMP_FLAG_BIT_22 = SUB_FLAG(22), SUB_COMP_FLAG_BIT_23 = SUB_FLAG(23), SUB_COMP_FLAG_BIT_24 = SUB_FLAG(24), SUB_COMP_FLAG_BIT_25 = SUB_FLAG(25), SUB_COMP_FLAG_BIT_26 = SUB_FLAG(26), SUB_COMP_FLAG_BIT_27 = SUB_FLAG(27), SUB_COMP_FLAG_BIT_28 = SUB_FLAG(28), SUB_COMP_FLAG_BIT_29 = SUB_FLAG(29), SUB_COMP_FLAG_BIT_30 = SUB_FLAG(30), SUB_COMP_FLAG_MASK = SUB_COMP_FLAG_VTABLE | SUB_COMP_FLAG_METHOD | SUB_COMP_FLAG_NSENTRY | SUB_COMP_FLAG_PF_INIT } sub_comp_flags_enum; #undef SUB_FLAG #define Sub_comp_get_FLAGS(o) ((o)->comp_flags) #define Sub_comp_flag_TEST(flag, o) (Sub_comp_get_FLAGS(o) & SUB_COMP_FLAG_ ## flag) #define Sub_comp_flag_SET(flag, o) (Sub_comp_get_FLAGS(o) |= SUB_COMP_FLAG_ ## flag) #define Sub_comp_flag_CLEAR(flag, o) (Sub_comp_get_FLAGS(o) &= ~(UINTVAL)(SUB_COMP_FLAG_ ## flag)) #define Sub_comp_flags_SETTO(o, f) Sub_comp_get_FLAGS(o) = (f) #define Sub_comp_flags_CLEARALL(o) Sub_comp_flags_SETTO((o), 0) #define Sub_comp_INIT_TEST(o) Sub_comp_flag_TEST(PF_INIT, o) #define Sub_comp_INIT_SET(o) Sub_comp_flag_SET(PF_INIT, o) #define Sub_comp_INIT_CLEAR(o) Sub_comp_flag_CLEAR(PF_INIT, o) /* * maximum sub recursion depth */ #define RECURSION_LIMIT 1000 /* * Counts and flags describing the arguments. */ typedef struct Parrot_sub_arginfo { Parrot_UInt2 pos_required; Parrot_UInt2 pos_optional; Parrot_UInt2 named_required; Parrot_UInt2 named_optional; Parrot_UInt1 pos_slurpy; Parrot_UInt1 named_slurpy; } Parrot_sub_arginfo; #define PMC_get_sub(interp, pmc, sub) \ do { \ const INTVAL type = (pmc)->vtable->base_type; \ if (type == enum_class_Sub || \ type == enum_class_Coroutine || \ type == enum_class_Eval) \ {\ (sub) = PARROT_SUB((pmc)); \ } \ else { \ (sub) = (Parrot_Sub_attributes*)Parrot_get_sub_pmc_from_subclass((interp), (pmc)); \ } \ } while (0) typedef struct Parrot_Sub_attributes Parrot_sub; typedef struct Parrot_Coroutine_attributes Parrot_coro; typedef struct Parrot_Continuation_attributes Parrot_cont; #define PMC_cont(pmc) PARROT_CONTINUATION(pmc) typedef struct Parrot_Context_info { STRING *subname; STRING *nsname; STRING *fullname; STRING *file; opcode_t *address; int pc; int line; } Parrot_Context_info; /* HEADERIZER BEGIN: src/sub.c */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_EXPORT PARROT_CANNOT_RETURN_NULL void * Parrot_get_sub_pmc_from_subclass(PARROT_INTERP, ARGIN(PMC *subclass)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_EXPORT void Parrot_sub_capture_lex(PARROT_INTERP, ARGMOD(PMC *sub_pmc)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*sub_pmc); PARROT_EXPORT int Parrot_sub_context_get_info(PARROT_INTERP, ARGIN(PMC *ctx), ARGOUT(Parrot_Context_info *info)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*info); PARROT_EXPORT PARROT_CAN_RETURN_NULL PARROT_WARN_UNUSED_RESULT STRING* Parrot_sub_Context_infostr(PARROT_INTERP, ARGIN(PMC *ctx), int is_top) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_EXPORT PARROT_CAN_RETURN_NULL PARROT_WARN_UNUSED_RESULT STRING* Parrot_sub_full_sub_name(PARROT_INTERP, ARGIN_NULLOK(PMC* sub_pmc)) __attribute__nonnull__(1); PARROT_EXPORT PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT PMC* Parrot_sub_new_closure(PARROT_INTERP, ARGIN(PMC *sub_pmc)) __attribute__nonnull__(1) __attribute__nonnull__(2); void Parrot_sub_continuation_check(PARROT_INTERP, ARGIN(const PMC *pmc)) __attribute__nonnull__(1) __attribute__nonnull__(2); void Parrot_sub_continuation_rewind_environment(PARROT_INTERP, ARGIN(PMC *pmc)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_CAN_RETURN_NULL PARROT_WARN_UNUSED_RESULT PMC* Parrot_sub_find_dynamic_pad(PARROT_INTERP, ARGIN(STRING *lex_name), ARGIN(PMC *ctx)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3); PARROT_CAN_RETURN_NULL PARROT_WARN_UNUSED_RESULT PMC* Parrot_sub_find_pad(PARROT_INTERP, ARGIN(STRING *lex_name), ARGIN(PMC *ctx)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3); PARROT_CANNOT_RETURN_NULL STRING * Parrot_sub_get_filename_from_pc(PARROT_INTERP, ARGIN_NULLOK(PMC *subpmc), ARGIN_NULLOK(opcode_t *pc)) __attribute__nonnull__(1); INTVAL Parrot_sub_get_line_from_pc(PARROT_INTERP, ARGIN_NULLOK(PMC *subpmc), ARGIN_NULLOK(opcode_t *pc)) __attribute__nonnull__(1); #define ASSERT_ARGS_Parrot_get_sub_pmc_from_subclass \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(subclass)) #define ASSERT_ARGS_Parrot_sub_capture_lex __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(sub_pmc)) #define ASSERT_ARGS_Parrot_sub_context_get_info __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(ctx) \ , PARROT_ASSERT_ARG(info)) #define ASSERT_ARGS_Parrot_sub_Context_infostr __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(ctx)) #define ASSERT_ARGS_Parrot_sub_full_sub_name __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_sub_new_closure __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(sub_pmc)) #define ASSERT_ARGS_Parrot_sub_continuation_check __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(pmc)) #define ASSERT_ARGS_Parrot_sub_continuation_rewind_environment \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(pmc)) #define ASSERT_ARGS_Parrot_sub_find_dynamic_pad __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(lex_name) \ , PARROT_ASSERT_ARG(ctx)) #define ASSERT_ARGS_Parrot_sub_find_pad __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(lex_name) \ , PARROT_ASSERT_ARG(ctx)) #define ASSERT_ARGS_Parrot_sub_get_filename_from_pc \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_sub_get_line_from_pc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: src/sub.c */ #endif /* PARROT_SUB_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ 01_temp_var.pir000644000765000765 175112101554066 21027 0ustar00brucebruce000000000000parrot-5.9.0/examples/tutorial# Copyright (C) 2007-2012, Parrot Foundation. =pod =head1 DESCRIPTION A tutorial lesson about Parrot's register variables. =head1 SIMPLE VARIABLES PIR has two kinds of variables. The most simple kind are Parrot register variables. Register variables are named with a dollar sign followed by a single letter and an integer. The letter corresponds to the type of the variable, I for integer, N for number (float), S for string, and P for PMC (any kind of object). The C<=> symbol can be used to assign a value to one of these register variables. =cut .sub main :main $I0 = 42 # set temp integer var to the integer value 42 $N3 = 3.14159 # set temp float var to an approximation of pi $S5 = "Hello" # set temp string var to "Hello" $P0 = new ['String'] $P0 = "Ford" # set temp PMC var to "Ford" say $I0 say $N3 say $S5 say $P0 .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: 10-cmp.t000644000765000765 331512101554066 16763 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx/t/nqp#!./parrot-nqp # check comparisons say('1..19'); ##Integers, positive and negative if 1 == 1 { say("ok 1 # numeric equality, integers"); } unless 1 == 2 { say("ok 2 # numeric equality, integers, not equal"); } if -3 == -3 { say("ok 3 # numeric equality, negative integers"); } if 1 != 2 { say("ok 4 # numeric inequality, integers"); } unless 1 != 1 { say("ok 5 # numeric inequality, equal, integers"); } unless -2 != -2 { say("ok 6 # numeric inequality, equal, negative integers"); } ##Strings if "eq" eq "eq" { say("ok 7 # string equality"); } unless "one" eq "two" { say("ok 8 # string equality, not equal"); } if "ONE" ne "TWO" { say("ok 9 # string inequality"); } unless "STRING" ne "STRING" { say("ok 10 # string inequality, equal"); } ##Coerce strings into integers if "11" ne ~11 { print("not "); } say("ok 11 # coerce integer 11 into string eleven"); if "-12" ne ~-12 { print("not "); } say("ok 12 # coerce integer -12 into string twelve"); ##Coerce integers into strings if 13 ne +"13" { print("not "); } say("ok 13 # coerce string 13 into an integer"); if -14 ne +"-14" { print("not "); } say("ok 14 # coerce string -14 into an integer"); ##Containers if (1,2) =:= (1,2) { print("not "); } say("ok 15 # container equality, unnamed arrays"); my @a := (1, 2); unless @a =:= @a { print("not "); } say("ok 16 # container equality, self"); my @b := @a; unless @a =:= @b { print("not "); } say("ok 17 # container equality, named arrays"); my $x := 'foo'; my $y := $x; my $z := 'foo'; unless $x =:= $y { print("not "); } say("ok 18 # container equality, string binding"); if $x =:= $z { print("not "); } say("ok 19 # container equality, string value"); uniq.pir000644000765000765 506311533177635 16630 0ustar00brucebruce000000000000parrot-5.9.0/examples/pir# Copyright (C) 2001-2008, Parrot Foundation. =head1 NAME examples/pir/uniq.pir - Remove duplicate lines from a sorted file =head1 SYNOPSIS % ./parrot examples/pir/uniq.pir -o uniq.pbc =head1 DESCRIPTION Parrot implementation of C. Removes duplicate lines from a sorted file. You'll have to create a suitable file to "de-dup". =head2 Command-line Options =over 4 =item C<-c> Precede each output line with the count of the number of times the line occurred in the input, followed by a single space =item C<-d> Don't output lines that are not repeated in the input =item C<-u> Don't output lines that are repeated in the input =back =head1 HISTORY By Leon Brocard . Converted to PIR by Bernhard Schmalhofer. =cut .loadlib 'io_ops' # convenient I/O dynamic opcodes .sub "uniq" :main .param pmc argv .local string program program = shift argv .local int num_args num_args = argv if num_args > 0 goto SOURCE print "usage: parrot " print program print " [-c] [-d] [-u] filename\n" goto END SOURCE: # set up flag registers $I10 = 0 $I11 = 0 $I12 = 0 # do some simple option parsing .local string option option = shift argv ne option, "-c", NOTC $I10 = 1 # count mode option = shift argv NOTC: ne option, "-d", NOTD $I11 = 1 # duplicate mode option = shift argv NOTD: ne option, "-u", GO $I12 = 1 # unique mode option = shift argv GO: .local string file_name file_name = option $I1 = 1 # count .local pmc in_fh in_fh = open file_name, 'r' unless in_fh, ERR .local string prev_line, curr_line prev_line = readline in_fh SOURCE_LOOP: unless in_fh, END curr_line = readline in_fh if curr_line == prev_line goto MATCH # different line unless $I10, NOTC2 # count mode # we go to some lengths to make the count pretty set $S3, $I1 length $I2, $S3 sub $I2, 7, $I2 set $S3, " " repeat $S3, $S3, $I2 print $S3 print $I1 print " " print prev_line branch RESET NOTC2: unless $I11, NOTD2 # show duplicates mode eq 1, $I1, RESET print prev_line branch RESET ERR: print "Couldn't read " print $S0 exit 1 NOTD2: unless $I12, NOTU2 # don't show lines that are duplicated mode ne 1, $I1, RESET print prev_line branch RESET NOTU2: # default mode print prev_line branch RESET RESET: set $I1, 1 branch LOOP MATCH: inc $I1 # fall through LOOP: set prev_line, curr_line if curr_line, SOURCE_LOOP close in_fh END: .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: global_setup.c000644000765000765 1732012101554067 16150 0ustar00brucebruce000000000000parrot-5.9.0/src/* Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME src/global_setup.c - Global setup =head1 DESCRIPTION Performs all the global setting up of things. This includes the very few global variables that Parrot totes around. I =head2 Functions =over 4 =cut */ #define INSIDE_GLOBAL_SETUP #include "parrot/parrot.h" #include "parrot/oplib/core_ops.h" #include "global_setup.str" #include "parrot/api.h" /* These functions are defined in the auto-generated file core_pmcs.c */ /* XXX Get it into some public place */ extern void Parrot_gbl_initialize_core_pmcs(PARROT_INTERP, int pass); void Parrot_gbl_register_core_pmcs(PARROT_INTERP, PMC* registry); static const unsigned char* parrot_config_stored = NULL; static unsigned int parrot_config_size_stored = 0; static PMC * parrot_config_hash_global = NULL; /* HEADERIZER HFILE: include/parrot/global_setup.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void Parrot_gbl_set_config_hash_interpreter(PARROT_INTERP) __attribute__nonnull__(1); static void Parrot_gbl_setup_2(PARROT_INTERP) __attribute__nonnull__(1); #define ASSERT_ARGS_Parrot_gbl_set_config_hash_interpreter \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gbl_setup_2 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Called by Parrot_set_config_hash with the serialized hash which will be used in subsequently created Interpreters. =cut */ void Parrot_gbl_set_config_hash_internal(ARGIN(const unsigned char* parrot_config), unsigned int parrot_config_size) { ASSERT_ARGS(Parrot_gbl_set_config_hash_internal) if (parrot_config_stored != NULL) { parrot_config_stored = parrot_config; parrot_config_size_stored = parrot_config_size; } } /* =item C Called by embed API with the pmc hash which will be used in subsequently created Interpreters. =cut */ void Parrot_set_config_hash_pmc(PARROT_INTERP, ARGIN(PMC *config)) { ASSERT_ARGS(Parrot_set_config_hash_pmc) parrot_config_hash_global = config; if (!PMC_IS_NULL(config)) Parrot_gbl_set_config_hash_interpreter(interp); } /* =item C Used internally to associate the config hash with an Interpreter using the last registered config data. =cut */ static void Parrot_gbl_set_config_hash_interpreter(PARROT_INTERP) { ASSERT_ARGS(Parrot_gbl_set_config_hash_interpreter) PMC * const iglobals = interp->iglobals; PMC *config_hash = parrot_config_hash_global; if (config_hash == NULL) config_hash = Parrot_pmc_new(interp, enum_class_Hash); else { /* On initialization, we probably set up an empty hash for our first interpreter. We should use this branch here to insert some sane defaults so that things do not go crazy if the user forgets to set the config hash later */ } VTABLE_set_pmc_keyed_int(interp, iglobals, (INTVAL) IGLOBALS_CONFIG_HASH, config_hash); if (!PMC_IS_NULL(config_hash) && VTABLE_elements(interp, config_hash)) Parrot_lib_update_paths_from_config_hash(interp); } /* =item C Call init_world() if it hasn't been called before. C should be the root interpreter created in C. =cut */ void Parrot_gbl_init_world_once(PARROT_INTERP) { ASSERT_ARGS(Parrot_gbl_init_world_once) if (!interp->world_inited) { /* init_world() sets up some vtable stuff. * It must only be called once. */ interp->world_inited = 1; init_world(interp); } } /* =item C This is the actual initialization code called by C. It sets up the Parrot system, running any platform-specific init code if necessary, then initializing the string subsystem, and setting up the base vtables and core PMCs. C should be the root interpreter created in C. =cut */ void init_world(PARROT_INTERP) { ASSERT_ARGS(init_world) PMC *iglobals, *self, *pmc; /* Check assumptions about our config */ PARROT_STATIC_ASSERT(sizeof (INTVAL) == sizeof (opcode_t)); Parrot_platform_init_code(); /* Call base vtable class constructor methods */ Parrot_gbl_setup_2(interp); Parrot_gbl_initialize_core_pmcs(interp, 1); iglobals = interp->iglobals; VTABLE_set_pmc_keyed_int(interp, iglobals, (INTVAL)IGLOBALS_CLASSNAME_HASH, interp->class_hash); self = Parrot_pmc_new_noinit(interp, enum_class_ParrotInterpreter); VTABLE_set_pointer(interp, self, interp); /* PMC_data(self) = interp; */ VTABLE_set_pmc_keyed_int(interp, iglobals, (INTVAL)IGLOBALS_INTERPRETER, self); /* lib search paths */ parrot_init_library_paths(interp); Parrot_gbl_set_config_hash_interpreter(interp); /* load_bytecode and dynlib loaded hash */ pmc = Parrot_pmc_new(interp, enum_class_Hash); VTABLE_set_pmc_keyed_int(interp, iglobals, IGLOBALS_PBC_LIBS, pmc); pmc = Parrot_pmc_new(interp, enum_class_Hash); VTABLE_set_pmc_keyed_int(interp, iglobals, IGLOBALS_LOADED_PBCS, pmc); pmc = Parrot_pmc_new(interp, enum_class_Hash); VTABLE_set_pmc_keyed_int(interp, iglobals, IGLOBALS_DYN_LIBS, pmc); pmc = Parrot_pmc_new(interp, enum_class_Hash); VTABLE_set_pointer(interp, pmc, Parrot_hash_create(interp, enum_type_PMC, Hash_key_type_PMC)); VTABLE_set_pmc_keyed_int(interp, iglobals, IGLOBALS_NCI_FUNCS, pmc); #ifdef PARROT_HAS_CORE_NCI_THUNKS Parrot_nci_load_core_thunks(interp); #endif #ifdef PARROT_HAS_EXTRA_NCI_THUNKS Parrot_nci_load_extra_thunks(interp); #endif #ifdef PARROT_HAS_LIBFFI Parrot_nci_libffi_register(interp); #endif } /* =item C called from inmidst of PMC bootstrapping between pass 0 and 1 =cut */ static void Parrot_gbl_setup_2(PARROT_INTERP) { ASSERT_ARGS(Parrot_gbl_setup_2) PMC *classname_hash; create_initial_context(interp); /* initialize the ops hash */ if (interp->parent_interpreter) { interp->op_hash = interp->parent_interpreter->op_hash; } else { op_lib_t * const core_ops = PARROT_CORE_OPLIB_INIT(interp, 1); interp->op_hash = Parrot_hash_create_sized(interp, enum_type_ptr, Hash_key_type_cstring, core_ops->op_count); parrot_hash_oplib(interp, core_ops); } /* create the namespace root stash */ interp->root_namespace = Parrot_pmc_new(interp, enum_class_NameSpace); Parrot_hll_init_HLL(interp); Parrot_pcc_set_namespace(interp, CURRENT_CONTEXT(interp), VTABLE_get_pmc_keyed_int(interp, interp->HLL_namespace, 0)); /* We need a class hash */ interp->class_hash = classname_hash = Parrot_pmc_new(interp, enum_class_NameSpace); Parrot_gbl_register_core_pmcs(interp, classname_hash); /* init the interpreter globals array */ interp->iglobals = Parrot_pmc_new_init_int(interp, enum_class_FixedPMCArray, (INTVAL)IGLOBALS_SIZE); } /* =back =head1 SEE ALSO F =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ annotations.pir000644000765000765 56211533177645 20251 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc/testlib# Copyright (C) 2009-2010, Parrot Foundation. # This file is used from Packfile PMCs tests .sub 'main' .annotate "file", "annotations.pir" .annotate "creator", "Parrot Foundation" .annotate "line", 1 say "Hi" say "line" .annotate "line", 2 .return () .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: compiler_faq.pod000644000765000765 4132412101554066 16632 0ustar00brucebruce000000000000parrot-5.9.0/docs# Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME docs/compiler_faq.pod - Parrot FAQ for compiler writers in PIR =head1 DESCRIPTION This is the FAQ for anyone interested in writing compilers in PIR, targeting the Parrot Virtual Machine. =head1 GENERAL QUESTIONS =head2 Which C compilers can I use with Parrot? Whoa, there--you're looking at the wrong FAQ. This document is for people writing compilers that target Parrot. To answer your question, though, Parrot should theoretically work with any C89-compliant C compiler. See the F files in the root directory for more information about building Parrot. =head2 How can I implement a compiler to use as a compiler object from within Parrot? See L. =head2 How do I embed source locations in my code for debugging? Use C<.line 42 "file.pir"> for this. =head1 SUBROUTINES =head2 How do I generate a sub call in PIR? This looks like a function call in many HLLs: =begin PIR_FRAGMENT $P0( $P1, $P2, $P3 ) =end PIR_FRAGMENT where $P0 is the function object, and $P1, $P2, and $P3 are its parameters. You can also use a function's name in place of the object, as long as it's in the same namespace. =begin PIR_FRAGMENT somefunctionlabel( $P1, $P2, $P3 ) =end PIR_FRAGMENT You can also get return value(s): =begin PIR_FRAGMENT ($P1,$P2) = $P0( $P1, $P2, $P3 ) =end PIR_FRAGMENT If the function name might collide with a Parrot opcode, quote it: =begin PIR_FRAGMENT .local int i i = 'new'(42) =end PIR_FRAGMENT You can also use the full PCC for these calls. See L and other questions below for more information. =head2 How do I generate a method call in PIR? Similar to function calls, just append C<.> and the method name to the object. You should quote a literal method name to avoid confusion. =begin PIR_FRAGMENT .local pmc ret_val, some_obj, arg ret_val = some_obj.'some_meth'(arg) =end PIR_FRAGMENT The method name may also be a string variable representing a method name: =begin PIR_FRAGMENT .local string m .local pmc curses_obj m = 'bold' curses_obj.m() =end PIR_FRAGMENT =head2 How do I locate or create a subroutine object? There are several ways to achieve this, depending on the location of the subroutine. If the sub is in the same file use a Sub constant: =begin PIR_FRAGMENT .const 'Sub' foo = 'foo' # ... foo() =end PIR_FRAGMENT A more dynamic way is: =begin PIR_FRAGMENT .local pmc foo foo = find_name 'foo' =end PIR_FRAGMENT This searches for a subroutine 'foo' in the current lexical pad, in the current namespace, in the global, and in the builtin namespace in that order. This opcode is generated, if I is used, but the compiler can't figure out, where the function is. If the subroutine is in a different namespace, use the C or C opcodes: =begin PIR_FRAGMENT .local pmc foo foo = get_root_global ['Foo'], 'foo' =end PIR_FRAGMENT This fetches the sub C in the C namespace. =head2 How do I create a Closure or Coroutine? Closure and Coroutine carry both a dynamic state. Therefore you need to perform two steps. First use one of the above ways to locate the Sub object. Then use the op C to capture the environment. =begin PIR_FRAGMENT .local pmc coro coro = find_name 'my_coro' coro = newclosure coro =end PIR_FRAGMENT Any subroutine that contains a C<.yield> directive is automatically created as a Coroutine PMC: =begin PIR .sub my_coro # automagically a Coroutine PMC .param pmc result #... .yield (result) #... .end =end PIR =head2 How do I generate a tail call in PIR? =begin PIR .sub foo # ... .tailcall bar(42) # tail call sub bar .end .sub bar .param int answer inc answer .return(answer) .end =end PIR The sub C will return to the caller of C. (Warning! This fails in some cases. XXX Find the Trac ticket and reference it here.) =head2 How do I generate a sub call with a variable-length parameter list in PIR? If you have a variable amounts of arguments in an array, you can pass all items of that array with the C<:flat> directive. =begin PIR_FRAGMENT .local pmc ar, foo ar = new 'ResizablePMCArray' push ar, "arg 1\n" push ar, "arg 2\n" #... foo(ar :flat) #... =end PIR_FRAGMENT =head2 How to I retrieve the contents of a variable-length parameter list being passed to me? Use a slurpy array: =begin PIR .sub mysub .param pmc argv :slurpy .local int argc argc = argv #... .end =end PIR If you have a few fixed parameters too, you can use a slurpy array to get the rest of the arguments =begin PIR .sub mysub .param pmc arg0 .param pmc arg1 .param pmc varargs :slurpy .local int num_varargs num_varargs = varargs # ... .end =end PIR =head2 How do I pass optional arguments? Use the C<:optional> and C<:opt_flag> pragmas: =begin PIR .sub foo .param pmc arg1 :optional .param int has_arg1 :opt_flag .param pmc arg2 :optional .param int has_arg2 :opt_flag if has_arg1 goto got_arg1 # ... got_arg1: # ... .end =end PIR =head2 How do I create nested subroutines? Please refer to L for details. =head1 VARIABLES =head2 How do I fetch a variable from the global namespace? Use the C or C op: =begin PIR_FRAGMENT get_hll_global $P0, ['name'; 'space'], 'name_of_the_global' get_hll_global $P1, 'name_of_the_global' =end PIR_FRAGMENT =head2 How can I delete a global? You can retrieve the namespace hash and use the C opcode. =begin PIR .sub main :main $P0 = new 'Integer' $P0 = 42 set_hll_global 'foo', $P0 set_hll_global ['Bar'], 'baz', $P0 show_baz() .local pmc ns, Bar_ns ns = get_hll_namespace delete ns['foo'] # delete from top level Bar_ns = ns['Bar'] # get Bar namespace delete Bar_ns['baz'] show_baz() .end .sub show_baz $P0 = get_hll_global ['Bar'], 'baz' print "'baz' is " if null $P0 goto is_null print $P0 print ".\n" .return () is_null: print "null.\n" .end =end PIR =head2 How do I use lexical pads to have both a function scope and a global scope? Please refer to L for details. =head2 How can I delete a lexical variable? You can't. You can store a PMCNULL as the value though, which will catch all further access to that variable and throw an exception. (You can create a PMCNULL with the C opcode.) =head2 How do I resolve a variable name? Use C: =begin PIR_FRAGMENT $P0 = find_name '$x' find_name $P0, 'foo' # same thing =end PIR_FRAGMENT This will find the name C in the lexical, global, or builtin namespace, in that order, and store it in C<$P0>. =head2 How do I fetch a variable from the current lexical pad? =begin PIR_FRAGMENT find_lex $P0, 'foo' =end PIR_FRAGMENT or much better, if possible just use the variable defined along with the C<.lex> definition of C. =head2 How do I fetch a variable from any nesting depth? That is still the same: =begin PIR_FRAGMENT find_lex $P0, 'foo' =end PIR_FRAGMENT This finds a C variable at any B depth starting from the top. If your language looks up variables differently, you have to walk the 'caller' chain. See also F. =head2 How can I produce more efficient code for lexicals? Don't emit C at all. Use C only if the compiler doesn't know the variable. You can always just use the register that was defined in the C<.lex> directive as an alias to that lexical, if you are in the same scope. =head1 MODULES, CLASSES, and OBJECTS =head2 How do I create a module? XXX =head2 How do I create a class? With the C op: =begin PIR_FRAGMENT newclass $P0, 'Animal' =end PIR_FRAGMENT =head2 How do I add instance variables/attributes? Each class knows which attributes its objects can have. You can add attributes to a class (not to individual objects) like so: =begin PIR_FRAGMENT addattribute $P0, 'legs' =end PIR_FRAGMENT =head2 How do I add instance methods to a class? Methods are declared as functions in the class namespace with the C<:method> keyword appended to the function declaration: =begin PIR .namespace [ 'Animal' ] .sub run :method print "slow and steady\n" .end =end PIR =head2 How do I override a vtable on a class? As with methods, but note the new keyword. The vtable name specified B be an existing vtable slot. =begin PIR .namespace [ 'NearlyPi' ] .sub get_string :vtable .return ('three and a half') .end =end PIR Now, given an instance of NearlyPi in $P0 =begin PIR_FRAGMENT $S0 = $P0 say $S0 # prints 'three and a half' =end PIR_FRAGMENT =head2 How do I access attributes? You can access attributes by a short name: =begin PIR_FRAGMENT_INVALID $P0 = getattribute self, 'legs' assign $P0, 4 # set attribute's value =end PIR_FRAGMENT_INVALID =head2 When should I use properties vs. attributes? Properties aren't inherited. If you have some additional data that don't fit into the class's hierarchy, you could use properties. =head2 How do I create a class that is a subclass of another class? You first have to get the class PMC of the class you want to subclass. Either you use the PMC returned by the C op if you created the class, or use the C op: =begin PIR_FRAGMENT get_class $P0, 'Animal' =end PIR_FRAGMENT Then you can use the C op to create a new class that is a subclass of this class: =begin PIR_FRAGMENT subclass $P1, $P0, 'Dog' =end PIR_FRAGMENT This stores the newly created class PMC in $P1. =head2 How do I create a class that has more than one parent class? First, create a class without a parent class using C (or with only one subclass, see previous question). Then add the other parent classes to it. Please refer to the next question for an example. =head2 How do I add another parent class to my class? If you have a class PMC (created with C or by C), you can add more parent classes to it with the C op: =begin PIR_FRAGMENT get_class $P1, 'Dog' subclass $P2, $P1, 'SmallDog' get_class $P3, 'Pet' addparent $P2, $P3 # make "SmallDog" also a "Pet" =end PIR_FRAGMENT =head2 How can I specify the constructor of a class? Just override the init vtable for that class. =begin PIR .sub _ :main newclass $P0, 'Dog' # create a class named Dog .end .namespace ['Dog'] .sub init :vtable # ... .end =end PIR Or you can specify the constructor method by setting the BUILD property of the class PMC: =begin PIR_FRAGMENT newclass $P0, 'Dog' # create a class named Dog new $P1, 'String' # create a string set $P1, 'initialise' # set it to the name of the constructor method setprop $P0, 'BUILD', $P1 # set the BUILD property =end PIR_FRAGMENT =head2 How do I instantiate a class? You can do so either with the class name: =begin PIR_FRAGMENT new $P0, 'Dog' =end PIR_FRAGMENT or with the class object: =begin PIR_FRAGMENT_INVALID .loadlib 'io_ops' $P1 = get_class 'Dog' # find the 'Dog' class unless null $P1 goto have_dog_class printerr "Oops; can't find the 'Dog' class.\n" .return () have_dog_class: new $P0, $P1 # creates a Dog object and stores it in register $P0 =end PIR_FRAGMENT_INVALID The chief difference is that using a string constant will produce the specific error "Class 'Dog' not found" if that happens to be the case; the other code has to check explicitly. During the C opcode the constructor is called. =head2 How can I pass arguments to a constructor? You can pass only a single argument to a constructor. By convention, a hash PMC is passed to the constructor that contains the arguments as key/value pairs: =begin PIR_FRAGMENT new $P0, 'Hash' set $P0['greeting'], 'hello' set $P0['size'], 1.23 new $P1, 'Alien', $P0 # create an Alien object and pass # the hash to the constructor =end PIR_FRAGMENT =head2 How do I add module/class methods? XXX =head2 How do I access module/class variables? XXX =head1 EXCEPTIONS =head2 How do I throw an exception in PIR? The easiest way is the perl-like =begin PIR_FRAGMENT die 'Eeeek!' =end PIR_FRAGMENT You can also explicitly create an exception object and throw it: =begin PIR_FRAGMENT $P0 = new 'Exception' $P0 = 'something happened' throw $P0 =end PIR_FRAGMENT =head2 How do I catch an exception in PIR? Use C to push an exception handler onto the stack. End the set of instructions that might throw the exception you're interested in with C. =begin PIR_FRAGMENT_INVALID push_eh handler die 'whoops' # or any other code that might throw an exception... pop_eh # ok =end PIR_FRAGMENT_INVALID An exception handler is called with one argument, which is the exception object. The message of the exception can be easily extracted, as follows: =begin PIR_FRAGMENT handler: # exception .get_results ($P0) print 'Exception caught:' $S0 = $P0['message'] say $S0 =end PIR_FRAGMENT =head2 How do I let exceptions from C pass through my handler? Rethrow the exception if it has a severity of C. =begin PIR_FRAGMENT .include 'except_severity.pasm' # ... handler: .get_results ($P0) $I0 = $P0['severity'] if $I0 == .EXCEPT_EXIT goto handle_exit say 'Exception caught!' # ... handle_exit: rethrow $P0 # let the next handler deal with it. =end PIR_FRAGMENT Exception example: =begin PIR_FRAGMENT push_eh handler $P0 = new 'Exception' $P0 = 'something happened' throw $P0 pop_eh exit 0 handler: .local pmc exception .local string message .get_results (exception) print 'Exception: ' message = exception['message'] print message print "\n" exit 1 =end PIR_FRAGMENT =head1 C EXTENSIONS =head2 How do I create PMCs for my compiler? Parrot supports dynamic PMCs, loadable at runtime, to allow compiler writers to extend Parrot with additional types. For more information about writing PMCs, see L and L. See L for an example of how to build your dynamic PMCS. =head2 How do I add another op to Parrot? Parrot supports dynamic op libraries. These allow for ops specific to one language to be used without having to place them into the Parrot core itself. For examples of dynamic op libraries, see L. =head2 How do I use the Native Calling Interface (NCI)? Using the NCI you can invoke functions written in C from a Parrot script. To every NCI invocation, there are two parts: the native function to be invoked, and the PIR code to do the invocation. First the native function, to be written in C. On Windows, it is necessary to do a DLL export specification of the NCI function: /* foo.c */ /* specify the function prototype */ #ifdef __WIN32 __declspec(dllexport) void foo(void); #else void foo(void); #endif void foo(void) { printf("Hello Parrot!\n"); } Then, after having compiled the file as a shared library, the PIR code looks like this: =begin PIR .sub main :main .local pmc lib, func # load the shared library lib = loadlib "hello" # no extension, .so or .dll is assumed # get a reference to the function from the library just # loaded, called "foo", and signature "void" (and no arguments) func = dlfunc lib, "foo", "v" # invoke func() .end =end PIR If you embedded a Parrot in your C file and you want to invoke another function in that same C file, you should pass a null string to loadlib. Do that as follows: =begin PIR_FRAGMENT .local pmc lib .local string libname null libname lib = loadlib libname =end PIR_FRAGMENT Under Linux, the .c file must then be linked with the -export-dynamic option. =head1 MISC. =head2 How can I access a program's environment? Create a new C PMC and access it like a hash. =begin PIR_FRAGMENT .local pmc e e = new 'Env' $P0 = e['USER'] # lt =end PIR_FRAGMENT =head2 How can I access Parrot's configuration? =begin PIR_FRAGMENT .include 'iglobals.pasm' .local pmc interp, cfg interp = getinterp cfg = interp[.IGLOBALS_CONFIG_HASH] $S0 = cfg['VERSION'] # "0.3.0" =end PIR_FRAGMENT See F for all the keys in the config hash - or iterate over the config hash. =cut ch08_dynops.pod000644000765000765 2374311533177634 20400 0ustar00brucebruce000000000000parrot-5.9.0/docs/book/draft=pod =head1 Dynamic Opcodes Z The smallest executable component is not the compilation unit or even the subroutine, but is actually the I. Opcodes in Parrot, like opcodes in other machines (both virtual and physical), are individual instructions that implement low-level operations in the machine. In the world of microprocessors, the word "opcode" typically refers to the numeric identifier for each instructions. The human-readable word used in the associated assembly language is called the "mnemonic". An assembler, among other tasks, is responsible for converting mnemonics into opcodes for execution. In Parrot, instead of referring to an instruction by different names depending on what form it's in, we just call them all "opcodes". =head2 Opcodes Opcodes are the smallest logical execution element in Parrot. An individual opcode corresponds, in an abstract kind of way, with a single machine code instruction for a particular hardware processor architecture. Parrot is a pretty high-level virtual machine, and even though its opcodes represent the smallest bits of executable code in Parrot, they are hardly small or low-level by themselves. In fact, some Parrot opcodes implement some complex operations and algorithms. Other opcodes are more traditional, performing basic arithmetic and data manipulating operations. Parrot comes with about 1,200 opcodes total in a basic install. It also has a facility for dynamically loading additional opcode libraries, called C, as needed. =head3 Opcode naming To the PIR and PASM programmers, opcodes appear to be polymorphic. That is, some opcodes appear to have multiple allowable argument formats. This is just an illusion, however. Parrot opcodes are not polymorphic, although certain features enable them to appear that way to the PIR programmer. Different argument list formats are detected during parsing and mapped to separate, unique opcode names. During the Parrot build process, opcode definitions called "ops files" are translated into C code prior to compilation. This translation process renames all ops to use unique names depending on their argument lists. An op "foo" that takes two PMCs and returns an integer would be renamed to C. Another op named "foo" that takes one floating point number and returns a string would be renamed to C. So, when we call the opcode "foo" from our PIR program, the PIR compiler will look at the list of arguments and call the appropriate opcode to handle it. =head2 Writing Opcodes Writing Opcodes, like writing PMCs, is done in a C-like language which is later compiled into C code by the X opcode compiler. The opcode script represents a thin overlay on top of ordinary C code: All valid C code is valid opcode script. There are a few neat additions that make writing opcodes easier. The C keyword, for instance, contains a reference to the current interpreter structure. C is always available when writing opcodes, even though it isn't defined anywhere. Opcodes are all defined with the C keyword. Opcodes are written in files with the C<.ops> extension. The core operation files are stored in the C directory. =head3 Opcode Parameters Each opcode can take any fixed number of input and output arguments. These arguments can be any of the four primary data types--INTVALs, PMCs, NUMBERS and STRINGs--but can also be one of several other types of values including LABELs, KEYs and INTKEYs. Each parameter can be an input, an output or both, using the C, C, and C keywords respectively. Here is an example: op Foo (out INT, in NUM) This opcode could be called like this: $I0 = Foo $N0 # in PIR syntax Foo I0, N0 # in PASM syntax When Parrot parses through the file and sees the C operation, it converts it to the real name C. The real name of an opcode is its name followed by an underscore-separated ordered list of the parameters to that opcode. This is how Parrot appears to use polymorphism: It translates the overloaded opcode common names into longer unique names depending on the parameter list of that opcode. Here is a list of some of the variants of the C opcode: add_i_i # $I0 += $I1 add_n_n # $N0 += $N1 add_p_p # $P0 += $P1 add_i_i_i # $I0 = $I1 + $I2 add_p_p_i # $P0 = $P1 + $I0 add_p_p_n # $P0 = $P1 + $N0 This isn't a complete list, but you should get the picture. Each different combination of parameters translates to a different unique operation, and each operation is remarkably simple to implement. In some cases, Parrot can even use its multi-method dispatch system to call opcodes which are heavily overloaded, or for which there is no exact fit but the parameters could be coerced into different types to complete the operation. For instance, attempting to add a STRING to a PMC might coerce the string into a numerical PMC type first, and then dispatch to the C opcode. This is just an example, and the exact mechanisms may change as more opcodes are added or old ones are deleted. Parameters can be one of the following types: =over 4 =item * INT A normal integer type, such as one of the I registers =item * NUM A floating point number, like is used in the N registers =item * STR A string, such as in a S register =item * PMC A PMC value, like a P register =item * KEY A key value. Something like C<[5 ; "Foo" ; 6 ; "Bar"]>. These are the same as indexes that we use in PMC aggregates. =item * INTKEY A basic key value that uses only integer values C<[1 ; 2 ; 3 ]>. =item * LABEL A label value, which represents a named statement in PIR or PASM code. =back In addition to these types, you need to specify the direction that data is moving through that parameter: =over 4 =item * in The parameter is an input, and should be initialized before calling the op. =item * out The parameter is an output =item * inout The parameter is an input and an output. It should be initialized before calling the op, and its value will change after the op executes. =item * invar The parameter is a reference type like a String or PMC, and its internals might change in the call. =back =head3 Opcode Control Flow Some opcodes have the ability to alter control flow of the program they are in. There are a number of control behaviors that can be implemented, such as an unconditional jump in the C opcode, or a subroutine call in the C code, or the conditional behavior implemented by C. At the end of each opcode you can call a C operation to jump to the next opcode to execute. If no C is performed, control flow will continue like normal to the next operation in the program. In this way, opcodes can easily manipulate control flow. Opcode script provides a number of keywords to alter control flow: =over 4 =item * NEXT() The keyword C contains the address of the next opcode in memory. At the end of a normal op you don't need to call C because moving to the next opcode in the program is the default behavior of Parrot N. The C keyword is frequently used in places like the C opcode to create a continuation to the next opcode to return to after the subroutine returns. =item * ADDRESS() Jumps execution to the given address. ADDRESS(x); Here, C should be an C value of the opcode to jump to. =item * OFFSET() Jumps to the address given as an offset from the current address. OFFSET(x) Here, C is an offset in C units that represents how far forward (positive) or how far backwards (negative) to jump to. =back =head2 The Opcode Compiler As we've seen in our discussions above, ops have a number of transformations to go through before they can be become C code and compiled into Parrot. The various special variables like C<$1>, C and C

    need to be converted to normal variable values. Also, each runcore requires the ops be compiled into various formats: The slow and fast cores need the ops to be compiled into individual subroutines. The switch core needs all the ops to be compiled into a single function using a large C statement. The computed goto cores require the ops be compiled into a large function with a large array of label addresses. Parrot's opcode compiler is a tool that's tasked with taking raw opcode files with a C<.ops> extension and converting them into several different formats, all of which need to be syntactically correct C code for compilation. =head2 Dynops Parrot has about 1200 built-in opcodes. These represent operations which are sufficiently simple and fundamental, but at the same time are very common. However, these do not represent all the possible operations that some programmers are going to want to use. Of course, not all of those 1200 ops are unique, many of them are overloaded variants of one another. As an example there are about 36 variants of the C opcode, to account for all the different types of values you may want to set to all the various kinds of registers. The number of unique operations therefore is much smaller then 1200. This is where I come in. Dynops are dynamically-loadable libraries of ops that can be written and compiled separately from Parrot and loaded in at runtime. dynops, along with dynpmcs and runtime libraries are some of the primary ways that Parrot can be extended. Parrot ships with a small number of example dynops libraries in the file L. These are small libraries of mostly nonsensical but demonstrative opcodes that can be used as an example to follow. Dynops can be written in a C<.ops> file like the normal built-in ops are. The ops file should use C<#include "parrot/extend.h"> in addition to any other libraries the ops need. They can be compiled into C using the opcode compiler, then compiled into a shared library using a normal C compiler. Once compiled, the dynops can be loaded into Parrot using the .loadlib directive. =cut # Local variables: # c-file-style: "parrot" # End: # vim: expandtab shiftwidth=4: pod.t000644000765000765 1006712227307455 15574 0ustar00brucebruce000000000000parrot-5.9.0/t/examples#! perl # Copyright (C) 2009-2010, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use File::Temp qw(tempfile); use Test::More qw(no_plan); use Parrot::Test; use Parrot::Test::Pod; use Parrot::Config qw(%PConfig); my @files = @ARGV; if (!@files) { my $podTester = Parrot::Test::Pod->new( { argv => [ @ARGV ], } ); @files = @{$podTester->identify_files_for_POD_testing()}; } foreach my $file ( @files ) { foreach my $snippet (get_samples($file)) { compile_ok($snippet); } } #################### SUBROUTINES #################### sub compile_ok { my $snippet = shift; # If it's a PIR fragment, wrap it in a sub. if ($snippet->{type} eq "PIR" && $snippet->{modifier} =~ /FRAGMENT/) { $snippet->{code} = ".sub 'testing'\n" . $snippet->{code} . "\n.end"; } # Generate a temp file for the source. my ($fh,$tempfile) = tempfile( SUFFIX => '.' . lc $snippet->{type}, UNLINK => 1 ); print {$fh} $snippet->{code}; close $fh; # Generate a temp file for stderr my ($err_fh,$err_tempfile) = tempfile( SUFFIX => '.err', UNLINK => 1 ); close $err_fh; # Send the output to /dev/null; similar to perl5's -c my $cmd = File::Spec->curdir() . $PConfig{slash} . $PConfig{test_prog} . " -o " . File::Spec->devnull() . " " . $tempfile . ' 2> ' . $err_tempfile; my $description = join (':', map {$snippet->{$_}} qw(file line type modifier)); my $rc = system($cmd); open my $errout_fh, '<', $err_tempfile; my $error_output; { undef local $/; $error_output = <$errout_fh>; } my $todo = 0; $todo = 1 if ($snippet->{modifier} =~ /TODO|INVALID/); TODO: { # conditionally todo the file. local $TODO = 'invalid code' if $todo; is ($error_output,'',$description); } } sub get_samples { my $file = shift; open my $fh, '<', $file; my @snippets; my $snippet = {}; my $code = ''; my $target; my $in_code = 0; while (my $line = <$fh>) { if ( $in_code ) { if ($line =~ /^=end $target$/) { $snippet->{code} = $code; push @snippets, $snippet; $code = ''; $snippet = {}; $in_code = 0; } else { $code .= $line; } } elsif ( $line =~ /^=begin ((PIR|PASM)(_(.*))?)$/ ) { $in_code = 1; $snippet->{file} = $file; $snippet->{line} = $.; $snippet->{type} = $2; $snippet->{modifier} = defined($4) ? $4 : ''; $target = $1; } } # We don't check for an example in progress here because no file # should end with =end. return @snippets; } __END__ =head1 NAME t/examples/pod.t - Compile examples found in POD =head1 SYNOPSIS # test all files % prove t/examples/pod.t # test specific files % perl t/examples/pod.t docs/compiler_faq.pod =head1 DESCRIPTION Tests the syntax for any embedded PIR in POD, for all files in the repository that contain POD. Any invalid examples are reported in the test output. To test a snippet of parrot code, wrap it in C<=begin> and C<=end> blocks like: =begin PASM set I0, 0 =end PASM C and C are both valid target languages. Additionally, you can add the following modifiers (prepending with an underscore). =over 4 =item * FRAGMENT For PIR, wraps the code in a C<.sub> block. =item * TODO =item * INVALID Either of these will force the test to be marked TODO. =back For example, this PIR fragment uses an old, invalid opcode and needs to be updated: =begin PIR_FRAGMENT_INVALID find_type $I1, 'Integer' =end PIR_FRAGMENT_INVALID As shown, you can "stack" the modifiers. Take care to make the begin and and end POD targets identical. Always begin with the target language. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: packfilerawsegment.pmc000644000765000765 1310611716253437 20465 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME src/pmc/packfilerawsegment.pmc - PackfileRawSegment PMC =head1 DESCRIPTION This class implements a PackfileRawSegment object, a low level view of a segment that just splits it into an array of integers. See packfile.pmc for the toplevel Packfile interface, see packfilesegment.pmc for the list of common methods every packfile segment pmc must implement; see PDD13 for the design spec. =head2 Methods =over 4 =cut */ /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* HEADERIZER END: static */ pmclass PackfileRawSegment auto_attrs extends PackfileSegment { /* Type of segment */ ATTR INTVAL type; /* ResizableIntegerArray of opcodes */ ATTR PMC *opcodes; /* =item C Create empty PackfileRawSegment. =cut */ VTABLE void init() { Parrot_PackfileRawSegment_attributes * const attrs = PMC_data_typed(SELF, Parrot_PackfileRawSegment_attributes*); attrs->opcodes = Parrot_pmc_new(INTERP, enum_class_ResizableIntegerArray); attrs->type = PF_BYTEC_SEG; PObj_custom_mark_SET(SELF); } /* =item C Marks the object as live. =cut */ VTABLE void mark() { Parrot_PackfileRawSegment_attributes * const attrs = PARROT_PACKFILERAWSEGMENT(SELF); Parrot_gc_mark_PMC_alive(INTERP, attrs->opcodes); SUPER(); } /* =item C Initialize PackfileRawSegment from PackFile_Segment =cut */ VTABLE void set_pointer(void * pointer) { const PackFile_Segment * const pfseg = (const PackFile_Segment *)pointer; Parrot_PackfileRawSegment_attributes * const attrs = PARROT_PACKFILERAWSEGMENT(SELF); PMC * const opcodes = attrs->opcodes; /* Preserve type of unpacked segment */ attrs->type = pfseg->type; if (pfseg->size) { size_t i; /* copy data to own array */ VTABLE_set_integer_native(INTERP, opcodes, pfseg->size); /* Not very efficient... */ for (i = 0; i < pfseg->size; ++i) { VTABLE_set_integer_keyed_int(INTERP, opcodes, i, pfseg->data[i]); } } } /* =item C =cut */ VTABLE void *get_pointer() { PackFile_Segment * const pfseg = (PackFile_Segment*)mem_gc_allocate_zeroed_typed(INTERP, PackFile_ByteCode); const Parrot_PackfileRawSegment_attributes * const attrs = PARROT_PACKFILERAWSEGMENT(SELF); PMC * const opcodes = attrs->opcodes; size_t i; pfseg->type = attrs->type; pfseg->size = VTABLE_get_integer(INTERP, opcodes); pfseg->data = mem_gc_allocate_n_typed(INTERP, pfseg->size, opcode_t); /* Not very efficient... */ for (i = 0; i < pfseg->size; ++i) { pfseg->data[i] = VTABLE_get_integer_keyed_int(INTERP, opcodes, i); } return pfseg; } /* =item C Get the number of elements in the array. =cut */ VTABLE INTVAL elements() { return VTABLE_elements(INTERP, PARROT_PACKFILERAWSEGMENT(SELF)->opcodes); } VTABLE INTVAL get_integer() { return VTABLE_elements(INTERP, PARROT_PACKFILERAWSEGMENT(SELF)->opcodes); } VTABLE FLOATVAL get_number() { return VTABLE_elements(INTERP, PARROT_PACKFILERAWSEGMENT(SELF)->opcodes); } /* =item C =item C =item C Fetch an integer's worth of data from the segment. =cut */ VTABLE INTVAL get_integer_keyed_int(INTVAL key) { return VTABLE_get_integer_keyed_int(INTERP, PARROT_PACKFILERAWSEGMENT(SELF)->opcodes, key); } VTABLE PMC *get_pmc_keyed_int(INTVAL index) { return Parrot_pmc_box_integer(INTERP, STATICSELF.get_integer_keyed_int(index)); } VTABLE PMC *get_pmc_keyed(PMC *key) { return STATICSELF.get_pmc_keyed_int(VTABLE_get_integer(INTERP, key)); } /* =item C Set an integer's worth of data in the segment. =cut */ VTABLE void set_integer_keyed_int(INTVAL key, INTVAL value) { VTABLE_set_integer_keyed_int(INTERP, PARROT_PACKFILERAWSEGMENT(SELF)->opcodes, key, value); } VTABLE void set_pmc_keyed(PMC *key, PMC *value) { SELF.set_integer_keyed_int( VTABLE_get_integer(INTERP, key), VTABLE_get_integer(INTERP, value)); } /* =item C Append opcode to segment =cut */ VTABLE void push_integer(INTVAL value) { VTABLE_push_integer(INTERP, PARROT_PACKFILERAWSEGMENT(SELF)->opcodes, value); } VTABLE void push_pmc(PMC *value) { VTABLE_push_integer(INTERP, PARROT_PACKFILERAWSEGMENT(SELF)->opcodes, VTABLE_get_integer(INTERP, value)); } /* =item C Set of get segment type. =cut TODO: Don't allow create Directory, Annotations, etc segments. */ METHOD type(INTVAL type :optional, INTVAL got_type :opt_flag) { Parrot_PackfileRawSegment_attributes * const attrs = PARROT_PACKFILERAWSEGMENT(SELF); INTVAL res; if (got_type) { attrs->type = type; } res = attrs->type; RETURN(INTVAL res); } } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ events.c000644000765000765 2613212171255166 15002 0ustar00brucebruce000000000000parrot-5.9.0/src/* Copyright (C) 2007-2013, Parrot Foundation. =head1 NAME src/events.c - Event Handling =head1 DESCRIPTION Users can register event handlers. When events occur, they are dispatched to the appropriate handler asynchronously. =over 4 =cut */ #include "parrot/parrot.h" #include "parrot/runcore_api.h" #include "parrot/events.h" #include "events.str" #include "pmc/pmc_arrayiterator.h" #include "pmc/pmc_exception.h" /* HEADERIZER HFILE: include/parrot/events.h */ #define CX_DEBUG 0 /* =item C Add a handler to the current context's list of handlers. =cut */ PARROT_EXPORT void Parrot_cx_add_handler_local(PARROT_INTERP, ARGIN(PMC *handler)) { ASSERT_ARGS(Parrot_cx_add_handler_local) if (PMC_IS_NULL(Parrot_pcc_get_handlers(interp, interp->ctx))) Parrot_pcc_set_handlers(interp, interp->ctx, Parrot_pmc_new(interp, enum_class_ResizablePMCArray)); VTABLE_unshift_pmc(interp, Parrot_pcc_get_handlers(interp, interp->ctx), handler); } /* =item C Remove the top task handler from the context's list of handlers. =cut */ PARROT_EXPORT void Parrot_cx_delete_handler_local(PARROT_INTERP) { ASSERT_ARGS(Parrot_cx_delete_handler_local) PMC *handlers = Parrot_pcc_get_handlers(interp, interp->ctx); if (PMC_IS_NULL(handlers)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "No handler to delete."); /* test elements so that we get a nice error message */ if (!VTABLE_elements(interp, handlers)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "No handler to delete."); VTABLE_shift_pmc(interp, handlers); } /* =item C Remove handlers until the specified handler is reached. The handler itself is not removed. If the handler is not found, all handlers will be removed and an exception is thrown. =cut */ PARROT_EXPORT void Parrot_cx_delete_upto_handler_local(PARROT_INTERP, ARGIN(PMC *handler)) { ASSERT_ARGS(Parrot_cx_delete_upto_handler_local) PMC *handlers = Parrot_pcc_get_handlers(interp, interp->ctx); if (!PMC_IS_NULL(handlers)) { while (VTABLE_elements(interp, handlers)) { PMC * const cand = VTABLE_get_pmc_keyed_int(interp, handlers, 0); if (cand == handler) return; VTABLE_shift_pmc(interp, handlers); } } Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Specified handler is not in the handler list."); } /* =item C Count the number of active handlers from the context's list of handlers. =cut */ PARROT_EXPORT INTVAL Parrot_cx_count_handlers_local(PARROT_INTERP) { ASSERT_ARGS(Parrot_cx_count_handlers_local) PMC * const handlers = Parrot_pcc_get_handlers(interp, interp->ctx); if (PMC_IS_NULL(handlers)) return 0; return VTABLE_elements(interp, handlers); } /* =item C Add a task handler to scheduler's list of handlers. =cut */ PARROT_EXPORT void Parrot_cx_add_handler(PARROT_INTERP, ARGIN(PMC *handler)) { ASSERT_ARGS(Parrot_cx_add_handler) STRING * const add_handler = CONST_STRING(interp, "add_handler"); if (!interp->scheduler) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Scheduler was not initialized for this interpreter.\n"); Parrot_pcc_invoke_method_from_c_args(interp, interp->scheduler, add_handler, "P->", handler); } /* =item C Remove the top task handler of a particular type from the scheduler's list of handlers. =cut */ PARROT_EXPORT void Parrot_cx_delete_handler_typed(PARROT_INTERP, ARGIN(STRING *handler_type)) { ASSERT_ARGS(Parrot_cx_delete_handler_typed) if (!interp->scheduler) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Scheduler was not initialized for this interpreter.\n"); Parrot_pcc_invoke_method_from_c_args(interp, interp->scheduler, CONST_STRING(interp, "delete_handler"), "S->", handler_type); } /* =item C Count the number of active handlers of a particular type (event, exception) in the concurrency scheduler. =cut */ PARROT_EXPORT INTVAL Parrot_cx_count_handlers_typed(PARROT_INTERP, ARGIN(STRING *handler_type)) { ASSERT_ARGS(Parrot_cx_count_handlers_typed) INTVAL count = 0; if (!interp->scheduler) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Scheduler was not initialized for this interpreter.\n"); Parrot_pcc_invoke_method_from_c_args(interp, interp->scheduler, CONST_STRING(interp, "count_handlers"), "S->I", handler_type, &count); return count; } /* =back =head2 Task Interface Functions Functions that are used to interface with a specific task in the concurrency scheduler. =over 4 =item C Retrieve a handler appropriate to a given task. If the scheduler has no appropriate handler, returns PMCNULL. =cut */ PARROT_EXPORT PARROT_CAN_RETURN_NULL PMC * Parrot_cx_find_handler_for_task(PARROT_INTERP, ARGIN(PMC *task)) { ASSERT_ARGS(Parrot_cx_find_handler_for_task) PMC *handler = PMCNULL; #if CX_DEBUG fprintf(stderr, "searching for handler\n"); #endif if (!interp->scheduler) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Scheduler was not initialized for this interpreter.\n"); Parrot_pcc_invoke_method_from_c_args(interp, interp->scheduler, CONST_STRING(interp, "find_handler"), "P->P", task, &handler); #if CX_DEBUG fprintf(stderr, "done searching for handler\n"); #endif return handler; } /* =item C Retrieve a handler appropriate to a given task from the local context. If the context has no appropriate handler, returns PMCNULL. =cut */ PARROT_EXPORT PARROT_CAN_RETURN_NULL PMC * Parrot_cx_find_handler_local(PARROT_INTERP, ARGIN(PMC *task)) { ASSERT_ARGS(Parrot_cx_find_handler_local) /* * Quick&dirty way to avoid infinite recursion * when an exception is thrown while looking * for a handler */ static int already_doing = 0; static PMC * keep_context = NULL; PMC *context; STRING * const handled_str = CONST_STRING(interp, "handled"); STRING * const handler_str = CONST_STRING(interp, "handler"); STRING * const handlers_left_str = CONST_STRING(interp, "handlers_left"); STRING * const exception_str = CONST_STRING(interp, "Exception"); const Parrot_Int is_exception = (task->vtable->base_type == enum_class_Exception) || VTABLE_does(interp, task, exception_str); PMC *handlers; INTVAL pos, elements; if (already_doing) { Parrot_io_eprintf(interp, "** Exception caught while looking for a handler, trying next **\n"); if (! keep_context) return NULL; /* * Note that we are now trying to handle the new exception, * not the initial task argument (exception or whatever). */ context = Parrot_pcc_get_caller_ctx(interp, keep_context); keep_context = NULL; if (context) { handlers = Parrot_pcc_get_handlers(interp, context); elements = !PMC_IS_NULL(handlers) ? VTABLE_elements(interp, handlers) : 0; pos = 0; } } else { INTVAL handled = 0; ++already_doing; /* Exceptions store the handler iterator for rethrow, other kinds of * tasks don't (though they could). */ if (is_exception) { if (task->vtable->base_type == enum_class_Exception) GETATTR_Exception_handled(interp, task, handled); else handled = VTABLE_get_integer_keyed_str(interp, task, handled_str); } if (handled == -1) { context = (PMC *)VTABLE_get_pointer(interp, task); handlers = Parrot_pcc_get_handlers(interp, context); elements = !PMC_IS_NULL(handlers) ? VTABLE_elements(interp, handlers) : 0; if (task->vtable->base_type == enum_class_Exception) GETATTR_Exception_handlers_left(interp, task, pos); else pos = VTABLE_get_integer_keyed_str(interp, task, handlers_left_str); pos = elements - pos; if (pos < 0) pos = 0; if (pos > elements) pos = elements; } else { context = CURRENT_CONTEXT(interp); handlers = Parrot_pcc_get_handlers(interp, context); elements = !PMC_IS_NULL(handlers) ? VTABLE_elements(interp, handlers) : 0; pos = 0; } } while (context) { keep_context = context; /* Loop from newest handler to oldest handler. */ for (; pos < elements; pos++) { PMC * const handler = VTABLE_get_pmc_keyed_int(interp, handlers, pos); if (!PMC_IS_NULL(handler)) { INTVAL valid_handler = 0; Parrot_pcc_invoke_method_from_c_args(interp, handler, CONST_STRING(interp, "can_handle"), "P->I", task, &valid_handler); if (valid_handler) { if (is_exception) { /* Store iterator and context for a later rethrow. */ VTABLE_set_pointer(interp, task, context); if (task->vtable->base_type == enum_class_Exception) { SETATTR_Exception_handlers_left(interp, task, elements - pos - 1); SETATTR_Exception_handler(interp, task, handler); } else { VTABLE_set_integer_keyed_str(interp, task, handlers_left_str, elements - pos - 1); VTABLE_set_attr_str(interp, task, handler_str, handler); } } --already_doing; keep_context = NULL; return handler; } } } /* Continue the search in the next context up the chain. */ context = Parrot_pcc_get_caller_ctx(interp, context); if (context) { handlers = Parrot_pcc_get_handlers(interp, context); elements = !PMC_IS_NULL(handlers) ? VTABLE_elements(interp, handlers) : 0; pos = 0; } else elements = pos = 0; } /* Reached the end of the context chain without finding a handler. */ --already_doing; return PMCNULL; } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ vpm.py000644000765000765 43011567202623 17601 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks#! python # Copyright (C) 2004-2011, Parrot Foundation. import string big = 0 astring = "just another pyth hacker" for i in range(100000): big = big + 1 str = list(astring) f = str.pop(0) str.append(f) astring = string.join(str,"") print big print astring pf_items.c000644000765000765 16201212101554067 17073 0ustar00brucebruce000000000000parrot-5.9.0/src/packfile/* Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME src/packfile/pf_items.c - Fetch/store packfile data =head1 DESCRIPTION Low level packfile functions to fetch and store Parrot data, i.e. C, C, C ... C<< PF_fetch_() >> functions retrieve the datatype item from the opcode stream and convert byteordering or binary format on the fly, depending on the packfile header. C<< PF_store_() >> functions write the datatype item to the stream as is. These functions don't check the available size. C<< PF_size_() >> functions return the store size of item in C units. C and C are short for "Big-endian", while C and C are short for "little endian". =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" #include "pf_items.str" /* HEADERIZER HFILE: include/parrot/packfile.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void cvt_num12_num16( ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); static void cvt_num12_num16_le( ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); static void cvt_num12_num8( ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); static void cvt_num12_num8_le( ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); static void cvt_num16_num12( ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); static void cvt_num16_num12_be( ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); static void cvt_num16_num8( ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); static void cvt_num16_num8_be( ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); static void cvt_num16_num8_le( ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); static void cvt_num8_num12( ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); static void cvt_num8_num12_be( ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); static void cvt_num8_num16( ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); static void cvt_num8_num16_be( ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); static void cvt_num8_num16_le( ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*dest); PARROT_INLINE static void fetch_buf_be_12( ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*rb); PARROT_INLINE static void fetch_buf_be_16( ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*rb); PARROT_INLINE static void fetch_buf_be_32( ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*rb); PARROT_INLINE static void fetch_buf_be_4( ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*rb); PARROT_INLINE static void fetch_buf_be_8( ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*rb); PARROT_INLINE static void fetch_buf_le_12( ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*rb); PARROT_INLINE static void fetch_buf_le_16( ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*rb); PARROT_INLINE static void fetch_buf_le_32( ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*rb); PARROT_INLINE static void fetch_buf_le_4( ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*rb); PARROT_INLINE static void fetch_buf_le_8( ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*rb); PARROT_INLINE PARROT_WARN_UNUSED_RESULT PARROT_CONST_FUNCTION static INTVAL fetch_iv_be(INTVAL w); PARROT_INLINE PARROT_WARN_UNUSED_RESULT PARROT_CONST_FUNCTION static INTVAL fetch_iv_le(INTVAL w); PARROT_INLINE PARROT_WARN_UNUSED_RESULT PARROT_CONST_FUNCTION static opcode_t fetch_op_be(opcode_t w); PARROT_WARN_UNUSED_RESULT static opcode_t fetch_op_be_4(ARGIN(const unsigned char *b)) __attribute__nonnull__(1); PARROT_WARN_UNUSED_RESULT static opcode_t fetch_op_be_8(ARGIN(const unsigned char *b)) __attribute__nonnull__(1); PARROT_INLINE PARROT_WARN_UNUSED_RESULT PARROT_CONST_FUNCTION static opcode_t fetch_op_le(opcode_t w); PARROT_WARN_UNUSED_RESULT static opcode_t fetch_op_le_4(ARGIN(const unsigned char *b)) __attribute__nonnull__(1); PARROT_WARN_UNUSED_RESULT static opcode_t fetch_op_le_8(ARGIN(const unsigned char *b)) __attribute__nonnull__(1); #define ASSERT_ARGS_cvt_num12_num16 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest) \ , PARROT_ASSERT_ARG(src)) #define ASSERT_ARGS_cvt_num12_num16_le __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest) \ , PARROT_ASSERT_ARG(src)) #define ASSERT_ARGS_cvt_num12_num8 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest) \ , PARROT_ASSERT_ARG(src)) #define ASSERT_ARGS_cvt_num12_num8_le __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest) \ , PARROT_ASSERT_ARG(src)) #define ASSERT_ARGS_cvt_num16_num12 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest) \ , PARROT_ASSERT_ARG(src)) #define ASSERT_ARGS_cvt_num16_num12_be __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest) \ , PARROT_ASSERT_ARG(src)) #define ASSERT_ARGS_cvt_num16_num8 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest) \ , PARROT_ASSERT_ARG(src)) #define ASSERT_ARGS_cvt_num16_num8_be __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest) \ , PARROT_ASSERT_ARG(src)) #define ASSERT_ARGS_cvt_num16_num8_le __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest) \ , PARROT_ASSERT_ARG(src)) #define ASSERT_ARGS_cvt_num8_num12 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest) \ , PARROT_ASSERT_ARG(src)) #define ASSERT_ARGS_cvt_num8_num12_be __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest) \ , PARROT_ASSERT_ARG(src)) #define ASSERT_ARGS_cvt_num8_num16 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest) \ , PARROT_ASSERT_ARG(src)) #define ASSERT_ARGS_cvt_num8_num16_be __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest) \ , PARROT_ASSERT_ARG(src)) #define ASSERT_ARGS_cvt_num8_num16_le __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(dest) \ , PARROT_ASSERT_ARG(src)) #define ASSERT_ARGS_fetch_buf_be_12 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(rb) \ , PARROT_ASSERT_ARG(b)) #define ASSERT_ARGS_fetch_buf_be_16 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(rb) \ , PARROT_ASSERT_ARG(b)) #define ASSERT_ARGS_fetch_buf_be_32 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(rb) \ , PARROT_ASSERT_ARG(b)) #define ASSERT_ARGS_fetch_buf_be_4 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(rb) \ , PARROT_ASSERT_ARG(b)) #define ASSERT_ARGS_fetch_buf_be_8 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(rb) \ , PARROT_ASSERT_ARG(b)) #define ASSERT_ARGS_fetch_buf_le_12 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(rb) \ , PARROT_ASSERT_ARG(b)) #define ASSERT_ARGS_fetch_buf_le_16 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(rb) \ , PARROT_ASSERT_ARG(b)) #define ASSERT_ARGS_fetch_buf_le_32 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(rb) \ , PARROT_ASSERT_ARG(b)) #define ASSERT_ARGS_fetch_buf_le_4 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(rb) \ , PARROT_ASSERT_ARG(b)) #define ASSERT_ARGS_fetch_buf_le_8 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(rb) \ , PARROT_ASSERT_ARG(b)) #define ASSERT_ARGS_fetch_iv_be __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) #define ASSERT_ARGS_fetch_iv_le __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) #define ASSERT_ARGS_fetch_op_be __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) #define ASSERT_ARGS_fetch_op_be_4 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(b)) #define ASSERT_ARGS_fetch_op_be_8 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(b)) #define ASSERT_ARGS_fetch_op_le __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) #define ASSERT_ARGS_fetch_op_le_4 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(b)) #define ASSERT_ARGS_fetch_op_le_8 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(b)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* * round val up to whole size, return result in bytes */ #define ROUND_UP_B(val, size) ((((val) + ((size) - 1))/(size)) * (size)) /* * round val up to whole opcode_t, return result in opcodes */ #define ROUND_UP(val, size) (((val) + ((size) - 1))/(size)) /* * offset not in ptr diff, but in byte */ #define OFFS(pf, cursor) ((pf) ? ((const char *)(cursor) - (const char *)((pf)->src)) : 0) /* * low level FLOATVAL fetch and convert functions * * Floattype 0 = IEEE-754 8 byte double * Floattype 1 = x86 little endian 12 byte long double * Floattype 2 = IEEE-754 16 byte long double * */ /* =item C Converts i386 LE 12-byte long double to IEEE 754 8-byte double. Tested ok. =cut */ #if (NUMVAL_SIZE == 8) static void cvt_num12_num8(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) { ASSERT_ARGS(cvt_num12_num8) int expo, i, s; # ifdef __LCC__ int expo2; # endif /* 12-byte double (96 bits): sign 1 bit 95 exp 15 bits 94-80 man 80 bits 79-0 to 8-byte double (64 bits): sign 1 bit 63 exp 11 bits 62-52 man 52 bits 51-0 +-------+-------+-------+-------+-------+-------+--...--+-------+ |src[11]|src[10]|src[9] |src[8] |src[7] |src[6] | ... |src[0] | S| E | F | +-------+-------+-------+-------+-------+-------+--...--+-------+ 1|<-----15----->|<----------------80 bits---------------------->| <----------------------------96 bits----------------------------> +-------+-------+-------+-------+-------+-------+-------+-------+ |dest[7]|dest[6]|dest[5]|dest[4]|dest[3]|dest[2]|dest[1]|dest[0]| S| E | F | +-------+-------+-------+-------+-------+-------+-------+-------+ 1|<---11-->|<---------------------52 bits---------------------->| <----------------------------64 bits----------------------------> 8-byte DOUBLE FLOATING-POINT */ memset(dest, 0, 8); /* exponents 15 -> 11 bits */ s = src[9] & 0x80; /* sign */ expo = ((src[9] & 0x7f)<< 8 | src[8]); if (expo == 0) { nul: if (s) dest[7] |= 0x80; return; } # ifdef __LCC__ /* Yet again, LCC blows up mysteriously until a temporary variable is * added. */ expo2 = expo - 16383; expo = expo2; # else expo -= 16383; /* - bias */ # endif expo += 1023; /* + bias 8byte */ if (expo <= 0) /* underflow */ goto nul; if (expo > 0x7ff) { /* inf/nan */ dest[7] = 0x7f; dest[6] = src[7] == 0xc0 ? 0xf8 : 0xf0 ; goto nul; } expo <<= 4; dest[6] = (expo & 0xff); dest[7] = (expo & 0x7f00) >> 8; if (s) dest[7] |= 0x80; /* long double frac 63 bits => 52 bits src[7] &= 0x7f; reset integer bit */ for (i = 0; i < 6; ++i) { dest[i+1] |= (i==5 ? src[7]&0x7f : src[i+2]) >> 3; dest[i] |= (src[i+2] & 0x1f) << 5; } dest[0] |= src[1] >> 3; } #endif /* =item C Converts IEEE 754 LE 16-byte long double to i386 LE 12-byte long double. See http://babbage.cs.qc.cuny.edu/IEEE-754/References.xhtml Tested ok. =cut */ #if (NUMVAL_SIZE == 12) static void cvt_num16_num12(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) { ASSERT_ARGS(cvt_num16_num12) /* 16-byte double (128 bits): sign 1 bit 127 exp 15 bits 126-112 man 112 bits 111-0 to 12-byte double (96 bits): sign 1 bit 95 exp 15 bits 94-80 man 80 bits 79-0 +-------+-------+-------+-------+-------+-------+--...--+-------+ |src[15]|src[14]|src[13]|src[12]|src[11]|src[10]| ... |src[0] | S| E | F | +-------+-------+-------+-------+-------+-------+--...--+-------+ 1|<-----15----->|<----------------112 bits--------------------->| <---------------------------128 bits----------------------------> 16-byte LONG DOUBLE FLOATING-POINT (IA64 or BE 64-bit) +-------+-------+-------+-------+-------+-------+--...--+-------+ |dest[11]dest[10]dest[9]|dest[8]|dest[7]|dest[6]| ... |dest[0]| S| E | F | +-------+-------+-------+-------+-------+-------+--...--+-------+ 1|<-----15----->|<----------------80 bits---------------------->| <----------------------------96 bits----------------------------> 12-byte LONG DOUBLE FLOATING-POINT (i386 special) */ memset(dest, 0, 12); /* simply copy over sign + exp */ dest[10] = src[15]; dest[11] = src[14]; /* and copy the rest */ memcpy(&dest[0], &src[0], 10); } #endif /* =item C Converts i386 LE 12-byte long double to IEEE 754 LE 16-byte long double. Tested ok. Fallback 12->8->16 disabled. =cut */ #if (NUMVAL_SIZE == 16) static void cvt_num12_num16(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) { ASSERT_ARGS(cvt_num12_num16) # if 0 unsigned char b[8]; cvt_num12_num8(b, src); cvt_num8_num16(dest, b); # endif /* 12-byte double (96 bits): sign 1 bit 95 exp 15 bits 94-80 man 80 bits 79-0 to 16-byte double (128 bits): sign 1 bit 127 exp 15 bits 126-112 man 112 bits 111-0 +-------+-------+-------+-------+-------+-------+--...--+-------+ |src[11]|src[10]| src[9]| src[8]| src[7]| src[6]| ... | src[0]| S| E | F | +-------+-------+-------+-------+-------+-------+--...--+-------+ 1|<-----15----->|<----------------80 bits---------------------->| <----------------------------96 bits----------------------------> 12-byte LONG DOUBLE FLOATING-POINT (i386 special) +-------+-------+-------+-------+-------+-------+--...--+-------+ |dest[15]dest[14]dest[13]dest[12]dest[11]dest[10] ... |dest[0]| S| E | F | +-------+-------+-------+-------+-------+-------+--...--+-------+ 1|<-----15----->|<----------------112 bits--------------------->| <---------------------------128 bits----------------------------> 16-byte LONG DOUBLE FLOATING-POINT (x86_64 or BE 64-bit) */ memset(dest, 0, 16); /* simply copy over sign + exp */ dest[15] = src[11]; dest[14] = src[10]; /* and copy the rest */ memcpy(&dest[0], &src[0], 10); } #endif /* =item C Converts IEEE 754 16-byte long double to IEEE 754 8 byte double. First variant ok, 2nd not ok. =cut */ #if (NUMVAL_SIZE == 8) static void cvt_num16_num8(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) { ASSERT_ARGS(cvt_num16_num8) if ((sizeof (long double) == 16) && (sizeof (double) == 8)) { long double ld; double d; memcpy(&ld, src, 16); d = (double)ld; /* compiler cast */ memcpy(dest, &d, 8); } else { /* FIXME: This codepath fails */ int expo, i, s; # ifdef __LCC__ int expo2; # endif Parrot_x_force_error_exit(NULL, 1, "cvt_num16_num8: long double conversion unsupported"); /* Have only 12-byte long double, or no long double at all. Need to disect it */ /* 16-byte double (128 bits): sign 1 bit 127 exp 15 bits 126-112 man 112 bits 111-0 to 8-byte double (64 bits): sign 1 bit 63 exp 11 bits 62-52 man 52 bits 51-0 +-------+-------+-------+-------+-------+-------+--...--+-------+ |src[15]|src[14]|src[13]|src[12]|src[11]|src[10]| ... |src[0] | S| E | F | +-------+-------+-------+-------+-------+-------+--...--+-------+ 1|<-----15----->|<----------------112 bits--------------------->| <---------------------------128 bits----------------------------> 16-byte LONG DOUBLE FLOATING-POINT (IA64 or BE 64-bit) +-------+-------+-------+-------+-------+-------+-------+-------+ |dest[7]|dest[6]|dest[5]|dest[4]|dest[3]|dest[2]|dest[1]|dest[0]| S| E | F | +-------+-------+-------+-------+-------+-------+-------+-------+ 1|<---11-->|<---------------------52 bits---------------------->| <----------------------------64 bits----------------------------> 8-byte DOUBLE FLOATING-POINT */ memset(dest, 0, 8); s = src[15] & 0x80; /* 10000000 */ /* 15->11 exponents bits */ expo = ((src[15] & 0x7f)<< 8 | src[14]); if (expo == 0) { nul: if (s) dest[7] |= 0x80; return; } # ifdef __LCC__ /* LCC blows up mysteriously until a temporary variable is * added. */ expo2 = expo - 16383; expo = expo2; # else expo -= 16383; /* - same bias as with 12-byte */ # endif expo += 1023; /* + bias 8byte */ if (expo <= 0) /* underflow */ goto nul; if (expo > 0x7ff) { /* inf/nan */ dest[7] = 0x7f; dest[6] = src[7] == 0xc0 ? 0xf8 : 0xf0 ; goto nul; } expo <<= 4; dest[6] = (expo & 0xff); dest[7] = (expo & 0x7f00) >> 8; if (s) dest[7] |= 0x80; /* long double frac 112 bits => 52 bits src[13] &= 0x7f; reset integer bit */ for (i = 0; i < 6; ++i) { dest[i+1] |= (i==5 ? src[13]&0x7f : src[i+7]) >> 3; dest[i] |= (src[i+7] & 0x1f) << 5; } dest[0] |= src[1] >> 3; } } #endif /* =item C Converts IEEE 754 8-byte double to IEEE 754 16 byte long double. Tested ok. =cut */ #if (NUMVAL_SIZE == 16) static void cvt_num8_num16(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) { ASSERT_ARGS(cvt_num8_num16) /* The compiler can do this for us */ long double ld; double d; memcpy(&d, src, 8); ld = (long double)d; /* TODO: test compiler cast */ memcpy(dest, &ld, 16); } #endif /* =item C Converts i386 8-byte double to i386 12 byte long double. Tested ok. =cut */ #if (NUMVAL_SIZE == 12) && !PARROT_BIGENDIAN static void cvt_num8_num12(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) { ASSERT_ARGS(cvt_num8_num12) long double ld; double d; memcpy(&d, src, 8); ld = (long double)d; /* compiler cast */ memcpy(dest, &ld, 12); } #endif /* =item C Converts a big-endian IEEE 754 8-byte double to i386 LE 12-byte long double. Tested ok. =cut */ #if (NUMVAL_SIZE == 12) && !PARROT_BIGENDIAN static void cvt_num8_num12_be(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) { ASSERT_ARGS(cvt_num8_num12_be) unsigned char b[8]; fetch_buf_be_8(b, src); cvt_num8_num12(dest, b); } #endif /* =item C Converts a little-endian IEEE 754 8-byte double to big-endian 16-byte long double. Yet untested. =cut */ #if (NUMVAL_SIZE == 16) && PARROT_BIGENDIAN static void cvt_num8_num16_le(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) { ASSERT_ARGS(cvt_num8_num16_le) unsigned char b[8]; fetch_buf_be_8(b, src); /* TODO test endianize */ cvt_num8_num16(dest, b); } #endif /* =item C Converts a little-endian 12-byte double to big-endian 16-byte long double. Tested nok. =cut */ #if (NUMVAL_SIZE == 16) && PARROT_BIGENDIAN static void cvt_num12_num16_le(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) { ASSERT_ARGS(cvt_num12_num16_le) unsigned char b[12]; fetch_buf_be_12(b, src); /* TODO test endianize */ cvt_num12_num16(dest, b); } #endif /* =item C Converts a little-endian 12-byte i386 long double into a big-endian IEEE 754 8-byte double. Tested nok. =cut */ #if (NUMVAL_SIZE == 8) && PARROT_BIGENDIAN static void cvt_num12_num8_le(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) { ASSERT_ARGS(cvt_num12_num8_le) unsigned char b[12]; fetch_buf_le_12(b, src); /* TODO test endianize */ cvt_num12_num8(dest, b); Parrot_x_force_error_exit(NULL, 1, "cvt_num12_num8_le: long double conversion unsupported"); } #endif /* =item C Converts a little-endian IEEE 754 intel 16-byte long double into a big-endian IEEE 754 8-byte double. Tested nok. Produces all zeros. =cut */ #if (NUMVAL_SIZE == 8) && PARROT_BIGENDIAN static void cvt_num16_num8_le(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) { ASSERT_ARGS(cvt_num16_num8_le) unsigned char b[16]; fetch_buf_le_16(b, src); cvt_num16_num8(dest, b); Parrot_x_force_error_exit(NULL, 1, "cvt_num16_num8_le: long double conversion unsupported"); } #endif /* =item C Converts a big-endian IEEE 754 16-byte long double into a IEEE 754 8-byte double. Untested. =cut */ #if (NUMVAL_SIZE == 8) && !PARROT_BIGENDIAN static void cvt_num16_num8_be(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) { ASSERT_ARGS(cvt_num16_num8_be) unsigned char b[16]; fetch_buf_be_16(b, src); cvt_num16_num8(dest, b); } #endif /* =item C Converts a big-endian IEEE 754 16-byte long double into a 12-byte i386 long double. Untested. =cut */ #if (NUMVAL_SIZE == 12) && !PARROT_BIGENDIAN static void cvt_num16_num12_be(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) { ASSERT_ARGS(cvt_num16_num12_be) unsigned char b[16]; fetch_buf_be_16(b, src); cvt_num16_num12(dest, b); } #endif /* =item C Converts a big-endian IEEE 754 8-byte double to little-endian IEEE 754 16 byte long double. Untested. =cut */ #if (NUMVAL_SIZE == 16) && !PARROT_BIGENDIAN static void cvt_num8_num16_be(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) { ASSERT_ARGS(cvt_num8_num16_be) unsigned char b[8]; fetch_buf_be_8(b, src); cvt_num8_num16(dest, b); } #endif /* =item C Fetches a 4-byte big-endian opcode. =cut */ PARROT_WARN_UNUSED_RESULT static opcode_t fetch_op_be_4(ARGIN(const unsigned char *b)) { ASSERT_ARGS(fetch_op_be_4) union { unsigned char buf[4]; opcode_t o; } u; fetch_buf_be_4(u.buf, b); #if PARROT_BIGENDIAN # if OPCODE_T_SIZE == 8 return (Parrot_Int4)(u.o >> 32); # else return u.o; # endif #else # if OPCODE_T_SIZE == 8 return (Parrot_Int4)(fetch_iv_le((INTVAL)u.o) & 0xffffffff); # else return (opcode_t) fetch_iv_le((INTVAL)u.o); # endif #endif } /* =item C Fetches an 8-byte big-endian opcode. =cut */ PARROT_WARN_UNUSED_RESULT static opcode_t fetch_op_be_8(ARGIN(const unsigned char *b)) { ASSERT_ARGS(fetch_op_be_8) union { unsigned char buf[8]; opcode_t o[2]; } u; fetch_buf_be_8(u.buf, b); #if PARROT_BIGENDIAN # if OPCODE_T_SIZE == 8 return u.o[0]; # else return u.o[1]; # endif #else return (opcode_t) fetch_iv_le((INTVAL)u.o[0]); #endif } /* =item C Fetches a 4-byte little-endian opcode =cut */ PARROT_WARN_UNUSED_RESULT static opcode_t fetch_op_le_4(ARGIN(const unsigned char *b)) { ASSERT_ARGS(fetch_op_le_4) union { unsigned char buf[4]; opcode_t o; } u; fetch_buf_le_4(u.buf, b); #if PARROT_BIGENDIAN # if OPCODE_T_SIZE == 8 return (Parrot_Int4)(u.o >> 32); # else return (opcode_t) fetch_iv_be((INTVAL)u.o); # endif #else # if OPCODE_T_SIZE == 8 /* without the cast we would not get a negative int, the vtable indices */ return (Parrot_Int4)(u.o & 0xffffffff); # else return u.o; # endif #endif } /* =item C Fetches an 8-byte little-endian opcode =cut */ PARROT_WARN_UNUSED_RESULT static opcode_t fetch_op_le_8(ARGIN(const unsigned char *b)) { ASSERT_ARGS(fetch_op_le_8) union { unsigned char buf[8]; opcode_t o[2]; } u; fetch_buf_le_8(u.buf, b); #if PARROT_BIGENDIAN # if OPCODE_T_SIZE == 8 return u.o[0]; # else return (opcode_t) fetch_op_be((INTVAL)u.o[1]); # endif #else return u.o[0]; #endif } /* =item C Fetches an C from the stream, converting byteorder if needed. When used for freeze/thaw the C argument might be NULL. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL opcode_t PF_fetch_opcode(ARGIN_NULLOK(const PackFile *pf), ARGMOD(const opcode_t **stream)) { ASSERT_ARGS(PF_fetch_opcode) if (!pf || !pf->fetch_op) { return *(*stream)++; } else { const unsigned char *ucstream = *(const unsigned char **)stream; opcode_t o = (pf->fetch_op)(ucstream); ucstream += pf->header->wordsize; *stream = (const opcode_t *)ucstream; return o; } } /* =item C Stores an C to stream as-is. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL opcode_t* PF_store_opcode(ARGOUT(opcode_t *cursor), opcode_t val) { ASSERT_ARGS(PF_store_opcode) *cursor++ = val; return cursor; } /* =item C Returns the size of an item in C units. The size of C is 1 I. =cut */ PARROT_CONST_FUNCTION PARROT_WARN_UNUSED_RESULT size_t PF_size_opcode(void) { ASSERT_ARGS(PF_size_opcode) return 1; } /* =item C Fetches an C from the stream, converting byteorder if needed. XXX assumes C - we don't have C size in the PackFile header. See TT #1047 or RT #56810. =cut */ PARROT_WARN_UNUSED_RESULT INTVAL PF_fetch_integer(ARGIN(PackFile *pf), ARGIN(const opcode_t **stream)) { ASSERT_ARGS(PF_fetch_integer) INTVAL i; if (!pf->fetch_iv) return *(*stream)++; i = (pf->fetch_iv)(*((const unsigned char **)stream)); /* XXX assume sizeof (opcode_t) == sizeof (INTVAL) on the * machine producing this PBC. * * TODO GH #415 on Sparc 64bit: On pbc wordsize=4 but native ptrsize=8 and * ptr_alignment=8 the advance by 4 will signal BUS (invalid address alignment) * in PF_fetch_integer and elsewhere. */ *((const unsigned char **) (stream)) += pf->header->wordsize; return i; } /* =item C Stores an C to stream as is. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL opcode_t* PF_store_integer(ARGOUT(opcode_t *cursor), INTVAL val) { ASSERT_ARGS(PF_store_integer) *cursor++ = (opcode_t)val; /* XXX */ return cursor; } /* =item C Returns stored size of C in C units. =cut */ PARROT_CONST_FUNCTION size_t PF_size_integer(void) { ASSERT_ARGS(PF_size_integer) return sizeof (INTVAL) / sizeof (opcode_t); } /* =item C Fetches a C from the stream, converting byteorder if needed. Then advances the stream pointer by the packfile float size. =cut */ PARROT_WARN_UNUSED_RESULT FLOATVAL PF_fetch_number(ARGIN_NULLOK(PackFile *pf), ARGIN(const opcode_t **stream)) { ASSERT_ARGS(PF_fetch_number) /* When we have alignment all squared away we don't need * to use memcpy() for native byteorder. */ FLOATVAL f; double d; if (!pf || !pf->fetch_nv) { memcpy(&f, (const char *)*stream, sizeof (FLOATVAL)); (*stream) += (sizeof (FLOATVAL) + sizeof (opcode_t) - 1)/ sizeof (opcode_t); return f; } f = (FLOATVAL) 0; /* 12->8 has a messy cast. */ if (NUMVAL_SIZE == 8 && pf->header->floattype == FLOATTYPE_12) { (pf->fetch_nv)((unsigned char *)&d, (const unsigned char *) *stream); f = d; } else { (pf->fetch_nv)((unsigned char *)&f, (const unsigned char *) *stream); } if (pf->header->floattype == FLOATTYPE_8) { *((const unsigned char **) (stream)) += 8; } else if (pf->header->floattype == FLOATTYPE_12) { *((const unsigned char **) (stream)) += 12; } else if (pf->header->floattype == FLOATTYPE_16) { *((const unsigned char **) (stream)) += 16; } else if (pf->header->floattype == FLOATTYPE_16MIPS) { *((const unsigned char **) (stream)) += 16; } else if (pf->header->floattype == FLOATTYPE_16AIX) { *((const unsigned char **) (stream)) += 16; } else if (pf->header->floattype == FLOATTYPE_4) { *((const unsigned char **) (stream)) += 4; } return f; } /* =item C Writes a C to the opcode stream as-is. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL opcode_t* PF_store_number(ARGOUT(opcode_t *cursor), ARGIN(const FLOATVAL *val)) { ASSERT_ARGS(PF_store_number) opcode_t padded_size = (sizeof (FLOATVAL) + sizeof (opcode_t) - 1) / sizeof (opcode_t); memcpy(cursor, val, sizeof (FLOATVAL)); cursor += padded_size; return cursor; } /* =item C Returns stored size of FLOATVAL in C units. =cut */ PARROT_CONST_FUNCTION size_t PF_size_number(void) { ASSERT_ARGS(PF_size_number) return ROUND_UP(sizeof (FLOATVAL), sizeof (opcode_t)); } /* =item C Fetches a buffer (fixed_8 encoded temporary C) from bytecode. Opcode format is: opcode_t size * data When used for freeze/thaw, the C argument might be C. The returned buffer points to the underlying packfile. It should be used and discarded immediately to avoid things changing underneath you. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * PF_fetch_buf(PARROT_INTERP, ARGIN_NULLOK(PackFile *pf), ARGIN(const opcode_t **cursor)) { ASSERT_ARGS(PF_fetch_buf) const int wordsize = pf ? pf->header->wordsize : sizeof (opcode_t); size_t size = PF_fetch_opcode(pf, cursor); STRING *s = Parrot_str_new_init(interp, (const char *)*cursor, size, Parrot_binary_encoding_ptr, PObj_external_FLAG); *((const unsigned char **)(cursor)) += ROUND_UP_B(size, wordsize); return s; } /* =item C Write a buffer (fixed_8 encoded, binary string) to the opcode stream. These are encoded more compactly and read more efficiently than normal strings, but have limitations (see C). =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL opcode_t* PF_store_buf(ARGOUT(opcode_t *cursor), ARGIN(const STRING *s)) { ASSERT_ARGS(PF_store_buf) const int wordsize = sizeof (opcode_t); PARROT_ASSERT(s->encoding == Parrot_binary_encoding_ptr); *cursor++ = s->bufused; if (s->strstart) { char *charcursor = (char *) cursor; memcpy(charcursor, s->strstart, s->bufused); charcursor += s->bufused; /* Pad up to wordsize boundary. */ while ((charcursor - (char *)cursor) % wordsize) *charcursor++ = 0; cursor += (charcursor - (char *)cursor) / wordsize; } return cursor; } /* =item C Reports the stored size of a buffer in C units. =cut */ PARROT_PURE_FUNCTION size_t PF_size_buf(ARGIN(const STRING *s)) { ASSERT_ARGS(PF_size_buf) if (STRING_IS_NULL(s)) return 1; else return PF_size_strlen(s->bufused) - 1; } /* =item C Fetches a C from bytecode and return a new C. Opcode format is: opcode_t flags8 | encoding opcode_t size * data When used for freeze/thaw the C argument might be NULL. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * PF_fetch_string(PARROT_INTERP, ARGIN_NULLOK(PackFile *pf), ARGIN(const opcode_t **cursor)) { ASSERT_ARGS(PF_fetch_string) STRING *s; UINTVAL flags; UINTVAL encoding_nr; const STR_VTABLE *encoding; size_t size; const int wordsize = pf ? pf->header->wordsize : sizeof (opcode_t); opcode_t flag_charset_word = PF_fetch_opcode(pf, cursor); if (flag_charset_word == -1) return STRINGNULL; /* decode flags, charset and encoding */ flags = (flag_charset_word & 0x1 ? PObj_constant_FLAG : 0) | (flag_charset_word & 0x2 ? PObj_private7_FLAG : 0) ; encoding_nr = (flag_charset_word >> 8) & 0xFF; size = (size_t)PF_fetch_opcode(pf, cursor); encoding = Parrot_get_encoding(interp, encoding_nr); if (!encoding) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED, "Invalid encoding number '%d' specified", encoding_nr); if (size || (encoding != CONST_STRING(interp, "")->encoding)) s = Parrot_str_new_init(interp, (const char *)*cursor, size, encoding, flags); else s = CONST_STRING(interp, ""); size = ROUND_UP_B(size, wordsize); *((const unsigned char **) (cursor)) += size; return s; } /* =item C Writes a C to the opcode stream. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL opcode_t* PF_store_string(ARGOUT(opcode_t *cursor), ARGIN(const STRING *s)) { ASSERT_ARGS(PF_store_string) opcode_t padded_size = s->bufused; char *charcursor; if (padded_size % sizeof (opcode_t)) { padded_size += sizeof (opcode_t) - (padded_size % sizeof (opcode_t)); } if (STRING_IS_NULL(s)) { /* preserve NULL-ness of strings */ *cursor++ = -1; return cursor; } /* * TODO as soon as we have dynamically loadable charsets * we have to store the charset name, not the number * * TODO encoding * * see also PF_fetch_string */ /* encode charset_nr, encoding_nr and flags into the same word */ *cursor++ = (Parrot_encoding_number_of_str(NULL, s) << 8) | (PObj_get_FLAGS(s) & PObj_constant_FLAG ? 0x1 : 0x0) | (PObj_get_FLAGS(s) & PObj_private7_FLAG ? 0x2 : 0x0) ; *cursor++ = s->bufused; /* Switch to char * since rest of string is addressed by * characters to ensure padding. */ charcursor = (char *)cursor; if (s->strstart) { memcpy(charcursor, s->strstart, s->bufused); charcursor += s->bufused; /* Pad up to sizeof (opcode_t) boundary. */ while ((unsigned long) (charcursor - (char *) cursor) % sizeof (opcode_t)) { *charcursor++ = 0; } } PARROT_ASSERT(((unsigned long) (charcursor - (char *) cursor) % sizeof (opcode_t)) == 0); cursor += (charcursor - (char *) cursor) / sizeof (opcode_t); return cursor; } /* =item C Reports stored size of C in C units. =cut */ PARROT_PURE_FUNCTION size_t PF_size_string(ARGIN(const STRING *s)) { ASSERT_ARGS(PF_size_string) /* TODO: don't break encapsulation on strings */ const UINTVAL len = s->bufused; if (STRING_IS_NULL(s)) return 1; else return PF_size_strlen(len); } /* =item C Reports stored size of C in C units given its in-memory byte length. =cut */ PARROT_CONST_FUNCTION PARROT_WARN_UNUSED_RESULT size_t PF_size_strlen(const UINTVAL len) { ASSERT_ARGS(PF_size_strlen) opcode_t padded_size = len; if (padded_size % sizeof (opcode_t)) { padded_size += sizeof (opcode_t) - (padded_size % sizeof (opcode_t)); } /* Include space for flags, representation, and size fields. */ return 2 + (size_t)padded_size / sizeof (opcode_t); } /* =item C Fetches a cstring from bytecode and returns an allocated copy =cut */ PARROT_MALLOC PARROT_CANNOT_RETURN_NULL char * PF_fetch_cstring(PARROT_INTERP, ARGIN(PackFile *pf), ARGIN(const opcode_t **cursor)) { ASSERT_ARGS(PF_fetch_cstring) const size_t str_len = strlen((const char *)(*cursor)) + 1; char * const p = mem_gc_allocate_n_typed(interp, str_len, char); const int wordsize = pf->header->wordsize; strcpy(p, (const char*) (*cursor)); *((const unsigned char **) (cursor)) += ROUND_UP_B(str_len, wordsize); return p; } /* =item C Writes a C-terminated string to the stream. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL opcode_t* PF_store_cstring(ARGOUT(opcode_t *cursor), ARGIN(const char *s)) { ASSERT_ARGS(PF_store_cstring) /* * This is not very efficient for filling padding with zeros. * But it's more efficient than calculate strlen twice. */ size_t store_size = PF_size_cstring(s); memset((char *) cursor, 0, store_size * sizeof (opcode_t)); strcpy((char *) cursor, s); return cursor + store_size; } /* =item C Returns store size of a C-string in C units. =cut */ PARROT_PURE_FUNCTION size_t PF_size_cstring(ARGIN(const char *s)) { ASSERT_ARGS(PF_size_cstring) size_t str_len; PARROT_ASSERT(s); str_len = strlen(s); return ROUND_UP(str_len + 1, sizeof (opcode_t)); } /* =item C Assigns transform functions to the vtable. =cut */ void PackFile_assign_transforms(ARGMOD(PackFile *pf)) { ASSERT_ARGS(PackFile_assign_transforms) const int need_endianize = pf->header->byteorder != PARROT_BIGENDIAN; const int need_wordsize = pf->header->wordsize != sizeof (opcode_t); pf->need_endianize = need_endianize; pf->need_wordsize = need_wordsize; #if PARROT_BIGENDIAN /* this Parrot is on a BIG ENDIAN machine */ if (need_endianize) { if (pf->header->wordsize == 4) pf->fetch_op = fetch_op_le_4; else pf->fetch_op = fetch_op_le_8; pf->fetch_iv = pf->fetch_op; switch (pf->header->floattype) { # if NUMVAL_SIZE == 8 case FLOATTYPE_8: pf->fetch_nv = fetch_buf_le_8; break; case FLOATTYPE_12: pf->fetch_nv = cvt_num12_num8_le; break; case FLOATTYPE_16: pf->fetch_nv = cvt_num16_num8_le; break; # endif # if NUMVAL_SIZE == 16 case FLOATTYPE_8: pf->fetch_nv = cvt_num8_num16_le; break; case FLOATTYPE_12: pf->fetch_nv = cvt_num12_num16_le; break; case FLOATTYPE_16: pf->fetch_nv = fetch_buf_le_16; break; # endif default: Parrot_x_force_error_exit(NULL, 1, "PackFile_unpack: unsupported float conversion %d to %d, " "PARROT_BIGENDIAN=%d\n", NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN); break; } return; } else { /* no need_endianize */ if (pf->header->wordsize == 4) pf->fetch_op = fetch_op_be_4; else pf->fetch_op = fetch_op_be_8; pf->fetch_iv = pf->fetch_op; switch (pf->header->floattype) { # if NUMVAL_SIZE == 8 case FLOATTYPE_8: /* native */ break; case FLOATTYPE_12: pf->fetch_nv = cvt_num12_num8; break; case FLOATTYPE_16: pf->fetch_nv = cvt_num16_num8; break; # endif # if NUMVAL_SIZE == 16 case FLOATTYPE_8: pf->fetch_nv = cvt_num8_num16; break; case FLOATTYPE_12: pf->fetch_nv = cvt_num12_num16; break; case FLOATTYPE_16: /* native */ break; # endif default: Parrot_x_force_error_exit(NULL, 1, "PackFile_unpack: unsupported float conversion %d to %d, " "PARROT_BIGENDIAN=%d\n", NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN); break; } return; } #else /* ENDIAN */ /* this Parrot is on a LITTLE ENDIAN machine */ if (need_endianize) { if (pf->header->wordsize == 4) pf->fetch_op = fetch_op_be_4; else pf->fetch_op = fetch_op_be_8; pf->fetch_iv = pf->fetch_op; switch (pf->header->floattype) { # if NUMVAL_SIZE == 8 case FLOATTYPE_8: pf->fetch_nv = fetch_buf_be_8; break; case FLOATTYPE_12: Parrot_x_force_error_exit(NULL, 1, "PackFile_unpack: invalid floattype 1 big-endian"); break; case FLOATTYPE_16: pf->fetch_nv = cvt_num16_num8_be; break; # endif # if NUMVAL_SIZE == 12 case FLOATTYPE_8: pf->fetch_nv = cvt_num8_num12_be; break; case FLOATTYPE_12: Parrot_x_force_error_exit(NULL, 1, "PackFile_unpack: invalid floattype 1 big-endian"); break; case FLOATTYPE_16: pf->fetch_nv = cvt_num16_num12_be; break; # endif # if NUMVAL_SIZE == 16 case FLOATTYPE_8: pf->fetch_nv = cvt_num8_num16_be; break; case FLOATTYPE_12: Parrot_x_force_error_exit(NULL, 1, "PackFile_unpack: invalid floattype 1 big-endian"); break; case FLOATTYPE_16: pf->fetch_nv = fetch_buf_be_16; break; # endif default: Parrot_x_force_error_exit(NULL, 1, "PackFile_unpack: unsupported float conversion %d to %d, " "PARROT_BIGENDIAN=%d\n", NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN); break; } return; } else { if (pf->header->wordsize == 4) pf->fetch_op = fetch_op_le_4; else pf->fetch_op = fetch_op_le_8; pf->fetch_iv = pf->fetch_op; switch (pf->header->floattype) { # if NUMVAL_SIZE == 8 case FLOATTYPE_8: /* native */ break; case FLOATTYPE_12: pf->fetch_nv = cvt_num12_num8; break; case FLOATTYPE_16: pf->fetch_nv = cvt_num16_num8; break; # endif # if NUMVAL_SIZE == 12 case FLOATTYPE_8: pf->fetch_nv = cvt_num8_num12; break; case FLOATTYPE_12: /* native */ break; case FLOATTYPE_16: pf->fetch_nv = cvt_num16_num12; break; # endif # if NUMVAL_SIZE == 16 case FLOATTYPE_8: pf->fetch_nv = cvt_num8_num16; break; case FLOATTYPE_12: pf->fetch_nv = cvt_num12_num16; break; case FLOATTYPE_16: /* native */ break; # endif default: Parrot_x_force_error_exit(NULL, 1, "PackFile_unpack: unsupported float conversion %d to %d, " "PARROT_BIGENDIAN=%d\n", NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN); break; } return; } #endif } /* =item C This function converts a 4 or 8 byte C into little endian format. If the native format is already little endian, then no conversion is done. =cut */ PARROT_INLINE PARROT_WARN_UNUSED_RESULT PARROT_CONST_FUNCTION static INTVAL fetch_iv_le(INTVAL w) { ASSERT_ARGS(fetch_iv_le) #if !PARROT_BIGENDIAN return w; #else # if INTVAL_SIZE == 4 return (w << 24) | ((w & 0xff00) << 8) | ((w & 0xff0000) >> 8) | (w >> 24); # else # if INTVAL_SIZE == 8 INTVAL r; r = w << 56; r |= (w & 0xff00) << 40; r |= (w & 0xff0000) << 24; r |= (w & 0xff000000) << 8; r |= (w & 0xff00000000) >> 8; r |= (w & 0xff0000000000) >> 24; r |= (w & 0xff000000000000) >> 40; r |= (w & 0xff00000000000000) >> 56; return r; # else Parrot_x_force_error_exit(NULL, 1, "Unsupported INTVAL_SIZE=%d\n", INTVAL_SIZE); # endif # endif #endif } /* =item C This function converts a 4 or 8 byte C into big endian format. If the native format is already big endian, then no conversion is done. =cut */ PARROT_INLINE PARROT_WARN_UNUSED_RESULT PARROT_CONST_FUNCTION static INTVAL fetch_iv_be(INTVAL w) { ASSERT_ARGS(fetch_iv_be) #if PARROT_BIGENDIAN return w; #else # if INTVAL_SIZE == 4 return (w << 24) | ((w & 0xff00) << 8) | ((w & 0xff0000) >> 8) | (w >> 24); # else # if INTVAL_SIZE == 8 INTVAL r; r = w << 56; r |= (w & 0xff00) << 40; r |= (w & 0xff0000) << 24; r |= (w & 0xff000000) << 8; r |= (w & 0xff00000000) >> 8; r |= (w & 0xff0000000000) >> 24; r |= (w & 0xff000000000000) >> 40; r |= (w & 0xff00000000000000) >> 56; return r; # else Parrot_x_force_error_exit(NULL, 1, "Unsupported INTVAL_SIZE=%d\n", INTVAL_SIZE); # endif # endif #endif } /* =item C Same as C for opcode_t =cut */ PARROT_INLINE PARROT_WARN_UNUSED_RESULT PARROT_CONST_FUNCTION static opcode_t fetch_op_be(opcode_t w) { ASSERT_ARGS(fetch_op_be) #if PARROT_BIGENDIAN return w; #else # if OPCODE_T_SIZE == 4 return (w << 24) | ((w & 0x0000ff00) << 8) | ((w & 0x00ff0000) >> 8) | ((w & 0xff000000) >> 24); # else opcode_t r; r = w << 56; r |= (w & 0xff00) << 40; r |= (w & 0xff0000) << 24; r |= (w & 0xff000000) << 8; r |= (w & 0xff00000000) >> 8; r |= (w & 0xff0000000000) >> 24; r |= (w & 0xff000000000000) >> 40; r |= (w & 0xff00000000000000) >> 56; return r; # endif #endif } /* =item C Same as C for opcode_t =cut */ PARROT_INLINE PARROT_WARN_UNUSED_RESULT PARROT_CONST_FUNCTION static opcode_t fetch_op_le(opcode_t w) { ASSERT_ARGS(fetch_op_le) #if !PARROT_BIGENDIAN return w; #else # if OPCODE_T_SIZE == 4 return (w << 24) | ((w & 0x0000ff00) << 8) | ((w & 0x00ff0000) >> 8) | ((w & 0xff000000) >> 24); # else opcode_t r; r = w << 56; r |= (w & 0xff00) << 40; r |= (w & 0xff0000) << 24; r |= (w & 0xff000000) << 8; r |= (w & 0xff00000000) >> 8; r |= (w & 0xff0000000000) >> 24; r |= (w & 0xff000000000000) >> 40; r |= (w & 0xff00000000000000) >> 56; return r; # endif #endif } /* =pod Unrolled routines for swapping various sizes from 32-128 bits. These should only be used if alignment is unknown or we are pulling something out of a padded buffer. =cut */ /* =item C Converts a 4-byte big-endian buffer C into a little-endian C. =cut */ PARROT_INLINE static void fetch_buf_be_4(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) { ASSERT_ARGS(fetch_buf_be_4) #if PARROT_BIGENDIAN memcpy(rb, b, 4); #else rb[0] = b[3]; rb[1] = b[2]; rb[2] = b[1]; rb[3] = b[0]; #endif } /* =item C Converts a 4-byte little-endian buffer C into a big-endian buffer C. =cut */ PARROT_INLINE static void fetch_buf_le_4(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) { ASSERT_ARGS(fetch_buf_le_4) #if !PARROT_BIGENDIAN memcpy(rb, b, 4); #else rb[0] = b[3]; rb[1] = b[2]; rb[2] = b[1]; rb[3] = b[0]; #endif } /* =item C Converts an 8-byte big-endian buffer C into a little-endian buffer C =cut */ PARROT_INLINE static void fetch_buf_be_8(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) { ASSERT_ARGS(fetch_buf_be_8) #if PARROT_BIGENDIAN memcpy(rb, b, 8); #else rb[0] = b[7]; rb[1] = b[6]; rb[2] = b[5]; rb[3] = b[4]; rb[4] = b[3]; rb[5] = b[2]; rb[6] = b[1]; rb[7] = b[0]; #endif } /* =item C Converts an 8-byte little-endian buffer C into a big-endian buffer C. =cut */ PARROT_INLINE static void fetch_buf_le_8(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) { ASSERT_ARGS(fetch_buf_le_8) #if !PARROT_BIGENDIAN memcpy(rb, b, 8); #else rb[0] = b[7]; rb[1] = b[6]; rb[2] = b[5]; rb[3] = b[4]; rb[4] = b[3]; rb[5] = b[2]; rb[6] = b[1]; rb[7] = b[0]; #endif } /* =item C Converts a 12-byte little-endian buffer C into a big-endian buffer C. =cut */ PARROT_INLINE static void fetch_buf_le_12(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) { ASSERT_ARGS(fetch_buf_le_12) #if !PARROT_BIGENDIAN memcpy(rb, b, 12); #else rb[0] = b[11]; rb[1] = b[10]; rb[2] = b[9]; rb[3] = b[8]; rb[4] = b[7]; rb[5] = b[6]; rb[6] = b[5]; rb[7] = b[4]; rb[8] = b[3]; rb[9] = b[2]; rb[10] = b[1]; rb[11] = b[0]; #endif } /* =item C Converts a 12-byte big-endian buffer C into a little-endian buffer C. =cut */ PARROT_INLINE static void fetch_buf_be_12(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) { ASSERT_ARGS(fetch_buf_be_12) #if PARROT_BIGENDIAN memcpy(rb, b, 12); #else rb[0] = b[11]; rb[1] = b[10]; rb[2] = b[9]; rb[3] = b[8]; rb[4] = b[7]; rb[5] = b[6]; rb[6] = b[5]; rb[7] = b[4]; rb[8] = b[3]; rb[9] = b[2]; rb[10] = b[1]; rb[11] = b[0]; #endif } /* =item C Converts a 16-byte little-endian buffer C into a big-endian buffer C. =cut */ PARROT_INLINE static void fetch_buf_le_16(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) { ASSERT_ARGS(fetch_buf_le_16) #if !PARROT_BIGENDIAN memcpy(rb, b, 16); #else rb[0] = b[15]; rb[1] = b[14]; rb[2] = b[13]; rb[3] = b[12]; rb[4] = b[11]; rb[5] = b[10]; rb[6] = b[9]; rb[7] = b[8]; rb[8] = b[7]; rb[9] = b[6]; rb[10] = b[5]; rb[11] = b[4]; rb[12] = b[3]; rb[13] = b[2]; rb[14] = b[1]; rb[15] = b[0]; #endif } /* =item C Converts a 16-byte big-endian buffer C into a little-endian buffer C. =cut */ PARROT_INLINE static void fetch_buf_be_16(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) { ASSERT_ARGS(fetch_buf_be_16) #if PARROT_BIGENDIAN memcpy(rb, b, 16); #else rb[0] = b[15]; rb[1] = b[14]; rb[2] = b[13]; rb[3] = b[12]; rb[4] = b[11]; rb[5] = b[10]; rb[6] = b[9]; rb[7] = b[8]; rb[8] = b[7]; rb[9] = b[6]; rb[10] = b[5]; rb[11] = b[4]; rb[12] = b[3]; rb[13] = b[2]; rb[14] = b[1]; rb[15] = b[0]; #endif } /* =item C Converts a 32-byte little-endian buffer C into a big-endian buffer C. =cut */ PARROT_INLINE static void fetch_buf_le_32(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) { ASSERT_ARGS(fetch_buf_le_32) #if !PARROT_BIGENDIAN memcpy(rb, b, 32); #else rb[0] = b[31]; rb[1] = b[30]; rb[2] = b[29]; rb[3] = b[28]; rb[4] = b[27]; rb[5] = b[26]; rb[6] = b[25]; rb[7] = b[24]; rb[8] = b[23]; rb[9] = b[22]; rb[10] = b[21]; rb[11] = b[20]; rb[12] = b[19]; rb[13] = b[18]; rb[14] = b[17]; rb[15] = b[16]; rb[16] = b[15]; rb[17] = b[14]; rb[18] = b[13]; rb[19] = b[12]; rb[20] = b[11]; rb[21] = b[10]; rb[22] = b[9]; rb[23] = b[8]; rb[24] = b[7]; rb[25] = b[6]; rb[26] = b[5]; rb[27] = b[4]; rb[28] = b[3]; rb[29] = b[2]; rb[30] = b[1]; rb[31] = b[0]; #endif } /* =item C Converts a 32-byte big-endian buffer C into a little-endian buffer C. =cut */ PARROT_INLINE static void fetch_buf_be_32(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) { ASSERT_ARGS(fetch_buf_be_32) #if PARROT_BIGENDIAN memcpy(rb, b, 32); #else rb[0] = b[31]; rb[1] = b[30]; rb[2] = b[29]; rb[3] = b[28]; rb[4] = b[27]; rb[5] = b[26]; rb[6] = b[25]; rb[7] = b[24]; rb[8] = b[23]; rb[9] = b[22]; rb[10] = b[21]; rb[11] = b[20]; rb[12] = b[19]; rb[13] = b[18]; rb[14] = b[17]; rb[15] = b[16]; rb[16] = b[15]; rb[17] = b[14]; rb[18] = b[13]; rb[19] = b[12]; rb[20] = b[11]; rb[21] = b[10]; rb[22] = b[9]; rb[23] = b[8]; rb[24] = b[7]; rb[25] = b[6]; rb[26] = b[5]; rb[27] = b[4]; rb[28] = b[3]; rb[29] = b[2]; rb[30] = b[1]; rb[31] = b[0]; #endif } /* =back =head1 TODO C<()>> - write an opcode_t stream to cursor in natural byte-ordering. C<()>> - read items and possibly convert the foreign format. C<()>> - return the needed size in C units. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ io.t000644000765000765 2562112101554067 15602 0ustar00brucebruce000000000000parrot-5.9.0/t/dynoplibs#!./parrot # Copyright (C) 2008-2011, Parrot Foundation. =head1 NAME t/op/io.t - Testing io opcodes =head1 SYNOPSIS % prove t/op/io.t =head1 DESCRIPTION Tests various io opcodes. =cut .loadlib 'io_ops' .sub 'main' :main .include 'test_more.pir' plan(59) read_on_null() test_bad_open() open_pipe_for_reading() getfd_fdopen() test_fdopen_p_i_sc() test_fdopen_p_ic_s() test_fdopen_p_ic_sc() test_fdopen_p_i_s() test_open_p_s_s() test_seek_tell() test_peek() test_read() printerr_tests() stat_tests() stdout_tests() # must come after (these don't use test_more) open_pipe_for_writing() read_invalid_fh() .end .sub 'test_bad_open' null $S0 throws_substring(<<"CODE", "Invalid open", "bad open_p_s_s") .sub main $P0 = open $S0, $S0 .end CODE throws_substring(<<"CODE", "Invalid open", "bad open_p_sc_s") .sub main $P0 = open "", $S0 .end CODE throws_substring(<<"CODE", "Invalid open", "bad open_p_s_sc") .sub main $P0 = open $S0, "" .end CODE # throws_substring(<<"CODE", "Invalid open", "bad open_p_sc_sc") # .sub main # $P0 = open "", "" # .end #CODE throws_substring(<<"CODE", "Invalid open", "bad open_p_s") .sub main $P0 = open $S0 .end CODE # throws_substring(<<"CODE", "Invalid open", "bad open_p_sc") # .sub main # $P0 = open "" # .end #CODE .end .loadlib 'sys_ops' .sub 'tt661_todo_test' :anon # As of r41963, these tests need to be todo'ed at least on Win32. Add new # platforms known to fail. .include 'sysinfo.pasm' $S0 = sysinfo .SYSINFO_PARROT_OS if $S0 == 'MSWin32' goto tt661_todo .return (0) tt661_todo: .return (1) .end .include 'iglobals.pasm' .sub 'open_pipe_for_reading' .local pmc interp interp = getinterp .local pmc conf conf = interp[.IGLOBALS_CONFIG_HASH] .local string command command = '"' $S0 = conf['build_dir'] command .= $S0 .local string aux aux = conf['slash'] command .= aux aux = conf['test_prog'] command .= aux aux = conf['exe'] command .= aux command .= '" -V' .local pmc pipe pipe = open command, 'rp' unless pipe goto open_pipe_for_reading_failed .local string line line = readline pipe line = substr line, 0, 14 is('This is Parrot', line, 'open pipe for reading') .return () open_pipe_for_reading_failed: nok(1, 'open pipe for reading') .return () .end .sub 'open_pipe_for_writing' $I0 = tt661_todo_test() if $I0 goto open_pipe_for_writing_todoed .local pmc interp interp = getinterp .local pmc conf conf = interp[.IGLOBALS_CONFIG_HASH] .local string command .local string aux command = '"' aux = conf['build_dir'] command .= aux aux = conf['slash'] command .= aux .local string filename filename .= command filename .= 'examples/pasm/cat.pasm' aux = conf['test_prog'] command .= aux aux = conf['exe'] command .= aux command .= '" ' command .= filename command .= '"' .local pmc pipe pipe = open command, 'wp' unless pipe goto open_pipe_for_writing_failed ok(1, 'open pipe for writing') close pipe .return () open_pipe_for_writing_failed: nok(1, 'open pipe for writing') .return () open_pipe_for_writing_todoed: todo(0, 'Unimplemented in this platform, TT #661') .end # GH #465 .sub 'getfd_fdopen' getstdout $P0 $I0 = $P0.'get_fd'() fdopen $P1, $I0, 'w' $I0 = defined $P1 ok($I0, 'fdopen - no close') .end .sub 'test_fdopen_p_i_sc' $I0 = 1 fdopen $P0, $I0, 'w' $I0 = defined $P0 ok($I0, 'fdopen_p_i_sc') fdopen $P0, $I0, '' $I0 = defined $P0 is($I0, 0, 'bad fdopen_p_i_sc') .end .sub 'test_fdopen_p_ic_s' $S0 = 'w' $S1 = '' fdopen $P0, 1, $S0 $I0 = defined $P0 ok($I0, 'fdopen_p_ic_s') fdopen $P0, 1, $S1 $I0 = defined $P0 is($I0, 0, 'bad fdopen_p_ic_s') .end .sub 'test_fdopen_p_ic_sc' fdopen $P0, 1, 'w' $I0 = defined $P0 ok($I0, 'fdopen_p_ic_sc') fdopen $P0, 1, '' $I0 = defined $P0 is($I0, 0, 'bad fdopen_p_ic_sc') .end .sub 'test_fdopen_p_i_s' getstdout $P0 $S0 = 'w' $S1 = '' $I0 = $P0.'get_fd'() fdopen $P1, $I0, $S0 $I0 = defined $P1 ok($I0, 'fdopen_p_i_s') fdopen $P0, $I0, $S1 $I0 = defined $P0 is($I0, 0, 'bad fdopen_p_i_sc') .end .sub 'test_open_p_s_s' $S0 = "README.pod" $S1 = "r" $P0 = open $S0, $S1 $I0 = defined $P0 ok($I0, "open_p_s_s") .end .sub 'test_seek_tell' $S0 = 'r' $P0 = open "README.pod", $S0 $I0 = tell $P0 is( $I0, 0, 'tell_i_p' ) $I0 = 4 # offset $I1 = 1 # from current pos $I4 = -10 # bad number seek $P0, $I0, $I1 $I2 = tell $P0 is( $I2, $I0, 'seek_p_i_i' ) throws_substring(<<"CODE", "seek failed (32bit)", "bad seek_p_i_i") .sub main seek $P0, $I4, $I4 .end CODE seek $P0, 4, $I1 $I2 = tell $P0 is( $I2, 8, 'seek_p_ic_i' ) throws_substring(<<"CODE", "seek failed (32bit)", "bad seek_p_ic_i") .sub main seek $P0, -10, $I4 .end CODE seek $P0, $I0, 1 $I2 = tell $P0 is( $I2, 12, 'seek_p_i_ic' ) throws_substring(<<"CODE", "seek failed (32bit)", "bad seek_p_i_ic") .sub main seek $P0, $I4, -10 .end CODE seek $P0, 4, 1 $I2 = tell $P0 is( $I2, 16, 'seek_p_ic_ic' ) throws_substring(<<"CODE", "seek failed (32bit)", "bad seek_p_ic_ic") .sub main seek $P0, -10, -10 .end CODE seek $P0, 0, $I0, $I1 $I2 = tell $P0 is( $I2, 20, 'seek_p_ic_i_i' ) throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_ic_i_i") .sub main seek $P0, -10, $I4, $I4 .end CODE $I3 = 0 # high order intval seek $P0, $I3, $I0, $I1 $I2 = tell $P0 is( $I2, 24, 'seek_p_i_i_i' ) throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_i_i_i") .sub main seek $P0, $I4, $I4, $I4 .end CODE seek $P0, $I3, 4, $I1 $I2 = tell $P0 is( $I2, 28, 'seek_p_i_ic_i' ) throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_i_ic_i") .sub main seek $P0, $I4, -10, $I4 .end CODE seek $P0, 0, 4, $I1 $I2 = tell $P0 is( $I2, 32, 'seek_p_ic_ic_i' ) throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_ic_ic_i") .sub main seek $P0, -10, -10, $I4 .end CODE seek $P0, $I3, $I0, 1 $I2 = tell $P0 is( $I2, 36, 'seek_p_i_i_ic' ) throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_i_i_ic") .sub main seek $P0, $I4, $I4, -10 .end CODE seek $P0, 0, $I0, 1 $I2 = tell $P0 is( $I2, 40, 'seek_p_ic_i_ic' ) throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_ic_i_ic") .sub main seek $P0, -10, $I4, -10 .end CODE seek $P0, $I3, 4, 1 $I2 = tell $P0 is( $I2, 44, 'seek_p_i_ic_ic' ) throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_i_ic_ic") .sub main seek $P0, $I4, -10, -10 .end CODE seek $P0, 0, 4, 1 $I2 = tell $I5, $P0 is( $I5, 48, 'seek_p_i_ic_ic' ) throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_i_ic_ic") .sub main seek $P0, -10, -10, -10 .end CODE .end .sub 'test_peek' .include 'stat.pasm' $I0 = stat 'README.pod', .STAT_FILESIZE $P0 = open 'README.pod', 'r' close $P0 $P1 = getstdin setstdin $P0 $S0 = peek $I1 = isnull $S0 ok($I1, 'can peek_s closed file') $S0 = peek $P0 $I1 = isnull $S0 ok($I1, 'can peek_s_p closed file') setstdin $P1 .end .sub 'test_read' getstdin $P1 $P0 = open 'README.pod', 'r' $I0 = 4 setstdin $P0 ok(1, 'can setstdin') $S0 = read $I0 $I1 = tell $P0 is( $I1, 4, 'read_s_i' ) $S0 = read 4 $I1 = tell $P0 is( $I1, 8, 'read_s_ic' ) setstdin $P1 $S0 = read $P0, $I0 $I1 = tell $P0 is( $I1, 12, 'read_s_p_i' ) $S0 = read $P0, 4 $I1 = tell $P0 is( $I1, 16, 'read_s_p_i' ) .end .sub 'read_on_null' .const string description = "read on null PMC throws exception" push_eh eh null $P1 $S0 = read $P1, 1 ok(0, description) goto ret eh: ok(1, description) ret: pop_eh .return () .end .sub 'read_invalid_fh' $P0 = new ['FileHandle'] push_eh _readline_handler $S0 = readline $P0 print "not " _readline_handler: ok(1, '_readline_handler') pop_eh push_eh _read_handler $S0 = read $P0, 1 print "not " _read_handler: ok(1, '_read_handler') pop_eh push_eh _print_handler print $P0, "kill me now\n" print "not " _print_handler: ok(1, '_print_handler') pop_eh .end .sub 'printerr_tests' # temporarily capture stderr $P0 = getstderr $P1 = new ['StringHandle'] $S0 = null $P1.'open'($S0, 'w') setstderr $P1 $I1 = 10 $N1 = 1.0 $S1 = "foo" $P2 = new ['String'] $P2 = "This is a test\n" printerr 10 printerr "\n" printerr $I1 printerr "\n" printerr 1.0 printerr "\n" printerr $N1 printerr "\n" printerr "foo" printerr "\n" printerr $S1 printerr "\n" printerr $P2 # restore stderr setstderr $P0 $S0 = $P1.'readall'() is($S0, <<'OUTPUT', 'printerr opcode') 10 10 1 1 foo foo This is a test OUTPUT .end .sub 'stat_tests' .const string description = 'stat failed' .include "stat.pasm" $S0 = sysinfo .SYSINFO_PARROT_OS if $S0 == 'MSWin32' goto run_win32_stat_tests goto run_unix_stat_tests run_win32_stat_tests: $I0 = stat "parrot.exe", .STAT_FILESIZE ok(1, 'can stat_i_sc_ic') $S0 = 'parrot.exe' $I0 = stat $S0, $I1 ok(1, 'can stat_i_s_i') $I1 = .STAT_FILESIZE $I0 = stat 'parrot.exe', $I1 ok(1, 'can stat_i_sc_i') goto done_stat_filename_tests run_unix_stat_tests: $I0 = stat "parrot", .STAT_FILESIZE ok(1, 'can stat_i_sc_ic') $S0 = 'parrot' $I0 = stat $S0, $I1 ok(1, 'can stat_i_s_i') $I1 = .STAT_FILESIZE $I0 = stat 'parrot', $I1 ok(1, 'can stat_i_sc_i') done_stat_filename_tests: throws_substring(<<"CODE", description, "bad stat_i_sc_ic") .sub main $I0 = stat 'no_such_file', .STAT_FILESIZE .end CODE throws_substring(<<"CODE", description, "bad stat_i_s_i") .sub main $I1 = .STAT_FILESIZE $S0 = 'no_such_file' $I0 = stat $S0, $I1 .end CODE .end .sub stdout_tests .local pmc os os = new 'OS' $P0 = getstdout $P1 = open 'test_file', 'w' setstdout $P1 say 'test' setstdout $P0 close $P1 $P1 = open 'test_file', 'r' $S0 = $P1.'read'(4) close $P1 os.'rm'('test_file') is($S0, 'test', 'setstdout') .end .namespace ["Testing"] .sub open :method .param pmc args :slurpy .return(42) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: foo2.t000644000765000765 113111533177644 15307 0ustar00brucebruce000000000000parrot-5.9.0/t/dynpmc#!./parrot # Copyright (C) 2009-2010, Parrot Foundation. =head1 NAME t/dynpmc/foo2.t - Test for a very simple dynamic PMC =head1 SYNOPSIS % prove t/dynpmc/foo2.t =head1 DESCRIPTION Tests the Foo PMC. =cut .sub main :main .include 'test_more.pir' plan(1) test_dynpmcs_can_use_super() .end .sub test_dynpmcs_can_use_super $P0 = loadlib 'foo_group' $P1 = new "Foo2" $I1 = $P1 is($I1, 43, 'dynpmcs can use SUPER to call parent dynpmc VTABLE functions') .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: md5sum.pir000644000765000765 323012101554066 17717 0ustar00brucebruce000000000000parrot-5.9.0/examples/library# Copyright (C) 2005-2009, Parrot Foundation. =head1 NAME examples/library/md5sum.pir - calculate MD5 checksums =head1 SYNOPSIS % ./parrot examples/library/md5sum.pir filename [filename ...] =head1 DESCRIPTION The main purpose of this script is testing the Digest/MD5.pir library. It should behave very much like md5sum(1). Running parrot with C<-R jit> will give a significant performance boost (often about ten-fold). =head1 AUTHOR Nick Glencross - Leopold Toetsch - =cut .sub _main :main .param pmc args .local int size load_bytecode "Digest/MD5.pbc" # Argument count $I0 = args $I0 = $I0 - 1 if $I0 > 0 goto has_args $S0 = args[0] print "(parrot) " print $S0 print " filename [filename ...]\n" exit 1 has_args: $I1 = 1 next_iter: if $I1 > $I0 goto iter_done .local string file file = args[$I1] .include "stat.pasm" # Get size of file .local pmc os, stat_buf os = new ['OS'] stat_buf = os.'stat'(file) size = stat_buf[7] .local pmc pio, cl cl = new 'FileHandle' # slurp the file into memory .local string contents contents = cl.'readall'(file) $I2 = length contents if $I2 == size goto size_ok print file print ": size mismatch (" print size print " vs " print $I2 print ")\n" goto iter_cont size_ok: $P0 = _md5sum (contents) _md5_print ($P0) print "\t" print file print "\n" iter_cont: $I1 = $I1 + 1 goto next_iter iter_done: .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: parrot_config.pod000644000765000765 142712101554066 20601 0ustar00brucebruce000000000000parrot-5.9.0/docs/binaries# Copyright (C) 2011, Parrot Foundation. =head1 Name parrot_config - Parrot Configuration =head1 DESCRIPTION parrot_config can be used find out compile-time configuration information about the Parrot executable. =head1 SYNOPSIS To print every available key: parrot_config --dump With specific key it will print only it's corresponding value. To get the current version of Parrot: parrot_config VERSION To get a descriptive version string that will uniquely identify commits which are not releases: parrot_config git_describe =head1 Help For more help or any other question you go to L or L.Or you can send email to 'parrot-dev@parrot.org'. You can also join Parrot IRC channel: #parrot on irc.parrot.org . =cut parrot.el000644000765000765 151311533177634 15642 0ustar00brucebruce000000000000parrot-5.9.0/editor;;; Emacs support for working on the source code of the Parrot virtual ;;; machine. ;; ;; Note that the support for editing pasm files is currently in the separate ;; file "pasm.el". This file is for editing the Parrot VM source. ;; ;; To use this file, copy it to a known location and add this statement to ;; your .emacs file: ;; ;; (load-file "/known/location/parrot.el") ;; (c-add-style "parrot" '("stroustrup" (indent-tabs-mode . nil) (fill-column . 100) (c-offsets-alist . ( (label . *) (access-label . *) (case-label . *) (statement-case-intro . *) (inextern-lang . 0) )))) (setq auto-mode-alist (cons '("\\.pmc$" . c-mode) auto-mode-alist)) (setq auto-mode-alist (cons '("\\.ops$" . perl-mode) auto-mode-alist)) UseParrotCoda.pm000644000765000765 474511533177636 24004 0ustar00brucebruce000000000000parrot-5.9.0/lib/Perl/Critic/Policy/CodeLayoutpackage Perl::Critic::Policy::CodeLayout::UseParrotCoda; # Copyright (C) 2006-2007, Parrot Foundation. use strict; use warnings; use Perl::Critic::Utils; use Perl::Critic::Violation; use base 'Perl::Critic::Policy'; =head1 NAME Perl::Critic::Policy::CodeLayout::UseParrotCoda =head1 DESCRIPTION The pumpking has declared that all parrot source code must include a series of comments at the end of the source. After much discussion C<__END__> and C<__DATA__> blocks are exempt from this policy. =cut our $VERSION = '0.1'; $VERSION = eval $VERSION; ## no critic my $desc = q{Missing properly located perl coda for parrot source}; my $expl = q{According to PDD07, all perl source in parrot must contain a comment coda}; #---------------------------------------------------------------------------- sub default_severity { return $SEVERITY_LOW } sub applies_to { return 'PPI::Document' } #---------------------------------------------------------------------------- # The actual coda we're looking for: our $CODA = <<'END_CODA'; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: END_CODA #---------------------------------------------------------------------------- sub violates { my ( $self, $elem, $doc ) = @_; my @coda_lines = split /\n/, $CODA; my $last_node = $doc->last_element; # __END__ and __DATA__ blocks are excepted from having the coda if ( $last_node->isa('PPI::Statement::End') or $last_node->isa('PPI::Statement::Data') ) { return; } else { for ( $last_node = $doc->last_element ; $last_node && @coda_lines ; $last_node = $last_node->previous_sibling ) { next if ( $last_node->isa('PPI::Token::Whitespace') ); last if ( !$last_node->isa('PPI::Token::Comment') ); my $last_coda_line = $coda_lines[-1]; my $last_actual_line = $last_node->content; chomp $last_actual_line; last if ( $last_coda_line ne $last_actual_line ); pop @coda_lines; } } return if ( !@coda_lines ); # We made it through all the coda lines return $self->violation( $desc, $expl, $last_node || $doc ); } 1; # How meta! We ourselves must have this coda to be a valid perl file in the # parrot repository... # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: perlcritic.t000644000765000765 521311567202625 17266 0ustar00brucebruce000000000000parrot-5.9.0/t/codingstd#! perl # Copyright (C) 2008-2010, Parrot Foundation. =head1 NAME t/codingstd/perlcritic.t - use perlcritic for perl coding stds. =head1 SYNOPSIS # test all files % prove t/codingstd/perlcritic.t % perl t/codingstd/perlcritic.t [--theme=sometheme] # test specific files % perl t/codingstd/perlcritic.t src/foo.pl lib/parrot/bar.pm # Skip perlcritic when running a testing target. % PARROT_TEST_NO_PERLCRITIC=1 make codetest =head1 DESCRIPTION By default, tests all perl source files for some very specific perl coding violations. This test uses a standard perlcriticrc file, located in F If you wish to run a specific policy, the easiest way to do so is to temporarily add a custom theme to the configuration file and then specify that on the command line to this script. =cut use strict; use warnings; use lib qw( lib ../lib ../../lib ); use File::Spec; use Getopt::Long; use Parrot::Config qw(%PConfig); use Parrot::Distribution; use Test::More; # There's no point in continuing if we're missing some certain modules, or # if the developer doesn't want to. if (exists $ENV{'PARROT_TEST_NO_PERLCRITIC'}) { give_up('absence of PARROT_TEST_NO_PERLCRITIC environment variable'); } eval { require Test::Perl::Critic }; if ($@) { give_up('Test::Perl::Critic'); } my $minimum_version = 1.090; if ($Perl::Critic::VERSION < $minimum_version) { give_up("Perl::Critic version $minimum_version"); } my $theme = 'parrot'; GetOptions( 'theme=s' => \$theme ); my $config = File::Spec->catfile( $PConfig{build_dir}, qw{tools dev perlcritic.conf} ); Test::Perl::Critic->import( -profile => $config, -theme => $theme ); my $dist = Parrot::Distribution->new(); my @files; if ( !@ARGV ) { # We want to skip any language's perl files except those which have declared # they wish to be tested. # As languages are leaving the Parrot repository, there are currently no # languages that want to be tested in the root 'make codetest'. my $languages_dir = File::Spec->catdir( $PConfig{build_dir}, 'languages'); my $filter_languages = qr/^\Q$languages_dir$PConfig{slash}\E(?!dummy)/x; @files = grep {! m/$filter_languages/} map { $_->path } grep { $_->read !~ m/use v6;/ } grep { $_->read !~ m/#!\s*nqp/ } $dist->get_perl_language_files(); } else { @files = <@ARGV>; } plan(tests => scalar(@files)); critic_ok($_) foreach @files; sub give_up { my $excuse = shift; plan(skip_all => "$excuse required to criticize code."); exit; } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: snprintf-01.t000644000765000765 521611533177646 17351 0ustar00brucebruce000000000000parrot-5.9.0/t/steps/auto#! perl # Copyright (C) 2007, Parrot Foundation. # auto/snprintf-01.t use strict; use warnings; use Test::More tests => 18; use Carp; use lib qw( lib t/configure/testlib ); use_ok('config::auto::snprintf'); use Parrot::Configure::Options qw( process_options ); use Parrot::Configure::Step::Test; use Parrot::Configure::Test qw( test_step_constructor_and_description ); use IO::CaptureOutput qw| capture |; ########## regular ########## my ($args, $step_list_ref) = process_options( { argv => [], mode => q{configure}, } ); my $conf = Parrot::Configure::Step::Test->new; $conf->include_config_results( $args ); my $pkg = q{auto::snprintf}; $conf->add_steps($pkg); my $serialized = $conf->pcfreeze(); $conf->options->set(%{$args}); my $step = test_step_constructor_and_description($conf); $conf->replenish($serialized); ########## _evaluate_snprintf() ########## ($args, $step_list_ref) = process_options( { argv => [], mode => q{configure}, } ); $conf->options->set(%{$args}); $step = test_step_constructor_and_description($conf); my $res; $res = q{old snprintf}; ok($step->_evaluate_snprintf($conf, $res), "_evaluate_snprintf returned true value"); ok($conf->data->get('HAS_OLD_SNPRINTF'), "Got expected value"); $res = q{C99 snprintf}; ok($step->_evaluate_snprintf($conf, $res), "_evaluate_snprintf returned true value"); ok($conf->data->get('HAS_C99_SNPRINTF'), "Got expected value"); ok($conf->data->get('HAS_SNPRINTF'), "Got expected value"); $conf->replenish($serialized); ########## --verbose; _evaluate_snprintf() ########## ($args, $step_list_ref) = process_options( { argv => [ q{--verbose} ], mode => q{configure}, } ); $conf->options->set(%{$args}); $step = test_step_constructor_and_description($conf); { my $stdout; my $res = q{snprintf}; my $ret = capture( sub { $step->_evaluate_snprintf($conf, $res) }, \$stdout ); ok($ret, "_evaluate_snprintf returned true value"); ok($conf->data->get('HAS_SNPRINTF'), "Got expected value"); } $conf->cc_clean(); pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME auto/snprintf-01.t - test auto::snprintf =head1 SYNOPSIS % prove t/steps/auto/snprintf-01.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file test auto::snprintf. =head1 AUTHOR James E Keenan =head1 SEE ALSO config::auto::snprintf, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: 01-default_tests.t000644000765000765 1132411533177645 20105 0ustar00brucebruce000000000000parrot-5.9.0/t/pharness#! perl # Copyright (C) 2007-2009, Parrot Foundation. # 01-default_tests.t use strict; use warnings; use lib qw( lib ); use Test::More; eval { use Parrot::Config qw( %PConfig ); }; plan( skip_all => 't/harness only runs once configuration has completed' ) if $@; plan( tests => 29 ); use Carp; use Cwd; use File::Temp qw( tempdir ); use Parrot::Harness::DefaultTests; @Parrot::Harness::DefaultTests::runcore_tests = qw( alpha.t ); @Parrot::Harness::DefaultTests::core_tests = qw( beta.t ); @Parrot::Harness::DefaultTests::configure_tests = qw( gamma.t ); @Parrot::Harness::DefaultTests::developing_tests = qw( epsilon.t ); @Parrot::Harness::DefaultTests::library_tests = qw( zeta.t ); my ($core_tests_only, $runcore_tests_only); my (@default_tests, $default_tests_ref); my %default_tests_seen; my $cwd = cwd(); my $longopts = {}; { # Simulate non-existence of DEVELOPING my $tdir1 = tempdir( CLEANUP => 1 ); ok( chdir $tdir1, "Able to change to tempdir for testing"); # ($core_tests_only, $runcore_tests_only) = (0,1); $longopts = { core_tests_only => 0, runcore_tests_only => 1 }; ok(@default_tests = get_common_tests( $longopts ), "get_common_tests() returned successfully"); is(scalar(@default_tests), 1, "Got expected 1 test"); is($default_tests[0], q{alpha.t}, "runcore_tests only as expected"); @default_tests = (); $longopts = { core_tests_only => 1, runcore_tests_only => 0 }; ok(@default_tests = get_common_tests( $longopts ), "get_common_tests() returned successfully"); is(scalar(@default_tests), 2, "Got expected 2 tests"); is($default_tests[1], q{beta.t}, "core_tests only as expected"); @default_tests = (); $longopts = { core_tests_only => 0, runcore_tests_only => 0 }; ok(@default_tests = get_common_tests( $longopts ), "get_common_tests() returned successfully"); is(scalar(@default_tests), 4, "Got expected 4 tests"); is($default_tests[0], q{gamma.t}, "Start with configure_tests as expected"); is($default_tests[3], q{zeta.t}, "End with library_tests as expected"); @default_tests = (); $longopts = { core_tests_only => 0, runcore_tests_only => 0 }; ok($default_tests_ref = get_common_tests( $longopts ), "get_common_tests() returned successfully"); is(scalar(@{ $default_tests_ref }), 4, "Got expected 4 tests"); ok(chdir $cwd, "Able to change back to starting directory after testing"); } { # Simulate existence of DEVELOPING my $tdir2 = tempdir( CLEANUP => 1 ); ok( chdir $tdir2, "Able to change to tempdir for testing"); open my $FH, ">", q{DEVELOPING} or croak "Unable to open file for writing"; print $FH qq{12345\n}; close $FH or croak "Unable to close file after writing"; $longopts = { core_tests_only => 0, runcore_tests_only => 1 }; ok(@default_tests = get_common_tests( $longopts ), "get_common_tests() returned successfully"); is(scalar(@default_tests), 1, "Got expected 1 test"); is($default_tests[0], q{alpha.t}, "runcore_tests only as expected"); @default_tests = (); $longopts = { core_tests_only => 1, runcore_tests_only => 0 }; ok(@default_tests = get_common_tests( $longopts ), "get_common_tests() returned successfully"); is(scalar(@default_tests), 2, "Got expected 2 tests"); is($default_tests[1], q{beta.t}, "core_tests only as expected"); @default_tests = (); $longopts = { core_tests_only => 0, runcore_tests_only => 0 }; ok(@default_tests = get_common_tests( $longopts ), "get_common_tests() returned successfully"); is(scalar(@default_tests), 4, "Got expected 4 tests"); is($default_tests[0], q{gamma.t}, "Start with configure_tests as expected"); is($default_tests[3], q{zeta.t}, "End with library_tests as expected"); @default_tests = (); $longopts = { core_tests_only => 0, runcore_tests_only => 0 }; ok($default_tests_ref = get_common_tests( $longopts ), "get_common_tests() returned successfully"); is(scalar(@{ $default_tests_ref }), 4, "Got expected 4 tests"); # reset for subsequent tests ok(chdir $cwd, "Able to change back to starting directory after testing"); } pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME 01-default_tests.t - test Parrot::Harness::DefaultTests =head1 SYNOPSIS % prove t/pharness/01-default_tests.t =head1 DESCRIPTION This file holds tests for Parrot::Harness::DefaultTests::get_common_tests(). =head1 AUTHOR James E Keenan =head1 SEE ALSO Parrot::Harness::DefaultTests, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: TESTS_STATUS.pod000644000765000765 1067112101554067 15513 0ustar00brucebruce000000000000parrot-5.9.0/t# Copyright (C) 2012, Parrot Foundation. =pod =head1 DESCRIPTION This is the Parrot testing status, the primary goal of which is to provide complete coverage of the critical Parrot core subsystems on all targeted platforms. Secondary goals include testing of non-critical core subsystems, and non-core code. This document tracks the status of our effort. Until we have an automated way of quantitatively tracking test coverage, coverage will be tracked quantitatively, using the scale described below: =over 4 =item Poor Very little, or no coverage of a component. This status is completely unacceptable and should be remedied immediately. =item Fair Some coverage of basic component operation. Missing some subtests of basic operation, failure cases, and invalid input. Component functionality may only be tested on a subset of platforms that provide that functionality. =item Good Full or nearly-full coverage of basic component operation, failure cases, and invalid input. Tests are run on all platforms which allow component operation. Hard-to-test code is not yet well-covered. Some missing functionality is partially tested with failing B and B tests. =item Excellent Full coverage of basic component operation, failure cases, and invalid input on all platforms. Hard-to-test code is well-covered. Missing component functionality, including basic operation, failure cases, and invalid input is tested with failing B and B tests. =back =head2 Parrot Core Subsystems Below is a breakdown of the Parrot core subsystems, and a qualitative measure of testing status. =head3 Parser This module tokenizes the input. =over 4 =item Status B. There are tests for basic operation, however these tests are spread throughout the test suite, and are not comprehensive. We can assume basic operation is well-tested, otherwise the compiler, optimizer, and interpreter probably wouldn't work very well. Tests under B, and others. =back =head3 Compilers: IMCC, PGE, TGE =over 4 =item Status B. =back =head3 Optimizer This rearranges B code to make it run faster. =over 4 =item Status Untested. IMCC no longer has the ability to output PASM code, only PBC. =back =head3 Interpreter This is the core of Parrot. It comprises the various runcores, input/output, threading, events, exceptions, objects, bytecode loader, etc. Test coverage of the Parrot Interpreter is critical. =over 4 =item Status B. A breakdown of Interpreter subsystems below lists individual status. =over 4 =item PMCs B. Each PMC file has a corresponding test file. Some PMCs are heavily undertested. Tests under B. =item Operators B. Most operators are well-tested. Tests under B. =item IO B. Tests exist, but do not run on all platforms, and do not test some important cases. Tests in B and B. =item Dynamic PMCs B. Some dynamic PMCs do not have test files. Coverage in existing test files is far from complete. Tests under B. =item Dynamic ops B. Only a few tests exist, and coverage of important test cases is weak. Tests under B. =item Packfiles B. For more exotic platforms tests under B are rarely updated. =back =back =head3 Runtime Libraries and Includes =over 4 =item Status B. Some runtime libraries are tested, while others are not. No tests exist for include files. Tests under B. =back =head3 Configure Libraries =over 4 =item Status B. Tests exist, and the coverage is decent and improving. Tests under B. =back =head3 Test Libraries =over 4 =item Status B. Few tests exist, and coverage is poor. However, the test suite I to run fine, giving a false sense of security. =back =head3 Documentation =over 4 =item Status B. Opcode documentation is well-tested, and Pod files are checked for standards-conformance, but many documentation tests are missing. Tests under B. =back =head3 Coding standard =over 4 =item Status B. Tests under F. =back =head3 Examples and Benchmarks =over 4 =item Status B. Tests exist, and cover basic functionality of nearly all examples and benchmarks. Extensive testing of failures is not a priority. Tests under B and B. =back =head3 Tools =over 4 =item Status B. Few tests exist, and coverage is sparse. Tests under B. =back =cut 012-verbose.t000644000765000765 461011533177643 17102 0ustar00brucebruce000000000000parrot-5.9.0/t/configure#! perl # Copyright (C) 2007, Parrot Foundation. # 012-verbose.t use strict; use warnings; use Test::More tests => 12; use Carp; use lib qw( lib t/configure/testlib ); use Parrot::Configure; use Parrot::Configure::Options qw( process_options ); use IO::CaptureOutput qw | capture |; $| = 1; is( $|, 1, "output autoflush is set" ); my ($args, $step_list_ref) = process_options( { argv => [q{--verbose}], mode => q{configure}, } ); ok( defined $args, "process_options returned successfully" ); my %args = %$args; my $conf = Parrot::Configure->new; ok( defined $conf, "Parrot::Configure->new() returned okay" ); my $step = q{init::beta}; my $description = 'Determining if your computer does beta'; $conf->add_steps($step); my @confsteps = @{ $conf->steps }; isnt( scalar @confsteps, 0, "Parrot::Configure object 'steps' key holds non-empty array reference" ); is( scalar @confsteps, 1, "Parrot::Configure object 'steps' key holds ref to 1-element array" ); my $nontaskcount = 0; foreach my $k (@confsteps) { $nontaskcount++ unless $k->isa("Parrot::Configure::Task"); } is( $nontaskcount, 0, "Each step is a Parrot::Configure::Task object" ); is( $confsteps[0]->step, $step, "'step' element of Parrot::Configure::Task struct identified" ); ok( !ref( $confsteps[0]->object ), "'object' element of Parrot::Configure::Task struct is not yet a ref" ); $conf->options->set(%args); is( $conf->options->{c}->{debugging}, 1, "command-line option '--debugging' has been stored in object" ); { my $rv; my $stdout; capture ( sub {$rv = $conf->runsteps}, \$stdout ); ok( $rv, "runsteps successfully ran $step" ); like( $stdout, qr/$description\.\.\..*beta is verbose.*You've got beta.*done\./s, #' "Got message expected upon running $step" ); } pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME 012-verbose.t - test the C<--verbose> command-line argument =head1 SYNOPSIS % prove t/configure/012-verbose.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file examine what happens when you configure with C<--verbose>. =head1 AUTHOR James E Keenan =head1 SEE ALSO Parrot::Configure, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: spectralnorm.pir_output000644000765000765 1411466337261 23024 0ustar00brucebruce000000000000parrot-5.9.0/examples/shootout1.274219991 hll.c000644000765000765 3212211716253437 14254 0ustar00brucebruce000000000000parrot-5.9.0/src/* Copyright (C) 2005-2011, Parrot Foundation. =head1 NAME src/hll.c - High Level Language support =head1 DESCRIPTION The Parrot core sometimes has to create new PMCs which should map to the current HLL's defaults. The current language and a typemap provides this feature. =head1 DATA interp->HLL_info @HLL_info = [ [ hll_name, hll_lib, { core_type => HLL_type, ... }, namespace, hll_id ], ... ] =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" #include "parrot/dynext.h" #include "pmc/pmc_callcontext.h" #include "pmc/pmc_fixedintegerarray.h" #include "hll.str" /* HEADERIZER HFILE: include/parrot/hll.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT static PMC* new_hll_entry(PARROT_INTERP, ARGIN(STRING *entry_name)) __attribute__nonnull__(1) __attribute__nonnull__(2); #define ASSERT_ARGS_new_hll_entry __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(entry_name)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* for shared HLL data, do COW stuff */ #define START_READ_HLL_INFO(interp, hll_info) #define END_READ_HLL_INFO(interp, hll_info) /* =item C Create a new HLL information table entry. Takes an interpreter name and (optional) entry name. Returns a pointer to the new entry. Used by Parrot_hll_register_HLL. =cut */ PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT static PMC* new_hll_entry(PARROT_INTERP, ARGIN(STRING *entry_name)) { ASSERT_ARGS(new_hll_entry) PMC * const hll_info = interp->HLL_info; const INTVAL id = VTABLE_elements(interp, hll_info); PMC *entry_id; PMC * const entry = Parrot_pmc_new_init_int(interp, enum_class_FixedPMCArray, e_HLL_MAX); if (entry_name && !STRING_IS_EMPTY(entry_name)) { VTABLE_set_pmc_keyed_str(interp, hll_info, entry_name, entry); } else VTABLE_push_pmc(interp, hll_info, entry); entry_id = Parrot_pmc_new_init_int(interp, enum_class_Integer, id); VTABLE_set_pmc_keyed_int(interp, entry, e_HLL_id, entry_id); VTABLE_push_pmc(interp, interp->HLL_entries, entry); return entry; } /* =item C Initialises the HLL_info and HLL_namespace fields of the interpreter structure. Registers the default HLL namespace "parrot". =cut */ void Parrot_hll_init_HLL(PARROT_INTERP) { ASSERT_ARGS(Parrot_hll_init_HLL) interp->HLL_info = Parrot_pmc_new(interp, enum_class_OrderedHash); interp->HLL_namespace = Parrot_pmc_new(interp, enum_class_ResizablePMCArray); interp->HLL_entries = Parrot_pmc_new(interp, enum_class_ResizablePMCArray); Parrot_hll_register_HLL(interp, CONST_STRING(interp, "parrot")); } /* =item C Register the HLL with the given STRING name C in the interpreter. If the HLL has already been registered, the ID of the HLL is returned. Otherwise the HLL is registered, a corresponding HLL namespace is created, and the HLL ID is returned. If there is an error, C<-1> is returned. =cut */ PARROT_EXPORT PARROT_IGNORABLE_RESULT INTVAL Parrot_hll_register_HLL(PARROT_INTERP, ARGIN(STRING *hll_name)) { ASSERT_ARGS(Parrot_hll_register_HLL) PMC *entry, *name, *ns_hash, *hll_info; INTVAL idx; /* TODO LOCK or disallow in threads */ idx = Parrot_hll_get_HLL_id(interp, hll_name); if (idx >= 0) return idx; hll_info = interp->HLL_info; idx = VTABLE_elements(interp, hll_info); entry = new_hll_entry(interp, hll_name); /* register HLL name */ name = Parrot_pmc_new(interp, enum_class_String); VTABLE_set_string_native(interp, name, hll_name); VTABLE_set_pmc_keyed_int(interp, entry, e_HLL_name, name); /* create HLL namespace */ hll_name = Parrot_str_downcase(interp, VTABLE_get_string(interp, name)); /* HLL type mappings aren't yet created, we can't create * a namespace in HLL's flavor yet - maybe promote the * ns_hash to another type, if mappings provide one * XXX - FIXME */ ns_hash = Parrot_ns_make_namespace_keyed_str(interp, interp->root_namespace, hll_name); /* cache HLL's toplevel namespace */ VTABLE_set_pmc_keyed_int(interp, interp->HLL_namespace, idx, ns_hash); /* create HLL typemap hash */ VTABLE_set_pmc_keyed_int(interp, entry, e_HLL_typemap, PMCNULL); return idx; } /* =item C Returns the ID number of the HLL with the given name. The default HLL namespace C has an ID number of 0. On error, or if an HLL with the given name does not exist, returns -1. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT INTVAL Parrot_hll_get_HLL_id(PARROT_INTERP, ARGIN(STRING *hll_name)) { ASSERT_ARGS(Parrot_hll_get_HLL_id) PMC * entry; PMC * const hll_info = interp->HLL_info; INTVAL i = -1; if (STRING_IS_NULL(hll_name)) return i; START_READ_HLL_INFO(interp, hll_info); entry = VTABLE_get_pmc_keyed_str(interp, hll_info, hll_name); if (!PMC_IS_NULL(entry)) { PMC * const entry_id = VTABLE_get_pmc_keyed_int(interp, entry, e_HLL_id); i = VTABLE_get_integer(interp, entry_id); } END_READ_HLL_INFO(interp, hll_info); return i; } /* =item C Returns the STRING name of the HLL with the given C number. If the id is out of range or does not exist, the NULL value is returned instead. Note that some HLLs are anonymous and so might also return NULL. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * Parrot_hll_get_HLL_name(PARROT_INTERP, INTVAL id) { ASSERT_ARGS(Parrot_hll_get_HLL_name) PMC * const hll_info = interp->HLL_info; const INTVAL nelements = VTABLE_elements(interp, hll_info); PMC *entry, *name_pmc; if (id < 0 || id >= nelements) return STRINGNULL; START_READ_HLL_INFO(interp, hll_info); entry = VTABLE_get_pmc_keyed_int(interp, hll_info, id); name_pmc = VTABLE_get_pmc_keyed_int(interp, entry, e_HLL_name); END_READ_HLL_INFO(interp, hll_info); /* loadlib-created 'HLL's are nameless */ if (PMC_IS_NULL(name_pmc)) return STRINGNULL; else return VTABLE_get_string(interp, name_pmc); } /* =item C Register a type mapping of C<< core_type => hll_type >> for the given HLL. =cut */ PARROT_EXPORT void Parrot_hll_register_HLL_type(PARROT_INTERP, INTVAL hll_id, INTVAL core_type, INTVAL hll_type) { ASSERT_ARGS(Parrot_hll_register_HLL_type) if (hll_id == Parrot_hll_get_HLL_id(interp, CONST_STRING(interp, "parrot"))) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Cannot map without an HLL"); else { PMC * const hll_info = interp->HLL_info; const INTVAL n = VTABLE_elements(interp, hll_info); if (hll_id >= n) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_GLOBAL_NOT_FOUND, "no such HLL ID (%vd)", hll_id); else { PMC *type_array; PMC * const entry = VTABLE_get_pmc_keyed_int(interp, hll_info, hll_id); PARROT_ASSERT(!PMC_IS_NULL(entry)); type_array = VTABLE_get_pmc_keyed_int(interp, entry, e_HLL_typemap); if (PMC_IS_NULL(type_array)) { int i; type_array = Parrot_pmc_new(interp, enum_class_FixedIntegerArray); VTABLE_set_integer_native(interp, type_array, PARROT_MAX_CLASSES); for (i = 0; i < PARROT_MAX_CLASSES; ++i) VTABLE_set_integer_keyed_int(interp, type_array, i, i); VTABLE_set_pmc_keyed_int(interp, entry, e_HLL_typemap, type_array); } VTABLE_set_integer_keyed_int(interp, type_array, core_type, hll_type); } } } /* =item C Get an equivalent HLL type number for the language C. If the given HLL doesn't remap the given type, or if C is the special value C, returns C unchanged. =cut */ PARROT_EXPORT INTVAL Parrot_hll_get_HLL_type(PARROT_INTERP, INTVAL hll_id, INTVAL core_type) { ASSERT_ARGS(Parrot_hll_get_HLL_type) if (hll_id == PARROT_HLL_NONE || hll_id == 0) return core_type; if (hll_id < 0) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_GLOBAL_NOT_FOUND, "no such HLL ID (%vd)", hll_id); else { PMC * const hll_info = interp->HLL_info; PMC *entry, *type_array; Parrot_FixedIntegerArray_attributes *type_array_attrs; START_READ_HLL_INFO(interp, hll_info); entry = VTABLE_get_pmc_keyed_int(interp, hll_info, hll_id); END_READ_HLL_INFO(interp, hll_info); if (PMC_IS_NULL(entry)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_GLOBAL_NOT_FOUND, "no such HLL ID (%vd)", hll_id); type_array = VTABLE_get_pmc_keyed_int(interp, entry, e_HLL_typemap); if (PMC_IS_NULL(type_array)) return core_type; if (core_type >= PARROT_MAX_CLASSES || core_type < 0) { Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS, "FixedIntegerArray: index out of bounds!"); } type_array_attrs = PARROT_FIXEDINTEGERARRAY(type_array); return type_array_attrs->int_array[core_type]; } } /* =item C Return an equivalent PMC type number according to the HLL settings in the current context. If no type is registered, returns C. =cut */ PARROT_EXPORT INTVAL Parrot_hll_get_ctx_HLL_type(PARROT_INTERP, INTVAL core_type) { ASSERT_ARGS(Parrot_hll_get_ctx_HLL_type) const INTVAL hll_id = Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)); if (!hll_id || hll_id == PARROT_HLL_NONE) return core_type; return Parrot_hll_get_HLL_type(interp, hll_id, core_type); } /* =item C Return root namespace of the current HLL. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL PMC* Parrot_hll_get_ctx_HLL_namespace(PARROT_INTERP) { ASSERT_ARGS(Parrot_hll_get_ctx_HLL_namespace) return Parrot_hll_get_HLL_namespace(interp, Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp))); } /* =item C Return root namespace of the HLL with the ID of I. If C is the special value C, return the global root namespace. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC* Parrot_hll_get_HLL_namespace(PARROT_INTERP, int hll_id) { ASSERT_ARGS(Parrot_hll_get_HLL_namespace) if (hll_id == PARROT_HLL_NONE) return interp->root_namespace; return VTABLE_get_pmc_keyed_int(interp, interp->HLL_namespace, hll_id); } /* =item C Create all HLL namespaces that don't already exist. This is necessary when creating a new interpreter which shares an old interpreter's HLL_info. =cut */ PARROT_EXPORT void Parrot_hll_regenerate_HLL_namespaces(PARROT_INTERP) { ASSERT_ARGS(Parrot_hll_regenerate_HLL_namespaces) const INTVAL n = VTABLE_elements(interp, interp->HLL_info); INTVAL hll_id; /* start at one since the 'parrot' namespace should already have been * created */ for (hll_id = 1; hll_id < n; ++hll_id) { PMC *ns_hash = VTABLE_get_pmc_keyed_int(interp, interp->HLL_namespace, hll_id); if (PMC_IS_NULL(ns_hash) || ns_hash->vtable->base_type == enum_class_Undef) { STRING * hll_name = Parrot_hll_get_HLL_name(interp, hll_id); if (!hll_name) continue; hll_name = Parrot_str_downcase(interp, hll_name); /* XXX as in Parrot_hll_register_HLL() this needs to be fixed to use * the correct type of namespace. It's relatively easy to do that * here because the typemap already exists, but it is not currently * done for consistency. */ ns_hash = Parrot_ns_make_namespace_keyed_str(interp, interp->root_namespace, hll_name); VTABLE_set_pmc_keyed_int(interp, interp->HLL_namespace, hll_id, ns_hash); } } } /* =back =head1 AUTHOR Leopold Toetsch =head1 SEE ALSO F =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ Defines.mak000644000765000765 63011533177633 17333 0ustar00brucebruce000000000000parrot-5.9.0/compilers/pctPCT_LIB_PBCS = \ $(LIBRARY_DIR)/PCT.pbc \ $(LIBRARY_DIR)/PCT/PAST.pbc \ $(LIBRARY_DIR)/PCT/Grammar.pbc \ $(LIBRARY_DIR)/PCT/HLLCompiler.pbc \ $(LIBRARY_DIR)/PCT/Dumper.pbc PCT_CLEANUPS = $(PCT_LIB_PBCS) \ compilers/pct/src/PCT/Node.pbc \ compilers/pct/src/PAST/Node.pbc \ compilers/pct/src/PAST/Compiler.pbc \ compilers/pct/src/POST/Node.pbc \ compilers/pct/src/POST/Compiler.pbc distutils.pir000644000765000765 27665212101554067 21772 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library# Copyright (C) 2009-2012, Parrot Foundation. =head1 NAME distutils - Parrot Distribution Utilities =head1 DESCRIPTION This module is greatly inspired by Python Distribution Utilities (L). Its goal is to make Parrot modules and extensions easily available to a wider audience with very little overhead for build/release/install mechanics. All the rules needed (dynops, dynpmc, pbc_to_exe, nqp, ...) are coded in this module distutils. A module author just must write a script C or C. A setup script can be as simple as this: pir::load_bytecode('distutils.pir'); setup( @steps, ... many key/values here ... ); Distutils could work with Plumage (L). Plumage handles setup.pir commands. Distutils could generate a skeleton of Plumage metadata. =head3 Commands / Steps / Targets The default are : =over 4 =item build Build the library. (it is the default command) =item test Run the test suite. =item install Install the library. =item uninstall Uninstall the library. =item clean Basic cleaning up. =item update Update from the repository. =item plumage Output a skeleton for Plumage =item sdist, sdist_gztar, sdist_rpm, manifest Create a source distribution or a source RPM package =item bdist, bdist_rpm, bdist_wininst, spec, control, ebuild Create a binary RPM package or Windows Installer. =item help Print a help message. =back The behaviour is driven by the data supplied to the function C. So, below each step is described with the list of key/values handled. An API allows to write customized step : C, C, C, C. Customized step could reuse Configuration Helpers & OS Utilities. =head3 Invocations Typical invocations are: $ parrot setup.pir $ parrot setup.pir test $ sudo parrot setup.pir install =head2 PERL DEPENDENCIES =over 4 =item pod2html core module Pod-Html =item pod2man core module Pod-Man =back =head2 PARROT DEPENDENCIES =over 4 =item glob (in step 'manifest' & 'sdist') PGE/Glob.pbc =back =head2 SYSTEM DEPENDENCIES =over 4 =item spec, sdist_rpm, bdist_rpm rpmbuild =item bdist_wininst Inno Setup =back =head2 EXAMPLES $ cat hello.pir .sub 'main' :main say 'hello world!' .end $ cat setup.pir .sub 'main' :main .param pmc args $S0 = shift args load_bytecode 'distutils.pbc' $P0 = new 'Hash' $P1 = new 'Hash' $P1['hello.pbc'] = 'hello.pir' $P0['pbc_pir'] = $P1 $P2 = new 'Hash' $P2['parrot-hello'] = 'hello.pbc' $P0['installable_pbc'] = $P2 .tailcall setup(args :flat, $P0 :flat :named) .end $ parrot setup.pir $ parrot setup.pir install $ parrot setup clean L L L L L L L L L L L L L L L L L L L L L L =cut .loadlib 'sys_ops' .include 'errors.pasm' .sub '__onload' :load :init :anon load_bytecode 'osutils.pbc' $P0 = new 'Hash' set_global '%step', $P0 .const 'Sub' _build_dynpmc = '_build_dynpmc' register_step('build', _build_dynpmc) .const 'Sub' _build_dynops = '_build_dynops' register_step_after('build', _build_dynops) .const 'Sub' _build_pir_pge = '_build_pir_pge' register_step_after('build', _build_pir_pge) .const 'Sub' _build_pir_tge = '_build_pir_tge' register_step_after('build', _build_pir_tge) .const 'Sub' _build_pir_nqp_rx = '_build_pir_nqp_rx' register_step_after('build', _build_pir_nqp_rx) .const 'Sub' _build_pir_winxed = '_build_pir_winxed' register_step_after('build', _build_pir_winxed) .const 'Sub' _build_inc_pir = '_build_inc_pir' register_step_after('build', _build_inc_pir) .const 'Sub' _build_pir_pir = '_build_pir_pir' register_step_after('build', _build_pir_pir) .const 'Sub' _build_pbc_pir = '_build_pbc_pir' register_step_after('build', _build_pbc_pir) .const 'Sub' _build_pbc_pbc = '_build_pbc_pbc' register_step_after('build', _build_pbc_pbc) .const 'Sub' _build_hll_hook = '_build_hll_hook' register_step_after('build', _build_hll_hook) .const 'Sub' _build_exe_pbc = '_build_exe_pbc' register_step_after('build', _build_exe_pbc) .const 'Sub' _build_installable_pbc = '_build_installable_pbc' register_step_after('build', _build_installable_pbc) .const 'Sub' _build_html_pod = '_build_html_pod' register_step_after('build', _build_html_pod) .const 'Sub' _build_man_pod = '_build_man_pod' register_step_after('build', _build_man_pod) .const 'Sub' _clean_dynpmc = '_clean_dynpmc' register_step('clean', _clean_dynpmc) .const 'Sub' _clean_dynops = '_clean_dynops' register_step_after('clean', _clean_dynops) .const 'Sub' _clean_pir_pge = '_clean_pir_pge' register_step_after('clean', _clean_pir_pge) .const 'Sub' _clean_pir_tge = '_clean_pir_tge' register_step_after('clean', _clean_pir_tge) .const 'Sub' _clean_pir_nqp_rx = '_clean_pir_nqp_rx' register_step_after('clean', _clean_pir_nqp_rx) .const 'Sub' _clean_pir_winxed = '_clean_pir_winxed' register_step_after('clean', _clean_pir_winxed) .const 'Sub' _clean_inc_pir = '_clean_inc_pir' register_step_after('clean', _clean_inc_pir) .const 'Sub' _clean_pir_pir = '_clean_pir_pir' register_step_after('clean', _clean_pir_pir) .const 'Sub' _clean_pbc_pir = '_clean_pbc_pir' register_step_after('clean', _clean_pbc_pir) .const 'Sub' _clean_pbc_pbc = '_clean_pbc_pbc' register_step_after('clean', _clean_pbc_pbc) .const 'Sub' _clean_exe_pbc = '_clean_exe_pbc' register_step_after('clean', _clean_exe_pbc) .const 'Sub' _clean_installable_pbc = '_clean_installable_pbc' register_step_after('clean', _clean_installable_pbc) .const 'Sub' _clean_html_pod = '_clean_html_pod' register_step_after('clean', _clean_html_pod) .const 'Sub' _clean_man_pod = '_clean_man_pod' register_step_after('clean', _clean_man_pod) .const 'Sub' _clean_gztar = '_clean_gztar' register_step_after('clean', _clean_gztar) .const 'Sub' _clean_smoke = '_clean_smoke' register_step_after('clean', _clean_smoke) .const 'Sub' _update = '_update' register_step('update', _update) .const 'Sub' _patch = '_patch' register_step('patch', _patch) .const 'Sub' _install = '_install' register_step('install', _install) .const 'Sub' _test = '_test' register_step('test', _test) .const 'Sub' _smoke = '_smoke' register_step('smoke', _smoke) .const 'Sub' _uninstall = '_uninstall' register_step('uninstall', _uninstall) .const 'Sub' _usage = '_usage' register_step('usage', _usage) register_step('help', _usage) .const 'Sub' _plumage = '_plumage' register_step('plumage', _plumage) .const 'Sub' _sdist = '_sdist' register_step('sdist', _sdist) .const 'Sub' _sdist_gztar = '_sdist_gztar' register_step('sdist_gztar', _sdist_gztar) .const 'Sub' _manifest = '_manifest' register_step('manifest', _manifest) .const 'Sub' _sdist_rpm = '_sdist_rpm' register_step('sdist_rpm', _sdist_rpm) .const 'Sub' _spec_rpm = '_spec_rpm' register_step('spec', _spec_rpm) .const 'Sub' _control_deb = '_control_deb' register_step('control', _control_deb) .const 'Sub' _ebuild_gentoo = '_ebuild_gentoo' register_step('ebuild', _ebuild_gentoo) .const 'Sub' _bdist = '_bdist' register_step('bdist', _bdist) .const 'Sub' _bdist_rpm = '_bdist_rpm' register_step('bdist_rpm', _bdist_rpm) $P0 = get_config() $S0 = $P0['osname'] unless $S0 == 'MSWin32' goto L1 .const 'Sub' _bdist_wininst = '_bdist_wininst' register_step('bdist_wininst', _bdist_wininst) .const 'Sub' _clean_wininst = '_clean_wininst' register_step_after('clean', _clean_wininst) L1: $I0 = $P0['has_zlib'] if $I0 goto L2 .const 'Sub' _no_zlib = '_no_zlib' register_step('smoke', _no_zlib) register_step('sdist_gztar', _no_zlib) register_step('bdist_rpm', _no_zlib) L2: .end =head2 Functions =over 4 =item setup Entry point. =cut .sub 'setup' :multi() .param pmc args :slurpy .param pmc kv :slurpy :named .local pmc steps errorsoff .PARROT_ERRORS_PARAM_COUNT_FLAG steps = new 'ResizableStringArray' $P0 = iter args L1: unless $P0 goto L2 $S0 = shift $P0 $S1 = substr $S0, 0, 2 unless $S1 == '--' goto L3 $S1 = substr $S0, 2 $S2 = shift $P0 print $S1 print "=" say $S2 kv[$S1] = $S2 goto L1 L3: push steps, $S0 goto L1 L2: push_eh _handler $P0 = iter steps if $P0 goto L11 # default step run_step('build', 'build' :named('__target__'), kv :flat :named) goto L12 L11: unless $P0 goto L12 $S0 = shift $P0 $I0 = run_step($S0, $S0 :named('__target__'), kv :flat :named) if $I0 goto L11 print "unknown target : " say $S0 run_step('usage', kv :flat :named) L12: pop_eh .return () _handler: .local pmc ex .get_results (ex) rethrow ex .end .sub 'setup' :multi(ResizableStringArray,Hash) .param pmc array .param pmc hash .tailcall setup(array :flat, hash :flat :named) .end =item run_step Call a step by its name. =cut .sub 'run_step' :multi() .param string name .param pmc kv :slurpy :named $P0 = get_global '%step' $I0 = exists $P0[name] if $I0 goto L1 .return (0) L1: $P1 = $P0[name] $P2 = iter $P1 L2: unless $P2 goto L3 $P3 = shift $P2 $P3(kv :flat :named) goto L2 L3: .return (1) .end .sub 'run_step' :multi(String,Hash) .param string name .param pmc hash .tailcall run_step(name, hash :flat :named) .end =item register_step Register a step by its name =cut .sub 'register_step' .param string name .param pmc step $P0 = get_global '%step' $P1 = new 'ResizablePMCArray' unshift $P1, step $P0[name] = $P1 .end =item register_step_after Append a step =cut .sub 'register_step_after' .param string name .param pmc step $P0 = get_global '%step' $P1 = $P0[name] push $P1, step .end =item register_step_before Insert a step =cut .sub 'register_step_before' .param string name .param pmc step $P0 = get_global '%step' $P1 = $P0[name] unshift $P1, step .end =back =head2 Steps =head3 Step usage Display a helpful message =over 4 =item usage Overload the default message =item setup the default value is setup.pir =back =cut .sub '_usage' :anon .param pmc kv :slurpy :named .local string setup setup = get_value('setup', "setup.pir" :named('default'), kv :flat :named) .local string command command = _command_setup(setup) $P0 = new 'FixedStringArray' set $P0, 1 $P0[0] = command $S0 = <<'USAGE' usage: %s [target|--key value]* Default targets are : build: Build the library. test: Run the test suite. install: Install the library. uninstall: Uninstall the library. clean: Basic cleaning up. update: Update from the repository. plumage: Output a skeleton for Plumage sdist: Create a source distribution bdist: Create a binary distribution help: Print this help message. USAGE $S0 = sprintf $S0, $P0 $S0 = get_value('usage', $S0 :named('default'), kv :flat :named) say $S0 .end =head3 Step build =over 4 =item pbc_pir hash the key is the PBC pathname the value is an array of pathname or a single pathname the first item of the array is the PIR source the others items of the array are just the dependencies =cut .sub '_build_pbc_pir' :anon .param pmc kv :slurpy :named $I0 = exists kv['pbc_pir'] unless $I0 goto L1 $P0 = kv['pbc_pir'] build_pbc_pir($P0) L1: .end .sub 'build_pbc_pir' .param pmc hash .local pmc jobs jobs = new 'ResizableStringArray' $P0 = iter hash L1: unless $P0 goto L2 .local string pbc, src pbc = shift $P0 .local pmc depends depends = hash[pbc] $I0 = does depends, 'array' unless $I0 goto L3 $I0 = newer(pbc, depends) if $I0 goto L1 src = shift depends goto L4 L3: src = depends $I0 = newer(pbc, src) if $I0 goto L1 L4: $S0 = dirname(pbc) mkpath($S0, 1 :named('verbose')) .local string cmd cmd = get_parrot() cmd .= " -o " cmd .= pbc cmd .= " " cmd .= src push jobs, cmd goto L1 L2: .tailcall run_jobs(jobs) .end .sub 'run_jobs' .param pmc jobs L1: unless jobs goto L2 $S0 = shift jobs system($S0, 1 :named('verbose')) goto L1 L2: .end =item pir_pge hash the key is the PIR pathname the value is an array of PGE pathname or a single PGE pathname =item pir_pge_flags =cut .sub '_build_pir_pge' :anon .param pmc kv :slurpy :named $I0 = exists kv['pir_pge'] unless $I0 goto L1 $P0 = kv['pir_pge'] $S0 = get_value('pir_pge_flags', '' :named('default'), kv :flat :named) build_pir_pge($P0, $S0) L1: .end .sub 'build_pir_pge' .param pmc hash .param string flags .local pmc jobs jobs = new 'ResizableStringArray' $P0 = iter hash L1: unless $P0 goto L2 .local string pir, src pir = shift $P0 .local pmc srcs srcs = hash[pir] $I0 = does srcs, 'array' unless $I0 goto L3 $I0 = newer(pir, srcs) if $I0 goto L1 src = join ' ', srcs goto L4 L3: src = srcs $I0 = newer(pir, src) if $I0 goto L1 L4: $S0 = dirname(pir) mkpath($S0, 1 :named('verbose')) .local string cmd cmd = get_parrot() cmd .= " " $S0 = get_library('PGE/Perl6Grammar.pbc') cmd .= $S0 cmd .= " --output=" cmd .= pir cmd .= " " cmd .= flags cmd .= " " cmd .= src push jobs, cmd goto L1 L2: .tailcall run_jobs(jobs) .end =item pir_tge hash the key is the PIR pathname the value is the TGE pathname =cut .sub '_build_pir_tge' :anon .param pmc kv :slurpy :named $I0 = exists kv['pir_tge'] unless $I0 goto L1 $P0 = kv['pir_tge'] build_pir_tge($P0) L1: .end .sub 'build_pir_tge' .param pmc hash .local pmc jobs jobs = new 'ResizableStringArray' $P0 = iter hash L1: unless $P0 goto L2 .local string pir, tge pir = shift $P0 tge = hash[pir] $I0 = newer(pir, tge) if $I0 goto L1 $S0 = dirname(pir) mkpath($S0, 1 :named('verbose')) .local string cmd cmd = get_parrot() cmd .= " " $S0 = get_compiler('tge/tgc.pir') cmd .= $S0 cmd .= " --output=" cmd .= pir cmd .= " " cmd .= tge push jobs, cmd goto L1 L2: .tailcall run_jobs(jobs) .end =item pir_nqp-rx / pir_nqprx / pir_nqp hash the key is the PIR pathname the value is the NQP pathname =item pir_nqp_flags =cut .sub '_build_pir_nqp_rx' :anon .param pmc kv :slurpy :named $I0 = exists kv['pir_nqp-rx'] unless $I0 goto L1 $P0 = kv['pir_nqp-rx'] $S0 = get_value('pir_nqp_flags', '' :named('default'), kv :flat :named) build_pir_nqp_rx($P0, $S0) L1: $I0 = exists kv['pir_nqprx'] unless $I0 goto L2 $P0 = kv['pir_nqprx'] $S0 = get_value('pir_nqp_flags', '' :named('default'), kv :flat :named) build_pir_nqp_rx($P0, $S0) L2: $I0 = exists kv['pir_nqp'] unless $I0 goto L3 $P0 = kv['pir_nqp'] $S0 = get_value('pir_nqp_flags', '' :named('default'), kv :flat :named) build_pir_nqp_rx($P0, $S0) L3: .end .sub 'build_pir_nqp_rx' .param pmc hash .param string flags .local pmc jobs jobs = new 'ResizableStringArray' $P0 = iter hash L1: unless $P0 goto L2 .local string pir, nqp pir = shift $P0 nqp = hash[pir] $I0 = newer(pir, nqp) if $I0 goto L1 $S0 = dirname(pir) mkpath($S0, 1 :named('verbose')) .local string cmd cmd = get_nqp_rx() cmd .= " --target=pir --output=" cmd .= pir cmd .= " " cmd .= flags cmd .= " " cmd .= nqp push jobs, cmd goto L1 L2: .tailcall run_jobs(jobs) .end =item inc_pir (include) hash the key is the PIR pathname the value is an array of PIR pathname =cut .sub '_build_inc_pir' :anon .param pmc kv :slurpy :named $I0 = exists kv['inc_pir'] unless $I0 goto L1 $P0 = kv['inc_pir'] build_inc_pir($P0) L1: .end .sub 'build_inc_pir' .param pmc hash $P0 = iter hash L1: unless $P0 goto L2 .local string inc inc = shift $P0 .local pmc srcs srcs = hash[inc] $I0 = newer(inc, srcs) if $I0 goto L1 $S0 = dirname(inc) mkpath($S0, 1 :named('verbose')) $S0 = "# generated by distutils\n\n.include '" $S1 = join "'\n.include '", srcs $S0 .= $S1 $S0 .= "'\n\n" spew(inc, $S0, 1 :named('verbose')) goto L1 L2: .end =item pir_winxed hash the key is the PIR pathname the value is the Winxed pathname =cut .sub '_build_pir_winxed' :anon .param pmc kv :slurpy :named $I0 = exists kv['pir_winxed'] unless $I0 goto L1 $P0 = kv['pir_winxed'] build_pir_winxed($P0) L1: .end .sub 'build_pir_winxed' .param pmc hash .local pmc jobs jobs = new 'ResizableStringArray' $P0 = iter hash L1: unless $P0 goto L2 .local string pir, winxed pir = shift $P0 winxed = hash[pir] $I0 = newer(pir, winxed) if $I0 goto L1 $S0 = dirname(pir) mkpath($S0, 1 :named('verbose')) .local string cmd cmd = get_winxed() cmd .= " -c -o" cmd .= pir cmd .= " " cmd .= winxed push jobs, cmd goto L1 L2: .tailcall run_jobs(jobs) .end =item pir_pir (concat) hash the key is the PIR pathname the value is an array of PIR pathname =cut .sub '_build_pir_pir' :anon .param pmc kv :slurpy :named $I0 = exists kv['pir_pir'] unless $I0 goto L1 $P0 = kv['pir_pir'] build_pir_pir($P0) L1: .end .sub 'build_pir_pir' .param pmc hash $P0 = iter hash L1: unless $P0 goto L2 .local string pir pir = shift $P0 .local pmc srcs srcs = hash[pir] $I0 = newer(pir, srcs) if $I0 goto L1 $S0 = dirname(pir) mkpath($S0, 1 :named('verbose')) spew(pir, '', 1 :named('verbose')) $P1 = iter srcs L3: unless $P1 goto L4 .local string src src = shift $P1 $S0 = slurp(src) append(pir, $S0) goto L3 L4: goto L1 L2: .end =item pbc_pbc hash the key is the PBC pathname the value is an array of PBC pathname =cut .sub '_build_pbc_pbc' :anon .param pmc kv :slurpy :named $I0 = exists kv['pbc_pbc'] unless $I0 goto L1 $P0 = kv['pbc_pbc'] build_pbc_pbc($P0) L1: .end .sub 'build_pbc_pbc' .param pmc hash .local pmc jobs jobs = new 'ResizableStringArray' $P0 = iter hash L1: unless $P0 goto L2 .local string pbc pbc = shift $P0 .local pmc srcs srcs = hash[pbc] $I0 = newer(pbc, srcs) if $I0 goto L1 $S0 = dirname(pbc) mkpath($S0, 1 :named('verbose')) .local string cmd cmd = get_executable('pbc_merge') cmd .= " -o " cmd .= pbc cmd .= " " $S0 = join " ", srcs cmd .= $S0 push jobs, cmd goto L1 L2: .tailcall run_jobs(jobs) .end =item hll_hook a subroutine =cut .sub '_build_hll_hook' :anon .param pmc kv :slurpy :named $I0 = exists kv['hll_hook'] unless $I0 goto L1 $P0 = kv['hll_hook'] $P0(kv :flat :named) L1: .end =item exe_pbc hash the key is the executable pathname the value is the PBC pathname =cut .sub '_build_exe_pbc' :anon .param pmc kv :slurpy :named $I0 = exists kv['exe_pbc'] unless $I0 goto L1 $P0 = kv['exe_pbc'] build_exe_pbc($P0) L1: .end .sub 'build_exe_pbc' .param pmc hash .local pmc jobs jobs = new 'ResizableStringArray' .local string exe exe = get_exe() $P0 = iter hash L1: unless $P0 goto L2 .local string bin, pbc bin = shift $P0 pbc = hash[bin] $I0 = newer(bin, pbc) if $I0 goto L1 .local string cmd cmd = get_executable('pbc_to_exe') cmd .= " --output=" cmd .= bin $S0 = get_exe() cmd .= $S0 cmd .= " " cmd .= pbc push jobs, cmd goto L1 L2: .tailcall run_jobs(jobs) .end .sub '_mk_path_exe' :anon .param string pbcname .param string exe $I0 = length pbcname $I0 -= 4 $S0 = substr pbcname, 0, $I0 $S1 = $S0 . exe .return ($S1) .end =item installable_pbc hash the key is the executable pathname the value is the PBC pathname =cut .sub '_build_installable_pbc' :anon .param pmc kv :slurpy :named $I0 = exists kv['installable_pbc'] unless $I0 goto L1 $P0 = kv['installable_pbc'] build_installable_pbc($P0) L1: .end .sub 'build_installable_pbc' .param pmc hash .local pmc jobs jobs = new 'ResizableStringArray' .local string exe exe = get_exe() .local int has_strip has_strip = _has_strip() $P0 = iter hash L1: unless $P0 goto L2 .local string bin, pbc bin = shift $P0 pbc = hash[bin] $S1 = _mk_path_installable(pbc, exe) $I0 = newer($S1, pbc) if $I0 goto L1 .local string cmd cmd = get_executable('pbc_to_exe') cmd .= " " cmd .= pbc cmd .= " --install" unless has_strip goto L3 cmd .= " && strip " cmd .= $S1 L3: push jobs, cmd goto L1 L2: .tailcall run_jobs(jobs) .end .sub '_mk_path_installable' :anon .param string pbcname .param string exe $P0 = split '/', pbcname $S0 = $P0[-1] $I0 = length $S0 $I0 -= 4 $S0 = substr $S0, 0, $I0 $S1 = "installable_" . $S0 $S1 .= exe $P0[-1] = $S1 $S1 = join '/', $P0 .return ($S1) .end .sub '_has_strip' :anon .param string cflags :optional .param int has_cflags :opt_flag .local pmc config config = get_config() $S0 = config['gccversion'] unless $S0 goto L1 unless has_cflags goto L2 $I0 = index cflags, '-g' unless $I0 < 0 goto L1 L2: $S0 = config['cflags'] $I0 = index $S0, '-g' unless $I0 < 0 goto L1 .return (1) L1: .return (0) .end =item dynops hash the key is the name the value is the OPS pathname =item dynops_cflags =item dynops_ldflags =cut .sub '_build_dynops' :anon .param pmc kv :slurpy :named $I0 = exists kv['dynops'] unless $I0 goto L1 .local string cflags, ldflags cflags = get_value('dynops_cflags', '' :named('default'), kv :flat :named) ldflags = get_value('dynops_ldflags', '' :named('default'), kv :flat :named) $P0 = kv['dynops'] build_dynops($P0, cflags, ldflags) L1: .end .sub 'build_dynops' .param pmc hash .param string cflags .param string ldflags mkpath('dynext', 1 :named('verbose')) .local string load_ext load_ext = get_load_ext() $P0 = iter hash L1: unless $P0 goto L2 .local string ops, src ops = shift $P0 src = hash[ops] $S0 = _mk_path_dynops(ops, load_ext) $I0 = newer($S0, src) if $I0 goto L1 __build_dynops(src, ops, cflags, ldflags) goto L1 L2: .end .sub '__build_dynops' :anon .param string src .param string ops .param string cflags .param string ldflags .local pmc config config = get_config() .local string cmd cmd = get_executable('ops2c') cmd .= " --dynamic " cmd .= src system(cmd, 1 :named('verbose')) $S0 = config['o'] $S1 = _mk_path_gen_dynops(src, ops, $S0) $S2 = _mk_path_gen_dynops(src, ops, '.c') __compile_cc($S1, $S2, cflags) .local string dynext $S0 = config['load_ext'] dynext = _mk_path_dynops(ops, $S0) cmd = config['ld'] cmd .= " " $S0 = config['ld_out'] cmd .= $S0 cmd .= dynext cmd .= " " $S0 = config['o'] $S0 = _mk_path_gen_dynops(src, ops, $S0) cmd .= $S0 cmd .= " " $S0 = get_ldflags() cmd .= $S0 cmd .= " " $S0 = config['ld_load_flags'] cmd .= $S0 cmd .= " " $I0 = config['parrot_is_shared'] unless $I0 goto L1 $S0 = config['inst_libparrot_ldflags'] cmd .= $S0 cmd .= " " L1: cmd .= ldflags system(cmd, 1 :named('verbose')) $I0 = _has_strip(cflags) unless $I0 goto L2 cmd = "strip " . dynext system(cmd, 1 :named('verbose')) L2: .end .sub '__compile_cc' .param string obj .param string src .param string cflags .local pmc config config = get_config() .local string cmd cmd = config['cc'] cmd .= " -c " $S0 = config['cc_o_out'] cmd .= $S0 cmd .= " " cmd .= obj cmd .= " -I" $S0 = get_incdir() cmd .= $S0 cmd .= " -I" cmd .= $S0 cmd .= "/pmc -I" $S0 = cwd() cmd .= $S0 cmd .= " " $S0 = get_cflags() cmd .= $S0 cmd .= " " cmd .= cflags cmd .= " " cmd .= src system(cmd, 1 :named('verbose')) .end .sub '_mk_path_dynops' :anon .param string ops .param string load_ext $S0 = "dynext/" . ops $S0 .= load_ext .return ($S0) .end .sub '_mk_path_gen_dynops' :anon .param string src .param string ops .param string ext $S0 = dirname(src) $S0 .= "/" $S0 .= ops $S0 .= ext .return ($S0) .end =item dynpmc hash the key is the PMC name the value is an array of PMC/C/H pathname or a single PMC pathname an array creates a PMC group =item dynpmc_cflags =item dynpmc_ldflags =cut .sub '_build_dynpmc' :anon .param pmc kv :slurpy :named $I0 = exists kv['dynpmc'] unless $I0 goto L1 .local string cflags, ldflags cflags = get_value('dynpmc_cflags', '' :named('default'), kv :flat :named) ldflags = get_value('dynpmc_ldflags', '' :named('default'), kv :flat :named) $P0 = kv['dynpmc'] build_dynpmc($P0, cflags, ldflags) L1: .end .sub 'build_dynpmc' .param pmc hash .param string cflags .param string ldflags mkpath('dynext', 1 :named('verbose')) .local string load_ext, obj load_ext = get_load_ext() obj = get_obj() $P0 = iter hash L1: unless $P0 goto L2 .local string name name = shift $P0 .local pmc srcs srcs = hash[name] $I0 = does srcs, 'array' unless $I0 goto L3 .local pmc pmcs, includes pmcs = new 'ResizableStringArray' includes = new 'ResizableStringArray' $P1 = iter srcs L4: unless $P1 goto L5 .local string src src = shift $P1 .local string ext $I0 = rindex src, '.' ext = substr src, $I0 unless ext == '.pmc' goto L6 push pmcs, src L6: unless ext == '.h' goto L4 push includes, src goto L4 L5: $P1 = iter srcs L7: unless $P1 goto L8 src = shift $P1 $I0 = rindex src, '.' ext = substr src, $I0 if ext == '.h' goto L7 $S0 = _mk_path_gen_dynpmc(src, obj) push includes, src $I0 = newer($S0, includes) $S1 = pop includes if $I0 goto L7 if ext == '.c' goto L9 __build_dynpmc(src, cflags) goto L7 L9: __compile_cc($S0, src, cflags) $S0 = ' ' . $S0 ldflags .= $S0 goto L7 L8: $S0 = _mk_path_dynpmc(name, load_ext) $I0 = newer($S0, srcs) if $I0 goto L1 __build_dynpmc_group(pmcs, name, cflags, ldflags) goto L1 L3: src = srcs $S0 = _mk_path_dynpmc(name, load_ext) $I0 = newer($S0, src) if $I0 goto L1 __build_dynpmc(src, cflags) __build_dynpmc_alone(src, name, cflags, ldflags) goto L1 L2: .end .sub '__build_dynpmc' .param string src .param string cflags .local pmc config config = get_config() .local string pmc2c pmc2c = config['perl'] pmc2c .= " " $S0 = get_tool('build/pmc2c.pl') pmc2c .= $S0 .local string pmc2c_includes pmc2c_includes = "--include " $S0 = get_srcdir() pmc2c_includes .= $S0 pmc2c_includes .= " --include " pmc2c_includes .= $S0 pmc2c_includes .= "/pmc" $S0 = dirname(src) pmc2c_includes .= " --include " pmc2c_includes .= $S0 .local string cmd cmd = clone pmc2c cmd .= " --dump " cmd .= pmc2c_includes cmd .= " " cmd .= src system(cmd, 1 :named('verbose')) cmd = clone pmc2c cmd .= " --c " cmd .= pmc2c_includes cmd .= " " cmd .= src system(cmd, 1 :named('verbose')) $S0 = config['o'] $S1 = _mk_path_gen_dynpmc(src, $S0) $S2 = _mk_path_gen_dynpmc(src, '.c') __compile_cc($S1, $S2, cflags) .end .sub '__build_dynpmc_group' :anon .param pmc srcs .param string group .param string cflags .param string ldflags .local pmc config config = get_config() .local string src, obj src = srcs[0] obj = config['o'] .local string cmd cmd = config['perl'] cmd .= " " $S0 = get_tool('build/pmc2c.pl') cmd .= $S0 cmd .= " --library " $S0 = dirname(src) cmd .= $S0 cmd .= "/" cmd .= group cmd .= " --c " $S0 = join " ", srcs cmd .= $S0 system(cmd, 1 :named('verbose')) $S1 = _mk_path_gen_dynpmc_group(src, group, obj) $S2 = _mk_path_gen_dynpmc_group(src, group, '.c') __compile_cc($S1, $S2, cflags) .local string dynext $S0 = config['load_ext'] dynext = _mk_path_dynpmc(group, $S0) cmd = config['ld'] cmd .= " " $S0 = config['ld_out'] cmd .= $S0 cmd .= dynext cmd .= " " $S0 = _mk_path_gen_dynpmc_group(src, group, obj) cmd .= $S0 cmd .= " " $P0 = iter srcs L3: unless $P0 goto L4 src = shift $P0 $S0 = _mk_path_gen_dynpmc(src, obj) cmd .= $S0 cmd .= " " goto L3 L4: $S0 = get_ldflags() cmd .= $S0 cmd .= " " $S0 = config['ld_load_flags'] cmd .= $S0 cmd .= " " $I0 = config['parrot_is_shared'] unless $I0 goto L5 $S0 = config['inst_libparrot_ldflags'] cmd .= $S0 cmd .= " " L5: cmd .= ldflags system(cmd, 1 :named('verbose')) $I0 = _has_strip(cflags) unless $I0 goto L6 cmd = "strip " . dynext system(cmd, 1 :named('verbose')) L6: .end .sub '__build_dynpmc_alone' :anon .param string src .param string name .param string cflags .param string ldflags .local pmc config config = get_config() .local string dynext $S0 = config['load_ext'] dynext = _mk_path_dynpmc(name, $S0) .local string cmd cmd = config['ld'] cmd .= " " $S0 = config['ld_out'] cmd .= $S0 cmd .= dynext cmd .= " " $S0 = config['o'] $S0 = _mk_path_gen_dynpmc(src, $S0) cmd .= $S0 cmd .= " " $S0 = get_ldflags() cmd .= $S0 cmd .= " " $S0 = config['ld_load_flags'] cmd .= $S0 cmd .= " " $I0 = config['parrot_is_shared'] unless $I0 goto L5 $S0 = config['inst_libparrot_ldflags'] cmd .= $S0 cmd .= " " L5: cmd .= ldflags system(cmd, 1 :named('verbose')) $I0 = _has_strip(cflags) unless $I0 goto L6 cmd = "strip " . dynext system(cmd, 1 :named('verbose')) L6: .end .sub '_mk_path_dynpmc' :anon .param string group .param string load_ext $S0 = "dynext/" . group $S0 .= load_ext .return ($S0) .end .sub '_mk_path_gen_dynpmc' :anon .param string src .param string ext $I0 = rindex src, '.' $S0 = substr src, 0, $I0 $S0 .= ext unless ext == '.h' goto L1 $S1 = dirname($S0) $S2 = basename($S0) $S0 = $S1 . "/pmc_" $S0 .= $S2 L1: .return ($S0) .end .sub '_mk_path_gen_dynpmc_group' :anon .param string src .param string group .param string ext $S0 = dirname(src) $S0 .= "/" $S0 .= group $S0 .= ext .return ($S0) .end =item html_pod hash the key is the HTML pathname the value is the POD pathname =cut .sub '_build_html_pod' :anon .param pmc kv :slurpy :named $I0 = exists kv['html_pod'] unless $I0 goto L1 $P0 = kv['html_pod'] build_html_pod($P0) L1: .end .sub 'build_html_pod' .param pmc hash $P0 = iter hash L1: unless $P0 goto L2 .local string html, pod html = shift $P0 pod = hash[html] $I0 = newer(html, pod) if $I0 goto L1 $S0 = dirname(html) mkpath($S0, 1 :named('verbose')) .local string cmd cmd = "pod2html --infile " cmd .= pod cmd .= " --outfile " cmd .= html system(cmd, 1 :named('verbose')) unlink("pod2htmd.tmp") unlink("pod2htmi.tmp") goto L1 L2: .end =item man_pod hash the key is the manpage pathname with usual conventions, for example 'man/man1/prog.1' the value is the POD pathname, for example 'src/prog.pir' =cut .sub '_build_man_pod' :anon .param pmc kv :slurpy :named $I0 = exists kv['man_pod'] unless $I0 goto L1 $P0 = kv['man_pod'] build_man_pod($P0) L1: .end .sub 'build_man_pod' .param pmc hash .local pmc config config = get_config() .local string version version = config['VERSION'] $S0 = config['DEVEL'] version .= $S0 $P0 = iter hash L1: unless $P0 goto L2 .local string man, pod man = shift $P0 pod = hash[man] $I0 = newer(man, pod) if $I0 goto L1 $S0 = dirname(man) mkpath($S0, 1 :named('verbose')) $S0 = basename(man) $I0 = index $S0, '.' .local string name name = substr $S0, 0, $I0 name = upcase name .local string section inc $I0 section = substr $S0, $I0 .local string cmd cmd = "pod2man --name=" cmd .= name cmd .= " --section=" cmd .= section cmd .= " --center=\"User Contributed Parrot Documentation\" --release=\"parrot " cmd .= version cmd .= "\" " cmd .= pod cmd .= " > " cmd .= man system(cmd, 1 :named('verbose')) goto L1 L2: .end =back =head3 Step clean =over 4 =item pbc_pir =cut .sub '_clean_pbc_pir' :anon .param pmc kv :slurpy :named $I0 = exists kv['pbc_pir'] unless $I0 goto L1 $P0 = kv['pbc_pir'] clean_key($P0) L1: .end .sub 'clean_key' .param pmc hash $P0 = iter hash L1: unless $P0 goto L2 $S0 = shift $P0 unlink($S0, 1 :named('verbose')) goto L1 L2: .end =item inc_pir =cut .sub '_clean_inc_pir' :anon .param pmc kv :slurpy :named $I0 = exists kv['inc_pir'] unless $I0 goto L1 $P0 = kv['inc_pir'] clean_key($P0) L1: .end =item pir_pir =cut .sub '_clean_pir_pir' :anon .param pmc kv :slurpy :named $I0 = exists kv['pir_pir'] unless $I0 goto L1 $P0 = kv['pir_pir'] clean_key($P0) L1: .end =item pir_pge =cut .sub '_clean_pir_pge' :anon .param pmc kv :slurpy :named $I0 = exists kv['pir_pge'] unless $I0 goto L1 $P0 = kv['pir_pge'] clean_key($P0) L1: .end =item pir_tge =cut .sub '_clean_pir_tge' :anon .param pmc kv :slurpy :named $I0 = exists kv['pir_tge'] unless $I0 goto L1 $P0 = kv['pir_tge'] clean_key($P0) L1: .end =item pir_nqp-rx / pir_nqprx / pir_nqp =cut .sub '_clean_pir_nqp_rx' :anon .param pmc kv :slurpy :named $I0 = exists kv['pir_nqp-rx'] unless $I0 goto L1 $P0 = kv['pir_nqp-rx'] clean_key($P0) L1: $I0 = exists kv['pir_nqprx'] unless $I0 goto L2 $P0 = kv['pir_nqprx'] clean_key($P0) L2: $I0 = exists kv['pir_nqp'] unless $I0 goto L3 $P0 = kv['pir_nqp'] clean_key($P0) L3: .end =item pir_winxed =cut .sub '_clean_pir_winxed' :anon .param pmc kv :slurpy :named $I0 = exists kv['pir_winxed'] unless $I0 goto L1 $P0 = kv['pir_winxed'] clean_key($P0) L1: .end =item pbc_pbc =cut .sub '_clean_pbc_pbc' :anon .param pmc kv :slurpy :named $I0 = exists kv['pbc_pbc'] unless $I0 goto L1 $P0 = kv['pbc_pbc'] clean_key($P0) L1: .end =item exe_pbc =cut .sub '_clean_exe_pbc' :anon .param pmc kv :slurpy :named $I0 = exists kv['exe_pbc'] unless $I0 goto L1 $P0 = kv['exe_pbc'] clean_exe_pbc($P0) L1: .end .sub 'clean_exe_pbc' .param pmc hash .local string bin, exe, obj, pbc exe = get_exe() obj = get_obj() $P0 = iter hash L1: unless $P0 goto L2 bin = shift $P0 pbc = hash[bin] $S1 = concat bin, exe unlink($S1, 1 :named('verbose')) $S1 = concat bin, '.c' unlink($S1, 1 :named('verbose')) $S1 = concat bin, obj unlink($S1, 1 :named('verbose')) goto L1 L2: .end =item installable_pbc =cut .sub '_clean_installable_pbc' :anon .param pmc kv :slurpy :named $I0 = exists kv['installable_pbc'] unless $I0 goto L1 $P0 = kv['installable_pbc'] clean_installable_pbc($P0) L1: .end .sub 'clean_installable_pbc' .param pmc hash .local string bin, exe, obj, pbc exe = get_exe() obj = get_obj() $P0 = iter hash L1: unless $P0 goto L2 bin = shift $P0 pbc = hash[bin] $S1 = _mk_path_installable(pbc, exe) unlink($S1, 1 :named('verbose')) $S1 = _mk_path_exe(pbc, '.c') unlink($S1, 1 :named('verbose')) $S1 = _mk_path_exe(pbc, obj) unlink($S1, 1 :named('verbose')) goto L1 L2: .end =item dynops =cut .sub '_clean_dynops' :anon .param pmc kv :slurpy :named $I0 = exists kv['dynops'] unless $I0 goto L1 $P0 = kv['dynops'] clean_dynops($P0) L1: .end .sub 'clean_dynops' .param pmc hash .local string load_ext, obj load_ext = get_load_ext() obj = get_obj() $P0 = iter hash L1: unless $P0 goto L2 .local string ops, src ops = shift $P0 src = hash[ops] $S0 = _mk_path_dynops(ops, load_ext) unlink($S0, 1 :named('verbose')) $S0 = _mk_path_gen_dynops(src, ops, '.c') unlink($S0, 1 :named('verbose')) $S0 = _mk_path_gen_dynops(src, ops, '.h') unlink($S0, 1 :named('verbose')) $S0 = _mk_path_gen_dynops(src, ops, obj) unlink($S0, 1 :named('verbose')) goto L1 L2: .end =item dynpmc =cut .sub '_clean_dynpmc' :anon .param pmc kv :slurpy :named $I0 = exists kv['dynpmc'] unless $I0 goto L1 $P0 = kv['dynpmc'] clean_dynpmc($P0) L1: .end .sub 'clean_dynpmc' .param pmc hash .local string load_ext, obj load_ext = get_load_ext() obj = get_obj() $P0 = iter hash L1: unless $P0 goto L2 .local string name name = shift $P0 .local pmc srcs srcs = hash[name] $S0 = _mk_path_dynpmc(name, load_ext) unlink($S0, 1 :named('verbose')) $I0 = does srcs, 'array' unless $I0 goto L5 $P1 = iter srcs L3: unless $P1 goto L4 .local string src src = shift $P1 .local string ext $I0 = rindex src, '.' ext = substr src, $I0 if ext == '.h' goto L3 $S0 = _mk_path_gen_dynpmc(src, obj) unlink($S0, 1 :named('verbose')) if ext == '.c' goto L3 $S0 = _mk_path_gen_dynpmc(src, '.c') unlink($S0, 1 :named('verbose')) $S0 = _mk_path_gen_dynpmc(src, '.h') unlink($S0, 1 :named('verbose')) $S0 = _mk_path_gen_dynpmc(src, '.dump') unlink($S0, 1 :named('verbose')) goto L3 L4: src = srcs[0] $S0 = _mk_path_gen_dynpmc_group(src, name, '.c') unlink($S0, 1 :named('verbose')) $S0 = _mk_path_gen_dynpmc_group(src, name, '.h') unlink($S0, 1 :named('verbose')) $S0 = _mk_path_gen_dynpmc_group(src, name, obj) unlink($S0, 1 :named('verbose')) goto L1 L5: src = srcs $S0 = _mk_path_gen_dynpmc(src, '.c') unlink($S0, 1 :named('verbose')) $S0 = _mk_path_gen_dynpmc(src, '.h') unlink($S0, 1 :named('verbose')) $S0 = _mk_path_gen_dynpmc(src, '.dump') unlink($S0, 1 :named('verbose')) $S0 = _mk_path_gen_dynpmc(src, obj) unlink($S0, 1 :named('verbose')) goto L1 L2: .end =item html_pod =cut .sub '_clean_html_pod' :anon .param pmc kv :slurpy :named $I0 = exists kv['html_pod'] unless $I0 goto L1 $P0 = kv['html_pod'] clean_key($P0) L1: .end =item man_pod =cut .sub '_clean_man_pod' :anon .param pmc kv :slurpy :named $I0 = exists kv['man_pod'] unless $I0 goto L1 $P0 = kv['man_pod'] clean_key($P0) L1: .end =back =head3 Step update The following Version Control System are handled : =over 4 =cut .sub '_update' :anon .param pmc kv :slurpy :named $S0 = get_vcs() unless $S0 == 'cvs' goto L1 .tailcall _update_cvs(kv :flat :named) L1: unless $S0 == 'git' goto L2 .tailcall _update_git(kv :flat :named) L2: unless $S0 == 'hg' goto L3 .tailcall _update_hg(kv :flat :named) L3: unless $S0 == 'svn' goto L4 .tailcall _update_svn(kv :flat :named) L4: die "Don't known how to update." .end =item CVS =cut .sub '_update_cvs' :anon .param pmc kv :slurpy :named system('cvs update', 1 :named('verbose')) .end =item Git =cut .sub '_update_git' :anon .param pmc kv :slurpy :named system('git pull', 1 :named('verbose')) .end =item Mercurial =cut .sub '_update_hg' :anon .param pmc kv :slurpy :named system('hg pull --update', 1 :named('verbose')) .end =item SVN =cut .sub '_update_svn' :anon .param pmc kv :slurpy :named system('svn update', 1 :named('verbose')) .end =back =head3 Step patch The following Version Control System are handled : =over 4 =cut .sub '_patch' :anon .param pmc kv :slurpy :named $S0 = get_vcs() unless $S0 == 'cvs' goto L1 .tailcall _patch_cvs(kv :flat :named) L1: unless $S0 == 'git' goto L2 .tailcall _patch_git(kv :flat :named) L2: unless $S0 == 'hg' goto L3 .tailcall _patch_hg(kv :flat :named) L3: unless $S0 == 'svn' goto L4 .tailcall _patch_svn(kv :flat :named) L4: die "Don't known how to create a patch." .end =item CVS =cut .sub '_patch_cvs' :anon .param pmc kv :slurpy :named system('cvs diff', 1 :named('verbose')) .end =item Git =cut .sub '_patch_git' :anon .param pmc kv :slurpy :named system('git diff', 1 :named('verbose')) .end =item Mercurial =cut .sub '_patch_hg' :anon .param pmc kv :slurpy :named system('hg diff', 1 :named('verbose')) .end =item SVN =cut .sub '_patch_svn' :anon .param pmc kv :slurpy :named system('svn diff', 1 :named('verbose')) .end =back =head3 Step test =over 4 =item prove_exec / test_exec option --exec of prove =item prove_files / test_files the default value is "t/*.t" =back =cut .sub '_test' :anon .param pmc kv :slurpy :named run_step('build', kv :flat :named) load_bytecode 'TAP/Harness.pbc' .local pmc opts, files, harness, aggregate opts = new 'Hash' $I0 = exists kv['prove_exec'] unless $I0 goto L1 $S0 = kv['prove_exec'] opts['exec'] = $S0 L1: $I0 = exists kv['test_exec'] unless $I0 goto L2 $S0 = kv['test_exec'] opts['exec'] = $S0 L2: $S0 = "t/*.t" $I0 = exists kv['prove_files'] unless $I0 goto L3 $S0 = kv['prove_files'] L3: $I0 = exists kv['test_files'] unless $I0 goto L4 $S0 = kv['test_files'] L4: $P0 = glob($S0) files = sort_strings($P0) harness = new ['TAP';'Harness'] harness.'process_args'(opts) aggregate = harness.'runtests'(files) $I0 = aggregate.'has_errors'() unless $I0 goto L5 die "test fails" L5: .end .sub 'sort_strings' .param pmc array # currently, FixedStringArray hasn't the method sort. # see GH #384 $I0 = elements array $P0 = new 'FixedPMCArray' set $P0, $I0 $I0 = 0 $P1 = iter array L1: unless $P1 goto L2 $S0 = shift $P1 $P0[$I0] = $S0 inc $I0 goto L1 L2: $P0.'sort'() .return ($P0) .end =head3 Step smoke =over 4 =item prove_exec / test_exec option --exec of prove =item prove_files / test_files the default value is "t/*.t" =item prove_archive / smolder_archive option --archive of prove the default value is report.tar.gz =item smolder_url a string =item smolder_tags a string =item smolder_comments a string =item smolder_extra_properties a hash =item smolder_credentials A string, of the form "USERNAME:PASSWORD" to be used as the credentials for the server. The default is "parrot-autobot:qa_rocks" =back =cut .sub '_smoke' :anon .param pmc kv :slurpy :named run_step('build', kv :flat :named) load_bytecode 'TAP/Harness.pbc' .local pmc opts, files, harness, aggregate opts = new 'Hash' $I0 = exists kv['prove_exec'] unless $I0 goto L1 $S0 = kv['prove_exec'] opts['exec'] = $S0 L1: $I0 = exists kv['test_exec'] unless $I0 goto L2 $S0 = kv['test_exec'] opts['exec'] = $S0 L2: $S0 = "t/*.t" $I0 = exists kv['prove_files'] unless $I0 goto L3 $S0 = kv['prove_files'] L3: $I0 = exists kv['test_files'] unless $I0 goto L4 $S0 = kv['test_files'] L4: $P0 = glob($S0) files = sort_strings($P0) harness = new ['TAP';'Harness';'Archive'] harness.'process_args'(opts) .local string archive archive = "report.tar.gz" $I0 = exists kv['prove_archive'] unless $I0 goto L5 archive = kv['prove_archive'] L5: $I0 = exists kv['smolder_archive'] unless $I0 goto L6 archive = kv['smolder_archive'] L6: archive = get_value('prove_archive', "report.tar.gz" :named('default'), kv :flat :named) harness.'archive'(archive) .local pmc extra_props $I0 = exists kv['smolder_extra_properties'] unless $I0 goto L7 extra_props = kv['smolder_extra_properties'] goto L8 L7: extra_props = new 'Hash' L8: $I0 = exists extra_props['Submitter'] if $I0 goto L9 $S0 = get_submitter() extra_props['Submitter'] = $S0 L9: harness.'extra_props'(extra_props) aggregate = harness.'runtests'(files) print "creat " say archive smolder_post(archive, kv :flat :named) .end .sub 'smolder_post' :anon .param string archive .param pmc kv :slurpy :named .local string cmd $I0 = exists kv['smolder_url'] unless $I0 goto L1 .local pmc config config = get_config() .local pmc contents contents = new 'ResizablePMCArray' # by couple push contents, 'architecture' $S0 = config['cpuarch'] push contents, $S0 push contents, 'platform' $S0 = config['osname'] push contents, $S0 push contents, 'revision' $S0 = config['git_describe'] push contents, $S0 $I0 = exists kv['smolder_tags'] unless $I0 goto L2 push contents, 'tags' $S0 = kv['smolder_tags'] push contents, $S0 L2: $I0 = exists kv['smolder_comments'] unless $I0 goto L3 push contents, 'comments' $S0 = kv['smolder_comments'] push contents, $S0 L3: push contents, 'report_file' $P0 = new 'FixedStringArray' set $P0, 1 $P0[0] = archive push contents, $P0 $S0 = get_value('smolder_credentials', "parrot-autobot:qa_rocks" :named('default'), kv :flat :named) $P0 = split ':', $S0 $P1 = $P0[0] push contents, 'username' push contents, $P1 $P1 = $P0[1] push contents, 'password' push contents, $P1 load_bytecode 'LWP/UserAgent.pir' .local pmc ua, response ua = new ['LWP';'UserAgent'] ua.'env_proxy'() ua.'show_progress'(1) $S0 = kv['smolder_url'] response = ua.'post'($S0, contents :flat, 'form-data' :named('Content-Type'), 'close' :named('Connection')) $I0 = response.'code'() unless $I0 == 302 goto L1 $S0 = response.'content'() $I0 = index $S0, 'Report' unless $I0 == 0 goto L4 $I0 = index $S0, "\n" if $I0 < 0 goto L4 $S0 = substr $S0, 0, $I0 L4: print $S0 L1: .end .sub '_clean_smoke' :anon .param pmc kv :slurpy :named $S0 = get_value('prove_archive', "report.tar.gz" :named('default'), kv :flat :named) unlink($S0, 1 :named('verbose')) $S0 = get_value('smolder_archive', "report.tar.gz" :named('default'), kv :flat :named) unlink($S0, 1 :named('verbose')) .end =head3 Step install =over 4 =item inst_bin (useful ?) array of pathname or a single pathname =item inst_data array of pathname or a single pathname =item inst_dynext (useful ?) array of pathname or a single pathname =item inst_inc array of pathname or a single pathname =item inst_lang array of pathname or a single pathname =item inst_lib array of pathname or a single pathname =item installable_pbc =item dynops =item dynpmc =item root =item man_dir the default value is man =cut .sub '_install' :anon .param pmc kv :slurpy :named .local string root root = get_value('root', '' :named('default'), kv :flat :named) $P0 = get_install_files(kv :flat :named) $P1 = iter $P0 L1: unless $P1 goto L2 $S0 = shift $P1 $S1 = $P0[$S0] $S2 = root . $S0 install($S1, $S2, 1 :named('verbose')) goto L1 L2: $P0 = get_install_xfiles(kv :flat :named) $P1 = iter $P0 L3: unless $P1 goto L4 $S0 = shift $P1 $S1 = $P0[$S0] $S2 = root . $S0 install($S1, $S2, 1 :named('exe'), 1 :named('verbose')) goto L3 L4: .local int has_zlib $P0 = get_config() has_zlib = $P0['has_zlib'] $S0 = $P0['osname'] unless $S0 == 'MSWin32' goto L8 has_zlib = 0 L8: $P0 = get_install_gzfiles(kv :flat :named) $P1 = iter $P0 L5: unless $P1 goto L6 $S0 = shift $P1 $S1 = $P0[$S0] $S2 = root . $S0 unless has_zlib goto L7 $S3 = $S2 . '.gz' $I0 = newer($S3, $S1) if $I0 goto L5 install($S1, $S2, 1 :named('verbose')) gzip($S2, 1 :named('verbose')) goto L5 L7: install($S1, $S2, 1 :named('verbose')) goto L5 L6: .end .sub 'get_install_files' :anon .param pmc kv :slurpy :named .local pmc files files = new 'Hash' $I0 = exists kv['inst_bin'] unless $I0 goto L1 $P0 = kv['inst_bin'] get_install_bin(files, $P0) L1: $I0 = exists kv['inst_dynext'] unless $I0 goto L2 $P0 = kv['inst_dynext'] get_install_lib(files, "dynext", $P0) L2: $I0 = exists kv['inst_inc'] unless $I0 goto L3 $P0 = kv['inst_inc'] get_install_lib(files, "include", $P0) L3: $I0 = exists kv['inst_lang'] unless $I0 goto L4 $P0 = kv['inst_lang'] get_install_lib(files, "languages", $P0) L4: $I0 = exists kv['inst_lib'] unless $I0 goto L5 $P0 = kv['inst_lib'] get_install_lib(files, "library", $P0) L5: $I0 = exists kv['inst_data'] unless $I0 goto L6 $P0 = kv['inst_data'] get_install_data(files, $P0) L6: .return (files) .end .sub 'get_install_bin' :anon .param pmc files .param pmc array $S1 = get_bindir() $S1 .= "/" $I0 = does array, 'array' if $I0 goto L1 $S0 = array $S2 = $S1 . $S0 files[$S2] = $S0 goto L2 L1: $P0 = iter array L3: unless $P0 goto L2 $S0 = shift $P0 $S2 = $S1 . $S0 files[$S2] = $S0 goto L3 L2: .end .sub 'get_install_data' :anon .param pmc files .param pmc array $S1 = get_datadir() $S1 .= "/" $I0 = does array, 'array' if $I0 goto L1 $S0 = array $S2 = $S1 . $S0 files[$S2] = $S0 goto L2 L1: $P0 = iter array L3: unless $P0 goto L2 $S0 = shift $P0 $S2 = $S1 . $S0 files[$S2] = $S0 goto L3 L2: .end .sub 'get_install_lib' :anon .param pmc files .param string dirname .param pmc array $S1 = get_libdir() $S1 .= "/" $S1 .= dirname $S1 .= "/" $I0 = does array, 'array' if $I0 goto L1 $S0 = array $S3 = $S0 $I0 = index $S0, "build/" unless $I0 == 0 goto L0 $S3 = substr $S0, 6 L0: $S2 = $S1 . $S3 files[$S2] = $S0 goto L2 L1: $P0 = iter array L3: unless $P0 goto L2 $S0 = shift $P0 $S3 = $S0 $I0 = index $S0, "build/" unless $I0 == 0 goto L4 $S3 = substr $S0, 6 L4: $S2 = $S1 . $S3 files[$S2] = $S0 goto L3 L2: .end .sub 'get_install_xfiles' :anon .param pmc kv :slurpy :named .local pmc files files = new 'Hash' $I0 = exists kv['installable_pbc'] unless $I0 goto L1 $P0 = kv['installable_pbc'] get_install_installable_pbc(files, $P0) L1: $I0 = exists kv['dynops'] unless $I0 goto L2 $P0 = kv['dynops'] get_install_dynops(files, $P0) L2: $I0 = exists kv['dynpmc'] unless $I0 goto L3 $P0 = kv['dynpmc'] get_install_dynpmc(files, $P0) L3: .return (files) .end .sub 'get_install_installable_pbc' :anon .param pmc files .param pmc hash .local string bin, bindir, pbc, exe bindir = get_bindir() exe = get_exe() $P0 = iter hash L1: unless $P0 goto L2 bin = shift $P0 pbc = hash[bin] $S1 = _mk_path_installable(pbc, exe) $S2 = bindir . '/' $S2 .= bin $S2 .= exe files[$S2] = $S1 goto L1 L2: .end .sub 'get_install_dynops' :anon .param pmc files .param pmc hash .local string libdir, load_ext, ops libdir = get_libdir() load_ext = get_load_ext() $P0 = iter hash L1: unless $P0 goto L2 ops = shift $P0 $S1 = _mk_path_dynops(ops, load_ext) $S2 = libdir . "/" $S2 .= $S1 files[$S2] = $S1 goto L1 L2: .end .sub 'get_install_dynpmc' :anon .param pmc files .param pmc hash .local string libdir, load_ext libdir = get_libdir() load_ext = get_load_ext() $P0 = iter hash L1: unless $P0 goto L2 $S0 = shift $P0 $S1 = _mk_path_dynpmc($S0, load_ext) $S2 = libdir . "/" $S2 .= $S1 files[$S2] = $S1 goto L1 L2: .end .sub 'get_install_gzfiles' :anon .param pmc kv :slurpy :named .local pmc files files = new 'Hash' .local string man man = get_value('man_dir', "man" :named('default'), kv :flat :named) get_install_man(files, man) .return (files) .end .sub 'get_install_man' :anon .param pmc files .param string man_dir $I0 = length man_dir $S0 = man_dir . '/man*/*.?' $P0 = glob($S0) $S1 = get_datadir() $S1 .= "/man" L1: $P1 = iter $P0 L3: unless $P1 goto L2 $S0 = shift $P1 $S2 = substr $S0, $I0 $S2 = $S1 . $S2 files[$S2] = $S0 goto L3 L2: .end =back =head3 Step uninstall Same options as install. =cut .sub '_uninstall' :anon .param pmc kv :slurpy :named .local string root root = get_value('root', '' :named('default'), kv :flat :named) $P0 = get_install_files(kv :flat :named) $P1 = iter $P0 L1: unless $P1 goto L2 $S0 = shift $P1 $S0 = root . $S0 unlink($S0, 1 :named('verbose')) goto L1 L2: $P0 = get_install_xfiles(kv :flat :named) $P1 = iter $P0 L3: unless $P1 goto L4 $S0 = shift $P1 $S0 = root . $S0 unlink($S0, 1 :named('verbose')) goto L3 L4: $P0 = get_install_gzfiles(kv :flat :named) $P1 = iter $P0 L5: unless $P1 goto L6 $S0 = shift $P1 $S0 = root . $S0 unlink($S0, 1 :named('verbose')) $S0 .= '.gz' unlink($S0, 1 :named('verbose')) goto L5 L6: .end =head3 Step plumage =over 4 =item name =item abstract =item authority =item version =item license_type =item license_uri =item copyright_holder =item packager =item description =item keywords =item checkout_uri =item browser_uri =item project_uri =item setup the default value is setup.pir =back =cut .sub '_plumage' :anon .param pmc kv :slurpy :named $S0 = get_plumage(kv :flat :named) $S1 = mk_plumage(kv :flat :named) $I0 = file_exists($S0) unless $I0 goto L1 $S0 = kv['__target__'] unless $S0 == 'plumage' goto L2 print $S1 goto L2 L1: $S2 = dirname($S0) mkpath($S2, 1 :named('verbose')) spew($S0, $S1, 1 :named('verbose')) L2: .end .sub 'get_plumage' :anon .param pmc kv :slurpy :named $S0 = get_name(kv :flat :named) $S0 .= '.json' $S0 = 'ports/plumage/' . $S0 .return ($S0) .end .sub 'mk_plumage' :anon .param pmc kv :slurpy :named .local string name name = get_name(kv :flat :named) .local string abstract $S0 = get_value('abstract', kv :flat :named) abstract = _json_escape($S0) .local string authority authority = get_value('authority', kv :flat :named) .local string version version = get_version(kv :flat :named) .local string license_type license_type = get_value('license_type', kv :flat :named) .local string license_uri license_uri = get_value('license_uri', kv :flat :named) .local string copyright_holder $S0 = get_value('copyright_holder', kv :flat :named) copyright_holder = _json_escape($S0) .local string packager $S0 = get_value('packager', "distutils" :named('default'), kv :flat :named) packager = _json_escape($S0) .local string description $S0 = get_value('description', kv :flat :named) description = _json_escape($S0) .local string keywords keywords = '' $I0 = exists kv['keywords'] unless $I0 goto L10 $P1 = kv['keywords'] $S1 = join "\", \"", $P1 keywords = "\"" . $S1 keywords .= "\"" L10: .local string setup setup = get_value('setup', "setup.pir" :named('default'), kv :flat :named) .local string instruction instruction = _plumage_instruction(setup) .local string vcs vcs = get_vcs() .local string checkout_uri checkout_uri = get_value('checkout_uri', kv :flat :named) .local string browser_uri browser_uri = get_value('browser_uri', kv :flat :named) .local string project_uri project_uri =get_value('project_uri', kv :flat :named) $P0 = new 'FixedStringArray' set $P0, 23 $P0[0] = name $P0[1] = abstract $P0[2] = authority $P0[3] = version $P0[4] = license_type $P0[5] = license_uri $P0[6] = copyright_holder $P0[7] = packager $P0[8] = keywords $P0[9] = description $P0[10] = instruction $P0[11] = instruction $P0[12] = instruction $P0[13] = instruction $P0[14] = instruction $P0[15] = instruction $P0[16] = instruction $P0[17] = name $P0[18] = vcs $P0[19] = vcs $P0[20] = checkout_uri $P0[21] = browser_uri $P0[22] = project_uri $S0 = <<'TEMPLATE' { "meta-spec" : { "version" : 1, "uri" : "https://trac.parrot.org/parrot/wiki/ModuleEcosystem" }, "general" : { "name" : "%s", "abstract" : "%s", "authority": "%s", "version" : "%s", "license" : { "type" : "%s", "uri" : "%s" }, "copyright_holder" : "%s", "generated_by" : "%s", "keywords" : [%s], "description" : "%s" }, "instructions" : { "fetch" : { "type" : "repository" }, "update" : { "type" : "%s" }, "build" : { "type" : "%s" }, "test" : { "type" : "%s" }, "smoke" : { "type" : "%s" }, "install" : { "type" : "%s" }, "uninstall": { "type" : "%s" }, "clean" : { "type" : "%s" } }, "dependency-info" : { "provides" : ["%s"], "requires" : { "fetch" : ["%s"], "build" : [], "test" : [], "install" : [], "runtime" : [] } }, "resources" : { "repository" : { "type" : "%s", "checkout_uri": "%s", "browser_uri" : "%s", "project_uri" : "%s" } } } TEMPLATE $S0 = sprintf $S0, $P0 .return ($S0) .end .sub '_json_escape' :anon .param string str $P0 = split '"', str str = join '\"', $P0 $P0 = split "\n", str str = join "\\n", $P0 .return (str) .end .sub '_plumage_instruction' :anon .param string setup .local string instruction instruction = "parrot_setup" $I0 = index setup, "." $S0 = substr setup, $I0 unless $S0 == '.nqp' goto L1 instruction = "nqp_setup" L1: .return (instruction) .end =head3 Step manifest =over 4 =item manifest_includes array of pathname or a single pathname =item manifest_excludes array of pathname or a single pathname =item doc_files array of pathname or a single pathname =item pbc_pir, pir_pge, pir_tge, pir_nqp, pir_nqp-rx, pir_nqprx, inc_pir, pir_pir pbc_pbc, exe_pbc, installable_pbc, dynops, dynpmc, html_pod =item inst_bin, inst_data, inst_dynext, inst_inc, inst_lang, inst_lib =item harness_files, prove_files =item setup the default value is setup.pir =back =cut .sub '_manifest' :anon .param pmc kv :slurpy :named $S0 = '' $I0 = file_exists('MANIFEST') unless $I0 goto L1 $S0 = slurp('MANIFEST') L1: $S1 = mk_manifest(kv :flat :named) unless $S0 != $S1 goto L2 spew('MANIFEST', $S1, 1 :named('verbose')) L2: .end .sub 'mk_manifest' :anon .param pmc kv :slurpy :named .local pmc needed, generated needed = new 'Hash' generated = new 'Hash' $P0 = split ' ', 'pbc_pir pir_pge pir_tge pir_nqp pir_nqp-rx pir_nqprx inc_pir pir_pir pbc_pbc exe_pbc installable_pbc dynops dynpmc html_pod man_pod' L1: unless $P0 goto L2 $S0 = shift $P0 $I0 = exists kv[$S0] unless $I0 goto L1 $P1 = kv[$S0] _manifest_add_hash(needed, generated, $P1) goto L1 L2: $P1 = get_install_gzfiles(kv :flat :named) _manifest_add_hash(needed, generated, $P1) $P0 = split ' ', 'inst_bin inst_data inst_dynext inst_inc inst_lang inst_lib doc_files' L3: unless $P0 goto L4 $S0 = shift $P0 $I0 = exists kv[$S0] unless $I0 goto L3 $P1 = kv[$S0] _manifest_add_array(needed, $P1) goto L3 L4: $P0 = split ' ', 'harness_files prove_files' $I1 = 0 L5: unless $P0 goto L6 $S0 = shift $P0 $I0 = exists kv[$S0] unless $I0 goto L5 $I1 = 1 $S1 = kv[$S0] _manifest_add_glob(needed, $S1) goto L5 L6: if $I1 goto L7 _manifest_add_glob(needed, 't/*.t') L7: $P0 = split ' ', 't/harness' $S0 = get_value('setup', 'setup.pir' :named('default'), kv :flat :named) push $P0, $S0 L8: unless $P0 goto L9 $S0 = shift $P0 $I0 = file_exists($S0) unless $I0 goto L8 needed[$S0] = 1 goto L8 L9: $S0 = get_license_file() if $S0 == '' goto L10 needed[$S0] = 1 L10: $P0 = iter generated L11: unless $P0 goto L12 $S0 = shift $P0 delete needed[$S0] goto L11 L12: $I0 = exists kv['manifest_includes'] unless $I0 goto L13 $P1 = kv['manifest_includes'] _manifest_add_array(needed, $P1) L13: $I0 = exists kv['manifest_excludes'] unless $I0 goto L14 $P1 = kv['manifest_excludes'] _manifest_del_array(needed, $P1) L14: $P1 = iter needed $I0 = elements $P1 inc $I0 $P0 = new 'FixedPMCArray' # currently, FixedStringArray hasn't the method sort. # see GH #384 set $P0, $I0 $I0 = 0 $P0[$I0] = 'MANIFEST' L21: unless $P1 goto L22 $S0 = shift $P1 inc $I0 $P0[$I0] = $S0 goto L21 L22: $P0.'sort'() $S0 = join "\n", $P0 $S0 .= "\n" .return ($S0) .end .sub '_manifest_add_hash' :anon .param pmc needed .param pmc generated .param pmc hash $P0 = iter hash L1: unless $P0 goto L2 .local string key key = shift $P0 generated[key] = 1 .local pmc depends depends = $P0[key] $I0 = does depends, 'array' unless $I0 goto L3 $P1 = iter depends L4: unless $P1 goto L1 $S0 = shift $P1 if $S0 == '' goto L4 needed[$S0] = 1 goto L4 L3: $S0 = depends needed[$S0] = 1 goto L1 L2: .end .sub '_manifest_add_array' :anon .param pmc needed .param pmc array $I0 = does array, 'array' unless $I0 goto L1 $P0 = iter array L2: unless $P0 goto L3 $S0 = shift $P0 needed[$S0] = 1 goto L2 L1: $S0 = array needed[$S0] = 1 L3: .end .sub '_manifest_del_array' :anon .param pmc needed .param pmc array $I0 = does array, 'array' unless $I0 goto L1 $P0 = iter array L2: unless $P0 goto L3 $S0 = shift $P0 delete needed[$S0] goto L2 L1: $S0 = array delete needed[$S0] L3: .end .sub '_manifest_add_glob' :anon .param pmc needed .param string str $P0 = glob(str) L1: unless $P0 goto L2 $S0 = shift $P0 needed[$S0] = 1 goto L1 L2: .end =head3 Step sdist =cut .sub '_sdist' :anon .param pmc kv :slurpy :named .tailcall run_step('sdist_gztar', kv :flat :named) .end =head3 Step sdist_gztar =cut .sub '_sdist_gztar' :anon .param pmc kv :slurpy :named run_step('manifest', kv :flat :named) load_bytecode 'Archive/Tar.pbc' $S0 = slurp('MANIFEST') $P0 = split "\n", $S0 $S0 = pop $P0 .local string archive_file archive_file = get_tarname('.tar.gz', kv :flat :named) $I0 = newer(archive_file, $P0) if $I0 goto L1 .local pmc archive archive = new ['Archive';'Tar'] $P1 = archive.'add_files'($P0 :flat) .local string dirname $S0 = get_tarname('', kv :flat :named) dirname = $S0 . '/' L2: unless $P1 goto L3 $P2 = shift $P1 $S0 = $P2.'full_path'() $S0 = dirname . $S0 $P2.'rename'($S0) goto L2 L3: $P0 = loadlib 'gziphandle' $P0 = new 'GzipHandle' $P0.'open'(archive_file, 'wb') archive.'write'($P0) $P0.'close'() print "creat " say archive_file L1: .end .sub '_clean_gztar' :anon .param pmc kv :slurpy :named $S0 = get_tarname('.tar.gz', kv :flat :named) unlink($S0, 1 :named('verbose')) unlink('MANIFEST', 1 :named('verbose')) .end .sub 'get_tarname' :anon .param string ext .param pmc kv :slurpy :named $S0 = 'parrot-' $S1 = get_name(kv :flat :named) $S0 .= $S1 $S0 .= '-' $S1 = get_version(kv :flat :named) $S0 .= $S1 $S0 .= ext .return ($S0) .end =head3 Step sdist_rpm =cut .sub '_sdist_rpm' :anon .param pmc kv :slurpy :named run_step('sdist_gztar', kv :flat :named) .local string rpm_base rpm_base = get_value('rpm_base', 'rpm' :named('default'), kv :flat :named) $S1 = get_tarname('.tar.gz', kv :flat :named) $S2 = rpm_base . "/SOURCES/" $S2 .= $S1 install($S1, $S2, 1 :named('verbose')) run_step('spec', kv :flat :named) .local string cmd cmd = "rpmbuild --define '_topdir " $S0 = cwd() cmd .= $S0 cmd .= "/" cmd .= rpm_base cmd .= "' -bs -v " $S0 = get_spec(kv :flat :named) cmd .= $S0 system(cmd, 1 :named('verbose')) .end =head3 Step bdist On Windows calls bdist_wininst, otherwise bdist_rpm =cut .sub '_bdist' :anon .param pmc kv :slurpy :named $P0 = get_config() $S0 = $P0['osname'] unless $S0 == 'MSWin32' goto L1 .tailcall run_step('bdist_wininst', kv :flat :named) L1: .tailcall run_step('bdist_rpm', kv :flat :named) .end =head3 Step spec =over 4 =item rpm_base the default value is ports/rpm =item name =item version =item release =item abstract =item license_type =item project_uri =item description =item packager =item doc_files =item installable_pbc, dynops, dynpmc =item inst_bin, inst_data, inst_dynext, inst_inc, inst_lang, inst_lib =item setup the default value is setup.pir =back =cut .sub '_spec_rpm' :anon .param pmc kv :slurpy :named $S0 = get_spec(kv :flat :named) $S1 = mk_spec(kv :flat :named) $I0 = file_exists($S0) unless $I0 goto L1 $S0 = kv['__target__'] unless $S0 == 'spec' goto L2 print $S1 goto L2 L1: $S2 = dirname($S0) mkpath($S2, 1 :named('verbose')) spew($S0, $S1, 1 :named('verbose')) .local string cmd $S2 = dirname($S2) cmd = "rpmbuild --define '_topdir " . $S2 cmd .= "' --nobuild " cmd .= $S0 system(cmd, 1 :named('verbose'), 1 :named('ignore_error')) L2: .end .sub 'get_spec' :anon .param pmc kv :slurpy :named $S0 = get_value('rpm_base', 'rpm' :named('default'), kv :flat :named) $S0 .= "/SPECS/parrot-" $S1 = get_name(kv :flat :named) $S0 .= $S1 $S0 .= '.spec' .return ($S0) .end .sub 'mk_spec' :anon .param pmc kv :slurpy :named .local pmc config config = get_config() .local string parrot_version $S1 = config['VERSION'] $S2 = config['DEVEL'] parrot_version = $S1 . $S2 .local string name name = get_name(kv :flat :named) .local string version version = get_version(kv :flat :named) .local string release release = get_value('release', '1' :named('default'), kv :flat :named) .local string abstract abstract = get_value('abstract', kv :flat :named) .local string license_type license_type = get_value('license_type', kv :flat :named) .local string project_uri project_uri =get_value('project_uri', kv :flat :named) .local string tarball tarball = get_tarname('.tar.gz', kv :flat :named) .local string description description = get_value('description', kv :flat :named) .local string packager packager = get_value('packager', "you " :named('default'), kv :flat :named) .local string setup setup = get_value('setup', "setup.pir" :named('default'), kv :flat :named) .local string command command = _command_setup(setup) $P0 = new 'FixedStringArray' set $P0, 12 $P0[0] = parrot_version $P0[1] = name $P0[2] = version $P0[3] = release $P0[4] = abstract $P0[5] = license_type $P0[6] = project_uri $P0[7] = tarball $P0[8] = description $P0[9] = command $P0[10] = command $P0[11] = command $S0 = <<'TEMPLATE' %%define parrot_version %s Name: parrot-%s Version: %s Release: %s Summary: %s License: %s Group: Development/Libraries URL: %s Source0: %s BuildRoot: %%{_tmppath}/%%{name}-%%{version}-%%{release} #BuildRequires: parrot = %%parrot_version #BuildRequires: parrot-devel = %%parrot_version %%description %s %%prep %%setup -n %%{name}-%%{version} %%build %s %%install rm -rf $RPM_BUILD_ROOT %s --root $RPM_BUILD_ROOT install %%check %s test %%clean rm -rf $RPM_BUILD_ROOT %%files %%defattr(-,root,root,-) TEMPLATE .local string spec spec = sprintf $S0, $P0 $S0 = mk_deb_docs(kv :flat :named) if $S0 == '' goto L1 spec .= "%doc " $P1 = split "\n", $S0 $S0 = pop $P1 $S0 = join "\n%doc ", $P1 spec .= $S0 spec .= "\n" L1: $S0 = mk_deb_install(kv :flat :named) $P1 = split parrot_version, $S0 $S0 = join "%{parrot_version}", $P1 spec .= $S0 spec .= "\n%changelog\n* " $I0 = time $S0 = localtime $I0 $I0 = length $S0 dec $I0 $S0 = substr $S0, 0, $I0 $S1 = substr $S0, 0, 11 spec .= $S1 $S1 = substr $S0, 20 spec .= $S1 spec .= " " spec .= packager spec .= "\n- created by distutils\n" .return (spec) .end .sub '_command_setup' :anon .param string setup .local string command command = "parrot " $I0 = index setup, '.' $S0 = substr setup, $I0 unless $S0 == '.nqp' goto L1 command = "parrot-nqp " L1: command .= setup .return (command) .end =head3 Step bdist_rpm =cut .sub '_bdist_rpm' :anon .param pmc kv :slurpy :named run_step('sdist_gztar', kv :flat :named) .local string rpm_base rpm_base = get_value('rpm_base', 'rpm' :named('default'), kv :flat :named) $S1 = get_tarname('.tar.gz', kv :flat :named) $S2 = rpm_base . "/SOURCES/" $S2 .= $S1 install($S1, $S2, 1 :named('verbose')) run_step('spec', kv :flat :named) .local string cmd cmd = "rpmbuild --define '_topdir " $S0 = cwd() cmd .= $S0 cmd .= "/" cmd .= rpm_base cmd .= "' -bb -v " $S0 = get_spec(kv :flat :named) cmd .= $S0 system(cmd, 1 :named('verbose')) .end =head3 Step control See L. =over 4 =item control_dir the default value is ports/debian =item name =item packager =item project_uri =item abstract =item description =item release =item copyright_holder =item doc_files =item installable_pbc, dynops, dynpmc =item inst_bin, inst_data, inst_dynext, inst_inc, inst_lang, inst_lib =item setup the default value is setup.pir =back =cut .sub '_control_deb' :anon .param pmc kv :slurpy :named $S0 = get_deb('control', kv :flat :named) $S1 = dirname($S0) mkpath($S1, 1 :named('verbose')) $S1 = mk_deb_control(kv :flat :named) $I0 = file_exists($S0) unless $I0 goto L1 $S0 = kv['__target__'] unless $S0 == 'control' goto L2 print $S1 goto L3 L1: spew($S0, $S1, 1 :named('verbose')) L2: $S0 = get_deb('changelog', kv :flat :named) $I0 = file_exists($S0) if $I0 goto L4 $S1 = mk_deb_changelog(kv :flat :named) spew($S0, $S1, 1 :named('verbose')) L4: $S0 = get_deb('copyright', kv :flat :named) $I0 = file_exists($S0) if $I0 goto L5 $S1 = mk_deb_copyright(kv :flat :named) spew($S0, $S1, 1 :named('verbose')) L5: $S0 = get_deb('rules', kv :flat :named) $S1 = mk_deb_rules(kv :flat :named) spew($S0, $S1, 1 :named('verbose')) $S0 = get_deb_ext('.docs', kv :flat :named) $S1 = mk_deb_docs(kv :flat :named) spew($S0, $S1, 1 :named('verbose')) $S0 = get_deb_ext('.install', kv :flat :named) $S1 = mk_deb_install(kv :flat :named) spew($S0, $S1, 1 :named('verbose')) L3: .end .sub 'get_deb' :anon .param string filename .param pmc kv :slurpy :named $S0 = get_value('control_dir', 'ports/debian' :named('default'), kv :flat :named) $S0 .= "/" $S0 .= filename .return ($S0) .end .sub 'get_deb_ext' :anon .param string ext .param pmc kv :slurpy :named $S0 = get_value('control_dir', 'ports/debian' :named('default'), kv :flat :named) $S0 .= "/parrot-" $S1 = get_name(kv :flat :named) $S0 .= $S1 $S0 .= ext .return ($S0) .end .sub 'mk_deb_control' :anon .param pmc kv :slurpy :named .local pmc config config = get_config() .local string parrot_version $S1 = config['VERSION'] $S2 = config['DEVEL'] parrot_version = $S1 . $S2 .local string name name = get_name(kv :flat :named) .local string packager packager = get_value('packager', "you " :named('default'), kv :flat :named) .local string project_uri project_uri =get_value('project_uri', kv :flat :named) .local string abstract abstract = get_value('abstract', kv :flat :named) .local string description $S0 = get_value('description', kv :flat :named) $P0 = split "\n", $S0 description = join "\n ", $P0 $P0 = new 'FixedStringArray' set $P0, 8 $P0[0] = name $P0[1] = packager $P0[2] = parrot_version $P0[3] = project_uri $P0[4] = name $P0[5] = parrot_version $P0[6] = abstract $P0[7] = description $S0 = <<'TEMPLATE' Source: parrot-%s Section: interpreters Priority: optional Maintainer: %s Build-Depends: debhelper (>= 7), parrot-devel (= %s) Standards-Version: 3.8.3 Homepage: %s Package: parrot-%s Architecture: any Depends: parrot-minimal (= %s) Description: %s %s TEMPLATE $S0 = sprintf $S0, $P0 .return ($S0) .end .sub 'mk_deb_changelog' :anon .param pmc kv :slurpy :named .local string name name = get_name(kv :flat :named) .local string version version = get_version(kv :flat :named) .local string release release = get_value('release', '1' :named('default'), kv :flat :named) .local string packager packager = get_value('packager', "you " :named('default'), kv :flat :named) .local string timestamp timestamp = get_timestamp() $P0 = new 'FixedStringArray' set $P0, 5 $P0[0] = name $P0[1] = version $P0[2] = release $P0[3] = packager $P0[4] = timestamp $S0 = <<'TEMPLATE' parrot-%s (%s-%s) unstable; urgency=low * Created by distutils. -- %s %s TEMPLATE $S0 = sprintf $S0, $P0 .return ($S0) .end .sub 'mk_deb_copyright' :anon .param pmc kv :slurpy :named .local string packager packager = get_value('packager', "you " :named('default'), kv :flat :named) .local string timestamp timestamp = get_timestamp() .local string project_uri project_uri =get_value('project_uri', kv :flat :named) .local string copyright_holder copyright_holder = get_value('copyright_holder', kv :flat :named) .local string license license = '' $S0 = get_license_file() if $S0 == '' goto L1 $S0 = slurp($S0) $P0 = split "\n", $S0 license = join "\n ", $P0 L1: $P0 = new 'FixedStringArray' set $P0, 5 $P0[0] = packager $P0[1] = timestamp $P0[2] = project_uri $P0[3] = copyright_holder $P0[4] = license $S0 = <<'TEMPLATE' This package was debianized by %s on %s. It was downloaded from %s Copyright for the code is held by: %s License: %s TEMPLATE $S0 = sprintf $S0, $P0 .return ($S0) .end .sub 'mk_deb_rules' :anon .param pmc kv :slurpy :named .local string setup setup = get_value('setup', "setup.pir" :named('default'), kv :flat :named) .local string command command = _command_setup(setup) $P0 = new 'FixedStringArray' set $P0, 3 $P0[0] = command $P0[1] = command $P0[2] = command $S0 = <<'TEMPLATE' #!/usr/bin/make -f # -*- makefile -*- # Uncomment this to turn on verbose mode. #export DH_VERBOSE=1 configure: configure-stamp configure-stamp: dh_testdir touch configure-stamp build: build-stamp build-stamp: configure-stamp dh_testdir %s build touch $@ clean: dh_testdir dh_testroot rm -f build-stamp configure-stamp %s clean dh_clean install: build dh_testdir dh_testroot dh_prep dh_installdirs %s --root $(CURDIR)/debian/tmp install dh_install --sourcedir=$(CURDIR)/debian/tmp --list-missing # Build architecture-independent files here. binary-indep: install # We have nothing to do by default. # Build architecture-dependent files here. binary-arch: build install dh_testdir dh_testroot dh_installchangelogs dh_installdocs dh_installexamples dh_installman dh_link dh_strip dh_compress dh_fixperms dh_installdeb dh_shlibdeps dh_gencontrol dh_md5sums dh_builddeb binary: binary-indep binary-arch .PHONY: build clean binary-indep binary-arch binary install configure TEMPLATE $S0 = sprintf $S0, $P0 .return ($S0) .end .sub 'mk_deb_docs' :anon .param pmc kv :slurpy :named $S0 = '' $I0 = exists kv['doc_files'] unless $I0 goto L1 $P0 = kv['doc_files'] $I0 = does $P0, 'array' if $I0 goto L2 $S0 = $P0 goto L1 L2: $S0 = join "\n", $P0 L1: $S0 .= "\n" .return ($S0) .end .sub 'mk_deb_install' :anon .param pmc kv :slurpy :named $P0 = new 'ResizablePMCArray' # currently, ResizableStringArray hasn't the method sort. # see GH #384 $P1 = get_install_files(kv :flat :named) $P2 = iter $P1 L1: unless $P2 goto L2 $S0 = shift $P2 push $P0, $S0 goto L1 L2: $P1 = get_install_xfiles(kv :flat :named) $P2 = iter $P1 L3: unless $P2 goto L4 $S0 = shift $P2 push $P0, $S0 goto L3 L4: $P1 = get_install_gzfiles(kv :flat :named) $P2 = iter $P1 L5: unless $P2 goto L6 $S0 = shift $P2 push $P0, $S0 goto L5 L6: $P0.'sort'() $S0 = join "\n", $P0 $S0 .= "\n" .return ($S0) .end .sub 'get_timestamp' :anon $P0 = new 'FileHandle' $P0.'open'('date --rfc-2822', 'rp') $S0 = $P0.'readline'() $P0.'close'() $S0 = chopn $S0, 1 .return ($S0) .end =head3 Step ebuild See L. =over 4 =item description =item project_uri =item license_type =item doc_files =item setup the default value is setup.pir =back =cut .sub '_ebuild_gentoo' :anon .param pmc kv :slurpy :named $S0 = get_ebuild(kv :flat :named) $S1 = mk_ebuild(kv :flat :named) $I0 = file_exists($S0) unless $I0 goto L1 $S0 = kv['__target__'] unless $S0 == 'ebuild' goto L2 print $S1 goto L2 L1: $S2 = dirname($S0) mkpath($S2, 1 :named('verbose')) spew($S0, $S1, 1 :named('verbose')) L2: .end .sub 'get_ebuild' :anon .param pmc kv :slurpy :named $S0 = "ports/gentoo/parrot-" $S1 = get_name(kv :flat :named) $S0 .= $S1 $S0 .= "-" $S1 = get_version(kv :flat :named) $S0 .= $S1 $S0 .= '.ebuild' .return ($S0) .end .sub 'mk_ebuild' :anon .param pmc kv :slurpy :named .local string description $S0 = get_value('description', kv :flat :named) description = _json_escape($S0) .local string project_uri project_uri =get_value('project_uri', kv :flat :named) .local string license_type license_type = get_value('license_type', kv :flat :named) .local string setup setup = get_value('setup', "setup.pir" :named('default'), kv :flat :named) .local string command command = _command_setup(setup) .local string doc doc = '' $I0 = exists kv['doc_files'] unless $I0 goto L1 doc = " dodoc " $P0 = kv['doc_files'] $I0 = does $P0, 'array' if $I0 goto L2 $S0 = $P0 goto L3 L2: $S0 = join " ", $P0 L3: doc .= $S0 doc .= " || die" L1: $P0 = new 'FixedStringArray' set $P0, 7 $P0[0] = description $P0[1] = project_uri $P0[2] = license_type $P0[3] = command $P0[4] = command $P0[5] = doc $P0[6] = command $S0 = <<'TEMPLATE' DESCRIPTION="%s" HOMEPAGE="%s" SRC_URI="./${P}.tar.gz" LICENSE="%s" SLOT="0" KEYWORDS="~arch" IUSE="" #DEPEND="" #RDEPEND="" src_compile() { %s build || die "build failed" } src_install() { %s --root ${D} install || die "install failed" %s } src_test() { %s test || die "test failed" } TEMPLATE $S0 = sprintf $S0, $P0 .return ($S0) .end =head3 Step bdist_wininst Build an installer with Inno Setup. See L. =over 4 =item name =item version =item copyright_holder =item project_uri =item installable_pbc, dynops, dynpmc =item inst_bin, inst_data, inst_dynext, inst_inc, inst_lang, inst_lib =item doc_files =back =cut .sub '_bdist_wininst' :anon .param pmc kv :slurpy :named run_step('build', kv :flat :named) $I0 = exists kv['installable_pbc'] unless $I0 goto L1 $P0 = kv['installable_pbc'] .local string exe, bin, pbc exe = get_exe() $P1 = iter $P0 L2: unless $P1 goto L1 bin = shift $P1 pbc = $P0[bin] $S1 = _mk_path_installable(pbc, exe) $S2 = bin . exe $I0 = newer($S2, $S1) if $I0 goto L2 cp($S1, $S2, 1 :named('verbose')) goto L2 L1: $S0 = mk_inno_script(kv :flat :named) spew('inno.iss', $S0) system("iscc inno.iss", 1 :named('verbose')) .end .sub 'mk_inno_script' :anon .param pmc kv :slurpy :named .local pmc config config = get_config() .local string prefix prefix = config['prefix'] .local string parrot_version $S1 = config['VERSION'] $S2 = config['DEVEL'] parrot_version = $S1 . $S2 .local string name name = get_Name(kv :flat :named) .local string version version = get_version(kv :flat :named) .local string copyright_holder copyright_holder = get_value('copyright_holder', kv :flat :named) .local string project_uri project_uri =get_value('project_uri', kv :flat :named) .local string license license = "; no LicenseFile" $S0 = get_license_file() if $S0 == '' goto L3 license = "LicenseFile=" . $S0 L3: .local string setupname setupname = get_setupname('', kv :flat :named) $P0 = new 'FixedStringArray' set $P0, 9 $P0[0] = name $P0[1] = parrot_version $P0[2] = name $P0[3] = version $P0[4] = copyright_holder $P0[5] = project_uri $P0[6] = prefix $P0[7] = license $P0[8] = setupname $S0 = <<'TEMPLATE' ; generated by distutils.pir for the Inno Setup Script Compiler. [Setup] AppName=Parrot-%s AppVerName=Parrot-%s-%s-%s AppPublisher=%s AppPublisherURL=%s DefaultDirName={sd}%s DefaultGroupName=Parrot AllowNoIcons=yes %s OutputDir=.\\ OutputBaseFilename=%s Compression=lzma SolidCompression=yes Uninstallable=no [Files] TEMPLATE .local string script script = sprintf $S0, $P0 $I0 = exists kv['dynops'] if $I0 goto L21 $I0 = exists kv['dynpmc'] if $I0 goto L21 goto L22 L21: script .= "Source: \".\\dynext\\*.dll\"; DestDir: \"{app}\\lib\\parrot\\dynext\"; Flags:\n" L22: $I0 = exists kv['installable_pbc'] unless $I0 goto L23 $P1 = kv['installable_pbc'] $P2 = iter $P1 L24: unless $P2 goto L23 $S0 = shift $P2 script .= "Source: \".\\" script .= $S0 script .= ".exe\"; DestDir: \"{app}\\bin\"; Flags:\n" goto L24 L23: $P1 = get_install_files(kv :flat :named) $P2 = iter $P1 L31: unless $P2 goto L32 $S0 = shift $P2 $S1 = $P1[$S0] $S0 = _mk_inno_line($S1, $S0) script .= $S0 goto L31 L32: $P1 = get_install_gzfiles(kv :flat :named) $P2 = iter $P1 L33: unless $P2 goto L34 $S0 = shift $P2 $S1 = $P1[$S0] $S0 = _mk_inno_line($S1, $S0) script .= $S0 goto L33 L34: $I0 = exists kv['doc_files'] unless $I0 goto L41 name = get_name(kv :flat :named) $P1 = kv['doc_files'] $I0 = does $P1, 'array' if $I0 goto L42 $S0 = $P1 $S0 = _mk_inno_line_doc($S0, name) script .= $S0 goto L41 L42: $P2 = iter $P1 L43: unless $P2 goto L41 $S0 = shift $P2 $S0 = _mk_inno_line_doc($S0, name) script .= $S0 goto L43 L41: script .= "\n" .return (script) .end .sub '_mk_inno_line' :anon .param string src .param string dest .local string line line = "Source: \".\\" $S0 = _escape_path_win32(src) line .= $S0 line .= "\"; DestDir: \"{app}\\" $S0 = dirname(dest) $I0 = index $S0, '/', 1 inc $I0 $S0 = substr $S0, $I0 $S0 = _escape_path_win32($S0) line .= $S0 line .= "\"; Flags:\n" .return (line) .end .sub '_mk_inno_line_doc' :anon .param string src .param string dest .local string line line = "Source: \".\\" $S0 = _escape_path_win32(src) line .= $S0 line .= "\"; DestDir: \"{app}\\share\\doc\\parrot\\" $S0 = dest line .= $S0 line .= "\"; Flags:\n" .return (line) .end .sub '_escape_path_win32' :anon .param string path $P0 = split "/", path $S0 = join "\\", $P0 .return ($S0) .end .sub 'get_setupname' :anon .param string ext .param pmc kv :slurpy :named .local pmc config config = get_config() $S0 = 'setup-parrot-' $S1 = config['VERSION'] $S0 .= $S1 $S1 = config['DEVEL'] $S0 .= $S1 $S0 .= '-' $S1 = get_name(kv :flat :named) $S0 .= $S1 $S0 .= '-' $S1 = get_version(kv :flat :named) $S0 .= $S1 $S0 .= ext .return ($S0) .end .sub '_clean_wininst' :anon .param pmc kv :slurpy :named $I0 = exists kv['installable_pbc'] unless $I0 goto L1 $P0 = kv['installable_pbc'] .local string exe, bin exe = get_exe() $P1 = iter $P0 L2: unless $P1 goto L1 bin = shift $P1 $S0 = bin . exe unlink($S0, 1 :named('verbose')) goto L2 L1: unlink('inno.iss', 1 :named('verbose')) $S0 = get_setupname('.exe', kv :flat :named) unlink($S0, 1 :named('verbose')) .end .sub '_no_zlib' :anon .param pmc kv :slurpy :named say "This step needs a parrot built with zlib" .end =head2 Configuration Helpers =over 4 =item get_config Return the whole config =cut .include 'iglobals.pasm' .sub 'get_config' $P0 = getinterp $P1 = $P0[.IGLOBALS_CONFIG_HASH] .return ($P1) .end =item get_bindir =cut .sub 'get_bindir' $P0 = get_config() $S0 = $P0['bindir'] .return ($S0) .end =item get_cflags =cut .sub 'get_cflags' $P0 = get_config() .local string flags flags = $P0['ccflags'] flags .= " " $S0 = $P0['cc_shared'] flags .= $S0 flags .= " " $S0 = $P0['cc_debug'] flags .= $S0 flags .= " " $S0 = $P0['ccwarn'] flags .= $S0 flags .= " " .return (flags) .end =item get_compiler =cut .sub 'get_compiler' .param string name $P0 = get_config() $I0 = $P0['installed'] unless $I0 goto L1 $S0 = $P0['libdir'] $S1 = $P0['versiondir'] $S0 .= $S1 $S0 .= '/languages/' goto L2 L1: $S0 = $P0['prefix'] $S0 .= '/compilers/' L2: $S0 .= name .return ($S0) .end =item get_datadir =cut .sub 'get_datadir' $P0 = get_config() $S0 = $P0['datadir'] .return ($S0) .end =item get_exe =cut .sub 'get_exe' $P0 = get_config() $S0 = $P0['exe'] .return ($S0) .end =item get_executable =cut .sub 'get_executable' .param string name $S0 = '"' $P0 = get_config() $I0 = $P0['installed'] unless $I0 goto L1 $S1 = $P0['bindir'] goto L2 L1: $S1 = $P0['prefix'] L2: $S0 .= $S1 $S0 .= '/' $S0 .= name $S1 = $P0['exe'] $S0 .= $S1 $S0 .= '"' .return ($S0) .end =item get_incdir =cut .sub 'get_incdir' $P0 = get_config() $S0 = $P0['includedir'] $S1 = $P0['versiondir'] $S0 .= $S1 .return ($S0) .end =item get_libdir =cut .sub 'get_libdir' $P0 = get_config() $S0 = $P0['libdir'] $S1 = $P0['versiondir'] $S0 .= $S1 .return ($S0) .end =item get_library =cut .sub 'get_library' .param string name $P0 = get_config() $I0 = $P0['installed'] unless $I0 goto L1 $S0 = $P0['libdir'] $S1 = $P0['versiondir'] $S0 .= $S1 $S0 .= '/library/' goto L2 L1: $S0 = $P0['prefix'] $S0 .= '/runtime/parrot/library/' L2: $S0 .= name .return ($S0) .end =item get_ldflags =cut .sub 'get_ldflags' $P0 = get_config() .local string flags flags = $P0['ldflags'] flags .= " " $S0 = $P0['ld_debug'] flags .= $S0 flags .= " " $S0 = $P0['rpath_blib'] flags .= $S0 flags .= " " $S0 = $P0['linkflags'] flags .= $S0 .return (flags) .end =item get_load_ext =cut .sub 'get_load_ext' $P0 = get_config() $S0 = $P0['load_ext'] .return ($S0) .end =item get_obj =cut .sub 'get_obj' $P0 = get_config() $S0 = $P0['o'] .return ($S0) .end =item get_parrot =cut .sub 'get_parrot' .tailcall get_executable('parrot') .end =item get_nqp =cut .sub 'get_nqp' .tailcall get_executable('parrot-nqp') .end =item get_nqp_rx =cut .sub 'get_nqp_rx' .tailcall get_executable('parrot-nqp') .end =item get_srcdir =cut =item get_winxed =cut .sub 'get_winxed' .tailcall get_executable('winxed') .end =item get_srcdir =cut .sub 'get_srcdir' $P0 = get_config() $S0 = $P0['srcdir'] $S1 = $P0['versiondir'] $S0 .= $S1 .return ($S0) .end =item get_tool =cut .sub 'get_tool' .param string name $P0 = get_config() $I0 = $P0['installed'] unless $I0 goto L1 $S0 = $P0['libdir'] $S1 = $P0['versiondir'] $S0 .= $S1 goto L2 L1: $S0 = $P0['prefix'] L2: $S0 .= '/tools/' $S0 .= name .return ($S0) .end =item get_vcs =cut .sub 'get_vcs' .local string vcs vcs = 'VCS' $I0 = file_exists('CVS') unless $I0 goto L1 vcs = 'cvs' goto L9 L1: $I0 = file_exists('.git') unless $I0 goto L2 vcs = 'git' goto L9 L2: $I0 = file_exists('.hg') unless $I0 goto L3 vcs = 'hg' goto L9 L3: $I0 = file_exists('.svn') unless $I0 goto L4 vcs = 'svn' goto L9 L4: L9: .return (vcs) .end =item get_license_file =cut .sub 'get_license_file' $P0 = split ' ', "LICENSE COPYING COPYRIGHT" L1: unless $P0 goto L2 $S0 = shift $P0 $I0 = file_exists($S0) unless $I0 goto L1 .return ($S0) L2: .return ('') .end =item get_Name =cut .sub 'get_Name' .param string name :named('name') :optional .param int has_name :opt_flag .param pmc extra :slurpy :named unless has_name goto L1 .return (name) L1: $S0 = cwd() $S0 = basename($S0) .return ($S0) .end =item get_name =cut .sub 'get_name' .param string name :named('name') :optional .param int has_name :opt_flag .param pmc extra :slurpy :named unless has_name goto L1 $S0 = downcase name .return ($S0) L1: $S0 = cwd() $S0 = basename($S0) $S0 = downcase $S0 .return ($S0) .end =item get_version =cut .sub 'get_version' .param pmc kv :slurpy :named .tailcall get_value('version', 'HEAD' :named('default'), kv :flat :named) .end =item get_value =cut .sub 'get_value' .param string key .param string default :named('default') :optional .param int has_default :opt_flag .param pmc kv :slurpy :named $I0 = exists kv[key] unless $I0 goto L1 $S0 = kv[key] .return ($S0) L1: unless has_default goto L2 .return (default) L2: $S0 = upcase key .return ($S0) .end =item get_submitter =cut .sub 'get_submitter' .local pmc env env = new 'Env' $I0 = exists env['SMOLDER_SUBMITTER'] unless $I0 goto L1 $S0 = env['SMOLDER_SUBMITTER'] .return ($S0) L1: .local string me $P0 = get_config() $I0 = exists $P0['win32'] unless $I0 goto L2 me = env['USERNAME'] goto L3 L2: me = env['LOGNAME'] L3: $S0 = me . '@unknown' .return ($S0) .end =item cc_run =cut .sub 'cc_run' .param string source .param string cflags :named('cflags') :optional .param int has_cflags :opt_flag .param string ldflags :named('ldflags') :optional .param int has_ldflags :opt_flag .param int verbose :named('verbose') :optional .const string srcname = 'tmp.c' spew(srcname, source) .local string exename exename = 'tmp' .local pmc config config = get_config() $S0 = config['osname'] if $S0 == 'MSWin32' goto L0 exename = './' . exename L0: $S0 = get_exe() exename .= $S0 .local string cmd cmd = config['cc'] cmd .= " " $S0 = get_cflags() cmd .= $S0 unless has_cflags goto L1 cmd .= " " cmd .= cflags L1: cmd .= " " cmd .= srcname cmd .= " " $S0 = get_ldflags() cmd .= $S0 unless has_ldflags goto L2 cmd .= " " cmd .= ldflags L2: cmd .= " -o " cmd .= exename system(cmd, verbose :named('verbose'), 1 :named('ignore_error')) unlink(srcname, verbose :named('verbose')) $P0 = new 'FileHandle' $P0.'open'(exename, 'rp') $S0 = $P0.'readall'() $P0.'close'() unlink(exename, verbose :named('verbose')) .return ($S0) .end =item probe_include =cut .sub 'probe_include' .param string include .param string cflags :named('cflags') :optional .param int verbose :named('verbose') :optional $P0 = new 'FixedStringArray' set $P0, 2 $P0[0] = include $P0[1] = include $S0 = sprintf <<'SOURCE_C', $P0 #include <%s> #include int main(int argc, char* argv[]) { printf("OK %s\n"); return 0; } SOURCE_C $S0 = cc_run($S0, cflags :named('cflags'), verbose :named('verbose')) $I0 = index $S0, 'OK ' .return ($I0) .end =item runtests =cut .sub 'runtests' :multi() .param pmc files :slurpy .param pmc opts :slurpy :named load_bytecode 'TAP/Harness.pbc' .local pmc harness harness = new ['TAP';'Harness'] harness.'process_args'(opts) .local pmc aggregate aggregate = harness.'runtests'(files) $I0 = aggregate.'has_errors'() unless $I0 goto L1 $I0 = exists opts['ignore_error'] unless $I0 goto L2 $I0 = opts['ignore_error'] if $I0 goto L1 L2: die "test fails" L1: .end .sub 'runtests' :multi(ResizableStringArray,Hash) .param pmc array .param pmc hash .tailcall runtests(array :flat, hash :flat :named) .end =back =head1 AUTHOR Francois Perrad =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: transform.pir000644000765000765 734011533177635 21111 0ustar00brucebruce000000000000parrot-5.9.0/examples/tge/branch# Copyright (C) 2006-2009, Parrot Foundation. =head1 NAME transform - transform a sample tree of Branch and Leaf nodes =head1 SYNOPSIS # must be run from this directory ... $ ../../../parrot transform.pir branch.g =head1 DESCRIPTION This example script constructs a tree grammar from a tree grammar syntax file, and uses the constructed grammar to transform a tree of the specified type. =cut .sub _main :main .param pmc argv load_bytecode 'TGE.pbc' load_bytecode 'lib/Leaf.pir' load_bytecode 'lib/Branch.pir' # Load the syntax file .local string source source = _get_source(argv) # Compile a grammar from the source grammar file .local pmc grammar $P1 = new ['TGE';'Compiler'] grammar = $P1.'compile'(source) # Build up the tree for testing .local pmc tree tree = buildtree() # Apply the grammar to the test tree .local pmc AGI AGI = grammar.'apply'(tree) # Retrieve the value of a top level attribute $P4 = AGI.'get'('gmin') print "----\nthe global minimum attribute value is: " print $P4 print " of type: " $S4 = typeof $P4 print $S4 print "\n" # Retrieve the transformed tree $P5 = AGI.'get'('result') # $S5 = typeof $P5 # print $S5 # print "\n" $P6 = getattribute tree, 'left' $P7 = getattribute $P6, 'left' $P8 = getattribute $P7, 'value' print "----\nbefore transform, the value of the left-most leaf is: " print $P8 print "\n" $P6 = getattribute $P5, 'left' $P7 = getattribute $P6, 'left' $P8 = getattribute $P7, 'value' print "after transform, the value of the left-most leaf is: " print $P8 print "\n" $P10 = getattribute tree, 'right' $P11 = getattribute $P10, 'right' $P12 = getattribute $P11, 'right' $P13 = getattribute $P12, 'value' print "----\nbefore transform, the value of the right-most leaf is: " print $P13 print "\n" $P10 = getattribute $P5, 'right' $P11 = getattribute $P10, 'right' $P12 = getattribute $P11, 'right' $P13 = getattribute $P12, 'value' print "after transform, the value of the right-most leaf is: " print $P13 print "\n----\n" end err_parse: print "Unable to parse the tree grammar.\n" end .end # Read in the source either from a file or from STDIN .sub _get_source .param pmc argv .local pmc filehandle .local string filename $I0 = argv if $I0 == 2 goto fromfile $P0 = getinterp filehandle = $P0.'stdin_handle'() goto grabline fromfile: # Read in the source file filename = argv[1] filehandle = new ['FileHandle'] filehandle.'open'(filename, 'r') grabline: $S1 = filehandle.'read'(65535) # $S1 = readline filehandle # print $S1 if $I0 != 2 goto finished filehandle.'close'() finished: .return ($S1) .end # ---------------------------------- .sub buildtree $P0 = build_Leaf(5) $P1 = build_Leaf(9) $P2 = build_Branch($P0, $P1) $P3 = build_Leaf(1) $P4 = build_Branch($P3, $P2) $P5 = build_Leaf(2) $P6 = build_Leaf(3) $P7 = build_Branch($P5, $P6) $P8 = build_Branch($P7, $P4) .return($P8) .end .sub build_Leaf .param int value .local pmc newnode newnode = new 'Leaf' $P1 = new 'Integer' $P1 = value setattribute newnode, 'value', $P1 .return(newnode) .end .sub build_Branch .param pmc left_child .param pmc right_child .local pmc newnode newnode = new 'Branch' setattribute newnode, 'left', left_child setattribute newnode, 'right', right_child .return(newnode) .end =head1 AUTHOR Allison Randal =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: phony000644000765000765 5111533177646 20261 0ustar00brucebruce000000000000parrot-5.9.0/t/tools/install/testlibFile used in testing of Parrot::Install. Defines.mak000644000765000765 107511606346601 17527 0ustar00brucebruce000000000000parrot-5.9.0/compilers/opscOPSC_DIR = compilers/opsc OPSC_SOURCES_GENERATED = \ $(OPSC_DIR)/gen/Ops/Compiler.pir \ $(OPSC_DIR)/gen/Ops/Compiler/Actions.pir \ $(OPSC_DIR)/gen/Ops/Compiler/Grammar.pir \ $(OPSC_DIR)/gen/Ops/Emitter.pir \ $(OPSC_DIR)/gen/Ops/Trans.pir \ $(OPSC_DIR)/gen/Ops/Trans/C.pir \ $(OPSC_DIR)/gen/Ops/Op.pir \ $(OPSC_DIR)/gen/Ops/OpLib.pir \ $(OPSC_DIR)/gen/Ops/File.pir OPSC_SOURCES = \ $(OPSC_DIR)/opsc.pir \ $(OPSC_DIR)/src/builtins.pir \ $(OPSC_SOURCES_GENERATED) OPSC_CLEANUPS = \ $(OPSC_DIR)/opsc.pbc \ $(LIBRARY_DIR)/opsc.pbc \ $(OPSC_SOURCES_GENERATED) core_inclusion.pod000644000765000765 546612101554066 20641 0ustar00brucebruce000000000000parrot-5.9.0/docs/project# Copyright (C) 2010-2012, Parrot Foundation. =pod =head1 NAME docs/project/core_inclusion.pod - Core Inclusion =head1 DESCRIPTION This document address questions we will consider when deciding whether or not to move a piece of code into core. =head1 ABSTRACT Occasionally useful bits of code will arise that someone thinks should be made core components of Parrot. This document lists some of the questions we'll consider when deciding whether this is a good idea. =head1 INTRODUCTION When considering whether to add code to Parrot, we'll ask ourselves and the developer(s) the following questions, in approximate order of importance. This is not an exhaustive list as much as a guide to help us make sure we think through the implications of adopting and supporting a new core component. =over 4 =item * What benefit will the code provide to Parrot and its users? How will it help Parrot and its users to further their goals? Examples include better debugging, increased execution speed, better code generation and improved modularity. =item * How does its benefit outweigh its maintenance (testing, updating, support, deprecation, etc.) burden? This is somewhat subjective, but the main question concerns how high the maintenance burden will be relative to the benefits the code will provide. =item * Is the code something that most of Parrot's users will be happy to find? More specifically, will the addition make development more fun for the majority of Parrot's users. A generic optimization framework would help most projects and have a good chance of inclusion. A specialized math library or an HLL-specific datatype won't be of use to most projects and should live as a separate project. =item * How well-documented and tested is it? If we can't figure out how it works or if it does what it claims, it'll have a hard getting accepted. We have enough undertested and underdocumented code already. =item * Which committers have expressed willingness to maintain it? How familiar are they with it? Core code needs to be maintained. If an experienced core committer expresses willingness to maintain an addition, that's good. If that committer has worked with the code, that's better. =item * Does the code have any portability issues? We want Parrot to run on as many platforms as possible. If the code has any OS- or CPU-specific components, are they well-separated and easy to port to other systems? =item * What impact does it have on Parrot's install footprint? =item * How will having the code in core help Parrot more than having it in an external project would? =item * How will the addition impact Parrot's runtime characteristics, e.g. its memory usage, speed, startup time, etc? =item * What drawbacks will result from including the addition in core? =back =cut __END__ Local Variables: fill-column:78 End: blue_rect.pir000644000765000765 273712101554066 17602 0ustar00brucebruce000000000000parrot-5.9.0/examples/sdl# Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME blue_rect.pir - draw a blue rectangle with the SDL Parrot bindings =head1 SYNOPSIS To run this file, run the following command from the Parrot directory: $ ./parrot examples/sdl/blue_rect.pir =head1 DESCRIPTION This is a PIR program which draws a blue rectangle with SDL Parrot bindings. =cut .sub _main :main # first load the necessary libraries load_bytecode "SDL/App.pir" load_bytecode "SDL/Rect.pir" load_bytecode "SDL/Color.pir" # create an SDL::App object .local pmc app app = new ['SDL'; 'App'] app.'init'( 'height' => 480, 'width' => 640, 'bpp' => 32, 'flags' => 1 ) # fetch the SDL::Surface representing the main window .local pmc main_screen main_screen = app.'surface'() # create an SDL::Rect object .local pmc rect new rect, ['SDL'; 'Rect'] rect.'init'( 'height' => 100, 'width' => 100, 'x' => 270, 'y' => 190 ) # create an SDL::Color object .local pmc color new color, ['SDL'; 'Color'] color.'init'( 'r' => 0, 'g' => 0, 'b' => 255 ) # draw the rectangle to the surface and update it main_screen.'fill_rect'( rect, color ) main_screen.'update_rect'( rect ) # pause for people to see it sleep 2 # and that's it! app.'quit'() end .end =head1 AUTHOR chromatic, Echromatic at wgz dot orgE. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: dynlexpad.t000644000765000765 1313211567202625 16451 0ustar00brucebruce000000000000parrot-5.9.0/t/dynpmc#! perl # Copyright (C) 2005-2007, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Test tests => 11; use Parrot::Config; =head1 NAME t/dynpmc/dynlexpad.t - test the DynLexPad PMC =head1 SYNOPSIS % prove t/dynpmc/dynlexpad.t =head1 DESCRIPTION Tests the C PMC. =cut pir_output_is( << 'CODE', << 'OUTPUT', "loadlib" ); .sub main :main .local pmc lib lib = loadlib "dynlexpad" unless lib goto not_loaded print "ok\n" end not_loaded: print "not loaded\n" .end CODE ok OUTPUT pir_error_output_like( << 'CODE', << 'OUTPUT', "init" ); .sub main :main .local pmc lib lib = loadlib "dynlexpad" $P0 = new ['DynLexPad'] .end CODE /don't create me like this/ OUTPUT my $loadlib = <<'EOC'; .loadlib "dynlexpad" .HLL "Some" .sub load :anon :init .local pmc interp, lexpad, dynlexpad interp = getinterp lexpad = get_class 'LexPad' dynlexpad = get_class 'DynLexPad' interp.'hll_map'(lexpad, dynlexpad) .end EOC pir_output_is( $loadlib . << 'CODE', << 'OUTPUT', "store_lex" ); # see loadlib .sub 'test' :main foo() .end .sub foo :lex $P1 = new 'Integer' $P1 = 13013 store_lex 'a', $P1 print "ok 1\n" $P2 = find_lex 'a' print "ok 2\n" print $P2 print "\n" end .end CODE ok 1 ok 2 13013 OUTPUT pir_output_is( $loadlib . << 'CODE', << 'OUTPUT', "check :outer" ); .sub 'test' :main foo() .end .sub foo :lex $P1 = new 'Integer' $P1 = 13013 store_lex 'a', $P1 $P2 = find_lex 'a' print $P2 print "\n" .const 'Sub' bar_sub = "bar" $P0 = newclosure bar_sub $P0() .end .sub bar :outer(foo) .const 'Sub' baz_sub = "baz" $P0 = newclosure baz_sub $P0() .end .sub baz :lex :outer(bar) $P1 = find_lex 'a' print $P1 print "\n" .end CODE 13013 13013 OUTPUT pir_output_is( $loadlib . << 'CODE', << 'OUTPUT', "tcl-ish upvar" ); .sub 'test' :main foo() .end .sub foo :lex $P1 = new 'Integer' $P1 = 13013 store_lex 'a', $P1 $P2 = find_lex 'a' print $P2 print "\n" .const 'Sub' bar_sub = "bar" $P0 = newclosure bar_sub $P0() # check the upvar $P2 = find_lex 'b' print $P2 print "\n" .end .sub bar :outer(foo) .const 'Sub' baz_sub = "baz" $P0 = newclosure baz_sub $P0() .end .sub baz :lex :outer(bar) $P1 = find_lex 'a' print $P1 print "\n" # upvar 2 'b', 55 .local pmc pad, interp interp = getinterp pad = interp["lexpad"; 2] $P2 = new 'Integer' $P2 = 55 pad['b'] = $P2 .return() err: print "outer not found\n" .end CODE 13013 13013 55 OUTPUT pir_output_is( $loadlib . << 'CODE', << 'OUTPUT', "check that dynlexpad honors hll" ); .sub 'test' :main foo() bar() .end .sub foo :lex .local pmc pad, interp interp = getinterp pad = interp["lexpad"] $S0 = typeof pad print $S0 print "\n" .end .HLL "parrot" .sub bar :lex .local pmc pad, interp interp = getinterp pad = interp["lexpad"] $S0 = typeof pad print $S0 print "\n" .end CODE DynLexPad LexPad OUTPUT pir_output_is( $loadlib . << 'CODE', << 'OUTPUT', "dynlexpad - lexpad interop" ); .sub 'test' :main foo() .end .sub foo .lex 'a', $P0 # static lexical $P0 = new 'String' $P0 = "ok 1" $P1 = find_lex 'a' say $P1 $P2 = new 'String' $P2 = "ok 2" store_lex 'a', $P2 say $P0 # sic! $P3 = new 'String' $P3 = "ok 3" store_lex 'b', $P3 # and a dynamic one $P4 = find_lex 'b' say $P4 .end CODE ok 1 ok 2 ok 3 OUTPUT pir_output_is( $loadlib . << 'CODE', << 'OUTPUT', "dynlexpad count" ); .sub 'test' :main foo() .end .sub foo .lex 'a', $P0 # static lexical $P0 = new 'String' store_lex 'a', $P0 # and a dynamic one $P1 = getinterp $P2 = $P1['lexpad'] $I0 = elements $P2 say $I0 .end CODE 1 OUTPUT pir_output_is( $loadlib . << 'CODE', << 'OUTPUT', "dynlexpad destroy" ); .sub 'test' :main foo() .end .sub meh .end .sub foo $P0 = get_global "meh" $P1 = new ['LexInfo'], $P0 $P2 = new ['DynLexPad'], $P1 $P3 = $P2['a'] $I0 = isnull $P3 say $I0 null $P2 sweep 1 say "ok" .end CODE 1 ok OUTPUT pir_output_is( $loadlib . << 'CODE', << 'OUTPUT', "dynlexpad exists" ); .sub 'test' :main foo() .end .sub foo .lex 'a', $P0 $P0 = new 'String' store_lex 'a', $P0 $P1 = getinterp $P2 = $P1['lexpad'] $P3 = new ['String'] $P3 = "q" $I0 = exists $P2[$P3] say $I0 $I1 = exists $P2['a'] say $I1 .end CODE 0 1 OUTPUT pir_output_is( $loadlib . << 'CODE', << 'OUTPUT', "dynlexpad - iterator" ); .loadlib 'dynlexpad' .sub 'onload' :immediate .local pmc interp interp = getinterp .local pmc core core = get_class 'LexPad' .local pmc hll hll = get_class 'DynLexPad' interp.'hll_map'(core,hll) .end .sub 'test' :main .local pmc str1,str2,str3 str1 = box 'pants' str2 = box 'shorts' str3 = box 'skirt' .lex 'a', str1 .lex 'b', str2 .lex 'c', str3 store_lex 'a', str1 store_lex 'b', str2 store_lex 'c', str3 .local pmc interp interp = getinterp .local pmc dlp dlp = interp['lexpad'] .local pmc iterator iterator = iter dlp iter_loop: unless iterator goto iter_done .local pmc key key = shift iterator .local pmc value value = dlp[key] say value goto iter_loop iter_done: .end CODE pants shorts skirt OUTPUT # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: sockaddr.t000644000765000765 231111567202625 15515 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc#!./parrot # Copyright (C) 2006-2010, Parrot Foundation. =head1 NAME t/pmc/sockaddr.t - test the Sockaddr PMC =head1 SYNOPSIS % prove t/pmc/sockaddr.t =head1 DESCRIPTION Test the Sockaddr PMC. =cut .sub main :main .include 'test_more.pir' plan(8) test_basic() test_bool() test_string() .end .sub test_basic new $P0, ['Socket'] ok(1, 'Instantiated a Socket PMC') $P1 = $P0."sockaddr"("localhost", 1234) ok(1, 'socket.sockaddr method successful') $I0 = isnull $P0 $I0 = not $I0 ok($I0, 'Sockaddr PMC created') $S0 = typeof $P1 is($S0, 'Sockaddr', 'PMC has correct type') $P2 = clone $P1 $S2 = typeof $P2 is($S2, 'Sockaddr', 'PMC clone has correct type') .end .sub test_bool $P0 = new 'Socket' $P1 = $P0."sockaddr"("localhost", 1234) ok($P1, 'get_bool on a SockAddr') .end .sub test_string $P0 = new 'Socket' $P1 = $P0."sockaddr"("localhost", 1234) is($P1,"127.0.0.1:1234","sockaddr stringification") null $S0 $P1 = $P0."sockaddr"($S0, 56789) is($P1,"127.0.0.1:56789","sockaddr stringification") .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: error.c000644000765000765 243411611421261 17361 0ustar00brucebruce000000000000parrot-5.9.0/src/platform/win32/* * Copyright (C) 2011, Parrot Foundation. */ /* =head1 NAME src/platform/win32/error.c =head1 DESCRIPTION Functions for handling system errors. =head2 Functions =over 4 =cut */ #include #include "parrot/parrot.h" /* HEADERIZER HFILE: none */ /* =item C Returns a error message for a system error code. =cut */ STRING * Parrot_platform_strerror(PARROT_INTERP, INTVAL error) { DWORD flags = FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_MAX_WIDTH_MASK; DWORD lang_id = MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT); DWORD len; char *msg; STRING *result; /* FormatMessage really expects a (char **) cast to a (char *) */ len = FormatMessage(flags, NULL, error, lang_id, (LPTSTR)&msg, 0, NULL); if (len == 0) { result = Parrot_sprintf_c(interp, "Error code %ld", error); } else { result = Parrot_str_from_platform_cstring(interp, msg); LocalFree(msg); } return result; } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ eventhandler.pir000644000765000765 546412101554066 21627 0ustar00brucebruce000000000000parrot-5.9.0/examples/sdl/tetris =head1 DESCRIPTION eventhandler.pir - a tetris event handler class =cut .namespace ["Tetris::EventHandler"] .sub __onload :load $P0 = get_class "Tetris::EventHandler" unless null $P0 goto END load_bytecode "library/SDL/EventHandler.pir" get_class $P0, ['SDL'; 'EventHandler'] subclass $P0, $P0, "Tetris::EventHandler" $P1 = new 'String' $P1 = "BUILD" setprop $P0, "BUILD", $P1 addattribute $P0, "app" END: .end .sub BUILD :method .param pmc app setattribute self, 'app', app .end .sub app :method .local pmc app getattribute app, self, 'app' .return (app) .end .sub dispatch_event :method .local pmc app .local int ret app = self."app"() app."setTimer"( 0 ) $P0 = get_hll_global ['SDL'; 'Event'], "disptach_event" ret = $P0() app."setTimer"( 1 ) .return (ret) .end .sub nextBlock :method .param int boardID .param int blockID .local pmc app .local pmc board .local pmc block print "next block on board " print boardID print " is " print blockID print "\n" app = self."app"() board = app."board"( boardID ) # get the current next block block = board."getNextBlock"() # set the wanted block as new next block board."nextBlock"( blockID ) # make it active by activating a new block board."nextBlock"() # restore the old "nextBlock" board."setNextBlock"( block ) .end .sub key_down_escape :method end .end .sub key_down_0 :method self."nextBlock"( 0, -1 ) .end .sub key_down_1 :method self."nextBlock"( 0, 0 ) .end .sub key_down_2 :method self."nextBlock"( 0, 1 ) .end .sub key_down_3 :method self."nextBlock"( 0, 2 ) .end .sub key_down_4 :method self."nextBlock"( 0, 3 ) .end .sub key_down_5 :method self."nextBlock"( 0, 4 ) .end .sub key_down_6 :method self."nextBlock"( 0, 5 ) .end .sub key_down_7 :method self."nextBlock"( 0, 6 ) .end .sub key_down_space :method $P0 = self."app"() $P0."fall"( 0 ) .end .sub key_down_left :method $P0 = self."app"() $P0."move"( 0, -1, 0 ) .end .sub key_down_right :method $P0 = self."app"() $P0."move"( 0, +1, 0 ) .end .sub key_down_up :method $P0 = self."app"() $P0."rotate"( 0, -1 ) .end .sub key_down_down :method $P0 = self."app"() $P0."rotate"( 0, +1 ) .end .sub key_down_F1 :method $P0 = self."app"() $P0."newGame"( 1 ) .end .sub key_down_F2 :method $P0 = self."app"() $P0."newGame"( 2 ) .end =head1 AUTHOR Jens Rieks Eparrot at jensbeimsurfen dot deE is the author and maintainer. Please send patches and suggestions to the Perl 6 Internals mailing list. =head1 COPYRIGHT Copyright (C) 2004-2008, Parrot Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: sumcol.pir_output000644000765000765 411466337261 21574 0ustar00brucebruce000000000000parrot-5.9.0/examples/shootout500 solaris.pm000644000765000765 762011533177634 20077 0ustar00brucebruce000000000000parrot-5.9.0/config/init/hints# Copyright (C) 2005-2008, Parrot Foundation. package init::hints::solaris; use strict; use warnings; sub runstep { my ( $self, $conf ) = @_; my $libs = $conf->data->get('libs'); if ( $libs !~ /-lpthread\b/ ) { $libs .= ' -lpthread'; } if ( $libs !~ /-lrt\b/ ) { $libs .= ' -lrt'; # Needed for sched_yield. } $conf->data->set( libs => $libs ); ################################################################ # If we're going to be using ICU (or any other C++-compiled library) we # need to use the c++ compiler as a linker. As soon as the user # selects a compiler, we will run the gccversion test. (If we were to # wait till it's normally run, the linker question would have already # been asked.) my $solaris_link_cb = sub { use Carp; my ( $key, $cc ) = @_; my %gnuc; my $link = $conf->data->get('link'); $conf->cc_gen("config/auto/gcc/test_c.in"); # Can't call cc_build since we haven't set all the flags yet. # This should suffice for this test. my $cc_inc = $conf->data->get('cc_inc'); Parrot::Configure::Utils::_run_command( "$cc -o test_$$ test_$$.c", "test_$$.cco", "test_$$.cco" ) and confess "C compiler failed (see test_$$.cco)"; %gnuc = eval $conf->cc_run() or die "Can't run the test program: $!"; if ( defined $gnuc{__GNUC__} ) { $link = 'g++'; } else { $link =~ s/\bcc\b/CC/; } unless ($conf->data->get('rpath')) { $conf->data->set( 'rpath', '-R' ); } $conf->data->set( link => $link ); $conf->data->deltrigger( "cc", "solaris_link" ); }; $conf->data->settrigger( "cc", "solaris_link", $solaris_link_cb ); ################################################################ # cc_shared: Flags to instruct the compiler to use position-independent # code for use in shared libraries. -KPIC for Sun's compiler, -fPIC for # gcc. We don't know which compiler we're using till after the # gccversion test. my $solaris_cc_shared_cb = sub { my ( $key, $gccversion ) = @_; if ($gccversion) { $conf->data->set( cc_shared => '-fPIC' ); } else { $conf->data->set( cc_shared => '-KPIC' ); } $conf->data->set( 'has_dynamic_linking', '1' ); $conf->data->set( 'parrot_is_shared', '1' ); $conf->data->deltrigger( "gccversion", "solaris_cc_shared" ); }; $conf->data->settrigger( "gccversion", "solaris_cc_shared", $solaris_cc_shared_cb ); ################################################################ # Parrot usually aims for IEEE-754 compliance. # For Solaris 8/Sun Workshop Pro 4, both # atan2( 0.0, -0.0) and atan2(-0.0, -0.0) # return 0, when they should return +PI and -PI respectively. # For Sun's compilers, fix this with the -xlibmieee flag. # I don't know of an equivalent flag for gcc. # (Alternatively, and more generally, perhaps we should run an # ieee-conformance test and then call back into a hints-file trigger # to set platform-specific flags.) # A. Dougherty 7 March 2005 # We don't know which compiler we're using till after the gccversion test. my $solaris_ieee_cb = sub { my ( $key, $gccversion ) = @_; if ($gccversion) { # Don't know how to do this for gcc. } else { my $linkflags = $conf->data->get('linkflags'); $conf->data->add( ' ', linkflags => '-xlibmieee' ) unless $linkflags =~ /-xlibmieee/; } $conf->data->deltrigger( "gccversion", "solaris_ieee" ); }; $conf->data->settrigger( "gccversion", "solaris_ieee", $solaris_ieee_cb ); } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: vtable_h.pl000644000765000765 240411606346603 17076 0ustar00brucebruce000000000000parrot-5.9.0/tools/build#! perl # Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME tools/build/vtable_h.pl - Create the vtable header =head1 SYNOPSIS % perl tools/build/vtable_h.pl =head1 DESCRIPTION This script creates F from F. It uses C. =head1 SEE ALSO =over 4 =item C =back =cut use strict; use warnings; use lib 'lib'; use Parrot::Vtable; my $tbl = 'src/vtable.tbl'; my $vtable = parse_vtable( $tbl ); open my $OUT, '>', 'include/parrot/vtable.h' or die $!; print $OUT <<"EOF"; /* ex: set ro: ** !!!!!!! DO NOT EDIT THIS FILE !!!!!!! ** ** This file is generated automatically from $tbl by tools/build/vtable_h.pl */ #ifndef PARROT_VTABLE_H_GUARD #define PARROT_VTABLE_H_GUARD #include "parrot/parrot.h" #define VTABLE_SIZE 512 EOF print $OUT vtbl_defs($vtable); print $OUT "\n"; print $OUT vtbl_struct($vtable); print $OUT vtbl_macros($vtable); # append the guard suffix and C code coda print $OUT <<"EOC"; #endif /* PARROT_VTABLE_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * buffer-read-only: t * End: * vim: expandtab shiftwidth=4: */ EOC # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: entropy.c000644000765000765 254511716253436 20422 0ustar00brucebruce000000000000parrot-5.9.0/src/platform/generic/* * Copyright (C) 2011, Parrot Foundation. */ /* =head1 NAME src/platform/generic/entropy.c =head1 DESCRIPTION Get some entropy from the system. =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" /* HEADERIZER HFILE: none */ /* =item C Get one INTVAL worth of entropy from the system. =cut */ INTVAL Parrot_get_entropy(PARROT_INTERP) { INTVAL entropy; size_t count; FILE *urand_fh = fopen("/dev/urandom", "r"); if (!urand_fh) { const char *msg = "Couldn't open /dev/urandom for reading."; /* This function is called during interp init, so use the GC registry * as a way to figure out interp's initializedness. */ if (interp->gc_registry) Parrot_ex_throw_from_c_args(interp, NULL, 1, msg); else PANIC(interp, msg); } count = fread(&entropy, sizeof (INTVAL), 1, urand_fh); if (count != 1) { const char* msg = "Couldn't read from /dev/urandom."; fclose(urand_fh); if (interp->gc_registry) Parrot_ex_throw_from_c_args(interp, NULL, 1, msg); else PANIC(interp, msg); } fclose(urand_fh); return entropy; } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ 022-version.t000644000765000765 316111533177643 17123 0ustar00brucebruce000000000000parrot-5.9.0/t/configure#! perl # Copyright (C) 2007, Parrot Foundation. # 022-version.t use strict; use warnings; use Test::More tests => 6; use Carp; use Cwd; use File::Copy; use File::Temp qw| tempdir |; use lib qw( lib t/configure/testlib ); use Parrot::BuildUtil; use Make_VERSION_File qw| make_VERSION_file |; my $cwd = cwd(); { my $tdir = tempdir( CLEANUP => 1 ); ok( chdir $tdir, "Changed to temporary directory for testing" ); ok( ( mkdir "lib" ), "Able to make directory lib" ); ok( ( mkdir "lib/Parrot" ), "Able to make directory lib/Parrot" ); # Case 4: VERSION file with non-numeric component in version number make_VERSION_file(q{0.tomboy.11}); eval { my $pv = Parrot::BuildUtil::parrot_version(); }; like( $@, qr/Illegal version component: 'tomboy'/, "Correctly detected non-numeric component in version number" ); unlink q{VERSION} or croak "Unable to delete file from tempdir after testing"; ok( chdir $cwd, "Able to change back to directory after testing" ); } pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME 022-version.t - test C =head1 SYNOPSIS % prove t/configure/022-version.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file test Parrot::BuildUtil (F). =head1 AUTHOR James E Keenan =head1 SEE ALSO Parrot::BuildUtil, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: yyscanner.h000644000765000765 63111606346601 17216 0ustar00brucebruce000000000000parrot-5.9.0/include/imcc/* * Copyright (C) 2011, Parrot Foundation. */ #ifndef PARROT_IMCC_YYSCANNER_H_GUARD #define PARROT_IMCC_YYSCANNER_H_GUARD /* An opaque pointer. */ #ifndef YY_TYPEDEF_YY_SCANNER_T # define YY_TYPEDEF_YY_SCANNER_T typedef void* yyscan_t; #endif #endif /* PARROT_IMCC_YYSCANNER_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ pct_hllcompiler.t000644000765000765 1313011567202625 21130 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/pct#!perl # Copyright (C) 2005-2006, Parrot Foundation. use strict; use warnings; use lib qw(t . lib ../lib ../../lib ../../../lib); use Test::More; use Parrot::Test tests => 6; pir_output_is( <<'CODE', <<'OUT', 'some of the auxiliary methods' ); .sub _main :main load_bytecode 'PCT/HLLCompiler.pbc' $P0 = new ['PCT';'HLLCompiler'] # parse_name method $P1 = $P0.'parse_name'('None::Module') $S1 = $P1[0] say $S1 $S1 = $P1[1] say $S1 $P0.'parsegrammar'('None::Parser') $S1 = $P0.'parsegrammar'() say $S1 $P0.'astgrammar'('None::Grammar') $S1 = $P0.'astgrammar'() say $S1 end .end CODE None Module None::Parser None::Grammar OUT pir_output_is( <<'CODE', <<'OUT', 'one complete start-to-end compiler' ); .namespace [ 'NoneParser' ] .sub 'TOP' .param string source .param pmc options :slurpy :named .return (source) .end .namespace [ 'NoneBuilder' ] .sub 'init' :anon :load :init load_bytecode 'P6object.pbc' $P0 = get_hll_global 'P6metaclass' $P1 = $P0.'new_class'('NoneBuilder', 'attr' => 'text') .end .sub 'get' :method .param string stage $P0 = new ['PAST';'Op'] $P0.'pasttype'('inline') $P0.'inline'("print %0\nprint \"\\n\"") $P2 = getattribute self, "text" $P1 = new ['PAST';'Val'] $P1.'value'($P2) $P0.'push'($P1) .return ($P0) .end .sub 'text' :method .param pmc word setattribute self, 'text', word .end .namespace [ 'NoneGrammar' ] .sub 'init' :anon :load :init load_bytecode 'P6object.pbc' $P0 = get_hll_global 'P6metaclass' $P1 = $P0.'new_class'('NoneGrammar') .end .sub 'apply' :method .param pmc source $P0 = new 'NoneBuilder' $P0.'text'(source) .return ($P0) .end .namespace [ 'None';'Compiler' ] .sub _main :main load_bytecode 'PCT.pbc' $P0 = new ['PCT';'HLLCompiler'] $P0.'language'('None') $P0.'parsegrammar'('NoneParser') $P0.'astgrammar'('NoneGrammar') .local pmc args args = new 'ResizableStringArray' push args, "command" push args, "-e" push args, "thingy" $P1 = $P0.'command_line'(args) .return() .end CODE thingy OUT pir_output_is( <<'CODE', <<'OUT', 'default stages' ); .sub _main :main load_bytecode 'PCT/HLLCompiler.pbc' .local pmc hllcompiler hllcompiler = new ['PCT';'HLLCompiler'] $P0 = getattribute hllcompiler, "@stages" $S0 = join " ", $P0 say $S0 .return() .end CODE parse past post pir evalpmc OUT pir_output_is( <<'CODE', <<'OUT', 'inserting and removing stages' ); .sub _main :main load_bytecode 'PCT/HLLCompiler.pbc' .local pmc hllcompiler hllcompiler = new ['PCT';'HLLCompiler'] hllcompiler.'removestage'('parse') hllcompiler.'addstage'('foo') hllcompiler.'addstage'('bar', 'before' => 'evalpmc') hllcompiler.'addstage'('optimize', 'after' => 'past') hllcompiler.'addstage'('optimize', 'after' => 'post') hllcompiler.'addstage'('peel', 'after' => 'optimize') $P0 = getattribute hllcompiler, "@stages" $S0 = join " ", $P0 say $S0 .return() .end CODE past optimize peel post optimize peel pir bar evalpmc foo OUT pir_output_is( <<'CODE', <<'OUT', 'EXPORTALL method' ); .namespace [] .sub main :main load_bytecode 'PCT.pbc' .local pmc h, source, dest h = new ['PCT';'HLLCompiler'] $P0 = new 'NameSpace' set_hll_global ['Omg'], 'Lol', $P0 source = get_hll_namespace ['Foo';'Bar'] dest = get_hll_namespace ['Omg';'Lol'] h.'EXPORTALL'(source,dest) $P0 = get_hll_global ['Omg';'Lol'], 'hi' $P0() $P0 = get_hll_global ['Omg';'Lol'], 'lol' $P0() .end .namespace ['Foo';'Bar';'EXPORT';'ALL'] .sub 'lol' say 'omgwtf!' .end .sub 'hi' say 'hello world!' .end CODE hello world! omgwtf! OUT pir_output_is( <<'CODE', <<'OUT', 'lineof method' ); .sub 'main' :main load_bytecode 'PCT/HLLCompiler.pbc' 'lineof_tests'() .end .sub 'is' .param int a .param int b .param string message if a == b goto ok print "not " ok: print "ok\n" .end .sub 'lineof_tests' .local pmc hll, target hll = get_hll_global ['PCT'], 'HLLCompiler' target = box "0123\n5678\r0123\r\n678\n" $I0 = hll.'lineof'(target, 0, 'cache'=>1) is($I0, 0, "lineof - beginning of string") $I0 = hll.'lineof'(target, 1, 'cache'=>1) is($I0, 0, "lineof - char on first line") $I0 = hll.'lineof'(target, 4, 'cache'=>1) is($I0, 0, "lineof - immediately before nl") $I0 = hll.'lineof'(target, 5, 'cache'=>1) is($I0, 1, "lineof - immediately after nl") $I0 = hll.'lineof'(target, 8, 'cache'=>1) is($I0, 1, "lineof - char before cr") $I0 = hll.'lineof'(target, 9, 'cache'=>1) is($I0, 1, "lineof - immediately before cr") $I0 = hll.'lineof'(target, 10, 'cache'=>1) is($I0, 2, "lineof - immediately after cr") $I0 = hll.'lineof'(target, 11, 'cache'=>1) is($I0, 2, "lineof - char after cr") $I0 = hll.'lineof'(target, 13, 'cache'=>1) is($I0, 2, "lineof - char before crnl") $I0 = hll.'lineof'(target, 14, 'cache'=>1) is($I0, 2, "lineof - immediately before crnl") $I0 = hll.'lineof'(target, 15, 'cache'=>1) is($I0, 3, "lineof - middle of crnl") $I0 = hll.'lineof'(target, 16, 'cache'=>1) is($I0, 3, "lineof - immediately after crnl") $I0 = hll.'lineof'(target, 19, 'cache'=>1) is($I0, 3, "lineof - immediately before final nl") $I0 = hll.'lineof'(target, 20, 'cache'=>1) is($I0, 4, "lineof - immediately after final nl") .end CODE ok ok ok ok ok ok ok ok ok ok ok ok ok ok OUT # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: opengl-01.t000644000765000765 1344212101554067 16776 0ustar00brucebruce000000000000parrot-5.9.0/t/steps/auto#! perl # Copyright (C) 2007-2013, Parrot Foundation. # auto/opengl-01.t use strict; use warnings; use Test::More tests => 29; use Carp; use lib qw( lib ); use_ok('config::auto::opengl'); use Parrot::Configure::Options qw( process_options ); use Parrot::Configure::Step::Test; use Parrot::Configure::Test qw( test_step_constructor_and_description ); use IO::CaptureOutput qw| capture |; ########## --without-opengl ########## my ($args, $step_list_ref) = process_options( { argv => [ q{--without-opengl} ], mode => q{configure}, } ); my $conf = Parrot::Configure::Step::Test->new; $conf->include_config_results( $args ); my $serialized = $conf->pcfreeze(); my $pkg = q{auto::opengl}; $conf->add_steps($pkg); $conf->options->set( %{$args} ); my $step = test_step_constructor_and_description($conf); ok( $step->runstep($conf), "runstep() returned true value"); is( $step->result(), 'skipped', "Got expected result" ); is( $conf->data->get( 'has_opengl' ), 0, "Got expected value for 'has_opengl'"); $conf->replenish($serialized); ########## _select_lib() ########## ($args, $step_list_ref) = process_options( { argv => [ ], mode => q{configure}, } ); $conf->add_steps($pkg); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); # Mock OS/C-compiler combinations my ($osname, $cc, $initial_libs); $initial_libs = $conf->data->get('libs'); $osname = 'mswin32'; $cc = 'gcc'; is($step->_select_lib( { conf => $conf, osname => $osname, cc => $cc, win32_gcc => '-lglut32 -lglu32 -lopengl32', win32_nongcc => 'glut.lib glu.lib gl.lib', darwin => '-framework OpenGL -framework GLUT', default => '-lglut -lGLU -lGL', } ), '-lglut32 -lglu32 -lopengl32', "_select_lib() returned expected value"); $osname = 'mswin32'; $cc = 'cc'; $initial_libs = $conf->data->get('libs'); is($step->_select_lib( { conf => $conf, osname => $osname, cc => $cc, win32_gcc => '-lglut32 -lglu32 -lopengl32', win32_nongcc => 'glut.lib glu.lib gl.lib', darwin => '-framework OpenGL -framework GLUT', default => '-lglut -lGLU -lGL', } ), 'glut.lib glu.lib gl.lib', "_select_lib() returned expected value"); $osname = 'darwin'; $cc = 'cc'; $initial_libs = $conf->data->get('libs'); is($step->_select_lib( { conf => $conf, osname => $osname, cc => $cc, win32_gcc => '-lglut32 -lglu32 -lopengl32', win32_nongcc => 'glut.lib glu.lib gl.lib', darwin => '-framework OpenGL -framework GLUT', default => '-lglut -lGLU -lGL', } ), '-framework OpenGL -framework GLUT', "_select_lib() returned expected value"); $osname = 'foobar'; $cc = 'cc'; $initial_libs = $conf->data->get('libs'); is($step->_select_lib( { conf => $conf, osname => $osname, cc => $cc, win32_gcc => '-lglut32 -lglu32 -lopengl32', win32_nongcc => 'glut.lib glu.lib gl.lib', darwin => '-framework OpenGL -framework GLUT', default => '-lglut -lGLU -lGL', } ), '-lglut -lGLU -lGL', "_select_lib() returned expected value"); $conf->replenish($serialized); ########## --verbose; _evaluate_cc_run() ########## ($args, $step_list_ref) = process_options( { argv => [ q{--verbose} ], mode => q{configure}, } ); $conf->add_steps($pkg); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); my @try = qw( 4 freeglut ); my $test = qq{$try[0] $try[1]\n}; { my ($stdout, $stderr); my ($glut_api_version, $glut_brand); capture( sub { ($glut_api_version, $glut_brand) = $step->_evaluate_cc_run( $conf, $test, ); }, \$stdout, \$stderr, ); is( $glut_api_version, $try[0], "Got first expected return value for _evaluate_cc_run()." ); is( $glut_brand, $try[1], "Got first expected return value for _evaluate_cc_run()." ); like( $stdout, qr/yes, $glut_brand API version $glut_api_version/, "Got expected verbose output for _evaluate_cc_run()" ); # prepare for next test $conf->options->set(verbose => undef); } ########## _handle_glut() ########## { my $glut_api_version = '4'; my $glut_brand = 'freeglut'; ok(auto::opengl::_handle_glut( $conf, 'lib', $glut_api_version, $glut_brand ), "_handle_glut() returned true value"); is( $conf->data->get( 'opengl' ), 'define', "Got expected value for opengl"); is( $conf->data->get( 'has_opengl' ), 1, "Got expected value for has_opengl"); is( $conf->data->get( 'HAS_OPENGL' ), 1, "Got expected value for HAS_OPENGL"); is( $conf->data->get( 'glut' ), 'define', "Got expected value for glut"); is( $conf->data->get( 'glut_brand' ), $glut_brand, "Got expected value for glut_brand"); is( $conf->data->get( 'has_glut' ), $glut_api_version, "Got expected value for has_glut"); is( $conf->data->get( 'HAS_GLUT' ), $glut_api_version, "Got expected value for HAS_GLUT"); } pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME auto/opengl-01.t - test auto::opengl =head1 SYNOPSIS % prove t/steps/auto/opengl-01.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file test configuration step class auto::opengl. =head1 AUTHOR Geoffrey Broadwell; modified from a similar file by James E Keenan =head1 SEE ALSO config::auto::opengl, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: 02-match.t000644000765000765 221411533177643 17235 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/pge#!./parrot # Copyright (C) 2006-2010, Parrot Foundation. =head1 NAME t/compilers/pge/02-match.t - test the Match class =head1 SYNOPSIS % prove t/compilers/pge/02-match.t =head1 DESCRIPTION Tests the Match class directly. =cut .sub main :main .include 'test_more.pir' plan(4) test_concat_on_a_match_object() test_push_on_a_match_object() .end .sub test_concat_on_a_match_object load_bytecode 'PGE.pbc' $P0 = compreg 'PGE::Perl6Regex' $P1 = $P0('.+') $P2 = $P1('world') is($P2, 'world', 'concat on a Match object (rt#39135)') $P3 = new 'String' $P3 = 'hello ' $P4 = concat $P3, $P2 is($P4, 'hello world', 'concat on a Match object (rt#39135)') .end .sub test_push_on_a_match_object .local pmc match, str, arr load_bytecode 'PGE.pbc' match = new ['PGE';'Match'] str = new 'String' str = 'foo' push match, str arr = match.'list'() $I0 = elements arr is($I0, 1, 'push on a Match object') $P3 = match[0] is($P3, 'foo', 'push on a Match object') .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: debug.pir000644000765000765 1742711567202623 20375 0ustar00brucebruce000000000000parrot-5.9.0/examples/pir/befunge# Copyright (C) 2002-2009, Parrot Foundation. # # ** globals used for debug purposes: # # step: boolean telling whether to stop at each step # # breakpoints: hash listing the existing breakpoints. the keys are # either the char to break upon when reaching it, or a location "y,x", # or a column "c:nn", or a row "r:nn" # eg: { "<" => 1, "10,10" => 1, "r:6" => 1, "c:3" => 1, ... } # # # debug_initialize() # # declare & initialize global debug variables # .sub "debug_initialize" .local pmc step, breakpoints step = new 'Integer' step = 1 breakpoints = new 'Hash' set_global "step", step set_global "breakpoints", breakpoints #repeat S10, "0", 128 # No char to break on. .return() .end .sub "_debug__print_status_coordinates" $P0 = get_global "status" $I0 = $P0["x"] $I1 = $P0["y"] print "(" print $I0 print "," print $I1 print ")" .end .sub "_debug__print_status_current_char" $P0 = get_global "status" $S0 = $P0["char"] $I0 = $P0["val"] print "'" print $S0 print "' (ord=" print $I0 print ")" .end .sub "_debug__print_direction" $P0 = get_global "status" $I0 = $P0["dir"] print "dir=" print $I0 .end .sub "_debug__print_flags" $P0 = get_global "status" $I0 = $P0["flag"] $S0 = '"' if $I0 == 1 goto DEBUG__PRINT_FLAGS__PRINT $S0 = '#' if $I0 == 2 goto DEBUG__PRINT_FLAGS__PRINT $S0 = '@' if $I0 == 3 goto DEBUG__PRINT_FLAGS__PRINT $S0 = '-' DEBUG__PRINT_FLAGS__PRINT: print $S0 .end .sub "_debug__print_stack" .local int i, len print "stack=" $P0 = get_global "stack" len = $P0 i = 0 if i >= len goto DEBUG_PRINT_STACK__END DEBUG_PRINT_STACK__LOOP: $I0 = $P0[i] print $I0 inc i if i >= len goto DEBUG_PRINT_STACK__END print "," goto DEBUG_PRINT_STACK__LOOP DEBUG_PRINT_STACK__END: .end # Print the status of the instruction pointer: # coordinates, current char, direction, flags and stack. .sub "_debug__print_status" _debug__print_status_coordinates() print " - " _debug__print_status_current_char() print " " _debug__print_direction() print " " _debug__print_flags() print " " _debug__print_stack() print "\n" .end .sub "_debug__help" print "Available commands are:\n" print " status - print state of current IP\n" print " dump - dump playfield\n" print " break c - set a breakpoint on character c\n" print " break x,y - set a breakpoint at coords (x,y)\n" print " break c:x - set a breakpoint on column x\n" print " break r:y - set a breakpoint on row y\n" print " delete c - delete breakpoint on character c\n" print " delete x,y - delete breakpoint at coords (x,y)\n" print " delete c:x - delete breakpoint on column x\n" print " delete r:y - delete breakpoint on row y\n" print " list - list breakpoints\n" print " next - step one befunge instruction\n" print " continue - resume execution\n" print " restart - restart execution\n" print " quit - abort execution\n" print " help - display this message\n" print "\n" .end # # _debug__dump_playfield() # # dump the playfield on stdout. # .sub "_debug__dump_playfield" .local string divider, line .local pmc playfield playfield = get_global "playfield" divider = repeat '-', 82 divider = concat divider, "\n" print divider $I0 = 0 DEBUG__DUMP_PLAYFIELD__NEXT_LINE: if $I0 >= 25 goto DEBUG__DUMP_PLAYFIELD__END $I1 = 0 line = "|" DEBUG__DUMP_PLAYFIELD__NEXT_CHAR: if $I1 >= 80 goto DEBUG__DUMP_PLAYFIELD__EOL $I2 = playfield[$I0;$I1] $S0 = chr $I2 line = concat line, $S0 inc $I1 goto DEBUG__DUMP_PLAYFIELD__NEXT_CHAR DEBUG__DUMP_PLAYFIELD__EOL: line = concat line, "|\n" print line inc $I0 goto DEBUG__DUMP_PLAYFIELD__NEXT_LINE DEBUG__DUMP_PLAYFIELD__END: print divider print "\n" .return() .end # The interpreter has reached a breakpoint. Let's # stop and interact with user. .sub "_debug__interact" DEBUG__INTERACT__LOOP: _debug__print_status() print "bef> " $P0 = getinterp $P0 = $P0.'stdin_handle'() $S0 = $P0.'readline'() $S0 = chopn $S0, 1 $I0 = length $S0 if $I0 == 0 goto DEBUG__INTERACT__NEXT $S1 = substr $S0, 0, 4 if $S1 == "dump" goto DEBUG__INTERACT__DUMP if $S1 == "help" goto DEBUG__INTERACT__HELP if $S1 == "list" goto DEBUG__INTERACT__LIST if $S1 == "next" goto DEBUG__INTERACT__NEXT if $S1 == "quit" goto DEBUG__INTERACT__QUIT $S1 = substr $S0, 0, 5 if $S1 == "break" goto DEBUG__INTERACT__BREAK $S1 = substr $S0, 0, 6 if $S1 == "delete" goto DEBUG__INTERACT__DELETE if $S1 == "status" goto DEBUG__INTERACT__STATUS $S1 = substr $S0, 0, 7 if $S1 == "restart" goto DEBUG__INTERACT__RESTART $S1 = substr $S0, 0, 8 if $S1 == "continue" goto DEBUG__INTERACT__CONTINUE print "Unknown instruction. Type help for help.\n" goto DEBUG__INTERACT__LOOP DEBUG__INTERACT__BREAK: $S0 = replace $S0, 0, 6, "" $P0 = get_global "breakpoints" $P0[$S0] = 1 set_global "breakpoints", $P0 goto DEBUG__INTERACT__LOOP DEBUG__INTERACT__CONTINUE: $P0 = get_global "step" $P0 = 0 set_global "step", $P0 goto DEBUG__INTERACT__END DEBUG__INTERACT__DELETE: $S0 = replace $S0, 0, 7, "" $P0 = get_global "breakpoints" delete $P0[$S0] set_global "breakpoints", $P0 goto DEBUG__INTERACT__LOOP DEBUG__INTERACT__DUMP: _debug__dump_playfield() goto DEBUG__INTERACT__LOOP DEBUG__INTERACT__HELP: _debug__help() goto DEBUG__INTERACT__LOOP DEBUG__INTERACT__LIST: print "Not yet implemented...\n" goto DEBUG__INTERACT__LOOP DEBUG__INTERACT__NEXT: .local pmc step step = get_global "step" step = 1 set_global "step", step goto DEBUG__INTERACT__END DEBUG__INTERACT__QUIT: end DEBUG__INTERACT__RESTART: print "Not yet implemented...\n" goto DEBUG__INTERACT__LOOP DEBUG__INTERACT__STATUS: _debug__print_status() goto DEBUG__INTERACT__LOOP DEBUG__INTERACT__END: .return() .end # Check whether we should stop the interpreter at the current # moment, allowing user to play with the debugger. .sub "debug__check_breakpoint" .local pmc step step = get_global "step" if step == 0 goto DEBUG__CHECK_BREAKPOINT__CHAR _debug__interact() goto DEBUG__CHECK_BREAKPOINT__END DEBUG__CHECK_BREAKPOINT__CHAR: .local pmc breakpoints, status breakpoints = get_global "breakpoints" status = get_global "status" $S0 = status["char"] $I0 = exists breakpoints[$S0] if $I0 == 0 goto DEBUG__CHECK_BREAKPOINT__COORD _debug__interact() goto DEBUG__CHECK_BREAKPOINT__END DEBUG__CHECK_BREAKPOINT__COORD: .local int x, y x = status["x"] y = status["y"] $S0 = x $S1 = y $S0 = concat $S0, "," $S0 = concat $S0, $S1 $I0 = exists breakpoints[$S0] if $I0 == 0 goto DEBUG__CHECK_BREAKPOINT__ROW _debug__interact() goto DEBUG__CHECK_BREAKPOINT__END DEBUG__CHECK_BREAKPOINT__ROW: $S0 = "r:" $S1 = y $S0 = concat $S0, $S1 $I0 = exists breakpoints[$S0] if $I0 == 0 goto DEBUG__CHECK_BREAKPOINT__COL _debug__interact() goto DEBUG__CHECK_BREAKPOINT__END DEBUG__CHECK_BREAKPOINT__COL: $S0 = "c:" $S1 = x $S0 = concat $S0, $S1 $I0 = exists breakpoints[$S0] if $I0 == 0 goto DEBUG__CHECK_BREAKPOINT__END _debug__interact() # fallback #goto DEBUG__CHECK_BREAKPOINT__END DEBUG__CHECK_BREAKPOINT__END: .return() .end ######################################################################## # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: core_thunks.c000644000765000765 232512101554067 16544 0ustar00brucebruce000000000000parrot-5.9.0/src/nci/* ex: set ro ft=c: * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! * * This file is generated automatically by tools/dev/nci_thunk_gen.pir * * Any changes made here will be lost! * */ /* src/nci/core_thunks.c * Copyright (C) 2010-2012, Parrot Foundation. * Overview: * Native Call Interface routines. * Code to call C from parrot. */ #include "parrot/parrot.h" #include "parrot/nci.h" #include "pmc/pmc_nci.h" #ifdef PARROT_IN_EXTENSION /* external libraries can't have strings statically compiled into parrot */ # define CONST_STRING(i, s) Parrot_str_new_constant((i), (s)) #else # include "core_thunks.str" #endif /* HEADERIZER HFILE: none */ void Parrot_nci_load_core_thunks(PARROT_INTERP); /* HEADERIZER STOP */ /* All our static functions that call in various ways. */ void Parrot_nci_load_core_thunks(PARROT_INTERP) { PMC * const iglobals = interp->iglobals; PMC *nci_funcs; PMC *temp_pmc; PARROT_ASSERT(!(PMC_IS_NULL(iglobals))); nci_funcs = VTABLE_get_pmc_keyed_int(interp, iglobals, IGLOBALS_NCI_FUNCS); PARROT_ASSERT(!(PMC_IS_NULL(nci_funcs))); } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ handle.pmc000644000765000765 1457612101554067 16051 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2008-2012, Parrot Foundation. =head1 NAME src/pmc/handle.pmc - IO Handle PMC =head1 DESCRIPTION This is the base-class for all IO-related PMCs. =head2 Vtable Functions =over 4 =item C =item C Handle shouldn't be directly instantiated, init and init_pmc throws EXCEPTION_INVALID_OPERATION. =cut */ #include "parrot/parrot.h" #include "../src/io/io_private.h" /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* HEADERIZER END: static */ pmclass Handle provides Handle manual_attrs { /* TODO: Consider encapsulating PIOHANDLE as a PMC type, for subclassing */ ATTR PIOHANDLE os_handle; /* Low level OS descriptor */ ATTR STRING *record_separator; /* Record separator */ ATTR IO_VTABLE *io_vtable; /* Function dispatch table */ ATTR IO_BUFFER *read_buffer; /* Read Buffer */ ATTR IO_BUFFER *write_buffer; /* Write Buffer */ ATTR STRING *encoding; /* The encoding for read/write */ VTABLE void init() { UNUSED(SELF) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "Handle cannot be instantiated directly."); } VTABLE void init_pmc(PMC * init) { UNUSED(SELF) UNUSED(init) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "Handle cannot be instantiated directly."); } VTABLE void *get_pointer_keyed_int(INTVAL key) { void * ptr; switch (key) { case IO_PTR_IDX_VTABLE: GET_ATTR_io_vtable(INTERP, SELF, ptr); break; case IO_PTR_IDX_READ_BUFFER: GET_ATTR_read_buffer(INTERP, SELF, ptr); break; case IO_PTR_IDX_WRITE_BUFFER: GET_ATTR_write_buffer(INTERP, SELF, ptr); break; default: Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_PIO_ERROR, "Handle: Cannot get pointer %d", key); } return ptr; } VTABLE void set_pointer_keyed_int(INTVAL key, void *ptr) { switch (key) { case IO_PTR_IDX_VTABLE: SET_ATTR_io_vtable(INTERP, SELF, (IO_VTABLE *)ptr); break; case IO_PTR_IDX_READ_BUFFER: SET_ATTR_read_buffer(INTERP, SELF, (IO_BUFFER *)ptr); break; case IO_PTR_IDX_WRITE_BUFFER: SET_ATTR_write_buffer(INTERP, SELF, (IO_BUFFER *)ptr); break; default: Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_PIO_ERROR, "Handle: Cannot set pointer %d", key); } } /* =back =head2 Methods =over 4 =item C Returns a boolean value indicating whether C is a console/tty. This default implementation always return false. Override it in subtypes that are or can be tty. =cut */ METHOD isatty() { RETURN(INTVAL 0); } /* =item C Retrieve the integer file descriptor for the Handle (only available on platforms that use integer file descriptors). =cut */ METHOD get_fd() { PIOHANDLE os_handle; INTVAL fd; GET_ATTR_os_handle(INTERP, SELF, os_handle); fd = (INTVAL)os_handle; RETURN(INTVAL fd); } /* =item C Read the given number of bytes from the handle and return them in a string. =cut */ METHOD read(INTVAL length) { STRING * const string_result = Parrot_io_reads(INTERP, SELF, length); RETURN(STRING *string_result); } /* =item C Read a line from the handle and return it in a string. =cut */ METHOD readline(STRING * record_separator :optional, INTVAL has_rs :opt_flag) { STRING * string_result; if (!has_rs) { GET_ATTR_record_separator(interp, SELF, record_separator); } string_result = Parrot_io_readline_s(INTERP, SELF, record_separator); RETURN(STRING *string_result); } /* =item C Read the given number of bytes from the handle and return them in a ByteBuffer. If C is omitted, or if it's C<-1> the handle will attempt to read whatever is available, up to the size of the buffer. =cut */ METHOD read_bytes(INTVAL length :optional, INTVAL has_length :opt_flag) { PMC * const bb = Parrot_io_read_byte_buffer_pmc(INTERP, SELF, PMCNULL, has_length ? length : PIO_READ_SIZE_ANY); RETURN(PMC *bb); } METHOD write_bytes(PMC *bytebuffer, INTVAL length) { const INTVAL written = Parrot_io_write_byte_buffer_pmc(INTERP, SELF, bytebuffer, length); RETURN(INTVAL written); } /* =item C Set the record separator for readline. =cut */ METHOD record_separator(STRING *str :optional, int has_str :opt_flag) { if (has_str) { if (STRING_IS_NULL(str)) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "Record separator may not be null"); str = Parrot_io_reencode_string_for_handle(INTERP, SELF, str); SET_ATTR_record_separator(INTERP, SELF, str); } else { GET_ATTR_record_separator(INTERP, SELF, str); } RETURN(STRING *str); } /* =item C Close the handle. =cut */ METHOD close() { const INTVAL status = Parrot_io_close(INTERP, SELF, 1); RETURN(INTVAL status); } /* =item C Set or retrieve the encoding attribute (a string name of the selected encoding scheme) for the filehandle. =cut */ METHOD encoding(STRING *encoding :optional, INTVAL got_encoding :opt_flag) { if (got_encoding) { STRING * record_separator; SET_ATTR_encoding(INTERP, SELF, encoding); GET_ATTR_record_separator(INTERP, SELF, record_separator); record_separator = Parrot_io_reencode_string_for_handle(INTERP, SELF, record_separator); SET_ATTR_record_separator(INTERP, SELF, record_separator); } else { GET_ATTR_encoding(INTERP, SELF, encoding); } RETURN(STRING *encoding); } } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ gziphandle.t000644000765000765 663112101554067 16567 0ustar00brucebruce000000000000parrot-5.9.0/t/dynpmc#!./parrot # Copyright (C) 2010, Parrot Foundation. =head1 NAME t/dynpmc/gziphandle.t - test the GzipHandle PMC =head1 SYNOPSIS % parrot t/dynpmc/gziphandle.t =head1 DESCRIPTION Tests the C PMC, a zlib wrapper. =cut .loadlib 'io_ops' .sub 'main' :main .include 'test_more.pir' .include 'iglobals.pasm' .local pmc config_hash, interp interp = getinterp config_hash = interp[.IGLOBALS_CONFIG_HASH] $S0 = config_hash['has_zlib'] unless $S0 goto no_zlib plan(15) $P0 = loadlib 'gziphandle' test_handle() test_stream() test_bad() test_version() test_basic() .return() no_zlib: skip_all('No zlib library available') .return() .end .sub 'test_handle' $P0 = new 'GzipHandle' $S0 = typeof $P0 is($S0, 'GzipHandle', 'GzipHandle typeof') $I0 = isa $P0, 'Handle' ok($I0, 'isa Handle') .end .include 'stat.pasm' .sub 'test_stream' # Use this file (repeated twice) as test data .local string orig $P0 = new 'FileHandle' orig = $P0.'readall'('t/dynpmc/gziphandle.t') # Save the data size .local int size size = length orig size = mul size, 2 diag(size) # Create the test file .local pmc file .const string filename = 't/dynpmc/gziphandle.t.gz' file = new 'GzipHandle' file.'open'(filename, 'wb') file.'print'(orig) file.'print'(orig) # write the same data again file.'close'() $I0 = stat filename, .STAT_FILESIZE diag($I0) $I0 = $I0 < size ok($I0, "file is smaller than original data") # Open the test file for reading file = new 'GzipHandle' file.'open'(filename) $I0 = file.'isatty'() is($I0, 0, 'not a tty') # Read the data back in # OS X 10.7.3 + gcc 4.2.1 + zlib 1.2.6 seems to have an issue # with the EOF test, so read one extra byte .local string result $I0 = size + 1 result = file.'read'($I0) orig = repeat orig, 2 is(result, orig, "data read is the same as data written") $I0 = file.'eof'() is($I0, 1, "gziphandle is at eof") $I0 = isfalse file ok($I0, "gziphandle at eof is false") $I0 = file.'flush'() is($I0, -2, "cannot flush gziphandle at eof") # Clean up after ourselves file.'close'() $P0 = new 'OS' $P0.'rm'(filename) .end .sub 'test_bad' throws_substring(<<"CODE", "gzopen fails", "gzopen non-existent file") .sub main $P3 = new 'GzipHandle' $P3.'open'('t/dynpmc/gziphandle.t.gz', 'rb') .end CODE throws_substring(<<"CODE", "input data corrupted", "gzip decompress bat data") .sub main $P3 = new 'GzipHandle' $P3.'uncompress'('fake fake fake') .end CODE .end .sub 'test_version' $P0 = new 'GzipHandle' $S0 =$P0.'version'() diag($S0) $I0 = index $S0, '1.' is($I0, 0, 'zlib version') .end .sub 'test_basic' $P0 = new 'GzipHandle' .const string data = "message" $I0 = $P0.'crc32'(0, data) ok($I0, "crc32") $S0 = $P0.'compress'(data) $I0 = length $S0 is($I0, 15, "compress") $S0 = $P0.'uncompress'($S0) is($S0, data, "uncompress") $S0 = repeat 'repeat', 100 $I0 = length $S0 $S1 = $P0.'compress'($S0) $I1 = length $S1 $N0 = $I1 / $I0 diag($N0) $S2 = $P0.'uncompress'($S1) is($S2, $S0, "uncompress with many realloc") .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: 23-named-args.t000644000765000765 74512101554066 20212 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx/t/nqp#!./parrot-nqp # test named parameters and arguments plan(4); sub f1 ($x, :$y) { $x - $y; } say('ok ', f1(2, :y(1)), ' # named args passable'); sub f2 ($x, :$y) { $x; } say('ok ', f2(2), ' # named args ignorable'); sub f3 (:$x, :$y) { $x - $y; } say('ok ', f3(:y(2), :x(5)), ' # args reorderable'); sub f4 ($w, $x, :$y, :$z) { $w + $x + $y + $z; } say('ok ', f4(:z(2), -3, :y(1), 4), ' # named/positional intermixable'); # XXX: test mandatory named args are actually mandatory roles_responsibilities.pod000644000765000765 1052312101554066 22427 0ustar00brucebruce000000000000parrot-5.9.0/docs/project# Copyright (C) 2007-2012, Parrot Foundation. =pod =head1 NAME docs/project/roles_responsibilities.pod - Parrot Roles and Responsibilities. =head1 DESCRIPTION This document describes the roles and responsibilities of parties involved in the Parrot project. =head1 PARROT ROLES AND RESPONSIBILITIES Roles are divided into three categories (Project Team, Committers, Contributors) and may be further subdivided. =head1 PROJECT TEAM Members of the Project Team set the overall direction of the project, track project progress, oversee the project source (and access to that source), and develop and maintain the project. The Project Team consists of positions selected on the basis of available volunteers, and a general evaluation of suitable skills by existing Project Team members. =head2 Architect The architect has primary responsibility for setting overall direction of the project, and to facilitate team communication and understanding of architectural issues. The architect is primarily but not solely responsible for making design decisions and documenting them in Parrot Design Documents; responsibility for design and design documentation of project subcomponents may be given to other members of the Project Team, or may be held jointly. The Architect also works with Release Managers to develop and maintain the release schedule. =head2 Release Manager Release Managers have responsibility for executing a product release, according to the release schedule. The release schedule is developed and maintained jointly with the Release Managers and the Architect. See F for more information. =head2 Metacommitter All Metacommitters are responsible for managing commit access to the Parrot repository. Once the Architect approves a request for a Contributor to be given commit access, a Metacommitter provides that access. The Architect is a Metacommitters, but other Project Team members also hold this role. See F for more information. =head1 COMMITTERS Contributors who submit numerous, high-quality patches may be considered to become a Committer. Committers have commit access to the full Parrot repository, but generally work only on one or more subprojects; Committer categories are described below. Contributors may considered for commit access either by being nominated by another Committer, or by asking for it. =head2 Core Developer Develops and maintains core subsystems (e.g. I/O, Exceptions.) =head2 Compiler Developer Develops and maintains one or more Parrot compilers (e.g. IMCC, PGE, TGE) =head2 High Level Language Developer Develops and maintains one or more High Level Languages (e.g. Tcl, Lua, Perl 6.) =head2 Build Manager Maintains and extends configure and build subsystems. Reviews smoke reports and attempts to extend platform support. =head2 Lead Tester Develops, maintains, and extends test suite and testing tools. Responsible for testing goals, including complete coverage of core components on targeted platforms. =head2 Platform Porter Develops and maintains Parrot for a particular platform, making portability fixes or creating installation packages. =head2 Patch Monster Reviews and applies patches submitted by general contributors, keeping an eye on conformance with coding standards and desirability of features. =head1 CONTRIBUTORS Contributors are volunteers who write code or documentation patches, take part in email or online conversations, or contribute to the project in other ways. All volunteer contributions are appreciated and recognized. All volunteers who contribute to a file in the Parrot repository may add their name to the CREDITS file. =head2 General Contributor Many Contributors have no more specific classification--they may find a bug, provide a patch, submit or respond to a question, write documentation, or contribute in some other way. =head2 Smoke Tester Submits smoke reports on one or more platforms. No knowledge of parrot internals necessary. =head2 Cage Cleaner Fixes failing tests, makes sure coding standards are implemented, reviews documentation and examples. A class of tickets in the tracking system (Trac) has been created for use by this group. This position encompasses tasks from entry level to advanced, and is a good way to get familiar with Parrot internals. =head1 SEE ALSO F, F =cut 04-op.t000644000765000765 160112101554067 16740 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/opsc#!./parrot-nqp # Copyright (C) 2010, Parrot Foundation. # Checking Ops::Op pir::load_bytecode("opsc.pbc"); plan(9); my $op := Ops::Op.new( code => 42, name => 'set', type => 'inline', args => , flags => hash( deprecated => 1, flow => 1 ), arg_types => , ); ok( 1, "Op created"); ok( $op.code == 42, "... with proper code"); ok( $op.name eq 'set', "... with proper name"); ok( $op.type eq 'inline', "... with proper type"); ok( +$op.arg_types == 3, "... with proper arg_types"); say('# ' ~ $op.arg_types); ok( $op.full_name eq 'set_i_i_ic', "full_name is correct"); ok( $op.deprecated, "Op is :deprecated"); $op := Ops::Op.new( name => 'set', type => 'inline', ); ok( $op.full_name eq 'set', "Argless op's full_name is correct"); ok( !$op.deprecated, "Op is not :deprecated"); # vim: expandtab shiftwidth=4 ft=perl6: imageiosize.t000644000765000765 254611533177645 16250 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc#!./parrot # Copyright (C) 2010, Parrot Foundation. =head1 NAME t/pmc/imageiosize.t - test ImageIOSize PMC =head1 SYNOPSIS % prove t/pmc/imagiosize.t =head1 DESCRIPTION Tests the ImageIOSize PMC. =cut .sub main :main .include 'test_more.pir' plan(4) .local pmc iios iios = new ['ImageIOSize'] ok(1, 'instantiated ImageIOSize') .local pmc test_pmc test_pmc = null setref iios, test_pmc $P0 = deref iios $S0 = freeze test_pmc $I0 = $P0 $I1 = length $S0 is($I0, $I1, 'gets the same size as freeze (null)') iios = new ['ImageIOSize'] test_pmc = 'get_test_simple'() setref iios, test_pmc $P0 = deref iios $S0 = freeze test_pmc $I0 = $P0 $I1 = length $S0 is($I0, $I1, 'gets the same size as freeze (simple)') iios = new ['ImageIOSize'] test_pmc = 'get_test_aggregate'() setref iios, test_pmc $P0 = deref iios $S0 = freeze test_pmc $I0 = $P0 $I1 = length $S0 is($I0, $I1, 'gets the same size as freeze (aggregate)') .end .sub get_test_simple $P0 = new ['Integer'] $P0 = -99 .return ($P0) .end .sub get_test_aggregate $P0 = new ['ResizableStringArray'] $P0[0] = 'parrot' $P0[1] = '???' $P0[2] = 'profit' .return ($P0) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: io.pir000644000765000765 177712101554066 16260 0ustar00brucebruce000000000000parrot-5.9.0/examples/pir# Copyright (C) 2001-2008, Parrot Foundation. =head1 NAME examples/pir/io.pir - IO Example =head1 SYNOPSIS % ./parrot examples/pir/io.pir =head1 DESCRIPTION Simple open/seek/write/close on a file. After the file is written it is read in again and printed to STDOUT. You should check where the file is going to be before you run this. =cut .loadlib 'io_ops' # convenient I/O dynamic opcodes .sub 'example' :main .local string test_fn test_fn = "tmp_example_io.tmp" $P0 = open test_fn, 'w' seek $P0, 300, 0 # 64bit version of seek with high 32bits = 0 #seek $IO, $P0, 0, 400, 0 print $P0, "test1\n" print $P0, "test2\n" print $P0, "test3\n" seek $P0, 0, 0 print $P0, "test4\n" print $P0, "test5\n" close $P0 $P0 = open test_fn, 'r' $S0 = read $P0, 1024 print $S0 # now clean up after ourselves. $P1 = new "OS" $P1."rm"(test_fn) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: Branch.pir000644000765000765 72712101554066 21010 0ustar00brucebruce000000000000parrot-5.9.0/examples/tge/branch/lib# Copyright (C) 2006-2009, Parrot Foundation. =head1 NAME Branch =head1 DESCRIPTION A sample branch node for Language::AtributeGrammar. =cut .namespace [ "Branch" ] .sub "__onload" :load .local pmc base newclass base, "Branch" addattribute base, "left" # left child addattribute base, "right" # right child .return () .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: arithmetics.t000644000765000765 2555611715102034 16122 0ustar00brucebruce000000000000parrot-5.9.0/t/op#!./parrot # Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME t/op/arithmetics.t - Arithmetic Ops =head1 SYNOPSIS % prove t/op/arithmetics.t =head1 DESCRIPTION Tests basic arithmetic on various combinations of Parrot integer and number types. =cut .sub main :main .include 'test_more.pir' .include 'iglobals.pasm' plan(80) take_the_negative_of_a_native_integer() take_the_absolute_of_a_native_integer() add_native_integer_to_native_integer() subtract_native_integer_from_native_integer() multiply_native_integer_with_native_integer() divide_native_integer_by_native_integer() negate_minus_zero_point_zero() negate_a_native_number() take_the_absolute_of_a_native_number() ceil_of_a_native_number() floor_of_a_native_number() add_native_integer_to_native_number() subtract_native_integer_from_native_number() multiply_native_number_with_native_integer() divide_native_number_by_native_integer() add_native_number_to_native_number() subtract_native_number_from_native_number() multiply_native_number_with_native_number() divide_native_number_by_native_number() # END_OF_TESTS .end # # Operations on a single INTVAL # .sub take_the_negative_of_a_native_integer set $I0, 0 neg $I0 is( $I0, "0", 'take_the_negative_of_a_native_integer' ) set $I0, 1234567890 neg $I0 is( $I0, "-1234567890", 'take_the_negative_of_a_native_integer' ) set $I0, -1234567890 neg $I0 is( $I0, "1234567890", 'take_the_negative_of_a_native_integer' ) set $I0, 0 set $I1, 0 neg $I1, $I0 is( $I1, "0", 'take_the_negative_of_a_native_integer' ) set $I0, 1234567890 neg $I1, $I0 is( $I1, "-1234567890", 'take_the_negative_of_a_native_integer' ) set $I0, -1234567890 neg $I1, $I0 is( $I1, "1234567890", 'take_the_negative_of_a_native_integer' ) .end .sub take_the_absolute_of_a_native_integer set $I0, 0 abs $I0 is( $I0, "0", 'take_the_absolute_of_a_native_integer' ) set $I0, 1234567890 abs $I0 is( $I0, "1234567890", 'take_the_absolute_of_a_native_integer' ) set $I0, -1234567890 abs $I0 is( $I0, "1234567890", 'take_the_absolute_of_a_native_integer' ) set $I0, 0 set $I1, 0 abs $I1, $I0 is( $I1, "0", 'take_the_absolute_of_a_native_integer' ) set $I0, 1234567890 abs $I1, $I0 is( $I1, "1234567890", 'take_the_absolute_of_a_native_integer' ) set $I0, -1234567890 abs $I1, $I0 is( $I1, "1234567890", 'take_the_absolute_of_a_native_integer' ) .end # # first arg is INTVAL, second arg is INTVAL # .sub add_native_integer_to_native_integer set $I0, 4000 set $I1, -123 add $I2, $I0, $I1 is( $I2, "3877", 'add_native_integer_to_native_integer' ) add $I0, $I0, $I1 is( $I0, "3877", 'add_native_integer_to_native_integer' ) .end .sub subtract_native_integer_from_native_integer set $I0, 4000 set $I1, -123 sub $I2, $I0, $I1 is( $I2, "4123", 'subtract_native_integer_from_native_integer' ) sub $I0, $I0, $I1 is( $I0, "4123", 'subtract_native_integer_from_native_integer' ) .end .sub multiply_native_integer_with_native_integer set $I0, 4000 set $I1, -123 mul $I2, $I0, $I1 is( $I2, "-492000", 'multiply_native_integer_with_native_integer' ) mul $I0, $I0, $I1 is( $I0, "-492000", 'multiply_native_integer_with_native_integer' ) .end .sub divide_native_integer_by_native_integer set $I0, 4000 set $I1, -123 div $I2, $I0, $I1 is( $I2, "-32", 'divide_native_integer_by_native_integer' ) div $I0, $I0, $I1 is( $I0, "-32", 'divide_native_integer_by_native_integer' ) .end # # print -0.0 as -0 # .sub negate_minus_zero_point_zero .local pmc interp, config_hash .local string has_negative_zero interp = getinterp config_hash = interp[.IGLOBALS_CONFIG_HASH] has_negative_zero = config_hash['has_negative_zero'] set $N0, 0 neg $N0 $S0 = $N0 unless has_negative_zero goto Todo_test1 is( $S0, "-0", '1' ) goto End_test1 Todo_test1: $I0 = $S0 == "-0" todo($I0, 'negative zero, GH #366') End_test1: set $N0, -0.0 neg $N0 $S0 = $N0 is( $S0, "0", '2' ) set $N0, -0.0 neg $N1, $N0 $S0 = $N1 is( $S0, "0", '3' ) set $N0, 0 set $N1, 1 neg $N1, $N0 $S0 = $N1 unless has_negative_zero goto Todo_test4 is( $S0, "-0", '4' ) goto End_test4 Todo_test4: $I0 = $S0 == "-0" todo($I0, 'negative zero, GH #366') End_test4: .end # # Operations on a single NUMVAL # .sub negate_a_native_number set $N0, 123.4567890 neg $N0 is( $N0, "-123.456789", 'negate_a_native_number' ) set $N0, -123.4567890 neg $N0 is( $N0, "123.456789", 'negate_a_native_number' ) set $N0, 123.4567890 neg $N1, $N0 is( $N1, "-123.456789", 'negate_a_native_number' ) set $N0, -123.4567890 neg $N1, $N0 is( $N1, "123.456789", 'negate_a_native_number' ) .end .sub take_the_absolute_of_a_native_number set $N0, 0 abs $N0 is( $N0, "0", 'take_the_absolute_of_a_native_number' ) set $N0, -0.0 abs $N0 is( $N0, "0", 'take_the_absolute_of_a_native_number' ) set $N0, 123.45678901 abs $N0 is( $N0, "123.45678901", 'take_the_absolute_of_a_native_number' ) set $N0, -123.45678901 abs $N0 is( $N0, "123.45678901", 'take_the_absolute_of_a_native_number' ) set $N0, 0 set $N1, 1 abs $N1, $N0 is( $N1, "0", 'take_the_absolute_of_a_native_number' ) set $N0, 0.0 set $N1, 1 abs $N1, $N0 is( $N1, "0", 'take_the_absolute_of_a_native_number' ) set $N0, 123.45678901 set $N1, 1 abs $N1, $N0 is( $N1, "123.45678901", 'take_the_absolute_of_a_native_number' ) set $N0, -123.45678901 set $N1, 1 abs $N1, $N0 is( $N1, "123.45678901", 'take_the_absolute_of_a_native_number' ) .end .sub ceil_of_a_native_number set $N0, 0 ceil $N0 is( $N0, "0", 'ceil_of_a_native_number' ) set $N0, 123.45678901 ceil $N0 is( $N0, "124", 'ceil_of_a_native_number' ) set $N0, -123.45678901 ceil $N0 is( $N0, "-123", 'ceil_of_a_native_number' ) set $N0, 0 set $N1, 1 ceil $N1, $N0 is( $N1, "0", 'ceil_of_a_native_number' ) set $N0, 0.0 set $N1, 1 ceil $N1, $N0 is( $N1, "0", 'ceil_of_a_native_number' ) set $N0, 123.45678901 set $N1, 1 ceil $N1, $N0 is( $N1, "124", 'ceil_of_a_native_number' ) set $N0, -123.45678901 set $N1, 1 ceil $N1, $N0 is( $N1, "-123", 'ceil_of_a_native_number' ) set $N0, 0 set $I1, 1 ceil $I1, $N0 is( $I1, "0", 'ceil_of_a_native_number' ) set $N0, 0.0 set $I1, 1 ceil $I1, $N0 is( $I1, "0", 'ceil_of_a_native_number' ) set $N0, 123.45678901 set $I1, 1 ceil $I1, $N0 is( $I1, "124", 'ceil_of_a_native_number' ) set $N0, -123.45678901 set $I1, 1 ceil $I1, $N0 is( $I1, "-123", 'ceil_of_a_native_number' ) .end .sub floor_of_a_native_number set $N0, 0 floor $N0 is( $N0, "0", 'floor_of_a_native_number' ) set $N0, 123.45678901 floor $N0 is( $N0, "123", 'floor_of_a_native_number' ) set $N0, -123.45678901 floor $N0 is( $N0, "-124", 'floor_of_a_native_number' ) set $N0, 0 set $N1, 1 floor $N1, $N0 is( $N1, "0", 'floor_of_a_native_number' ) set $N0, 0.0 set $N1, 1 floor $N1, $N0 is( $N1, "0", 'floor_of_a_native_number' ) set $N0, 123.45678901 set $N1, 1 floor $N1, $N0 is( $N1, "123", 'floor_of_a_native_number' ) set $N0, -123.45678901 set $N1, 1 floor $N1, $N0 is( $N1, "-124", 'floor_of_a_native_number' ) set $N0, 0 set $I1, 1 floor $I1, $N0 is( $I1, "0", 'floor_of_a_native_number' ) set $N0, 0.0 set $I1, 1 floor $I1, $N0 is( $I1, "0", 'floor_of_a_native_number' ) set $N0, 123.45678901 set $I1, 1 floor $I1, $N0 is( $I1, "123", 'floor_of_a_native_number' ) set $N0, -123.45678901 set $I1, 1 floor $I1, $N0 is( $I1, "-124", 'floor_of_a_native_number' ) .end # # FLOATVAL and INTVAL tests # .sub add_native_integer_to_native_number set $I0, 4000 set $N0, -123.123 add $N1, $N0, $I0 is( $N1, "3876.877", 'add_native_integer_to_native_number' ) add $N0, $N0, $I0 is( $N0, "3876.877", 'add_native_integer_to_native_number' ) add $N0, $I0 is( $N0, "7876.877", 'add_native_integer_to_native_number' ) .end .sub subtract_native_integer_from_native_number set $I0, 4000 set $N0, -123.123 sub $N1, $N0, $I0 is( $N1, "-4123.123", 'subtract_native_integer_from_native_number' ) sub $N0, $N0, $I0 is( $N0, "-4123.123", 'subtract_native_integer_from_native_number' ) sub $N0, $I0 is( $N0, "-8123.123", 'subtract_native_integer_from_native_number' ) .end .sub multiply_native_number_with_native_integer set $I0, 4000 set $N0, -123.123 mul $N1, $N0, $I0 is( $N1, "-492492", 'multiply_native_number_with_native_integer' ) mul $N0, $N0, $I0 is( $N0, "-492492", 'multiply_native_number_with_native_integer' ) mul $N0, -2 is( $N0, "984984", 'multiply_native_number_with_native_integer' ) .end .sub divide_native_number_by_native_integer set $I0, 4000 set $N0, -123.123 div $N1, $N0, $I0 is( $N1, "-0.03078075", 'divide_native_number_by_native_integer' ) div $N0, $N0, $I0 is( $N0, "-0.03078075", 'divide_native_number_by_native_integer' ) div $N0, 1 is( $N0, "-0.03078075", 'divide_native_number_by_native_integer' ) set $N0, 100.000 div $N0, 100 is( $N0, "1", 'divide_native_number_by_native_integer' ) div $N0, 0.01 is( $N0, "100", 'divide_native_number_by_native_integer' ) .end # # FLOATVAL and FLOATVAL tests # .sub add_native_number_to_native_number set $N2, 4000.246 set $N0, -123.123 add $N1, $N0, $N2 is( $N1, "3877.123", 'add_native_number_to_native_number' ) add $N0, $N0, $N2 is( $N0, "3877.123", 'add_native_number_to_native_number' ) .end .sub subtract_native_number_from_native_number set $N2, 4000.246 set $N0, -123.123 sub $N1, $N0, $N2 is( $N1, "-4123.369", 'subtract_native_number_from_native_number' ) sub $N0, $N0, $N2 is( $N0, "-4123.369", 'subtract_native_number_from_native_number' ) .end .sub multiply_native_number_with_native_number set $N2, 4000.246 set $N0, -123.123 mul $N1, $N0, $N2 is( $N1, "-492522.288258", 'multiply_native_number_with_native_number' ) mul $N0, $N0, $N2 is( $N0, "-492522.288258", 'multiply_native_number_with_native_number' ) .end .sub divide_native_number_by_native_number set $N2, 4000.246 set $N0, -123.123 div $N1, $N0, $N2 is( $N1, "-0.0307788571002883", 'divide_native_number_by_native_number' ) div $N0, $N0, $N2 is( $N0, "-0.0307788571002883", 'divide_native_number_by_native_number' ) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: 52_if_compare.pir000644000765000765 233712101554066 21325 0ustar00brucebruce000000000000parrot-5.9.0/examples/tutorial# Copyright (C) 2007-2012, Parrot Foundation. =pod =head1 DESCRIPTION A tutorial lesson about Parrot's control flow (continued). =head1 COMPARISON BRANCHING A simple C is the most simple version of flow control, but its usefulness is very limited. In most cases, branches should be conditional. The C statement implements a conditional branch, jumping only if a given condition is satisfied. These conditions can use various boolean relational operators C<=>, C<< < >>, C<< > >> and C to determine truth value. If the condition is satisfied, the jump occurs. In the C statement, the jump is taken if the condition given is true. In the C statement, the jump is taken if the condition is false. The commented-out code below shows how to use the relational opcodes like C directly instead of using the relational operators. =cut .sub main :main say "before if" $I0 = 42 $I1 = 43 # $I2 = islt $I0, $I1 # The long way # if $I2 goto branch_to_label if $I0 < $I1 goto branch_to_label # The short way say "never printed" branch_to_label: say "after if" .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: archive_tar.t000644000765000765 323711533177644 17114 0ustar00brucebruce000000000000parrot-5.9.0/t/library#!./parrot # Copyright (C) 2010, Parrot Foundation. =head1 NAME t/library/archive_tar.t =head1 DESCRIPTION Test the Archive/Tar library =head1 SYNOPSIS % prove t/library/archive_tar.t =cut .sub 'main' :main .include 'test_more.pir' load_bytecode 'Archive/Tar.pir' plan(12) test_new() test_tar() .end .sub 'test_new' $P0 = new ['Archive';'Tar'] $I0 = isa $P0, ['Archive';'Tar'] ok($I0, "new ['Archive';'Tar']") $P0 = new ['Archive';'Tar';'File'] $I0 = isa $P0, ['Archive';'Tar';'File'] ok($I0, "new ['Archive';'Tar';'File']") .end .sub 'test_tar' .local pmc archive, entry archive = new ['Archive';'Tar'] $I0 = isa archive, ['Archive';'Tar'] ok($I0, "test_tar") entry = archive.'add_data'('msg.txt', "some data") $I0 = isa entry, ['Archive';'Tar';'File'] ok($I0, "entry is an ['Archive';'Tar';'File']") $S0 = entry.'data'() is($S0, "some data", "data") $S0 = entry.'full_path'() is($S0, 'msg.txt', "full_path") .local string header header = entry.'_format_tar_entry'() $I0 = length header is($I0, 512, "length header") $I0 = index header, 'msg.txt' is($I0, 0, "header starts by filename") $I0 = index header, 'ustar' is($I0, 257, "magic at 257") .local pmc fh fh = new 'StringHandle' fh.'open'('in_memory', 'wb') archive.'write'(fh) $S0 = fh.'readall'() fh.'close'() $I0 = length $S0 is($I0, 2048, "size") $I0 = index $S0, 'msg.txt' is($I0, 0, 'filename') $I0 = index $S0, 'some data' is($I0, 512, 'data') .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: headers.pm000644000765000765 724012101554066 16702 0ustar00brucebruce000000000000parrot-5.9.0/config/auto# Copyright (C) 2001-2003, Parrot Foundation. =head1 NAME config/auto/headers.pm - C headers =head1 DESCRIPTION Probes for various C headers. =cut package auto::headers; use strict; use warnings; use base qw(Parrot::Configure::Step); use Parrot::Configure::Utils ':auto'; sub _init { my $self = shift; my %data; $data{description} = q{Probe for C headers}; $data{result} = q{}; return \%data; } sub runstep { my ( $self, $conf ) = @_; _set_from_Config($conf); my @extra_headers = _list_extra_headers($conf); my @found_headers; foreach my $header (@extra_headers) { my $pass = 0; # First try with just the header. If that fails, try with all the # headers we found so far. This is somewhat a hack, but makes probing # work on *BSD where some headers are documented as relying on others # being included first. foreach my $use_headers ( [$header], [ @found_headers, $header ] ) { $conf->data->set( TEMP_testheaders => join( '', map { "#include <$_>\n" } @$use_headers ) ); $conf->data->set( TEMP_testheader => $header ); $conf->cc_gen('config/auto/headers/test_c.in'); $conf->data->set( TEMP_testheaders => undef ); $conf->data->set( TEMP_testheader => undef ); eval { $conf->cc_build(); }; if ( !$@ && $conf->cc_run() =~ /^$header OK/ ) { $pass = 1; push @found_headers, $header; } $conf->cc_clean(); last if $pass; } my $flag = "i_$header"; $flag =~ s/\.h$//g; $flag =~ s/\///g; $conf->debug("$flag: $pass\n"); $conf->data->set( $flag => $pass ? 'define' : undef ); } return 1; } sub _set_from_Config { my $conf = shift; # Perl 5's Configure system doesn't call this by its full name, which may # confuse use later, particularly once we break free and start doing all # probing ourselves my %mapping = ( i_niin => "i_netinetin" ); for ( grep { /^i_/ } $conf->data->keys_p5() ) { $conf->data->set( $mapping{$_} || $_ => $conf->data->get_p5($_) ); } } sub _list_extra_headers { my $conf = shift; # some headers may not be probed-for by Perl 5, or might not be # properly reflected in %Config (i_fcntl seems to be wrong on my machine, # for instance). # # FreeBSD wants this order: #include #include #include #include # hence add sys/types.h to the reprobe list, and have 2 goes at getting # the header. my @extra_headers = qw(malloc.h fcntl.h setjmp.h pthread.h signal.h sys/types.h sys/socket.h netinet/in.h arpa/inet.h sys/stat.h sysexit.h limits.h sys/sysctl.h libcpuid.h); # more extra_headers needed on mingw/msys; *BSD fails if they are present if ( $conf->data->get('OSNAME_provisional') eq "msys" ) { push @extra_headers, qw(sysmman.h netdb.h sys/utsname.h); } if ( $conf->data->get('OSNAME_provisional') eq "MSWin32" ) { # Microsoft provides two annotations mechanisms. __declspec, which # has been around for a while, and Microsoft's standard source code # annotation language (SAL), introduced with Visual C++ 8.0. See # , # . push @extra_headers, qw(sal.h process.h); } return @extra_headers; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: validheader.in000644000765000765 17511567202625 23253 0ustar00brucebruce000000000000parrot-5.9.0/t/tools/dev/headerizer/testlibThis file has a valid HEADERIZER HFILE directive and has a corresponding header file. /* HEADERIZER HFILE: validheader.h */ platform.pm000644000765000765 320612101554066 17111 0ustar00brucebruce000000000000parrot-5.9.0/config/auto# Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME config/auto/platform.pm - Platform Files =head1 DESCRIPTION Generates a list of platform object files. =cut package auto::platform; use strict; use warnings; use base qw(Parrot::Configure::Step); use Parrot::Configure::Utils ':auto'; sub _init { my $self = shift; my %data; $data{description} = q{Generate a list of platform object files}; $data{result} = q{}; return \%data; } sub runstep { my ( $self, $conf ) = @_; $self->_set_implementations($conf); return 1; } sub _set_implementations { my $self = shift; my $conf = shift; my $platform = $conf->data->get('platform'); my @impls = qw/ io.c socket.c file.c time.c encoding.c env.c cpu_type.c num_cpus.c dl.c math.c itimer.c exec.c misc.c hires_timer.c sysmem.c uid.c error.c asm.s entropy.c /; my @impl_files; for my $im (@impls) { my $impl_file; if ( -e "src/platform/$platform/$im" ) { $impl_file = "src/platform/$platform/$im"; } elsif ( -e "src/platform/generic/$im" ) { $impl_file = "src/platform/generic/$im"; } else { next; } $impl_file =~ s/\.[cs]\z/\$(O)/; push(@impl_files, $impl_file); } $conf->data->set(TEMP_platform_o => join(' ', @impl_files)); return 1; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: VTable.pm000644000765000765 455412101554067 17216 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/Pmc2c# Copyright (C) 2004-2008, Parrot Foundation. package Parrot::Pmc2c::VTable; use strict; use warnings; use Storable (); use Parrot::Vtable (); use Parrot::Pmc2c::Method (); use File::Spec (); use File::Basename; use Cwd qw(cwd); sub new { my ( $class, $filename ) = @_; my $self = {}; bless $self, $class; $self->build($filename) if $filename; return $self; } sub build { my ( $self, $filename ) = @_; my $vtable_table = Parrot::Vtable::parse_vtable($filename); my ( %method_lookup, @methods, @method_names ); foreach my $entry (@$vtable_table) { $method_lookup{ $entry->[1] } = scalar @methods; push @methods, Parrot::Pmc2c::Method->new( { return_type => $entry->[0], name => $entry->[1], parameters => $entry->[2], section => $entry->[3], attrs => $entry->[5], type => Parrot::Pmc2c::Method::VTABLE_ENTRY, } ); push @method_names, $entry->[1]; } $self->filename($filename); $self->{'has_method'} = \%method_lookup; $self->{'methods'} = \@methods; $self->{'names'} = \@method_names; return; } sub dump { my ($self) = @_; my $dump_filename = File::Spec->catfile( cwd(), basename( Parrot::Pmc2c::UtilFunctions::filename( $self->filename, '.dump' ) ) ); Storable::nstore( $self, $dump_filename ); return $dump_filename; } sub has_method { my ( $self, $methodname ) = @_; return $self->{'has_method'}->{$methodname}; } sub get_method { my ( $self, $methodname ) = @_; my $method_index = $self->has_method($methodname); return unless defined $method_index; return $self->{methods}->[$method_index]; } sub names { my ( $self, $value ) = @_; $self->{names} = $value if $value; return $self->{names}; } sub methods { my ( $self, $value ) = @_; $self->{methods} = $value if $value; return $self->{methods}; } sub filename { my ( $self, $value ) = @_; $self->{filename} = $value if $value; return $self->{filename}; } sub attrs { my ( $self, $vt_meth ) = @_; return $self->get_method($vt_meth)->attrs; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: hires_timer.c000644000765000765 207611716253436 21103 0ustar00brucebruce000000000000parrot-5.9.0/src/platform/darwin/* * Copyright (C) 2009-2011, Parrot Foundation. */ /* =head1 NAME src/platform/generic/hires_timer.c =head1 DESCRIPTION High-resolution timer support =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" #include #define TIME_IN_NS(n) ((n).tv_sec * 1000*1000*1000 + (n).tv_nsec) /* HEADERIZER HFILE: none */ /* =item C Return a high-resolution number representing how long Parrot has been running. =cut */ UHUGEINTVAL Parrot_hires_get_time(void) { struct timespec ts; struct timeval tv; gettimeofday(&tv, NULL); ts.tv_sec = tv.tv_sec; ts.tv_nsec = tv.tv_usec * 1000; return TIME_IN_NS(ts); } /* =item C Return the number of ns that each time unit from Parrot_hires_get_time represents. =cut */ PARROT_CONST_FUNCTION UINTVAL Parrot_hires_get_tick_duration(void) { return (UINTVAL) 1; } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ up.gif000644000765000765 11411466337261 16553 0ustar00brucebruce000000000000parrot-5.9.0/docs/resourcesGIF89a€f™ÿÿÿ!ù,#„ Áím^X/ºS)KW+O}Ö¸`d¦médA+Ö¡™K’(;sub.pmc000644000765000765 10702512171255037 15421 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME src/pmc/sub.pmc - Subroutine =head1 DESCRIPTION These are the vtable functions for the Sub (subroutine) base class =head2 Functions =over 4 =cut */ #include "parrot/oplib/ops.h" #include "parrot/oplib/core_ops.h" #include "sub.str" /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void print_sub_name(PARROT_INTERP, ARGIN_NULLOK(PMC *sub)) __attribute__nonnull__(1); #define ASSERT_ARGS_print_sub_name __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C static function to print the name of the sub (for tracing/debugging) =cut */ static void print_sub_name(PARROT_INTERP, ARGIN_NULLOK(PMC *sub)) { ASSERT_ARGS(print_sub_name) Interp * const tracer = (interp->pdb && interp->pdb->debugger) ? interp->pdb->debugger : interp; /* sub was located via globals */ Parrot_io_eprintf(tracer, "# Calling sub '%Ss'\n# ", Parrot_sub_full_sub_name(interp, sub)); print_pbc_location(interp); } pmclass Sub auto_attrs provides invokable { ATTR PackFile_ByteCode *seg; /* bytecode segment */ ATTR size_t start_offs; /* sub entry in ops from seg->base.data */ ATTR size_t end_offs; ATTR INTVAL HLL_id; /* see src/hll.c XXX or per segment? */ ATTR PMC *namespace_name; /* where this Sub is in - this is either * a String or a [Key] and describes * the relative path in the NameSpace */ ATTR PMC *namespace_stash; /* the actual hash, HLL::namespace */ ATTR STRING *name; /* name of the sub */ ATTR STRING *method_name; /* method name of the sub */ ATTR STRING *ns_entry_name; /* ns entry name of the sub */ ATTR STRING *subid; /* The ID of the sub. */ ATTR INTVAL vtable_index; /* index in Parrot_vtable_slot_names */ ATTR PMC *multi_signature; /* list of types for MMD */ ATTR UINTVAL n_regs_used[4]; /* INSP in PBC */ ATTR PMC *lex_info; /* LexInfo PMC */ ATTR PMC *outer_sub; /* :outer for closures */ ATTR PMC *ctx; /* the context this sub is in */ ATTR UINTVAL comp_flags; /* compile time and additional flags */ ATTR Parrot_sub_arginfo *arg_info; /* Argument counts and flags. */ ATTR PMC *outer_ctx; /* outer context, if a closure */ /* =item C Initializes the subroutine. =cut */ /* * Sub PMC's flags usage: * - private0 ... Coroutine flip/flop - C exception handler * - private1 ... _IS_OUTER - have to preserve context * as some other sub has :outer(this) * - private2 ... tailcall invoked this Sub * - private3 ... pythonic coroutine generator flag * - private4 ... :main (originally @MAIN) * - private5 ... :load (originally @LOAD) * - private6 ... :immediate (originally @IMMEDIATE) * - private7 ... :postcomp (originally @POSTCOMP) * * see also the enum in include/parrot/sub.h */ VTABLE void init() { Parrot_Sub_attributes * const attrs = PMC_data_typed(SELF, Parrot_Sub_attributes *); attrs->seg = INTERP->code; attrs->outer_sub = PMCNULL; attrs->multi_signature = PMCNULL; attrs->namespace_name = PMCNULL; attrs->vtable_index = -1; PObj_custom_mark_destroy_SETALL(SELF); } /* =item C Initializes the "detached" subroutine from passed Hash. "Detached" means that surboutine is fully constructed but not attached to interpreter. =cut */ VTABLE void init_pmc(PMC* init) { Parrot_Sub_attributes * const attrs = PMC_data_typed(SELF, Parrot_Sub_attributes *); STRING *field = CONST_STRING(INTERP, "start_offs"); if (VTABLE_exists_keyed_str(INTERP, init, field)) attrs->start_offs = VTABLE_get_integer_keyed_str(INTERP, init, field); field = CONST_STRING(INTERP, "end_offs"); if (VTABLE_exists_keyed_str(INTERP, init, field)) attrs->end_offs = VTABLE_get_integer_keyed_str(INTERP, init, field); field = CONST_STRING(INTERP, "HLL_id"); if (VTABLE_exists_keyed_str(INTERP, init, field)) attrs->HLL_id = VTABLE_get_integer_keyed_str(INTERP, init, field); field = CONST_STRING(INTERP, "namespace_name"); if (VTABLE_exists_keyed_str(INTERP, init, field)) attrs->namespace_name = VTABLE_get_pmc_keyed_str(INTERP, init, field); field = CONST_STRING(INTERP, "namespace_stash"); if (VTABLE_exists_keyed_str(INTERP, init, field)) attrs->namespace_stash = VTABLE_get_pmc_keyed_str(INTERP, init, field); field = CONST_STRING(INTERP, "name"); if (VTABLE_exists_keyed_str(INTERP, init, field)) attrs->name = VTABLE_get_string_keyed_str(INTERP, init, field); field = CONST_STRING(INTERP, "method_name"); if (VTABLE_exists_keyed_str(INTERP, init, field)) attrs->method_name = VTABLE_get_string_keyed_str(INTERP, init, field); field = CONST_STRING(INTERP, "ns_entry_name"); if (VTABLE_exists_keyed_str(INTERP, init, field)) attrs->ns_entry_name = VTABLE_get_string_keyed_str(INTERP, init, field); field = CONST_STRING(INTERP, "subid"); if (VTABLE_exists_keyed_str(INTERP, init, field)) attrs->subid = VTABLE_get_string_keyed_str(INTERP, init, field); field = CONST_STRING(INTERP, "vtable_index"); if (VTABLE_exists_keyed_str(INTERP, init, field)) attrs->vtable_index = VTABLE_get_integer_keyed_str(INTERP, init, field); else attrs->vtable_index = -1; field = CONST_STRING(INTERP, "multi_signature"); if (VTABLE_exists_keyed_str(INTERP, init, field)) attrs->multi_signature = VTABLE_get_pmc_keyed_str(INTERP, init, field); field = CONST_STRING(INTERP, "lex_info"); if (VTABLE_exists_keyed_str(INTERP, init, field)) attrs->lex_info = VTABLE_get_pmc_keyed_str(INTERP, init, field); field = CONST_STRING(INTERP, "outer_sub"); if (VTABLE_exists_keyed_str(INTERP, init, field)) attrs->outer_sub = VTABLE_get_pmc_keyed_str(INTERP, init, field); /* comp_flags is actually UINTVAL */ field = CONST_STRING(INTERP, "comp_flags"); if (VTABLE_exists_keyed_str(INTERP, init, field)) { const UINTVAL flags = (UINTVAL)VTABLE_get_integer_keyed_str(INTERP, init, field); /* Mask comp flags only */ attrs->comp_flags = flags & SUB_COMP_FLAG_MASK; } /* In order to create Sub dynamicaly we have to set PObj flags */ field = CONST_STRING(INTERP, "pf_flags"); if (VTABLE_exists_keyed_str(INTERP, init, field)) { const UINTVAL flags = (UINTVAL)VTABLE_get_integer_keyed_str(INTERP, init, field); /* Mask Sub specific flags only */ PObj_get_FLAGS(SELF) |= flags & SUB_FLAG_PF_MASK; } field = CONST_STRING(INTERP, "n_regs_used"); if (VTABLE_exists_keyed_str(INTERP, init, field)) { PMC * const tmp = VTABLE_get_pmc_keyed_str(INTERP, init, field); INTVAL i; for (i = 0; i < 4; ++i) attrs->n_regs_used[i] = VTABLE_get_integer_keyed_int(INTERP, tmp, i); } field = CONST_STRING(INTERP, "arg_info"); if (VTABLE_exists_keyed_str(INTERP, init, field)) { PMC * const tmp = VTABLE_get_pmc_keyed_str(INTERP, init, field); /* Allocate structure to store argument information in. */ attrs->arg_info = mem_gc_allocate_zeroed_typed(INTERP, Parrot_sub_arginfo); /* Hash.get_integer_keyed_str return 0 if key doesn't exists. So, don't check existence of key, just use it. NB: Don't split line. CONST_STRING b0rked. */ attrs->arg_info->pos_required = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "pos_required")); attrs->arg_info->pos_optional = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "pos_optional")); attrs->arg_info->pos_slurpy = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "pos_slurpy")); attrs->arg_info->named_required = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "named_required")); attrs->arg_info->named_optional = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "named_optional")); attrs->arg_info->named_slurpy = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "named_slurpy")); } /* C not handled here, and shouldn't be, because of run-time nature. */ PObj_custom_mark_destroy_SETALL(SELF); } /* =item C Destroys the subroutine. =cut */ VTABLE void destroy() { Parrot_Sub_attributes * const sub = PARROT_SUB(SELF); if (sub && sub->arg_info) mem_gc_free(INTERP, sub->arg_info); } /* =item C Returns the name of the subroutine. =item C Sets the name of the subroutine. =cut */ VTABLE STRING *get_string() { STRING *name; GET_ATTR_name(INTERP, SELF, name); return name; } VTABLE void set_string_native(STRING *subname) { SET_ATTR_name(INTERP, SELF, subname); } /* =item C Sets the pointer to the actual subroutine. *** Don't use that - use C<.const 'Sub'> in PIR instead *** =cut */ VTABLE void set_pointer(void *value) { UNUSED(SELF) UNUSED(value) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "Don't set the address of a sub\nuse .const 'Sub' instead"); } /* =item C Returns the address of the actual subroutine. =cut */ VTABLE void *get_pointer() { Parrot_Sub_attributes *sub; PMC_get_sub(INTERP, SELF, sub); return sub->seg->base.data + sub->start_offs; } /* =item C I -DRS =cut */ VTABLE INTVAL get_integer_keyed(PMC *key) { UNUSED(key) Parrot_Sub_attributes *sub; PMC_get_sub(INTERP, SELF, sub); return (INTVAL) (sub->seg->base.data); } /* =item C =item C Returns True. =cut */ VTABLE INTVAL defined() { return 1; } VTABLE INTVAL get_bool() { return 1; } /* =item C Invokes the subroutine. =cut */ VTABLE opcode_t *invoke(void *next) { PMC * const caller_ctx = CURRENT_CONTEXT(INTERP); PMC *ccont = INTERP->current_cont; /* plain subroutine call * create new context, place it in interpreter */ PMC *context = Parrot_pcc_get_signature(INTERP, caller_ctx); Parrot_Sub_attributes *sub; opcode_t *pc; PMC_get_sub(INTERP, SELF, sub); if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG)) print_sub_name(INTERP, SELF); /* * A remark WRT tail calls * * we have: * sub A: * ... * B() * ... * sub B: * ... * .return C(...) * * that is the sub B() returns whatever C() returns. * * We are just calling the sub C(). * If the private2 flag is set, this code is called by a * tailcall opcode. * * We allocate a new register frame and recycle it * immediately after argument passing. * */ pc = sub->seg->base.data + sub->start_offs; INTERP->current_cont = NULL; PARROT_ASSERT(!PMC_IS_NULL(ccont)); if (PMC_IS_NULL(context)) context = Parrot_pmc_new(INTERP, enum_class_CallContext); Parrot_pcc_set_context(INTERP, context); Parrot_pcc_set_caller_ctx(INTERP, context, caller_ctx); /* support callcontext reuse */ if (context == caller_ctx) Parrot_pcc_free_registers(INTERP, context); Parrot_pcc_allocate_registers(INTERP, context, sub->n_regs_used); Parrot_pcc_init_context(INTERP, context, caller_ctx); Parrot_pcc_set_sub(INTERP, context, SELF); Parrot_pcc_set_continuation(INTERP, context, ccont); Parrot_pcc_set_constants(INTERP, context, sub->seg->const_table); /* check recursion/call depth */ if (Parrot_pcc_inc_recursion_depth(INTERP, context) > INTERP->recursion_limit) Parrot_ex_throw_from_c_args(INTERP, next, EXCEPTION_INTERNAL_PANIC, "maximum recursion depth exceeded"); /* and copy set context variables */ PARROT_GC_WRITE_BARRIER(interp, ccont); PARROT_CONTINUATION(ccont)->from_ctx = context; /* if this is an outer sub, then we need to set sub->ctx * to the new context */ if (PObj_get_FLAGS(SELF) & SUB_FLAG_IS_OUTER) { PARROT_GC_WRITE_BARRIER(interp, SELF); sub->ctx = context; } /* create pad if needed * TODO move this up in front of argument passing * and factor out common code with coroutine pmc */ if (!PMC_IS_NULL(sub->lex_info)) { Parrot_pcc_set_lex_pad(INTERP, context, Parrot_pmc_new_init(INTERP, Parrot_hll_get_ctx_HLL_type(INTERP, enum_class_LexPad), sub->lex_info)); VTABLE_set_pointer(INTERP, Parrot_pcc_get_lex_pad(INTERP, context), context); } /* set outer context */ if (!PMC_IS_NULL(sub->outer_ctx)) { PMC * outer_ctx = sub->outer_ctx; if (outer_ctx->vtable->base_type == enum_class_Proxy) outer_ctx = Parrot_pcc_unproxy_context(INTERP, outer_ctx); Parrot_pcc_set_outer_ctx(INTERP, context, outer_ctx); } else { /* autoclose */ PMC *c = context; PMC *outer_c = Parrot_pcc_get_outer_ctx(INTERP, c); for (c = context; PMC_IS_NULL(outer_c); c = outer_c, outer_c = Parrot_pcc_get_outer_ctx(INTERP, c)) { PMC *outer_pmc; Parrot_Sub_attributes *current_sub, *outer_sub; PMC_get_sub(INTERP, Parrot_pcc_get_sub(INTERP, c), current_sub); outer_pmc = current_sub->outer_sub; if (PMC_IS_NULL(outer_pmc)) break; PMC_get_sub(INTERP, outer_pmc, outer_sub); if (PMC_IS_NULL(outer_sub->ctx)) { PMC * const dummy = Parrot_alloc_context(INTERP, outer_sub->n_regs_used, PMCNULL); Parrot_pcc_set_sub(INTERP, dummy, outer_pmc); if (!PMC_IS_NULL(outer_sub->lex_info)) { Parrot_pcc_set_lex_pad(INTERP, dummy, Parrot_pmc_new_init(INTERP, Parrot_hll_get_ctx_HLL_type(INTERP, enum_class_LexPad), outer_sub->lex_info)); VTABLE_set_pointer(INTERP, Parrot_pcc_get_lex_pad(INTERP, dummy), dummy); } if (!PMC_IS_NULL(outer_sub->outer_ctx)) Parrot_pcc_set_outer_ctx(INTERP, dummy, outer_sub->outer_ctx); PARROT_GC_WRITE_BARRIER(interp, outer_pmc); outer_sub->ctx = dummy; } Parrot_pcc_set_outer_ctx(INTERP, c, outer_sub->ctx); outer_c = outer_sub->ctx; } } /* switch code segment if needed */ if (INTERP->code != sub->seg) Parrot_switch_to_cs(INTERP, sub->seg, 1); return pc; } /* =item C Creates and returns a clone of the subroutine. =cut */ VTABLE PMC *clone() { PMC * const ret = Parrot_pmc_new(INTERP, SELF->vtable->base_type); Parrot_Sub_attributes *dest_sub; Parrot_Sub_attributes *sub; /* XXX Why? */ /* we have to mark it ourselves */ PObj_custom_mark_destroy_SETALL(ret); PMC_get_sub(INTERP, SELF, dest_sub); PMC_get_sub(INTERP, ret, sub); /* first set the sub struct, Parrot_str_copy may cause GC */ *sub = *dest_sub; /* Be sure not to share arg_info. */ dest_sub->arg_info = NULL; return ret; } /* =item C Set SELF to the data in other. =cut */ VTABLE void set_pmc(PMC *other) { SELF.assign_pmc(other); } VTABLE void assign_pmc(PMC *other) { /* only handle the case where the other PMC is the same type */ if (other->vtable->base_type == SELF->vtable->base_type) { Parrot_Sub_attributes *my_sub; Parrot_Sub_attributes *other_sub; PMC_get_sub(INTERP, SELF, my_sub); PMC_get_sub(INTERP, other, other_sub); /* copy the sub struct */ memmove(my_sub, other_sub, sizeof (Parrot_Sub_attributes)); } else Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "Can't assign a non-Sub type to a Sub"); } /* =item C Marks the sub as live. =cut */ VTABLE void mark() { Parrot_Sub_attributes * const sub = PARROT_SUB(SELF); if (!sub) return; Parrot_gc_mark_STRING_alive(INTERP, sub->name); Parrot_gc_mark_STRING_alive(INTERP, sub->subid); Parrot_gc_mark_STRING_alive(INTERP, sub->method_name); Parrot_gc_mark_STRING_alive(INTERP, sub->ns_entry_name); Parrot_gc_mark_PMC_alive(INTERP, sub->ctx); Parrot_gc_mark_PMC_alive(INTERP, sub->lex_info); Parrot_gc_mark_PMC_alive(INTERP, sub->outer_ctx); Parrot_gc_mark_PMC_alive(INTERP, sub->outer_sub); Parrot_gc_mark_PMC_alive(INTERP, sub->namespace_name); Parrot_gc_mark_PMC_alive(INTERP, sub->multi_signature); Parrot_gc_mark_PMC_alive(INTERP, sub->namespace_stash); /* XXX * Workaround for things that subclass sub but don't point into packfiles * (eg: EventHandler) * TODO: use inheritance properly to avoid this */ if (sub->seg && ! Interp_flags_TEST(interp, PARROT_IS_THREAD)) Parrot_gc_mark_PMC_alive(INTERP, sub->seg->base.pf->view); } /* =item C Returns whether the two subroutines are equal. =cut */ MULTI INTVAL is_equal(PMC *value) { Parrot_Sub_attributes *my_sub, *value_sub; PMC_get_sub(INTERP, SELF, my_sub); PMC_get_sub(INTERP, value, value_sub); return SELF->vtable == value->vtable && (my_sub)->start_offs == (value_sub)->start_offs && (my_sub)->seg == (value_sub)->seg; } /* =item C This is used by freeze/thaw to visit the contents of the sub. =item C Archives the subroutine. =cut */ VTABLE void visit(PMC *info) { VISIT_PMC_ATTR(INTERP, info, SELF, Sub, namespace_name); VISIT_PMC_ATTR(INTERP, info, SELF, Sub, multi_signature); VISIT_PMC_ATTR(INTERP, info, SELF, Sub, outer_sub); /* * XXX visit_pmc_now is wrong, because it breaks * depth-first visit inside the todo list * TODO change all user visit functions to use * visit_pmc (the todo renamed visit_pm_later) * * Therefore the hash must be last during visit for now. */ VISIT_PMC_ATTR(INTERP, info, SELF, Sub, lex_info); SUPER(info); } VTABLE void freeze(PMC *info) { Parrot_Sub_attributes *sub; STRING *hll_name; int i; SUPER(info); PMC_get_sub(INTERP, SELF, sub); /* * we currently need to write these items: * - start offset in byte-code segment * - end offset in byte-code segment * - segment TODO ??? * - flags (i.e. :load pragma and such) * - name of the sub's label * - method name * - ns entry name * - namespace * - HLL_id * - multi_signature * - n_regs_used[i] * - lex_info * - vtable_index * - subid */ VTABLE_push_integer(INTERP, info, (INTVAL) sub->start_offs); VTABLE_push_integer(INTERP, info, (INTVAL) sub->end_offs); VTABLE_push_integer(INTERP, info, (INTVAL)(PObj_get_FLAGS(SELF) & SUB_FLAG_PF_MASK)); VTABLE_push_string(INTERP, info, sub->name); if (!sub->method_name) sub->method_name = CONST_STRING(INTERP, ""); VTABLE_push_string(INTERP, info, sub->method_name); if (!sub->ns_entry_name) sub->ns_entry_name = CONST_STRING(INTERP, ""); VTABLE_push_string(INTERP, info, sub->ns_entry_name); hll_name = Parrot_hll_get_HLL_name(INTERP, sub->HLL_id); if (!hll_name) hll_name = CONST_STRING(INTERP, ""); VTABLE_push_string(INTERP, info, hll_name); VTABLE_push_integer(INTERP, info, (INTVAL)sub->comp_flags); VTABLE_push_integer(INTERP, info, sub->vtable_index); for (i = 0; i < 4; ++i) VTABLE_push_integer(INTERP, info, sub->n_regs_used[i]); if (!sub->subid) sub->subid = CONST_STRING(INTERP, ""); VTABLE_push_string(INTERP, info, sub->subid); } /* =item C Unarchives the subroutine. =cut */ VTABLE void thaw(PMC *info) { Parrot_Sub_attributes *sub; INTVAL flags; int i; STATICSELF.init(); PMC_get_sub(INTERP, SELF, sub); /* we get relative offsets */ sub->start_offs = (size_t) VTABLE_shift_integer(INTERP, info); sub->end_offs = (size_t) VTABLE_shift_integer(INTERP, info); flags = VTABLE_shift_integer(INTERP, info); PObj_get_FLAGS(SELF) |= flags & SUB_FLAG_PF_MASK; sub->name = VTABLE_shift_string(INTERP, info); sub->method_name = VTABLE_shift_string(INTERP, info); sub->ns_entry_name = VTABLE_shift_string(INTERP, info); /* lookup or create HLL */ sub->HLL_id = Parrot_hll_register_HLL(INTERP, VTABLE_shift_string(INTERP, info)); sub->comp_flags = VTABLE_shift_integer(INTERP, info); sub->vtable_index = VTABLE_shift_integer(INTERP, info); for (i = 0; i < 4; ++i) sub->n_regs_used[i] = VTABLE_shift_integer(INTERP, info); sub->subid = VTABLE_shift_string(INTERP, info); } /* =item C Returns the full set of meta-data about the sub. =cut */ VTABLE PMC *inspect() { /* Create a hash, then use inspect_str to get all of its data */ PMC * const metadata = Parrot_pmc_new(INTERP, enum_class_Hash); STRING * const pos_required_str = CONST_STRING(INTERP, "pos_required"); STRING * const pos_optional_str = CONST_STRING(INTERP, "pos_optional"); STRING * const named_required_str = CONST_STRING(INTERP, "named_required"); STRING * const named_optional_str = CONST_STRING(INTERP, "named_optional"); STRING * const pos_slurpy_str = CONST_STRING(INTERP, "pos_slurpy"); STRING * const named_slurpy_str = CONST_STRING(INTERP, "named_slurpy"); VTABLE_set_pmc_keyed_str(INTERP, metadata, pos_required_str, VTABLE_inspect_str(INTERP, SELF, pos_required_str)); VTABLE_set_pmc_keyed_str(INTERP, metadata, pos_optional_str, VTABLE_inspect_str(INTERP, SELF, pos_optional_str)); VTABLE_set_pmc_keyed_str(INTERP, metadata, named_required_str, VTABLE_inspect_str(INTERP, SELF, named_required_str)); VTABLE_set_pmc_keyed_str(INTERP, metadata, named_optional_str, VTABLE_inspect_str(INTERP, SELF, named_optional_str)); VTABLE_set_pmc_keyed_str(INTERP, metadata, pos_slurpy_str, VTABLE_inspect_str(INTERP, SELF, pos_slurpy_str)); VTABLE_set_pmc_keyed_str(INTERP, metadata, named_slurpy_str, VTABLE_inspect_str(INTERP, SELF, named_slurpy_str)); return metadata; } /* =item C Returns the specified item of metadata about the sub. Allowable values are: =over 4 =item pos_required The number of required positional arguments =item pos_optional The number of optional positional arguments =item named_required The number of required named arguments =item named_optional The number of optional named arguments =item pos_slurpy 1 if it takes slurpy positional arguments, 0 if not =item named_slurpy 1 if it takes slurpy named arguments, 0 if not =back =cut */ VTABLE PMC *inspect_str(STRING *what) { Parrot_Sub_attributes *sub; PMC *retval; INTVAL count_found = -1; PMC_get_sub(INTERP, SELF, sub); /* If the argument info hasn't been generated yet, generate it. */ if (!sub->arg_info) { /* Get pointer into the bytecode where this sub starts. */ const opcode_t *pc = sub->seg->base.data + sub->start_offs; op_lib_t *core_ops = PARROT_GET_CORE_OPLIB(INTERP); /* Allocate structure to store argument information in. */ sub->arg_info = mem_gc_allocate_zeroed_typed(INTERP, Parrot_sub_arginfo); /* If the first instruction is a get_params... */ if (OPCODE_IS(INTERP, sub->seg, *pc, core_ops, PARROT_OP_get_params_pc)) { /* Get the signature (the next thing in the bytecode). */ PMC * const sig = sub->seg->const_table->pmc.constants[*(++pc)]; /* Iterate over the signature and compute argument counts. */ const INTVAL sig_length = VTABLE_elements(INTERP, sig); int i; ASSERT_SIG_PMC(sig); for (i = 0; i < sig_length; ++i) { int sig_item = VTABLE_get_integer_keyed_int(INTERP, sig, i); if (PARROT_ARG_SLURPY_ARRAY_ISSET(sig_item)){ if (PARROT_ARG_NAME_ISSET(sig_item)) sub->arg_info->named_slurpy = 1; else sub->arg_info->pos_slurpy = 1; } else if (PARROT_ARG_NAME_ISSET(sig_item)) { ++i; sig_item = VTABLE_get_integer_keyed_int(INTERP, sig, i); if (PARROT_ARG_OPTIONAL_ISSET(sig_item)) ++sub->arg_info->named_optional; else ++sub->arg_info->named_required; } else if (!PARROT_ARG_OPT_FLAG_ISSET(sig_item)) { if (PARROT_ARG_OPTIONAL_ISSET(sig_item)) ++sub->arg_info->pos_optional; else ++sub->arg_info->pos_required; } } } } /* Return the requested argument information */ if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "pos_required"))) { count_found = (INTVAL)sub->arg_info->pos_required; } else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "pos_optional"))) { count_found = (INTVAL)sub->arg_info->pos_optional; } else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "pos_slurpy"))) { count_found = (INTVAL)sub->arg_info->pos_slurpy; } else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "named_required"))) { count_found = (INTVAL)sub->arg_info->named_required; } else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "named_optional"))) { count_found = (INTVAL)sub->arg_info->named_optional; } else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "named_slurpy"))) { count_found = (INTVAL)sub->arg_info->named_slurpy; } else Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "Unknown introspection value '%S'", what); retval = Parrot_pmc_new_init_int(INTERP, enum_class_Integer, count_found); return retval; } /* =back =head2 METHODS =over 4 =item C Returns the start offset of the Sub. =item C Returns the end offset of the Sub. =item C Returns the namespace PMC, where the Sub is defined. TODO return C instead. =item C Returns the number of used registers for register kinds "I", "S", "P", "N". =item C Returns the LexInfo PMC, if any or a Null PMC. =item C Returns the MMD signature PMC, if any, or a Null PMC. =item C Gets the sub that is the outer of this one, if any, or a Null PMC. =item C Sets the sub that is the outer of this one. =item C Set the outer context to be used on the next invocation of this sub. =item C Returns the arity of the Sub (the number of arguments, excluding optional and slurpy arguments). =cut */ METHOD start_offs() { Parrot_Sub_attributes *sub; INTVAL start_offs; PMC_get_sub(INTERP, SELF, sub); start_offs = sub->start_offs; RETURN(INTVAL start_offs); } METHOD end_offs() { Parrot_Sub_attributes *sub; INTVAL end_offs; PMC_get_sub(INTERP, SELF, sub); end_offs = sub->end_offs; RETURN(INTVAL end_offs); } METHOD get_namespace() { PMC *_namespace; Parrot_Sub_attributes *sub; PMC_get_sub(INTERP, SELF, sub); /* XXX Rakudo's failing with this code on ASSERT. Why??? GET_ATTR_namespace_stash(INTERP, SELF, _namespace); PARROT_ASSERT(_namespace == sub->namespace_stash || !"consistency!!!"); */ _namespace = sub->namespace_stash; RETURN(PMC *_namespace); } METHOD __get_regs_used(STRING *reg) { /* TODO switch to canonical NiSP order * see also imcc/reg_alloc.c */ STRING * const types = CONST_STRING(INTERP, "INSP"); Parrot_Sub_attributes *sub; INTVAL regs_used; INTVAL kind; PMC_get_sub(INTERP, SELF, sub); PARROT_ASSERT(sub->n_regs_used); if (!reg || Parrot_str_length(INTERP, reg) != 1) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "illegal register kind '%Ss'", reg); kind = STRING_index(INTERP, types, reg, 0); if (kind == -1) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "illegal register kind '%Ss'", reg); regs_used = sub->n_regs_used[kind]; RETURN(INTVAL regs_used); } METHOD get_lexinfo() { PMC *lexinfo; Parrot_Sub_attributes *sub; PMC_get_sub(INTERP, SELF, sub); lexinfo = sub->lex_info ? sub->lex_info : PMCNULL; RETURN(PMC *lexinfo); } METHOD get_subid() { STRING *subid; Parrot_Sub_attributes *sub; PMC_get_sub(INTERP, SELF, sub); subid = sub->subid ? sub->subid : CONST_STRING(INTERP, ""); RETURN(STRING *subid); } METHOD get_outer() { PMC *outersub; Parrot_Sub_attributes *sub; PMC_get_sub(INTERP, SELF, sub); outersub = sub->outer_sub ? sub->outer_sub : PMCNULL; RETURN(PMC *outersub); } METHOD set_outer(PMC *outer) { /* Set outer sub. */ Parrot_Sub_attributes *sub; PMC *outer_ctx; PMC_get_sub(INTERP, SELF, sub); sub->outer_sub = outer; /* Make sure outer flag of that sub is set. */ PObj_get_FLAGS(outer) |= SUB_FLAG_IS_OUTER; /* Ensure we have lex info. */ if (PMC_IS_NULL(sub->lex_info)) { const INTVAL lex_info_id = Parrot_hll_get_ctx_HLL_type(INTERP, enum_class_LexInfo); sub->lex_info = Parrot_pmc_new_init(INTERP, lex_info_id, SELF); } /* Clear any existing outer context */ sub->outer_ctx = PMCNULL; /* If we've got a context around for the outer sub, set it as the * outer context. */ outer_ctx = CURRENT_CONTEXT(INTERP); while (!PMC_IS_NULL(outer_ctx)) { if (Parrot_pcc_get_sub(INTERP, outer_ctx) == outer) { sub->outer_ctx = outer_ctx; break; } outer_ctx = Parrot_pcc_get_caller_ctx(INTERP, outer_ctx); } } METHOD set_outer_ctx(PMC *outer_ctx) { Parrot_Sub_attributes *sub; PMC_get_sub(INTERP, SELF, sub); sub->outer_ctx = outer_ctx; } METHOD get_multisig() { PMC *multisig; Parrot_Sub_attributes *sub; PMC_get_sub(INTERP, SELF, sub); multisig = sub->multi_signature ? sub->multi_signature : PMCNULL; RETURN(PMC *multisig); } METHOD arity() { PMC * const pos_required = VTABLE_inspect_str(INTERP, SELF, CONST_STRING(INTERP, "pos_required")); PMC * const named_required = VTABLE_inspect_str(INTERP, SELF, CONST_STRING(INTERP, "named_required")); const INTVAL arity = VTABLE_get_integer(INTERP, pos_required) + VTABLE_get_integer(INTERP, named_required); RETURN(INTVAL arity); } /* =item C =item C (Experimental) Returns Sub flags. =item C (Experimental) Returns the packfile that contains this Sub =back =cut */ METHOD comp_flags() { Parrot_Sub_attributes *sub; INTVAL flags; PMC_get_sub(INTERP, SELF, sub); flags = sub->comp_flags; RETURN(INTVAL flags); } METHOD pf_flags() { /* Only PF specific flags */ INTVAL flags = PObj_get_FLAGS(SELF) & SUB_FLAG_PF_MASK; RETURN(INTVAL flags); } METHOD get_packfile() { Parrot_Sub_attributes *sub; PMC *view; PMC_get_sub(INTERP, SELF, sub); view = sub->seg->base.pf->view; if (!view) view = PMCNULL; RETURN(PMC * view); } } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ 14-while.t000644000765000765 342412101554066 17321 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx/t/nqp#!./parrot-nqp # while, until statements plan(14); my $a; my $sum; $a := 1; $sum := 0; while $a != 10 { $sum := $sum + $a; $a := $a + 1; } ok($sum == 45, 'basic while loop test'); $a := 1; $sum := 0; $sum := $sum + $a++ while $a < 10; ok($sum == 45, 'basic while statement modifier'); $a := 1; $sum := 0; until $a == 10 { $sum := $sum + $a; $a := $a + 1; } ok($sum == 45, 'basic until loop test'); $a := 1; $sum := 0; $sum := $sum + $a++ until $a > 9; ok($sum == 45, 'basic until statement modifier'); $a := 1; $sum := 0; while $a != 1 { $sum := 99; $a := 1; } ok($sum == 0, 'while loop exits initial false immediately'); $a := 1; $sum := 0; until $a == 1 { $sum := 99; $a := 1; } ok($sum == 0, 'until loop exits initial true immediately'); $a := 1; $sum := 0; repeat { $sum := $sum + $a; $a := $a + 1; } while $a != 10; ok($sum == 45, 'basic repeat_while loop'); $a := 1; $sum := 0; repeat { $sum := $sum + $a; $a := $a + 1; } until $a == 10; ok($sum == 45, 'basic repeat_until loop'); $a := 1; $sum := 0; repeat while $a != 10 { $sum := $sum + $a; $a := $a + 1; }; ok($sum == 45, 'basic repeat_while loop'); $a := 1; $sum := 0; repeat until $a == 10 { $sum := $sum + $a; $a := $a + 1; }; ok($sum == 45, 'basic repeat_until loop'); $a := 1; $sum := 0; repeat { $sum := 99; } while $a != 1; ok($sum == 99, 'repeat_while always executes at least once'); $a := 1; $sum := 0; repeat { $sum := 99; } until $a == 1; ok($sum == 99, 'repeat_until always executes at least once'); $a := 1; $sum := 0; repeat while $a != 1 { $sum := 99; }; ok($sum == 99, 'repeat_while always executes at least once'); $a := 1; $sum := 0; repeat until $a == 1 { $sum := 99; }; ok($sum == 99, 'repeat_until always executes at least once'); Parrot_Test.t000644000765000765 3671011606346603 16405 0ustar00brucebruce000000000000parrot-5.9.0/t/perl#! perl # Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME t/perl/Parrot_Test.t - Parrot::Test unit tests =head1 SYNOPSIS % prove t/perl/Parrot_Test.t =head1 DESCRIPTION These tests cover the basic functionality of C. =cut use strict; use warnings; use Test::More; use Carp; use File::Spec; use lib qw( lib ); use Parrot::Config; use IO::CaptureOutput qw| capture |; BEGIN { eval "use Test::Builder::Tester;"; if ($@) { plan( skip_all => "Test::Builder::Tester not installed\n" ); exit 0; } plan( tests => 112 ); } use lib qw( . lib ../lib ../../lib ); BEGIN { my $pre_env = exists $ENV{PARROT_TEST} ? $ENV{PARROT_TEST} : undef; use_ok('Parrot::Test') or die; my $post_env = exists $ENV{PARROT_TEST} ? $ENV{PARROT_TEST} : undef; if ( defined $pre_env ) { is( $post_env, $pre_env, 'PARROT_TEST env unchanged' ); } else { is( $post_env, 1, 'PARROT_TEST env set' ); } } can_ok( 'Parrot::Test', $_ ) for ( qw/ c_output_is c_output_isnt c_output_like c_output_unlike example_output_is example_output_isnt example_output_like example_error_output_is example_error_output_isnt example_error_output_like language_error_output_is language_error_output_isnt language_error_output_like language_output_is language_output_isnt language_output_like pasm_error_output_is pasm_error_output_isnt pasm_error_output_like pasm_error_output_unlike pasm_output_is pasm_output_isnt pasm_output_like pasm_output_unlike pbc_error_output_is pbc_error_output_isnt pbc_error_output_like pbc_error_output_unlike pbc_output_is pbc_output_isnt pbc_output_like pbc_output_unlike pir_error_output_is pir_error_output_isnt pir_error_output_like pir_error_output_unlike pir_output_is pir_output_isnt pir_output_like pir_output_unlike generate_languages_functions per_test plan skip slurp_file run_command write_code_to_file / ); # per_test is( Parrot::Test::per_test(), undef, 'per_test() no args' ); is( Parrot::Test::per_test( undef, 0 ), undef, 'per_test() invalid first arg' ); is( Parrot::Test::per_test( 0, undef ), undef, 'per_test() invalid second arg' ); is( Parrot::Test::per_test( undef, undef ), undef, 'per_test() two invalid args' ); my ( $desc, $err, $line ); # PASM $desc = 'pasm_output_is: success'; test_out("ok 1 - $desc"); pasm_output_is( <<'CODE', <<'OUTPUT', $desc ); .pcc_sub :main main: print "foo\n" end CODE foo OUTPUT test_test($desc); $desc = 'pasm_output_is: failure'; test_out("not ok 1 - $desc"); test_fail(+9); $err = <<"ERR"; # got: 'foo # ' # expected: 'bar # ' ERR chomp $err; test_err($err); pasm_output_is( <<'CODE', <<"OUTPUT", $desc ); .pcc_sub :main main: print "foo\n" end CODE bar OUTPUT test_test($desc); $desc = 'pasm_output_isnt: success'; test_out("ok 1 - $desc"); pasm_output_isnt( <<'CODE', <<"OUTPUT", $desc ); .pcc_sub :main main: print "foo\n" end CODE bar OUTPUT test_test($desc); # The exact error output for pasm_output_isnt() depends on the version of # Test::Builder. So, in order to avoid version dependent failures, be content # with checking the standard output. $desc = 'pasm_output_isnt: failure'; test_out("not ok 1 - $desc"); test_fail(+10); $err = <<"ERR"; # 'foo # ' # ne # 'foo # ' ERR chomp $err; test_err( $err ); pasm_output_isnt( <<'CODE', <<'OUTPUT', $desc ); .pcc_sub :main main: print "foo\n" end CODE foo OUTPUT test_test(title => $desc, skip_err => 1); $desc = 'pasm_output_like: success'; test_out("ok 1 - $desc"); pasm_output_like( <<'CODE', <<'OUTPUT', $desc ); .pcc_sub :main main: print "foo\n" end CODE /foo/ OUTPUT test_test($desc); $desc = 'pasm_output_like: failure'; test_out("not ok 1 - $desc"); test_fail(+9); $err = <<"ERR"; # 'foo # ' # doesn't match '/bar/ # ' ERR chomp $err; test_err($err); pasm_output_like( <<'CODE', <<"OUTPUT", $desc ); .pcc_sub :main main: print "foo\n" end CODE /bar/ OUTPUT test_test($desc); # PIR $desc = 'pir_output_is: success'; test_out("ok 1 - $desc"); pir_output_is( <<'CODE', <<'OUTPUT', $desc ); .sub 'test' :main print "foo\n" .end CODE foo OUTPUT test_test($desc); $desc = 'pir_output_is: failure'; test_out("not ok 1 - $desc"); test_fail(+9); $err = <<"ERR"; # got: 'foo # ' # expected: 'bar # ' ERR chomp $err; test_err($err); pir_output_is( <<'CODE', <<"OUTPUT", $desc ); .sub 'test' :main print "foo\n" .end CODE bar OUTPUT test_test($desc); $desc = 'pir_output_isnt: success'; test_out("ok 1 - $desc"); pir_output_isnt( <<'CODE', <<"OUTPUT", $desc ); .sub 'test' :main print "foo\n" .end CODE bar OUTPUT test_test($desc); # The exact error output for pir_output_isnt() depends on the version of # Test::Builder. So, in order to avoid version dependent failures, be content # with checking the standard output. $desc = 'pir_output_isnt: failure'; test_out("not ok 1 - $desc"); test_fail(+10); $err = <<"ERR"; # 'foo # ' # ne # 'foo # ' ERR chomp $err; test_err($err); pir_output_isnt( <<'CODE', <<'OUTPUT', $desc ); .sub 'test' :main print "foo\n" .end CODE foo OUTPUT test_test(title => $desc, skip_err => 1); $desc = 'pir_output_like: success'; test_out("ok 1 - $desc"); pir_output_like( <<'CODE', <<'OUTPUT', $desc ); .sub 'test' :main print "foo\n" .end CODE /foo/ OUTPUT test_test($desc); $desc = 'pir_output_like: failure'; test_out("not ok 1 - $desc"); test_fail(+9); $err = <<"ERR"; # 'foo # ' # doesn't match '/bar/ # ' ERR chomp $err; test_err($err); pir_output_like( <<'CODE', <<"OUTPUT", $desc ); .sub 'test' :main print "foo\n" .end CODE /bar/ OUTPUT test_test($desc); # # incorporate changes in Test::Builder after Version 0.94 # if ($Test::Builder::VERSION <= eval '0.94') { $desc = 'pir_error_output_like: todo'; $line = line_num(+22); my $location; if ($Test::Builder::VERSION <= eval '0.33') { $location = "in $0 at line $line"; } else { $location = "at $0 line $line"; } test_out("not ok 1 - $desc # TODO foo"); $err = <<"ERR"; # Failed (TODO) test '$desc' # $location. # Expected error but exited cleanly # Received: # foo # # Expected: # /bar/ # ERR chomp $err; test_err($err); pir_error_output_like( <<'CODE', <<"OUTPUT", $desc, todo => 'foo' ); .sub 'test' :main print "foo\n" .end CODE /bar/ OUTPUT if($Test::Builder::VERSION == 0.84) { test_test(title => $desc, skip_err => 1); } else { test_test($desc); } } #end of test for Test::Builder 0.94 or before # # Test for TEST::Builder after Version 0.94 # else { $line = line_num(+14); my $location = "at $0 line $line"; $desc = 'pir_output_like: todo'; test_out("not ok 1 - $desc # TODO foo"); $err = <<"EOUT"; # Failed (TODO) test '$desc' # $location. # 'foo # ' # doesn't match '/bar/ # ' EOUT chomp $err; test_out($err); pir_output_like( <<'CODE', <<"OUTPUT", $desc, todo => 'foo' ); .sub 'test' :main print "foo\n" .end CODE /bar/ OUTPUT test_test($desc); } my $file = q{t/perl/testlib/hello.pasm}; my $expected = qq{Hello World\n}; example_output_is( $file, $expected ); $expected = qq{Goodbye World\n}; example_output_isnt( $file, $expected ); $expected = qr{Hello World}; example_output_like( $file, $expected ); $file = q{t/perl/testlib/answer.pir}; $expected = < #include int main(int argc, char* argv[]) { printf("Hello, World!\n"); exit(0); } ENDOFCODE $desc = 'C: is hello world'; test_out("ok 1 - $desc"); c_output_is( < '/tmp/captureSTDOUT', STDERR => '/tmp/captureSTDERR', CD => '/tmp', } ); is($out, '/tmp/captureSTDOUT', "Got expected value for STDOUT"); is($err, '/tmp/captureSTDERR', "Got expected value for STDERR"); is($chdir, '/tmp', "Got expected value for working directory"); ( $out, $err, $chdir ) = Parrot::Test::_handle_test_options( { STDOUT => '/tmp/captureSTDOUT', STDERR => '', CD => '/tmp', } ); is($out, '/tmp/captureSTDOUT', "Got expected value for STDOUT"); is($err, '', "Got expected value for STDERR"); is($chdir, '/tmp', "Got expected value for working directory"); ( $out, $err, $chdir ) = Parrot::Test::_handle_test_options( { STDOUT => '', STDERR => '', CD => '', } ); is($out, '', "Got expected value for STDOUT"); is($err, '', "Got expected value for STDERR"); is($chdir, '', "Got expected value for working directory"); eval { ( $out, $err, $chdir ) = Parrot::Test::_handle_test_options( { STDJ => '', STDERR => '', CD => '', } ); }; like($@, qr/I don't know how to redirect 'STDJ' yet!/, "Got expected error message for bad option"); my $dn = File::Spec->devnull(); ( $out, $err, $chdir ) = Parrot::Test::_handle_test_options( { STDOUT => '', STDERR => ($^O eq 'MSWin32')? 'nul' : '/dev/null', CD => '', } ); is($out, '', "Got expected value for STDOUT"); is($err, $dn, "Got expected value for STDERR using null device"); is($chdir, '', "Got expected value for working directory"); ( $out, $err, $chdir ) = Parrot::Test::_handle_test_options( { STDOUT => '/tmp/foobar', STDERR => '/tmp/foobar', CD => '', } ); is($out, '/tmp/foobar', "Got expected value for STDOUT"); is($err, '&STDOUT', "Got expected value for STDERR when same as STDOUT"); is($chdir, '', "Got expected value for working directory"); { my $oldpath = $ENV{PATH}; my $oldldrunpath = $ENV{LD_RUN_PATH}; local $PConfig{build_dir} = 'foobar'; my $blib_path = File::Spec->catfile( $PConfig{build_dir}, 'blib', 'lib' ); { local $^O = 'cygwin'; Parrot::Test::_handle_blib_path(); is( $ENV{PATH}, $blib_path . ':' . $oldpath, "\$ENV{PATH} reset as expected for $^O"); $ENV{PATH} = $oldpath; } { local $^O = 'MSWin32'; Parrot::Test::_handle_blib_path(); is( $ENV{PATH}, $blib_path . ';' . $oldpath, "\$ENV{PATH} reset as expected for $^O"); $ENV{PATH} = $oldpath; } { local $^O = 'not_cygwin_not_MSWin32'; Parrot::Test::_handle_blib_path(); is( $ENV{LD_RUN_PATH}, $blib_path, "\$ENV{LD_RUN_PATH} reset as expected for $^O"); $ENV{LD_RUN_PATH} = $oldldrunpath; } } my $command_orig; $command_orig = 'ls'; is_deeply( Parrot::Test::_handle_command($command_orig), [ qw( ls ) ], "Scalar command transformed into array ref as expected"); $command_orig = [ qw( ls -l ) ]; is( Parrot::Test::_handle_command($command_orig), $command_orig, "Array ref holding multiple commands unchanged as expected"); { my $oldvalgrind = defined $ENV{VALGRIND} ? $ENV{VALGRIND} : ''; $command_orig = 'ls'; my $foo = 'foobar'; local $ENV{VALGRIND} = $foo; my $ret = Parrot::Test::_handle_command($command_orig); is( $ret->[0], "$foo $command_orig", "Got expected value in Valgrind environment"); $ENV{VALGRIND} = $oldvalgrind; } { local $? = -1; my $exit_message = Parrot::Test::_prepare_exit_message(); is( $exit_message, -1, "Got expected exit message" ); } { local $? = 0; my $exit_message = Parrot::Test::_prepare_exit_message(); is( $exit_message, 0, "Got expected exit message" ); } { local $? = 1; my $exit_message = Parrot::Test::_prepare_exit_message(); is( $exit_message, q{[SIGNAL 1]}, "Got expected exit message" ); } { local $? = 255; my $exit_message = Parrot::Test::_prepare_exit_message(); is( $exit_message, q{[SIGNAL 255]}, "Got expected exit message" ); } { local $? = 256; my $exit_message = Parrot::Test::_prepare_exit_message(); is( $exit_message, 1, "Got expected exit message" ); } { local $? = 512; my $exit_message = Parrot::Test::_prepare_exit_message(); is( $exit_message, 2, "Got expected exit message" ); } { my $q = $PConfig{PQ}; my $text = q{Hello, world}; my $cmd = "$^X -e ${q}print qq{$text\n};${q}"; my $exit_message; my ($stdout, $stderr); capture( sub { $exit_message = run_command( $cmd, 'CD' => '', ); }, \$stdout, \$stderr, ); like($stdout, qr/$text/, "Captured STDOUT"); is($exit_message, 0, "Got 0 as exit message"); } undef $out; undef $err; undef $chdir; SKIP: { skip 'feature not DWIMming even though test passes', 1; $desc = ''; test_out("ok 1 - $desc"); pasm_output_is( <<'CODE', <<'OUTPUT', $desc ); print "foo\n" end CODE foo OUTPUT test_test($desc); } my $outfile = File::Spec->catfile( qw| t perl Parrot_Test_1.out | ); { unlink $outfile; local $ENV{POSTMORTEM} = 1; $desc = 'pir_output_is: success'; test_out("ok 1 - $desc"); pir_output_is( <<'CODE', <<'OUTPUT', $desc ); .sub 'test' :main print "foo\n" .end CODE foo OUTPUT test_test($desc); ok( -f $outfile, "file created during test preserved due to \$ENV{POSTMORTEM}"); unlink $outfile; ok( ! -f $outfile, "file created during test has been deleted"); } { unlink $outfile; local $ENV{POSTMORTEM} = 0; $desc = 'pir_output_is: success'; test_out("ok 1 - $desc"); pir_output_is( <<'CODE', <<'OUTPUT', $desc ); .sub 'test' :main print "foo\n" .end CODE foo OUTPUT test_test($desc); ok( ! -f $outfile, "file created during test was not retained"); } # Cleanup t/perl/ unless ( $ENV{POSTMORTEM} ) { my $tdir = q{t/perl}; opendir my $DIRH, $tdir or croak "Unable to open $tdir for reading: $!"; my @need_cleanup = grep { m/Parrot_Test_\d+\.(?:pir|pasm|out|c|o|build)$/ } readdir $DIRH; closedir $DIRH or croak "Unable to close $tdir after reading: $!"; for my $f (@need_cleanup) { unlink qq{$tdir/$f} or croak "Unable to remove $f: $!"; } } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: ack.pir000644000765000765 223311533177635 17500 0ustar00brucebruce000000000000parrot-5.9.0/examples/shootout#!./parrot # Copyright (C) 2005-2009, Parrot Foundation. # OUTPUT="Ack(3, 9) = 4093\n" # # ./parrot -Oc # RQ (Karl) # Seems to be an old benchmark, now deprecated by the shootout # # ackermann - ack(3, 9) is default # shootout runs ack(3, 11) # time for ack(3,11): 0.8s (AMD X2@2000) # by Leopold Toetsch .sub main :main .param pmc argv .local int argc argc = elements argv .local int x, y, r x = 3 y = 7 if argc == 1 goto go $S0 = argv[1] if argc == 2 goto xdefault x = $S0 $S0 = argv[2] y = $S0 goto go xdefault: y = $S0 go: $P0 = getinterp $P0.'recursion_limit'(100000) r = ack(x, y) .local pmc args args = new 'ResizableIntegerArray' push args, x push args, y push args, r $S0 = sprintf "Ack(%d, %d) = %d\n", args print $S0 .end .sub ack .param int x .param int y if x goto a1 $I0 = y + 1 .return ($I0) a1: if y goto a2 $I0 = x - 1 $I1 = 1 .tailcall ack($I0, $I1) a2: $I2 = y - 1 $I3 = ack(x, $I2) $I4 = x - 1 .tailcall ack($I4, $I3) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: attributes-01.t000644000765000765 321111533177646 17665 0ustar00brucebruce000000000000parrot-5.9.0/t/steps/auto#! perl # Copyright (C) 2007, Parrot Foundation. # auto/attributes-01.t use strict; use warnings; use Test::More tests => 7; use Carp; use lib qw( lib t/configure/testlib ); use_ok('config::auto::attributes'); use Parrot::Configure::Options qw( process_options ); use Parrot::Configure::Step::Test; use Parrot::Configure::Test qw( test_step_constructor_and_description ); use IO::CaptureOutput qw | capture |; my ($args, $step_list_ref) = process_options( { argv => [ ], mode => q{configure}, } ); my $conf = Parrot::Configure::Step::Test->new; $conf->include_config_results( $args ); my $pkg = q{auto::attributes}; $conf->add_steps($pkg); $conf->options->set(%{$args}); my $step = test_step_constructor_and_description($conf); { my $rv; my $stdout; capture( sub { $rv = $step->runstep($conf); }, \$stdout, ); ok( defined $rv, "runstep() returned defined value" ); unlike($conf->data->get('ccflags'), qr/HASATTRIBUTE_NEVER_WORKS/, "'ccflags' excludes bogus attribute as expected" ); } $conf->cc_clean(); pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME auto/attributes-01.t - test auto::attributes =head1 SYNOPSIS % prove t/steps/auto/attributes-01.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file test auto::attributes. =head1 AUTHOR James E Keenan =head1 SEE ALSO config::auto::attributes, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: 49-regex-interpolation.t000644000765000765 531712135343346 22227 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx/t/nqp#!./parrot-nqp plan(33); my $b := "b+"; my @foo := [ "b+", "c+" ]; ok("ab+d" ~~ /a $b d/, 'plain scalar interpolates as literal 1'); ok(!("abbbbbd" ~~ /a $b d/), 'plain scalar interpolates as literal 2'); ok("ab+d" ~~ /a @foo d/, 'plain array interpolates as alternations of literals 1'); ok("ac+d" ~~ /a @foo d/, 'plain array interpolates as alternations of literals 2'); ok(!("abbbbbd" ~~ /a @foo d/), 'plain array interpolates as alternations of literals 3'); ok(!("acccccd" ~~ /a @foo d/), 'plain array interpolates as alternations of literals 4'); my @ltm := [ "b", "bb", "bbc", "bc" ]; ok(("abd" ~~ / @ltm /) eq 'b', 'array finds longest match 1'); ok(("abbd" ~~ / @ltm /) eq 'bb', 'array finds longest match 2'); ok(("abbcd" ~~ / @ltm /) eq 'bbc', 'array finds longest match 3'); ok(("abccd" ~~ / @ltm /) eq 'bc', 'array finds longest match 4'); ok(!("ab+d" ~~ /a <$b> d/), 'scalar assertion interpolates as regex 1'); ok("abbbbbd" ~~ /a <$b> d/, 'scalar assertion interpolates as regex 2'); ok(!("ab+d" ~~ /a <@foo> d/), 'array assertion interpolates as alternations of regexen 1'); ok(!("ac+d" ~~ /a <@foo> d/), 'array assertion interpolates as alternations of regexen 2'); ok("abbbbbd" ~~ /a <@foo> d/, 'array assertion interpolates as alternations of regexen 3'); ok("acccccd" ~~ /a <@foo> d/, 'array assertion interpolates as alternations of regexen 4'); ok(!("ab+d" ~~ /a <{ "b+" }> d/), 'code assersion interpolates as regex 1'); ok("abbbbd" ~~ /a <{ "b+" }> d/, 'code assersion interpolates as regex 2'); ok("abbbbd" ~~ /a <{ ["b+", "c+"] }> d/, 'code assertion that returns array interpolates as alternations of regexen 1'); ok("accccd" ~~ /a <{ ["b+", "c+"] }> d/, 'code assertion that returns array interpolates as alternations of regexen 2'); my $r := /b+/; ok(!("ab+d" ~~ /a $r d/), 'plain scalar containing precompiled regex 1'); ok("abbbd" ~~ /a $r d/, 'plain scalar containing precompiled regex 2'); my @r := [ /b+/, "c+" ]; ok("abbbbd" ~~ /a @r d/, 'plain array containing mix of precompiled and literal 1'); ok("ac+d" ~~ /a @r d/, 'plain array containing mix of precompiled and literal 1'); my $xyz := 'xyz'; ok("axyzxyzd" ~~ /a $xyz+ d/, 'Quantified plain scalar 1'); ok("ab+b+b+d" ~~ /a $b+ d/, 'Quantified plain scalar 2'); ok("abbbc+bbbd" ~~ /a @r+ d/, 'Quantified plain array'); ok("abbbcccbbcd" ~~ /a <{ [ "b+", /c+/ ] }>+ d/, 'Quantified code assertion'); ok("ad" ~~ /a { "bc" } d/, "Plain closure doesn't interpolate 1"); ok(!("abcd" ~~ /a { "bc" } d/), "Plain closure doesn't interpolate 2"); ok("ad" ~~ /a d/, 'Zero-width assertions still work 1'); ok(!("ad" ~~ /a d/), 'Zero-width assertions still work 2'); ok("test.h" ~~ /.h$/, 'Do not parse $/ as variable interpolation'); mops.il000644000765000765 1420311466337261 16642 0ustar00brucebruce000000000000parrot-5.9.0/examples/mops // Microsoft (R) .NET Framework IL Disassembler. Version 1.0.3705.0 // Copyright (C) Microsoft Corporation 1998-2001. All rights reserved. .assembly extern mscorlib { .publickeytoken = (B7 7A 5C 56 19 34 E0 89 ) // .z\V.4.. .ver 1:0:3300:0 } .assembly hello { // --- The following custom attribute is added automatically, do not uncomment ------- // .custom instance void [mscorlib]System.Diagnostics.DebuggableAttribute::.ctor(bool, // bool) = ( 01 00 01 00 00 00 ) .hash algorithm 0x00008004 .ver 0:0:0:0 } .module hello.exe // MVID: {B0E5F267-024F-4374-8B69-829095D88C15} .imagebase 0x00400000 .subsystem 0x00000003 .file alignment 512 .corflags 0x00000001 // Image base: 0x03010000 // // ============== CLASS STRUCTURE DECLARATION ================== // .class private auto ansi beforefieldinit App extends [mscorlib]System.Object { } // end of class App // ============================================================= // =============== GLOBAL FIELDS AND METHODS =================== // ============================================================= // =============== CLASS MEMBERS DECLARATION =================== // note that class flags, 'extends' and 'implements' clauses // are provided here for information only .class private auto ansi beforefieldinit App extends [mscorlib]System.Object { .method public hidebysig static int32 Main(string[] args) cil managed { .entrypoint // Code size 171 (0xab) .maxstack 2 .locals init ([0] int64 i1, [1] int64 i5, [2] int64 i3, [3] int64 i4, [4] valuetype [mscorlib]System.DateTime start, [5] valuetype [mscorlib]System.DateTime end, [6] float64 n1, [7] float64 n2, [8] valuetype [mscorlib]System.TimeSpan CS$00000000$00000000) .language '{3F5162F8-07C6-11D3-9053-00C04FA302A1}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' // Source File 'c:\test\hello.cs' //000009: long i4 = 100000000; IL_0000: ldc.i4.1 IL_0001: conv.i8 IL_0002: stloc.2 //000010: DateTime start, end; IL_0003: ldc.i4 0x5f5e100 IL_0008: conv.i8 IL_0009: stloc.3 //000011: double n1, n2; //000012: Console.WriteLine("Iterations: {0}", i4); //000013: IL_000a: ldstr "Iterations: {0}" IL_000f: ldloc.3 IL_0010: box [mscorlib]System.Int64 IL_0015: call void [mscorlib]System.Console::WriteLine(string, object) //000024: i1 = 8; //000025: i5 = i4 * i1; IL_001a: ldc.i4.8 IL_001b: conv.i8 IL_001c: stloc.0 //000026: Console.WriteLine("Estimated ops: {0}", i5); IL_001d: ldloc.3 IL_001e: ldloc.0 IL_001f: mul IL_0020: stloc.1 //000027: start = DateTime.Now; IL_0021: ldstr "Estimated ops: {0}" IL_0026: ldloc.1 IL_0027: box [mscorlib]System.Int64 IL_002c: call void [mscorlib]System.Console::WriteLine(string, object) //000028: REDO: IL_0031: call valuetype [mscorlib]System.DateTime [mscorlib]System.DateTime::get_Now() IL_0036: stloc.s start //000029: i4 = i4 - i3; //000030: if (i4 > 0) IL_0038: ldloc.3 IL_0039: ldloc.2 IL_003a: sub IL_003b: stloc.3 //000031: goto REDO; IL_003c: ldloc.3 IL_003d: ldc.i4.0 IL_003e: conv.i8 IL_003f: bgt.s IL_0038 //000032: end = DateTime.Now; //000033: n2 = (end-start).TotalMilliseconds; IL_0041: call valuetype [mscorlib]System.DateTime [mscorlib]System.DateTime::get_Now() IL_0046: stloc.s end //000034: n2 /= 1000; // Milliseconds to seconds IL_0048: ldloc.s end IL_004a: ldloc.s start IL_004c: call valuetype [mscorlib]System.TimeSpan [mscorlib]System.DateTime::op_Subtraction(valuetype [mscorlib]System.DateTime, valuetype [mscorlib]System.DateTime) IL_0051: stloc.s CS$00000000$00000000 IL_0053: ldloca.s CS$00000000$00000000 IL_0055: call instance float64 [mscorlib]System.TimeSpan::get_TotalMilliseconds() IL_005a: stloc.s n2 //000035: Console.WriteLine("Elapsed Time: {0}", n2); IL_005c: ldloc.s n2 IL_005e: ldc.r8 1000. IL_0067: div IL_0068: stloc.s n2 //000036: n1 = i5; IL_006a: ldstr "Elapsed Time: {0}" IL_006f: ldloc.s n2 IL_0071: box [mscorlib]System.Double IL_0076: call void [mscorlib]System.Console::WriteLine(string, object) //000037: n1 /= n2; IL_007b: ldloc.1 IL_007c: conv.r8 IL_007d: stloc.s n1 //000038: n2 = 100000.0; IL_007f: ldloc.s n1 IL_0081: ldloc.s n2 IL_0083: div IL_0084: stloc.s n1 //000039: n1 /= n2; IL_0086: ldc.r8 100000. IL_008f: stloc.s n2 //000040: Console.WriteLine("M op/s: {0}", n1); IL_0091: ldloc.s n1 IL_0093: ldloc.s n2 IL_0095: div IL_0096: stloc.s n1 //000041: return 0; IL_0098: ldstr "M op/s: {0}" IL_009d: ldloc.s n1 IL_009f: box [mscorlib]System.Double IL_00a4: call void [mscorlib]System.Console::WriteLine(string, object) //000042: } IL_00a9: ldc.i4.0 IL_00aa: ret } // end of method App::Main .method public hidebysig specialname rtspecialname instance void .ctor() cil managed { // Code size 7 (0x7) .maxstack 1 IL_0000: ldarg.0 IL_0001: call instance void [mscorlib]System.Object::.ctor() IL_0006: ret } // end of method App::.ctor } // end of class App // ============================================================= //*********** DISASSEMBLY COMPLETE *********************** // WARNING: Created Win32 resource file hello.res pdd01_overview.pod000644000765000765 1771312101554066 21066 0ustar00brucebruce000000000000parrot-5.9.0/docs/pdds/draft# Copyright (C) 2001-2010, Parrot Foundation. =head1 [DRAFT] PDD 1: Overview =head2 Abstract A high-level overview of the Parrot virtual machine. =head2 Description Parrot is a virtual machine for dynamic languages like Python, PHP, Ruby, and Perl. A dynamic language is one that allows things like extension of the code base, subroutine and class definition, and altering the type system at runtime. Static languages like Java or C# restrict these features to compile time. If this sounds like an edgy idea, keep in mind that Lisp, one of the prime examples of a dynamic language, has been around since 1958. The basic paradigm shift to dynamic languages leads the way to other more advanced dynamic features like higher-order functions, closures, continuations, and coroutines. =head2 Implementation =head3 Parser While individual high-level languages may implement their own parser, most will use Parrot's parser grammar engine (PGE). The parser grammar engine compiles a parsing definition (.pg) file into an executable parser for the language. The resulting parser takes source code as input and creates a raw parse tree. Subsequent stages of compilation convert the raw parse tree into an annotated syntax tree. The tree grammar engine (TGE) compiles a transformation definition (.tg) file into an executable set of rules to transform data structures. In most compilers, the syntax tree goes through a series of transformations, starting with the raw parse tree, through a syntax tree that is close to the semantics of the HLL, and ending in a syntax tree that is close to the semantics of Parrot's bytecode. Some compilers will also insert optimization stages into the compilation process between the common transformation stages. =head3 IMCC The intermediate code compiler (IMCC) is the main F executable, and encapsulates several core low-level components. =head4 PASM & PIR parser This Bison and Flex based parser/lexer handles Parrot's assembly language, PASM, and the slightly higher-level language, PIR (Parrot Intermediate Representation). =head4 Bytecode compiler The bytecode compiler module takes a syntax tree from the parser and emits an unoptimized stream of bytecode. This code is suitable for passing straight to the interpreter, though it is probably not going to be very fast. Note that currently, the only way to generate bytecode is by first generating PASM or PIR. =head4 Optimizer The optimizer module takes the bytecode stream from the compiler and optionally the syntax tree the bytecode was generated from, and optimizes the bytecode. =head4 Interpreter The interpreter module takes the bytecode stream from either the optimizer or the bytecode compiler and executes it. There must always be at least one interpreter module available for any program that can handle all of Perl, since it's required for use statements and BEGIN blocks. While there must be at least one interpreter, there may be multiple interpreter modules linked into an executable. This would be the case, for example, for programs that produced Java bytecode, where one of the interpreter modules would take the bytecode stream and spit out Java bytecode instead of interpreting it. =head4 Standalone pieces Each piece of IMCC can, with enough support hidden away (in the form of an interpreter for the parsing module, for example), stand on its own. This means it's feasible to make the parser, bytecode compiler, optimizer and interpreter separate executables. This allows us to develop pieces independently. It also means we can have a standalone optimizer which can spend a lot of time groveling over bytecode, far more than you might want to devote to optimizing one-liners or code that'll run only once or twice. =head3 Subsystems The following subsystems are each responsible for a key component of Parrot's core functionality. =head4 I/O subsystem The I/O subsystem provides source- and platform-independent synchronous and asynchronous I/O to Parrot. How this maps to the OS's underlying I/O code is not generally Parrot's concern, and a platform isn't obligated to provide asynchronous I/O. Additionally, the I/O subsystem allows a program to push filters onto an input stream if necessary, to manipulate the data before it is presented to a program. =head4 Regular expression engine The parser grammar engine (PGE) is also Parrot's regular expression engine. The job of the regular expression engine is to compile regular expression syntax (both Perl 5 compatible syntax and Perl 6 syntax) into classes, and apply the matching rules of the classes to strings. The regular expression engine is available to any language running on Parrot. =head4 Data transformation engine The tree grammar engine (TGE) is also a general-purpose data transformation tool (somewhat similar to XSLT). =head3 API Levels =head4 Embedding The embedding API is the set of calls exported to an embedding application. This is a small, simple set of calls, requiring minimum effort to use. The goal is to provide an interface that a competent programmer who is uninterested in Parrot internals can use to provide access to a Parrot interpreter within another application with very little programming or intellectual effort. Generally it should take less than thirty minutes for a simple interface, though more complete integration will take longer. =head4 Extensions The extension API is the set of calls exported to Parrot extensions. They provide access to most of the things an extension needs to do, while hiding the implementation details. (So that, for example, we can change the way scalars are stored without having to rewrite, or even recompile, an extension). =head4 Guts The guts-level APIs are the routines used within a component. These aren't guaranteed to be stable, and shouldn't be used outside a component. (For example, an extension to the interpreter shouldn't call any of the parser's internal routines). =head3 Target Platforms The ultimate goal of Parrot is portability to more-or-less the same platforms as Perl 5, including AIX, BeOS, BSD/OS, Cygwin, Darwin, Debian, DG/UX, DragonFlyBSD, Embedix, EPOC, FreeBSD, Gentoo, HP-UX, IRIX, Linux, Mac OS (Classic), Mac OS X, Mandriva, Minix, MS-DOS, NetBSD, NetWare, NonStop-UX, OpenBSD, OS/2, Plan 9, Red Hat, RISC OS, Slackware, Solaris, SuSE, Syllable, Symbian, TiVo (Linux), Tru64, Ubuntu, VMS, VOS, WinCE, Windows 95/98/Me/NT/2000/XP/Vista, and z/OS. Recognizing the fact that ports depend on volunteer labor, the minimum requirements for the 1.0 launch of Parrot are portability to major versions of Linux, BSD, Mac OS X, and Windows released within 2 years prior to the 1.0 release. As we approach the 1.0 release we will actively seek porters for as many other platforms as possible. =head2 Language Notes =head3 Parrot for small platforms One goal of the Parrot project, though not a requirement of the 1.0 release, is to run on small devices such as the Palm. For small platforms, any parser, compiler, and optimizer modules are replaced with a small bytecode loader module which reads in Parrot bytecode and passes it to the interpreter for execution. Note that the lack of a parser will limit the available functionality in some languages: for instance, in Perl, string eval, do, use, and require will not be available (although loading of precompiled modules via do, use, or require may be supported). =head3 Bytecode compilation One straightforward use of the Parrot system is to precompile a program into bytecode and save it for later use. Essentially, we would compile a program as normal, but then simply freeze the bytecode to disk for later loading. =head3 Your HLL in; Java, CLI, or whatever out The previous section assumes that we will be emitting Parrot bytecode. However, there are other possibilities: we could translate the bytecode to Java bytecode or .NET code, or even to a native executable. In principle, Parrot could also act as a front end to other modular compilers such as gcc or HP's GEM compiler system. =head2 References None. =cut __END__ Local Variables: fill-column:78 End: interlangs.pir000644000765000765 531611533177634 20022 0ustar00brucebruce000000000000parrot-5.9.0/examples/pir# Copyright (C) 2009, Parrot Foundation. # interlangs.pir # An example of language interoperability # First build perl6, ecmascript and pipp # Then do: # ../../parrot -L /yourparrotdir/languages/rakudo \ # -L /yourparrotdir/languages/ecmascript \ # -L /yourparrotdir/languages/pipp \ # interlangs.pir #----------------------------------------------------------------------- .sub main :main .local pmc perl6func, jsfunc, pippfunc say 'Loading languages and compiling...' # Compile functions perl6func = get_perl6_func() jsfunc = get_js_func() pippfunc = get_pipp_func() # Call js and pipp functions directly say "\nDirect calls\n" jsfunc('pir') pippfunc('pir') # Pass js and pipp functions to perl6 function say "\nCalls from perl6\n" $S1 = perl6func('pir', jsfunc) print 'Returned: ' say $S1 $S1 = perl6func('pir', pippfunc) print 'Returned: ' say $S1 say "\nBye!" .end #----------------------------------------------------------------------- # Compile perl6 code that return a function, # execute it, and return the result. .sub get_perl6_func load_bytecode 'perl6.pbc' .local pmc compiler, code, function compiler = compreg 'Perl6' code = compiler.'compile'(<<'ENDCODE') sub ($a, $b) { $b('perl6->' ~ $a); 'Hello from a perl6 sub, ' ~ $a; }; ENDCODE function = code() .return(function) .end #----------------------------------------------------------------------- # Compile ecmascript code that define a function, # execute it and get the function from the # js namespace. .sub get_js_func load_bytecode 'js.pbc' .local pmc compiler, code, block, ns, function compiler = compreg 'JS' code = compiler.'compile'(<<'JSCODE') function myecmascriptfunc(n) { print ('Hello from ecmascript,', n); } JSCODE block = code() ns = get_root_global 'js' function = ns['myecmascriptfunc'] .return(function) .end #----------------------------------------------------------------------- # Compile php code that define a function, # and get the function from the pipp # namespace .sub get_pipp_func load_bytecode 'pipp.pbc' .local pmc compiler, code, ns, function compiler = compreg 'Pipp' code = compiler.'compile'(<<'PIPPCODE') PIPPCODE ns = get_root_global 'pipp' function = ns['phpfunc'] .return(function) .end #----------------------------------------------------------------------- # That's all folks! ######################################################################## # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: ch01_introduction.pod000644000765000765 1715311715102031 21551 0ustar00brucebruce000000000000parrot-5.9.0/docs/book/draft=pod =head1 Introduction Parrot is a language-neutral virtual machine for dynamic languages such as Ruby, Python, PHP, and Perl. It hosts a powerful suite of compiler tools tailored to dynamic languages and a next generation regular expression engine. Its architecture is fundamentally different than existing virtual machines such as the JVM or CLR, with optimizations for dynamic languages included, a register-based system rather than stack-based, and the use of continuations as the core means of flow control. The name "Parrot" was inspired by Monty Python's Parrot sketch. As an April Fools' Day joke in 2001, Simon Cozens published "Programming Parrot", a fictional interview between Guido van Rossum and Larry Wall detailing their plans to merge Python and Perl into a new language called Parrot (U). =head2 Parrot Resources The starting point for all things related to Parrot is the main website U. The site lists additional resources, well as recent news and information about the project and the Parrot Foundation, which holds the copyright over Parrot and helps guide development and the community. =head3 Documentation Parrot includes extensive documentation in the distribution. The full documentation for the latest release is available online at U. =head3 Mailing Lists X X The primary mailing list for Parrot is I. If you're interested in getting involved in development, you may also want to follow the I and I lists. Information on all the Parrot mailing lists and subscription forms for each is available at U. The archives for I are also available on Google Groups at U and via NNTP at U. =head3 IRC X<#parrot (Parrot IRC channel)> X Parrot developers and users congregate on IRC at C<#parrot> on the U server. It's a good place to get real-time answers to questions or see how things are progressing. =head3 Issue Tracking & Wiki X X Parrot developers track issues using the Github issues system at L Users can submit new tickets and track the status of existing tickets. Github also provides a wiki used in project development and a source code browser. =head2 Parrot Development X Parrot's first release occurred in September 2001. It reached 1.0 in March 2009. The Parrot project makes releases on the third Tuesday of each month. Two releases a year E occuring every January and July E are "supported" releases intended for production use. The other ten releases are development releases for language implementers and testers. Development proceeds in cycles around releases. Activity just before a release focuses on closing tickets, fixing bugs, reviewing documentation, and preparing for the release. Immediately after the release, larger changes occur, such as merging branches, adding large features, or removing deprecated features. This allows developers to ensure that changes have sufficient testing time before the next release. Releases also encourage feedback as casual users and testers explore the newest versions. =head2 The Parrot Team Parrot developers fulfill several rules according to their skills and interests. =over 4 =item Architect X The architect has primary responsibility for setting the overall direction of the project, facilitating team communication, and explaining and evaluating architectural issues. The architect makes design decisions and documents them in Parrot Design Documents, and oversees design and documentation work delegated to other members of the team to provide a coherent vision across the project. The architect also works with the release managers to develop and maintain the release schedule. Allison Randal currently leads the Parrot project as architect. =item Release Managers X Release managers manage and produce monthly releases according to the release schedule. Parrot has multiple release managers who rotate the responsibility for each monthly release. The release managers develop and maintain the release schedule jointly with the project architect. =item Metacommitter X Metacommitters manage commit access to the Parrot repository. Once a contributor is selected for commit access, a metacommitter gives the new committer access to the repository and the bugtracker. The architect is a metacommitter, but other team members also hold this role. =item Committer X Contributors who submit numerous, high-quality patches may be considered to become a committer. Committers have commit access to the full Parrot repository, though they often specialize on particular parts of the project. Contributors may be considered for commit access either by being nominated by another committer, or by requesting it. =item Core Developer X Core developers develop and maintain core subsystems such as the I/O subsystem, the exceptions system, or the concurrency scheduler. =item Compiler Developer X Compiler developers develop and maintain one or more Parrot front-end compilers such as IMCC, PGE and TGE. =item High-Level Language Developer X Developers who work on any of the high-level languages that target ParrotEsuch as Lua, Perl, PHP, Python, Ruby, or TclEare high-level language developers. The Parrot repository includes a few example languages. A full list of languages is available at L =item Build Manager X Build managers maintain and extend configuration and build subsystems. They review smoke reports and attempt to extend platform support. =item Tester X Testers develop, maintain, and extend the core test suite coverage and testing tools. Testers are also responsible for testing goals, including complete coverage of core components on targeted platforms. =item Patch Monsters X Hackers and developers submit patches to Parrot every day, and it takes a keen eye and a steady hand to review and apply them all. Patch monsters check patches for conformance with coding standards and desirability of features, rework them as necessary, verify that the patches work as desired, and apply them. =item Cage Cleaners X The cage cleaners ensure that development follows the project's coding standards, documentation is complete and accurate, all tests function properly, and new users have accurate and comprehensive coding examples. A special class of Trac tickets is available for these tasks. Cage cleaning tasks run the gamut from entry-level to advanced; this is a good entry point for new users to work on Parrot. =item General Contributor X Contributors write code or documentation, report bugs, take part in email or online conversations, or contribute to the project in other ways. All volunteer contributions are appreciated. =back =head2 Licensing X The Parrot foundation supports the Parrot development community and holds trademarks and copyrights to Parrot. The project is available under the Artistic License 2.0, allowing free use in commercial and open source/free software contexts. =cut # Local variables: # c-file-style: "parrot" # End: # vim: expandtab shiftwidth=4: regression.t000644000765000765 213711533177643 20106 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/pge#! perl # Copyright (C) 2001-2009, Parrot Foundation. use strict; use warnings; use lib qw( t . lib ../lib ../../lib ); use Test::More; use Parrot::Test tests => 2; =head1 NAME t/compilers/pge/regression.t =head1 SYNOPSIS % prove t/compilers/pge/regression.t =head1 DESCRIPTION PGE regression tests =cut pir_output_is( <<'CODE', <<'OUTPUT', 'load_bytecode with .pir' ); .sub main :main load_bytecode 'PGE.pbc' load_bytecode 'dumper.pir' load_bytecode 'PGE/Dumper.pir' $P0 = compreg 'PGE::P5Regex' $P1 = $P0('aabb*') $P2 = $P1('fooaabbbar') _dumper($P2) .end CODE "VAR1" => PMC 'PGE;Match' => "aabbb" @ 3 OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', 'load_bytecode with .pbc' ); .sub main :main load_bytecode 'PGE.pbc' load_bytecode 'dumper.pbc' load_bytecode 'PGE/Dumper.pbc' $P0 = compreg 'PGE::P5Regex' $P1 = $P0('aabb*') $P2 = $P1('fooaabbbar') _dumper($P2) .end CODE "VAR1" => PMC 'PGE;Match' => "aabbb" @ 3 OUTPUT # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: gen_version.pl000644000765000765 147511606346603 17637 0ustar00brucebruce000000000000parrot-5.9.0/tools/build#! perl # Copyright (C) 2011, Parrot Foundation. use warnings; use strict; use lib 'lib'; use Parrot::SHA1; use Parrot::Git::Describe; =head1 NAME tools/build/gen_version.pl - generate runtime/parrot/include/parrot_version.pir =head1 SYNOPSIS % perl tools/build/gen_version.pl >runtime/parrot/include/parrot_version.pir =head1 DESCRIPTION Generate C, which contains information about which commit was used to build parrot. =cut my $sha1 = $Parrot::SHA1::current; my $describe = $Parrot::Git::Describe::current; print <<"PIR"; # generated by tools/build/gen_version.pl .macro_const PARROT_SHA1 "$sha1" .macro_const PARROT_GIT_DESCRIBE "$describe" PIR # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: clock.pir000644000765000765 537311567202623 17476 0ustar00brucebruce000000000000parrot-5.9.0/examples/sdl/lcd =head1 NAME clock.pir - LCD clock =head1 SYNOPSIS ./parrot examples/sdl/lcd/clock.pir =head1 DESCRIPTION This example demonstrates the SDL::LCD object. It shows a simple clock. =head1 FUNCTIONS =over 4 =cut .include "tm.pasm" .include "timer.pasm" .loadlib 'sys_ops' .loadlib 'math_ops' =item _main The main function. =cut .sub _main :main load_bytecode "SDL/App.pir" load_bytecode "SDL/Event.pir" load_bytecode "SDL/EventHandler.pir" load_bytecode "SDL/LCD.pir" # create the SDL application object .local pmc app app = new ['SDL'; 'App'] app.'init'( 'height' => 21, 'width' => 94, 'bpp' => 16, 'flags' => 5 ) .local pmc screen screen = app.'surface'() set_global 'screen', screen # create the LCD .local pmc lcd lcd = new ['SDL'; 'LCD'] set_global 'LCD', lcd # draw the watch drawWatch() # create the timer $P1 = get_global "drawWatch" $P0 = new 'Timer' $P0[.PARROT_TIMER_NSEC] = 0.5 $P0[.PARROT_TIMER_HANDLER] = $P1 $P0[.PARROT_TIMER_REPEAT] = -1 $P0[.PARROT_TIMER_RUNNING] = 1 # store the timer somewhere, it will be # collected and destroyed otherwise set_global "timer", $P0 # # event loop # .local pmc eh .local pmc loop eh = new ['SDL'; 'EventHandler'] loop = new ['SDL'; 'Event'] loop.'init'() loop.'process_events'( 0.1, eh ) .end =item drawWatch Creates, sets and redraws the LCD display content. =cut .sub drawWatch # decode the current time $I0 = time $P0 = decodelocaltime $I0 # use a dot or a space? $N0 -= $I0 $S2 = ":" if $N0 < 0.5 goto USE_DOTS $S2 = " " USE_DOTS: # hours $I0 = $P0[.TM_HOUR] $I0 /= 10 if $I0 > 0 goto NO_SPACE $S0 = ' ' branch HOUR NO_SPACE: $S0 = $I0 HOUR: $I0 = $P0[.TM_HOUR] cmod $I0, $I0, 10 $S1 = $I0 $S0 = concat $S0, $S1 # minutes $S0 = concat $S0, $S2 $I0 = $P0[.TM_MIN] $I0 /= 10 $S1 = $I0 $S0 = concat $S0, $S1 $I0 = $P0[.TM_MIN] cmod $I0, $I0, 10 $S1 = $I0 $S0 = concat $S0, $S1 # seconds $S0 = concat $S0, $S2 $I0 = $P0[.TM_SEC] $I0 /= 10 $S1 = $I0 $S0 = concat $S0, $S1 $I0 = $P0[.TM_SEC] cmod $I0, $I0, 10 $S1 = $I0 $S0 = concat $S0, $S1 # set the time $P0 = get_global "LCD" $P0 = $S0 # redraw the LCD $P1 = get_global "screen" $P0.'draw'( $P1 ) .end =back =head1 AUTHOR Jens Rieks Eparrot at jensbeimsurfen dot deE is the author and maintainer. Please send patches and suggestions to the Perl 6 Internals mailing list. =head1 COPYRIGHT Copyright (C) 2004-2010, Parrot Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: osutils.pir000644000765000765 6350112134026463 21413 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library# Copyright (C) 2009-2011, Parrot Foundation. =head1 NAME osutils - operating system utilities for Parrot =head1 SYNOPSIS .sub 'main' :main load_bytecode 'osutils.pbc' # Print current working directory $S0 = cwd() say $S0 # Make a new directory, then enter it $S1 = 'foobar' mkdir($S1) chdir($S1) .end =head1 DESCRIPTION The C library provides a procedural interface to many common shell utilities. Think of it as a watered down version of GNU coreutils for Parrot. =head1 FUNCTIONS =over 4 =cut .loadlib 'math_ops' .sub '' :init :load :anon .end =item B Executes a shell command. The first argument is a string that specifies which command to execute. The C<:verbose()> argument is an optional integer indicating whether or not to be verbose. If given, the name of the command in C will be displayed. The C<:ignore_error()> argument is also an optional integer indicating whether or not errors should be ignored. Returns the exit status of the C command. =cut .sub 'system' .param string cmd .param int verbose :named('verbose') :optional .param int has_verbose :opt_flag .param int ignore_error :named('ignore_error') :optional .param int has_ignore_error :opt_flag unless has_verbose goto L1 unless verbose goto L1 say cmd L1: $I0 = spawnw cmd unless $I0 goto L2 unless has_ignore_error goto L3 if ignore_error goto L2 L3: $S0 = "exit status: " $S1 = $I0 $S0 .= $S1 $S0 .= "\ncommand: " $S0 .= cmd $S0 .= "\n" die $S0 L2: .return ($I0) .end .loadlib 'io_ops' .include 'stat.pasm' =item B Returns an integer value indicating whether or not the file in C exists. A value of 1 means that it does exist while a value of 0 means that it does not. =cut .sub 'file_exists' .param string filename $I0 = stat filename, .STAT_EXISTS .return ($I0) .end =item B =item B =item B Checks whether or not the file in C is newer than the file in C. If either of the arguments are aggregates (i.e. array or hash), then C checks whether or not I the file(s) in C are newer than I the file(s) in C. Returns 1 if C is newer than C and 0 if it's not. If the file in C doesn't exist, then 0 is returned. =cut .sub 'newer' :multi(string, pmc) .param string target .param pmc depend $I0 = does depend, 'array' if $I0 goto L1 $S0 = depend .tailcall newer(target, $S0) L1: $I0 = stat target, .STAT_EXISTS unless $I0 goto L2 $I0 = stat target, .STAT_FILESIZE unless $I0 goto L2 goto L3 L2: .return (0) L3: $I0 = stat target, .STAT_MODIFYTIME $P0 = iter depend L4: unless $P0 goto L5 $S0 = shift $P0 if $S0 == '' goto L4 $I1 = stat $S0, .STAT_MODIFYTIME if $I1 < $I0 goto L4 .return (0) L5: .return (1) .end .sub 'newer' :multi(string, string) .param string target .param string depend $I0 = stat target, .STAT_EXISTS unless $I0 goto L1 $I0 = stat target, .STAT_FILESIZE unless $I0 goto L1 goto L2 L1: .return (0) L2: $I1 = stat target, .STAT_MODIFYTIME $I2 = stat depend, .STAT_MODIFYTIME $I0 = $I1 > $I2 .return ($I0) .end .sub 'newer' :multi(pmc, pmc) .param pmc target .param pmc depend $S0 = target .tailcall newer($S0, depend) .end =item B Creates the file path given in C. The C<:verbose()> argument is an optional integer which indicates whether or not to be verbose. If given, the string I will be displayed along with each directory name as it is created. =cut .sub 'mkpath' .param string pathname .param int verbose :named('verbose') :optional $I1 = 1 L1: $I1 = index pathname, '/', $I1 if $I1 < 0 goto L2 $S0 = substr pathname, 0, $I1 inc $I1 $I0 = stat $S0, .STAT_EXISTS if $I0 goto L1 $I0 = length $S0 if $I0 != 2 goto L3 $I0 = index $S0, ':' if $I0 == 1 goto L1 L3: mkdir($S0, verbose :named('verbose')) goto L1 L2: $I0 = stat pathname, .STAT_EXISTS if $I0 goto L4 mkdir(pathname, verbose :named('verbose')) L4: .end =item B Creates the directory given in C if it does not already exist. The C<:verbose()> argument is an optional integer indicating whether or not to be verbose. If given, the string I> will be displayed. An exception is thrown if C already exists. Note that unlike C, subdirectories cannot be created at the same time. For example, creating C will fail with C but will succeed with C. In this case, C must be created first, then C (in that order), before C can be created. =cut .sub 'mkdir' .param string dirname .param int verbose :named('verbose') :optional .param int has_verbose :opt_flag unless has_verbose goto L1 unless verbose goto L1 print "mkdir " say dirname L1: $P0 = new 'OS' $I1 = 0o775 push_eh _handler $P0.'mkdir'(dirname, $I1) pop_eh .return () _handler: .local pmc e .get_results (e) $S0 = "Can't mkdir '" $S0 .= dirname $S0 .= "' (" $S1 = err $S0 .= $S1 $S0 .= ")\n" e = $S0 rethrow e .end =item B Copies the file given in C to C and sets attributes. The C<:exe()> argument is an optional integer which indicates whether or not to set the executable mode bit for all users for the file given in C. The C<:verbose()> argument is an optional integer which indicates whether or not to be verbose. If given, each step during the installation process will be displayed. =cut .include 'iglobals.pasm' .sub 'install' .param string src .param string dst .param int exe :named('exe') :optional .param int has_exe :opt_flag .param int verbose :named('verbose') :optional $I1 = 1 L1: $I1 = index dst, '/', $I1 if $I1 < 0 goto L2 $S0 = substr dst, 0, $I1 inc $I1 $I0 = stat $S0, .STAT_EXISTS if $I0 goto L1 mkdir($S0, verbose :named('verbose')) goto L1 L2: $I0 = newer(dst, src) if $I0 goto L3 $I0 = stat dst, .STAT_EXISTS unless $I0 goto L4 unlink(dst, verbose :named('verbose')) L4: cp(src, dst, verbose :named('verbose')) unless has_exe goto L3 unless exe goto L3 $P0 = getinterp $P0 = $P0[.IGLOBALS_CONFIG_HASH] $I0 = $P0['win32'] if $I0 goto L3 chmod(dst, 0o755, verbose :named('verbose')) L3: .end =item B Copies the file given in C to C. The copy is completely independent of the original. The C<:verbose()> argument is an optional integer indicating whether or not to be verbose. If given, the string I C> will be displayed. The C file must be readable and the C file must be writable. If not, an exception will be thrown. Note that unlike the C shell command, the second argument I be a directory. For example, to copy C to C, C must be called as C. =cut .sub 'cp' .param string src .param string dst .param int verbose :named('verbose') :optional .param int has_verbose :opt_flag unless has_verbose goto L1 unless verbose goto L1 print "cp " print src print " " say dst L1: $P0 = new 'FileHandle' $P0.'encoding'('binary') push_eh _handler1 $S0 = $P0.'readall'(src) pop_eh push_eh _handler2 $P0.'open'(dst, 'w') pop_eh $P0.'print'($S0) $P0.'close'() .return () _handler1: .local pmc e .get_results (e) $S0 = "Can't open '" $S0 .= src $S0 .= "' (" $S1 = err $S0 .= $S1 $S0 .= ")\n" e = $S0 rethrow e _handler2: .local pmc e .get_results (e) $S0 = "Can't open '" $S0 .= dst $S0 .= "' (" $S1 = err $S0 .= $S1 $S0 .= ")\n" e = $S0 rethrow e .end =item B Changes the file mode bits for C according to C. The second argument, C, is an octal number representing the bit pattern for the new mode bits. The C<:verbose()> argument is an optional integer which indicates whether or not to be verbose. If given, the string I C> will be displayed. A full discussion of file permissions and mode bits is outside the scope of this reference. For a more in-depth explanation, see the L man page. Note that unlike the C shell command, the C argument I alternatively be a symbolic string representation of the changes to make. =cut .sub 'chmod' .param string filename .param int mode .param int verbose :named('verbose') :optional .param int has_verbose :opt_flag unless has_verbose goto L1 unless verbose goto L1 $P0 = new 'ResizablePMCArray' push $P0, mode $S0 = sprintf '%o', $P0 print "chmod " print filename print " 0o" say $S0 L1: $P0 = new 'OS' $P0.'chmod'(filename, mode) .end =item B =item B Removes a link to the file given in C. The C<:verbose()> argument is an optional integer indicating whether or not to be verbose. If given, the string I> will be displayed. If the file's link count becomes 0, its contents will be removed. Note that if one or more processes currently have the file open, it is not actually removed until those processes have been terminated. If C is a symbolic link, then only the link itself is removed and will not affect the file that it points to. =cut .sub 'unlink' :multi(string) .param string filename .param int verbose :named('verbose') :optional .param int has_verbose :opt_flag $I0 = stat filename, .STAT_EXISTS unless $I0 goto L1 $I0 = stat filename, .STAT_ISREG unless $I0 goto L1 unless has_verbose goto L2 unless verbose goto L2 print "unlink " say filename L2: new $P0, 'OS' push_eh _handler $P0.'unlink'(filename) pop_eh L1: .return () _handler: .local pmc e .get_results (e) $S0 = "Can't remove '" $S0 .= filename $S0 .= "' (" $S1 = err $S0 .= $S1 $S0 .= ")\n" e = $S0 rethrow e .end .sub 'unlink' :multi(pmc) .param pmc filename .param int verbose :named('verbose') :optional $I0 = does filename, 'array' if $I0 goto L1 $S0 = filename unlink($S0, verbose :named('verbose')) goto L2 L1: $P0 = iter filename L3: unless $P0 goto L2 $S0 = shift $P0 unlink($S0, verbose :named('verbose')) goto L3 L2: .end =item B Removes the directory path given in C. The C<:verbose()> argument is an optional integer indicating whether or not to be verbose. If given, the string I> will be displayed. =cut .sub 'rmtree' .param string path .param int verbose :named('verbose') :optional .param int has_verbose :opt_flag $I0 = stat path, .STAT_EXISTS unless $I0 goto L1 $I0 = stat path, .STAT_ISDIR unless $I0 goto L1 unless has_verbose goto L2 unless verbose goto L2 print "rmtree " say path L2: new $P0, 'OS' $P1 = $P0.'readdir'(path) push_eh _handler L3: unless $P1 goto L4 $S0 = shift $P1 if $S0 == '.' goto L3 if $S0 == '..' goto L3 $S1 = path . '/' $S1 .= $S0 $I0 = stat $S1, .STAT_ISDIR unless $I0 goto L5 rmtree($S1) goto L3 L5: $P0.'unlink'($S1) goto L3 L4: push_eh _handler $S1 = path $P0.'rmdir'($S1) pop_eh L1: .return () _handler: .local pmc e .get_results (e) $S0 = "Can't remove '" $S0 .= $S1 $S0 .= "' (" $S1 = err $S0 .= $S1 $S0 .= ")\n" e = $S0 rethrow e .end =item B Returns C with all leading directory components removed. Put differently, it returns the filename portion of C. =cut .sub 'basename' .param string path $I0 = 0 L1: $I1 = index path, '/', $I0 if $I1 < 0 goto L2 $I0 = $I1 + 1 goto L1 L2: $S0 = substr path, $I0 .return ($S0) .end =item B Returns C with the trailing component removed. Put differently, it returns the directory portion of C. If C contains no /'s, then "." (the current working directory) is returned. =cut .sub 'dirname' .param string path unless path goto L3 $I0 = 0 L1: $I1 = index path, '/', $I0 if $I1 < 0 goto L2 $I0 = $I1 + 1 goto L1 L2: dec $I0 unless $I0 > 0 goto L3 $S0 = substr path, 0, $I0 .return ($S0) L3: .return ('.') .end =item BB<(>B<)> Returns the pathname of the current working directory. =cut .sub 'cwd' new $P0, 'OS' $S0 = $P0.'cwd'() $P0 = split "\\", $S0 $S0 = join "/", $P0 .return ($S0) .end =item B Changes the current working directory to C. The C<:verbose()> argument is an optional integer indicating whether or not to be verbose. If given, the string I> will be displayed. Note that unlike the C shell command, not specifying a directory I change the working directory to the home directory. =cut .sub 'chdir' .param string dirname .param int verbose :named('verbose') :optional .param int has_verbose :opt_flag unless has_verbose goto L1 unless verbose goto L1 print "chdir " say dirname L1: new $P0, 'OS' push_eh _handler $P0.'chdir'(dirname) pop_eh .return () _handler: .local pmc e .get_results (e) $S0 = "Can't chdir '" $S0 .= dirname $S0 .= "' (" $S1 = err $S0 .= $S1 $S0 .= ")\n" e = $S0 rethrow e .end =item B Behaves similar to the C function in Perl by removing any trailing newline characters from C. Regardless of operating system, trims the last 2 chars if they are \r\n, or trims the last char if it is \n. =cut .include 'cclass.pasm' .sub 'chomp' .param string str .local int len, pos_n, pos_r, pos_char_last, pos_char_next_to_last len = length str if len == 0 goto trim_0 # Return original empty string pos_char_last = len - 1 pos_char_next_to_last = len - 2 pos_n = index str, "\n", pos_char_last if pos_n == -1 goto trim_0 # Does not end in \n; return original. if len == 1 goto trim_1 # str eq "\n"; remove only char. pos_r = index str, "\r", pos_char_next_to_last if pos_r == -1 goto trim_1 # Ends in \n not \r\n; remove last 1 char. goto trim_2 # Ends in \r\n; remove last 2 chars. trim_0: .return (str) trim_1: str = replace str, -1, 1, "" .return (str) trim_2: str = replace str, -2, 2, "" .return (str) .end =item B Searches the current working directory for all the pathnames matching C. For more information about pattern matching and wilcard expansion, see the C man page. Returns a (possibly empty) C of all the matched pathnames. =cut .sub 'glob' .param string patterns $P0 = new 'ResizableStringArray' $P1 = split ' ', patterns L1: unless $P1 goto L2 .local string pattern pattern = shift $P1 $I0 = index pattern, '*' unless $I0 < 0 goto L3 $I0 = index pattern, '?' unless $I0 < 0 goto L3 $I0 = index pattern, '[' unless $I0 < 0 goto L3 $I0 = stat pattern, .STAT_EXISTS unless $I0 goto L1 push $P0, pattern goto L1 L3: .local pmc matcher load_bytecode 'PGE/Glob.pbc' $P2 = compreg 'PGE::Glob' matcher = $P2.'compile'(pattern) $S0 = dirname(pattern) $P3 = glob($S0) $P4 = new 'OS' L4: unless $P3 goto L1 .local string dir dir = shift $P3 $I0 = stat dir, .STAT_ISDIR unless $I0 goto L4 $S0 = basename(dir) $P5 = $P4.'readdir'(dir) L5: unless $P5 goto L4 $S0 = shift $P5 if $S0 == '.' goto L5 if $S0 == '..' goto L5 if dir == '.' goto L6 $S1 = dir . '/' $S0 = $S1 . $S0 L6: $P6 = matcher($S0) unless $P6 goto L5 push $P0, $S0 goto L5 L2: .return ($P0) .end =item B Searches the environment list for the environment variable given in C. Returns a string representing the value of C. If the C environment variable is not defined, an empty string will be returned. =cut .sub 'getenv' .param string name new $P0, 'Env' $S0 = $P0[name] .return ($S0) .end =item B Adds or changes an environment variable. If the C environment variable does not already exist, it will be added. However, if C I already exist, its value is changed to C. The C<:verbose()> argument is an optional integer indicating whether or not to be verbose. If given, the string I = C> will be displayed. =cut .sub 'setenv' .param string name .param string value .param int verbose :named('verbose') :optional .param int has_verbose :opt_flag unless has_verbose goto L1 unless verbose goto L1 print "setenv " print name print " = " say value L1: new $P0, 'Env' $P0[name] = value .end =item B Reads the entire contents of the file given in C. The C<:encoding()> argument is an optional string containing the character encoding used by C. An exception is thrown if C does not exist. The C file must already exist and be readable. If not, an exception will be thrown. Returns the contents of C as a string. =cut .sub 'slurp' .param string filename .param string encoding :named('encoding') :optional .param int has_encoding :opt_flag $P0 = new 'FileHandle' unless has_encoding goto L1 $P0.'encoding'(encoding) L1: push_eh _handler $S0 = $P0.'readall'(filename) pop_eh .return ($S0) _handler: .local pmc e .get_results (e) $S0 = "Can't open '" $S0 .= filename $S0 .= "' (" $S1 = err $S0 .= $S1 $S0 .= ")\n" e = $S0 rethrow e .end =item B Creates a new file called C and writes the contents of C to it. If C already exists, its contents will be truncated to length 0 before writing. The C<:verbose()> argument is an optional integer indicating whether or not to be verbose. If given, the string I> will be displayed. =cut .sub 'spew' .param string filename .param string content .param int verbose :named('verbose') :optional .param int has_verbose :opt_flag unless has_verbose goto L1 unless verbose goto L1 print "spew " say filename L1: $P0 = new 'FileHandle' push_eh _handler $P0.'open'(filename, 'w') pop_eh $P0.'print'(content) $P0.'close'() .return () _handler: .local pmc e .get_results (e) $S0 = "Can't open '" $S0 .= filename $S0 .= "' (" $S1 = err $S0 .= $S1 $S0 .= ")\n" e = $S0 rethrow e .end =item B Appends the contents of C to the file given in C. If C does not exist, it will be created under the same conditions as C. The C<:verbose()> argument is an optional integer indicating whether or not to be verbose. If given, the string I> will be displayed. =cut .sub 'append' .param string filename .param string content .param int verbose :named('verbose') :optional .param int has_verbose :opt_flag unless has_verbose goto L1 unless verbose goto L1 print "append " say filename L1: $P0 = new 'FileHandle' push_eh _handler $P0.'open'(filename, 'a') pop_eh $P0.'print'(content) $P0.'close'() .return () _handler: .local pmc e .get_results (e) $S0 = "Can't open '" $S0 .= filename $S0 .= "' (" $S1 = err $S0 .= $S1 $S0 .= ")\n" e = $S0 rethrow e .end =item B Returns a string representing a unique filename that can be used for creating a temporary file. The format of the filename is C where C represents 3 random characters. Optionally, the C<:SUFFIX()> argument may be given which will append the string to the filename. For example, the call C could create a filename like C. =cut .sub 'tempdir' .param string suffix :named('SUFFIX') :optional .param int has_suffix :opt_flag $S0 = tmpdir() $S0 .= '/TEMPXXX' unless has_suffix goto L1 $S0 .= suffix L1: .tailcall _gettemp($S0) .end .sub '_gettemp' :anon .param string template $P0 = split "/", template $S0 = pop $P0 .const string TEMPCHARS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" $P1 = split '', TEMPCHARS $I1 = elements $P1 dec $I1 REDO: $S1 = '' $P2 = split '', $S0 L1: unless $P2 goto L2 $S2 = shift $P2 unless $S2 == 'X' goto L3 $I0 = rand $I1 $S2 = $P1[$I0] L3: $S1 .= $S2 goto L1 L2: push $P0, $S1 $S0 = join "/", $P0 $I0 = stat $S0, .STAT_EXISTS if $I0 goto REDO .return ($S0) .end .sub 'tmpdir' .local pmc env, dirlist env = new 'Env' dirlist = new 'ResizableStringArray' $P0 = getinterp $P0 = $P0[.IGLOBALS_CONFIG_HASH] $I0 = $P0['win32'] unless $I0 goto L1 $I0 = exists env['TMPDIR'] unless $I0 goto L2 $S0 = env['TMPDIR'] push dirlist, $S0 L2: $I0 = exists env['TEMP'] unless $I0 goto L3 $S0 = env['TEMP'] push dirlist, $S0 L3: $I0 = exists env['TMP'] unless $I0 goto L4 $S0 = env['TMP'] push dirlist, $S0 L4: push dirlist, 'c:/system/temp' push dirlist, 'c:/temp' push dirlist, '/tmp' push dirlist, '/' goto L5 L1: $I0 = exists env['TMPDIR'] unless $I0 goto L6 $S0 = env['TMPDIR'] push dirlist, $S0 L6: push dirlist, '/tmp' L5: unless dirlist goto L7 $S0 = shift dirlist $I0 = stat $S0, .STAT_EXISTS unless $I0 goto L5 $I0 = stat $S0, .STAT_ISDIR unless $I0 goto L5 $P0 = split "\\", $S0 $S0 = join "/", $P0 .return ($S0) L7: .end =item B Compresses the file given in C using the Lempel-Ziv algorithm. This replaces the file with one with the C<.gz> extension. An exception is thrown if C does not exist. For more information, see the C man page. =cut .sub 'gzip' .param string filename .param int verbose :named('verbose') :optional .param int has_verbose :opt_flag unless has_verbose goto L1 unless verbose goto L1 print "gzip " say filename L1: .local pmc fh, gh fh = new 'FileHandle' fh.'encoding'('binary') push_eh _handler1 $S0 = fh.'readall'(filename) $I0 = length $S0 pop_eh $P0 = loadlib 'gziphandle' push_eh _handler2 gh = new 'GzipHandle' $S1 = filename . '.gz' gh.'open'($S1, 'wb') gh.'print'($S0) gh.'close'() unlink(filename) .return () _handler1: .local pmc e .get_results (e) $S0 = "Can't open '" $S0 .= filename $S0 .= "' (" $S1 = err $S0 .= $S1 $S0 .= ")\n" e = $S0 rethrow e _handler2: .local pmc e .get_results (e) $S0 = "Can't gzip '" $S0 .= filename $S0 .= "'\n" e = $S0 rethrow e .end =item B Concatenates the directory names and filename in C. The C<:native()> argument is an optional integer indicating whether or not to use the native path separator. The default is C. Returns a string representing a complete path ending with a filename. =cut .sub 'catfile' .param pmc args :slurpy .param int native :named('native') :optional .param int has_native :opt_flag .local string slash slash = '/' unless has_native goto L1 unless native goto L1 $P0 = getinterp $P0 = $P0[.IGLOBALS_CONFIG_HASH] slash = $P0['slash'] L1: $S0 = join slash, args .return ($S0) .end =item B Returns a string representing the path given in C split into volume, directory, and filename portions. On systems that don't have the concept of "volumes", returns '' for the volume portion. =cut .sub 'splitpath' .param string path .local string volume, directories, file volume = '' $I0 = index path, ':' unless $I0 == 1 goto L1 volume = substr path, 0, 2 path = substr path, 2 L1: $I0 = 0 L2: $I1 = index path, '/', $I0 if $I1 < 0 goto L3 $I0 = $I1 + 1 goto L2 L3: file = substr path, $I0 directories = '' dec $I0 unless $I0 > 0 goto L4 directories = substr path, 0, $I0 L4: .return (volume, directories, file) .end =back =head1 AUTHOR Francois Perrad =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: makefiles-01.t000644000765000765 1366712101554067 17264 0ustar00brucebruce000000000000parrot-5.9.0/t/steps/gen#! perl # Copyright (C) 2007-2009, Parrot Foundation. # gen/makefiles-01.t use strict; use warnings; my @cond_tests; my @conf_args = ( true => 1, false => 0, value => 'xx' ); BEGIN { @cond_tests = ( # perl-syntax true or false ["IF(true)", 1], ["IF(false)", 0], ["UNLESS(true)", 0], ["UNLESS(false)", 1], ["IF(true | false)", 1], ["IF(true & false)", 0], ["IF(true or true)", 1], ["IF(true or false)", 1], ["IF(false or true)", 1], ["IF(false or false)", 0], ["IF(true and true)", 1], ["IF(true and false)", 0], ["IF(false and true)", 0], ["IF(false and false)", 0], ["UNLESS(true|false)", 0], ["UNLESS(true&false)", 1], ["IF(!false)", 1], ["IF(true)", 1], ["ELSIF(value)", 0], ["ELSE", 0], ["IF(false)", 0], ["ELSIF(value)", 1], ["ELSE", 0], ["IF(false)", 0], ["ELSIF(false)", 0], ["ELSE", 1], # Exercise the parser ["IF(true and (!false and value))", 1], ["IF(true and (!false) and value)", 1], ["IF(true and !false and value)", 1, 'no parens'], ["IF(true and not false and value)", 1, 'no parens'], ["IF(true&!false&value)", 1], ["IF(false or (!false and value))", 1, 'not parser problem'], ["UNLESS(!(true&!false&value))", 1, 'no ws, but nested parens'], ["IF(true&(!false&false))", 0, 'not precedence'], ["IF(true&(!false&value))", 1], ["IF(not true and value)", 0, 'not precedence over and'], ["IF(not false and value)", 1], ["IF((not false) and value)", 1], ["IF(not (false and value))", 1], ["IF(not (false or value))", 0], ["IF(true and not false)", 1], # platform ["IF(someplatform)", 1], ["IF(not someplatform)", 0], ["UNLESS(someplatform)", 0], ["UNLESS(not someplatform)", 1], # key==value ["IF(value==xx)", 1], ["IF(value==xxy)", 0], ["UNLESS(value==xx)", 0], ["UNLESS(value==xxy)", 1], ["IF(true & (value==xx & (!false)))",1], # These are invalid: #["IF(value == xx)", 0], # invalid op error #["IF(value = xx)", 0], # invalid op error ["IF(value=xx)", 0], # also invalid, no warning. checks for key value=xx ); } use Test::More tests => (7 + @cond_tests); use Carp; use lib qw( . lib ); use_ok('config::gen::makefiles'); use Parrot::Configure::Options qw( process_options ); use Parrot::Configure::Step::Test; use Parrot::Configure::Test qw( test_step_constructor_and_description ); ########## regular ########## my ($args, $step_list_ref) = process_options( { argv => [ ], mode => q{configure}, } ); my $conf = Parrot::Configure::Step::Test->new; $conf->include_config_results( $args ); my $pkg = 'gen::makefiles'; $conf->add_steps($pkg); $conf->options->set( %{$args} ); my $step = test_step_constructor_and_description($conf); my $missing_SOURCE = 0; my %makefiles = %{ $step->{makefiles} }; foreach my $k ( keys %makefiles ) { $missing_SOURCE++ unless (-f $makefiles{$k}{SOURCE}); } is($missing_SOURCE, 0, "No Makefile source file missing"); my $index = undef; sub result { my $c = shift; my $s = $c->[0]; $s =~ s/^\+/plus_/; $s =~ s/^\-/minus_/; $s =~ s/\|/OR/g; $s =~ s/\&/AND/g; $s =~ s/\!/NOT/g; $s =~ s/[\()]//g; $s =~ s/ /_/g; $s .= ("_".++$index) if $s =~ /^(ELSE|ELSIF)/; return $s."=".($c->[1]?"true":"false"); } # test #IF(keys):line $conf->data->set( @conf_args, ('osname' => 'someplatform' ) ); open my $IN, ">", "Makefile_$$.in"; print $IN "# There should only be =true results in .out\n"; for my $c (@cond_tests) { my $result = result($c); print $IN "#$c->[0]:$result\n"; } close $IN; $conf->genfile("Makefile_$$.in", "Makefile_$$.out", (makefile => 1, conditioned_lines => 1)); open my $OUT, "<", "Makefile_$$.out"; my $f; { local $/; $f = <$OUT>; } close $OUT; $index = undef; for my $c (@cond_tests) { my $result = result($c); if ($c->[2] and $c->[2] =~ /^TODO(.*)$/) { local $TODO = $1; ok(($c->[1] ? $f =~ /^$result$/m : $f !~ /^$result$/m), "$result"); } else { ok(($c->[1] ? $f =~ /^$result$/m : $f !~ /^$result$/m), "$result".($c->[2]?" $c->[2]":'')); } } # TT #279: reporting the makefile line number # step gen::makefiles died during execution: # invalid op "IF" in "#IF(bla)" at "(bla)" at Configure.pl line 72 open $IN, ">", "Makefile_$$.in"; print $IN "# Test reporting sourcefile line numbers. TT #279\n"; print $IN "#IF(IF(bla)):test\n"; close $IN; eval { $conf->genfile("Makefile_$$.in", "Makefile_$$.out", (makefile => 1, conditioned_lines => 1)); }; my $error = $@; ok($error eq "invalid op \"bla\" in \"IF(bla)\" at \"(bla)\" at Makefile_$$.in line 2\n", "report correct error line"); pass("Completed all tests in $0"); END { unlink "Makefile_$$.in", "Makefile_$$.out", "Makefile_$$.out_tmp"; } ################### DOCUMENTATION ################### =head1 NAME gen/makefiles-01.t - test gen::makefiles =head1 SYNOPSIS % prove t/steps/gen/makefiles-01.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file test gen::makefiles. =head1 AUTHOR James E Keenan Reini Urban =head1 SEE ALSO config::gen::makefiles, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: coverage-01.t000644000765000765 271611567202625 17274 0ustar00brucebruce000000000000parrot-5.9.0/t/steps/auto#! perl # Copyright (C) 2007, Parrot Foundation. # auto/coverage-01.t use strict; use warnings; use Test::More tests => 7; use Carp; use lib qw( lib t/configure/testlib ); use_ok('config::auto::coverage'); use Parrot::BuildUtil; use Parrot::Configure::Options qw( process_options ); use Parrot::Configure::Step::Test; use Parrot::Configure::Test qw( test_step_constructor_and_description ); ########## regular ########## my ($args, $step_list_ref) = process_options( { argv => [], mode => q{configure}, } ); my $conf = Parrot::Configure::Step::Test->new; $conf->include_config_results( $args ); my $pkg = q{auto::coverage}; $conf->add_steps($pkg); my $serialized = $conf->pcfreeze(); $conf->options->set(%{$args}); my $step = test_step_constructor_and_description($conf); ok($step->runstep($conf), "runstep() completed successfully"); ok(defined($step->result), "Result was defined"); pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME auto/coverage-01.t - test auto::coverage =head1 SYNOPSIS % prove t/steps/auto/coverage-01.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file test auto::coverage. =head1 AUTHOR James E Keenan =head1 SEE ALSO config::auto::coverage, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: stringhandle.pmc000644000765000765 2240312171255037 17266 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2008-2011, Parrot Foundation. =head1 NAME src/pmc/stringhandle.pmc - StringHandle PMC =head1 DESCRIPTION The StringHandle PMC performs I/O operations, but on an internal string rather than an external file. Commonly used as a mock FileHandle for testing. =cut */ #include "../src/io/io_private.h" /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_INLINE static int encoding_is_utf8(PARROT_INTERP, ARGIN_NULLOK(const STRING *s)) __attribute__nonnull__(1); #define ASSERT_ARGS_encoding_is_utf8 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =head2 Internal Functions =over 4 =item C Helper function for internal usage. Return 1 if the string argument is not null and has utf8 encoding, 0 otherwise. =back =cut */ PARROT_INLINE static int encoding_is_utf8(PARROT_INTERP, ARGIN_NULLOK(const STRING *s)) { ASSERT_ARGS(encoding_is_utf8) if (STRING_IS_NULL(s)) return 0; else return STRING_equal(interp, s, CONST_STRING(interp, "utf8")); } pmclass StringHandle extends Handle auto_attrs { ATTR INTVAL flags; /* Filehandle flags */ ATTR STRING *stringhandle; /* The string data */ ATTR STRING *mode; /* The mode string used in open */ ATTR STRING *filename; /* A mock path and filename */ ATTR INTVAL read_offset; /* Position, for reading bytes */ /* =head2 Vtable Functions =over 4 =item C Initializes a newly created StringHandle object. =cut */ VTABLE void init() { Parrot_StringHandle_attributes * const data_struct = (Parrot_StringHandle_attributes *) PMC_data(SELF); data_struct->flags = 0; data_struct->stringhandle = NULL; data_struct->mode = NULL; data_struct->encoding = STRINGNULL; data_struct->filename = NULL; data_struct->read_offset = 0; data_struct->io_vtable = (IO_VTABLE *)Parrot_io_get_vtable(interp, IO_VTABLE_STRINGHANDLE, NULL); data_struct->read_buffer = NULL; data_struct->write_buffer = NULL; data_struct->record_separator = CONST_STRING(interp, "\n"); PObj_custom_mark_SET(SELF); } /* =item C Create a copy of the stringhandle. =cut */ VTABLE PMC *clone() { const Parrot_StringHandle_attributes * const old_struct = PARROT_STRINGHANDLE(SELF); PMC * const copy = Parrot_pmc_new(INTERP, enum_class_StringHandle); Parrot_StringHandle_attributes * const data_struct = PARROT_STRINGHANDLE(copy); data_struct->stringhandle = old_struct->stringhandle; data_struct->mode = old_struct->mode; data_struct->encoding = old_struct->encoding; data_struct->flags = old_struct->flags; return copy; } /* =item C Mark active stringhandle data as live. =cut */ VTABLE void mark() { Parrot_StringHandle_attributes * const data_struct = PARROT_STRINGHANDLE(SELF); Parrot_gc_mark_STRING_alive(INTERP, data_struct->stringhandle); Parrot_gc_mark_STRING_alive(INTERP, data_struct->mode); Parrot_gc_mark_STRING_alive(INTERP, data_struct->encoding); Parrot_gc_mark_STRING_alive(INTERP, data_struct->filename); Parrot_gc_mark_STRING_alive(INTERP, data_struct->record_separator); Parrot_io_buffer_mark(interp, data_struct->read_buffer); Parrot_io_buffer_mark(interp, data_struct->write_buffer); } /* =item C Returns whether the StringHandle has reached the end of the file. =cut */ VTABLE INTVAL get_bool() { STRING *stringhandle; GET_ATTR_stringhandle(INTERP, SELF, stringhandle); if (STRING_IS_NULL(stringhandle)) return 0; return 1; } /* =back =head2 Methods =over 4 =item C Opens a string handle with the given mode. The filename is not used, but is stored for mocking. =cut */ METHOD open(STRING *filename :optional, INTVAL got_filename :opt_flag, STRING *mode :optional, INTVAL got_mode :opt_flag) { STRING *open_mode, *old_string; PMC * handle; INTVAL flags; if (got_mode && !STRING_IS_NULL(mode)) SET_ATTR_mode(INTERP, SELF, mode); if (got_filename && !STRING_IS_NULL(filename)) SET_ATTR_filename(INTERP, SELF, filename); handle = Parrot_io_open(INTERP, SELF, filename, mode); RETURN(PMC *handle); } /* =item C Check if the StringHandle is open. =cut */ METHOD is_closed() { const INTVAL closed = Parrot_io_is_closed(INTERP, SELF); RETURN(INTVAL closed); } /* =item METHOD readall(STRING *name); Read the entire contents of the StringHandle into a Parrot string. On a StringHandle object that isn't opened yet, returns an empty string. =cut */ METHOD readall(STRING *name :optional, INTVAL got_name :opt_flag) { STRING * const string_result = Parrot_io_readall_s(INTERP, SELF); RETURN(STRING *string_result); } /* =item C Clear the StringHandle by resetting it to a null value. =cut */ METHOD flush() { Parrot_io_flush(INTERP, SELF); } /* =item C Print the passed in integer, number, string, or PMC to the stringhandle. (Integers, numbers, and strings are auto-boxed as PMCs.) =cut */ METHOD print(PMC *to_print) { STRING * const string_to_print = VTABLE_get_string(INTERP, to_print); Parrot_io_write_s(INTERP, SELF, string_to_print); } /* =item C Print the string to the stringhandle. =cut */ METHOD puts(STRING *to_print) { const INTVAL status = Parrot_io_write_s(INTERP, SELF, to_print); RETURN(INTVAL status); } /* =item C Set or retrieve the buffering attribute for the stringhandle. This attribute is ignored, but stored for mocking. =cut */ METHOD buffer_type(STRING *new_type :optional, INTVAL got_type :opt_flag) { INTVAL flags; STRING * const nobuffer_string = CONST_STRING(INTERP, "unbuffered"); STRING * const linebuffer_string = CONST_STRING(INTERP, "line-buffered"); STRING * const fullbuffer_string = CONST_STRING(INTERP, "full-buffered"); GET_ATTR_flags(INTERP, SELF, flags); if (got_type) { if (STRING_equal(INTERP, new_type, nobuffer_string)) { flags &= ~ PIO_BF_LINEBUF; flags &= ~ PIO_BF_BLKBUF; } else if (STRING_equal(INTERP, new_type, linebuffer_string)) { flags |= PIO_BF_LINEBUF; flags &= ~ PIO_BF_BLKBUF; } else if (STRING_equal(INTERP, new_type, fullbuffer_string)) { flags &= ~ PIO_BF_LINEBUF; flags |= PIO_BF_BLKBUF; } SET_ATTR_flags(INTERP, SELF, flags); } if (flags & PIO_BF_LINEBUF) RETURN(STRING *linebuffer_string); else if (flags & PIO_BF_BLKBUF) RETURN(STRING *fullbuffer_string); RETURN(STRING *nobuffer_string); } /* =item C Returns the current size of the stringhandle. =cut */ METHOD buffer_size(INTVAL new_size :optional, INTVAL got_size :opt_flag) { INTVAL buffer_size; STRING *stringhandle; GET_ATTR_stringhandle(INTERP, SELF, stringhandle); if (STRING_IS_NULL(stringhandle)) { if (got_size) { stringhandle = Parrot_str_new_noinit(interp, new_size); SET_ATTR_stringhandle(INTERP, SELF, stringhandle); } else { RETURN(INTVAL 0); } } buffer_size = stringhandle->_buflen; RETURN(INTVAL buffer_size); } /* =item C Retrieve the read mode string for the stringhandle. =cut */ METHOD mode() { STRING *mode; GET_ATTR_mode(INTERP, SELF, mode); RETURN(STRING *mode); } /* =item C Check if the StringHandle is at end-of-file (if it has read to the end of the string data). =cut */ METHOD eof() { const INTVAL is_eof = Parrot_io_eof(INTERP, SELF); RETURN(INTVAL 0); } /* =item C StringHandles do not use integer file descriptors, so always returns an error value. =cut */ METHOD get_fd() { UNUSED(INTERP); RETURN(INTVAL -1); } /* =item C Close the handle. =cut */ METHOD close() { const INTVAL status = Parrot_io_close(INTERP, SELF, 0); RETURN(INTVAL status); } /* =back =cut */ } /* end pmclass */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ intro.pod000644000765000765 2700612101554066 17075 0ustar00brucebruce000000000000parrot-5.9.0/docs/user/pir# Copyright (C) 2001-2012, Parrot Foundation. =pod =head1 NAME docs/user/pir/intro.pod - A User-oriented Introduction writing PIR. =head1 DESCRIPTION This document is a user-oriented introduction to writing PIR for the Parrot Virtual Machine.[*] =head1 WRITING PIR PIR (Parrot Intermediate Representation) is a way to program the parrot virtual machine that is easier to use than PASM (Parrot Assembler). PASM notation is like any other assembler-like format and can be used directly, but it is more verbose and gives too much power to the user. PIR abstracts common operations and conventions into a syntax that more closely resembles a high-level language. PIR allows the programmer to write code that more naturally expresses their intent without worrying about setting up the exact details that PASM requires to function properly. This article will show the basics on programming in PIR. More advanced topics will appear in later articles. =head2 Getting Parrot In order to test the PIR and PASM code in this article, a parrot virtual machine is needed (henceforth just "parrot"). Parrot is available from L. Just download the latest release, or checkout the current development version from the Git repository. The programs in this article were tested with Parrot 0.8.1. Parrot is very easy to compile on unix-like and Microsoft Windows operating systems: just run C in the root directory of the parrot source and, if everything works correctly, a C executable should appear. At the moment of writing, the C target does not work properly, so in this and other articles it is assumed that the parrot executable is invoked from the parrot root directory. If you do not want to compile your own Parrot you can download a pre-compiled binary from http://www.parrot.org/source.html. =head2 Parrot Virtual Machine overview Before we get started with the examples, here's a quick overview of parrot's architecture. Parrot is a register-based virtual machine. It provides 4 types of registers. The register types are: =over 4 =item I - integer =item N - floating point =item S - string =item P - polymorphic container (PMC) =back In order to designate a register in PASM, use the character indicating the type (C, C, C or C

    ) and the register number. For instance, in order to use register 10 of type integer, you'd write C. In this series of articles, we will mainly focus on programming PIR. In PIR, you would type the C<$> character in front of the register, to indicate a I register. For instance, the integer registers are C<$I0>, C<$I1> and so on. The PMC registers hold arbitrary data objects and are parrot's mechanism for implementing more complex behavior than the ones that can be expressed using the other 3 register types alone. A virtual register is mapped to an actual register by the register allocator. You can use as many registers as you want, and the register allocator will allocate them as needed. PMCs will be covered in more detail in a future article. Examples in this article will focus on the first 3 register types. =head2 Simple Operators Let me start with a simple and typical example: =begin PIR .sub main :main print "hello world\n" .end =end PIR To run it, save the code in a C file and pass it to the parrot virtual machine: ./parrot hello.pir Note that I am using a relative path to parrot given that I didn't install it into the system. The keywords starting with a dot (C<.sub> and C<.end>) are PIR directives. They are used together to define subroutines. After the C<.sub> keyword I use the name of the subroutine. The keyword that starts with a colon (C<:main>) is a pragma that tells parrot that this is the main body of the program and that it should start by executing this subroutine. By the way, I could use C<.sub foo :main> and Parrot will use the C subroutine as the main body of the program. The actual name of the subroutine does not matter as long as it has the C<:main> pragma. If you don't specify the <:main> pragma on any subroutine, then parrot will start executing the first subroutine in the source file. The full set of pragmas are defined in L. Before going into more details about subroutines and calling conventions, let's compare some PIR syntax to the equivalent PASM. If I want to add two integer registers using PASM I would use the Parrot C opcode to put values into registers, and the C opcode to add them, like this: =begin PIR_FRAGMENT set $I1, 5 set $I2, 3 add $I0, $I1, $I2 # $I0 yields 5+3 =end PIR_FRAGMENT PIR includes infix operators for these common opcodes. I could write this same code as =begin PIR_FRAGMENT $I1 = 5 $I2 = 3 $I0 = $I1 + $I2 =end PIR_FRAGMENT There are the four arithmetic operators as you should be expecting, as well as the six different comparison operators, which return a boolean value: =begin PIR_FRAGMENT $I1 = 5 $I2 = 3 $I0 = $I1 <= $I2 # $I0 yields 0 (false) =end PIR_FRAGMENT I can also use the short accumulation-like operators, like C<+=>. Another PIR perk is that local variable names may be declared and used instead of register names. For that I just need to declare the variable using the C<.local> keyword with any of the four data types available on PIR: C, C, C and C: =begin PIR_FRAGMENT .local int size size = 5 =end PIR_FRAGMENT Note that all registers, both numbered and named, are consolidated by the Parrot register allocator, assigning these "virtual registers" to actual registers as needed. The register allocator even coalesces two virtual names onto the same physical register when it can prove that they have non-overlapping lifetimes, so there is no need to be stingy with register names. To see the actual registers used, use C on the C<*.pbc> output. You can generate a Parrot Byte Code (PBC) file as follows: ./parrot -o foo.pbc --output-pbc foo.pir Then, use C in order to disassemble it: ./pbc_disassemble foo.pbc =head2 Branching Another simplification of PASM are branches. Basically, when I want to test a condition and jump to another place in the code, I would write the following PASM code: =begin PASM le I1, I2, LESS_EQ # ... LESS_EQ: =end PASM Meaning, if C<$I1> is less or equal than C<$I2>, jump to label C. In PIR I would write it in a more legible way: =begin PIR_FRAGMENT if $I1 <= $I2 goto LESS_EQ # ... LESS_EQ: =end PIR_FRAGMENT PIR includes the C keyword as well. =head2 Calling Functions Subroutines can easily be created using the C<.sub> keyword shown before. If you do not need parameters, it is just as simple as I show in the following code: =begin PIR .sub main :main hello() .end .sub hello print "Hello World\n" .end =end PIR Now, I want to make my C subroutine a little more useful, such that I can greet other people. For that I will use the C<.param> keyword to define the parameters C can handle: =begin PIR .sub main :main hello("leo") hello("chip") .end .sub hello .param string person print "Hello " print person print "\n" .end =end PIR If I need more parameters I just need to add more C<.param> lines. To return values from PIR subroutines I use the C<.return> keyword, followed by one or more arguments, just like this: =begin PIR .sub _ .return (10, 20, 30) .end =end PIR The calling subroutine can accept these values. If you want to retrieve only one value (or only the first value, in case multiple values are returned), write this: =begin PIR_FRAGMENT $I0 = compute_it($I8, $I9) =end PIR_FRAGMENT To accept multiple values from such a function, use a parenthesized results list: =begin PIR_FRAGMENT ($I1, $I2, $I3) = compute_it($I8, $I9) =end PIR_FRAGMENT =head2 Factorial Example Now, for a little more complicated example, let me show how I would code Factorial subroutine: =begin PIR .sub main :main $I1 = factorial(5) print $I1 print "\n" .end .sub factorial .param int i if i > 1 goto recur .return (1) recur: $I1 = i - 1 $I2 = factorial($I1) $I2 *= i .return ($I2) .end =end PIR This example also shows that PIR subroutines may be recursive just as in a high-level language. =head2 Named Arguments As some other languages as Python and Perl support named arguments, PIR supports them as well. As before, I need to use C<.param> for each named argument, but you need to specify a flag indicating the parameter is named: =begin PIR .sub func .param int a :named("foo") .end =end PIR The subroutine will receive an integer named "foo", and inside of the subroutine that integer will be known as "a". When calling the function, I need to pass the names of the arguments. For that there are two syntaxes: =begin PIR_FRAGMENT func( 10 :named("foo") ) # or func( "foo" => 10 ) =end PIR_FRAGMENT Note that with named arguments, you may rearrange the order of your parameters at will. =begin PIR .sub foo .param string a :named('name') .param int b :named('age') .param string c :named('gender') # ... .end =end PIR This subroutine may be called in any of the following ways: =begin PIR_FRAGMENT foo( "Fred", 35, "m" ) foo( "gender" => "m", "name" => "Fred", "age" => 35 ) foo( "age" => 35, "gender" => "m", "name" => "Fred" ) foo( "m" :named("gender"), 35 :named("age"), "name" => "Fred" ) =end PIR_FRAGMENT and any other permutation you can think of as long as you use the named argument syntax. Note that any positional parameters must be passed before the named parameters. So, the following is allowed: =begin PIR .sub main .param int a .param int b :named("age") # ... .end =end PIR Whereas the following is not: =begin PIR .sub main .param int a :named("name") .param int b # cannot declare positional parameter after a named parameter # ... .end =end PIR It's also possible to use named syntax when returning values from subroutines. Into the C<.return> command I'll use: =begin PIR_FRAGMENT .return ( "bar" => 20, "foo" => 10) =end PIR_FRAGMENT and when calling the function, I will do: =begin PIR_FRAGMENT ("foo" => $I0, "bar" => $I1) = func() =end PIR_FRAGMENT And C<$I0> will yield 10, and C<$I1> will yield 20, as expected. =head2 Concluding To conclude this first article on PIR and to let you test what you learned, let me show you how to do input on PASM (hence, also in PIR). There is a C opcode to read from standard input. Just pass it a string register or variable where you wish the characters read to be placed and the number of characters you wish to read: =begin PIR_FRAGMENT_INVALID .loadlib 'io_ops' ... read $S1, 100 =end PIR_FRAGMENT_INVALID This line will read 100 characters (or until the end of the line) and put the read string into C<$S1>. In case you need a number, just assign the string to the correct register type: =begin PIR_FRAGMENT_INVALID .loadlib 'io_ops' read $S1, 100 ... $I1 = $S1 =end PIR_FRAGMENT_INVALID With the PIR syntax shown in this article you should be able to start writing simple programs. Next article we will look into available Polymorphic Containers (PMCs), and how they can be used. =head1 AUTHOR Alberto Simões =head1 THANKS =over 4 =item * Jonathan Scott Duff =back =head1 NOTES [*] One first version of this article was published on TPR 2.3. Please feel free to edit it to suit latest parrot developments and to be a good starting point for beginners. =cut pdd14_numbers.pod000644000765000765 4773612101554066 20707 0ustar00brucebruce000000000000parrot-5.9.0/docs/pdds/draft# Copyright (C) 2001-2010, Parrot Foundation. =head1 [DRAFT] PDD 14: Numbers =head2 Abstract This PDD describes Parrot's numeric data types. =head2 Description This PDD details the basic numeric datatypes that the Parrot core knows how to deal with, including the core numeric PMCs. =head3 Integer data types Parrot provides a native integer data type, generally known as an "Int". The size of the integer is chosen at Parrot configuration time, the same size as platform-native integers. In C, the typedefs C and C are native signed and unsigned integers respectively. The semantics of native integer data types are the same as the semantics of their C equivalents. Integer data types have a dedicated register set. In PIR, the C register variables (C<$I0>, etc.) and C<.param>s or C<.local>s declared with the C type are native integers. Native unsigned integers are not accessible directly in PIR. Many opcodes or vtable functions are defined with variants that take native integer arguments. When passed to a subroutine or method call, a native integer may be autoboxed as an C PMC, or as an HLL type mapped to C. =head3 Floating-point data types Parrot provides a native floating-point data type, generally known as a "Num". The size of the float is chosen at Parrot configuration time, the same size as platform-native floats. In C, the typedef C is a native float data type. The semantics of the native float data type are the same as the semantics of the C equivalent. Float data types have a dedicated register set. In PIR, the C register variables (C<$N0>, etc.) and C<.param>s or C<.local>s declared with the C type are native floats. Many opcodes or vtable functions are defined with variants that take native float arguments. When passed to a subroutine or method call, a native float may be autoboxed as a C PMC, or as an HLL type mapped to C. =head3 Integer PMC The C PMC is a high-level integer type, providing the features of a integer data type appropriate for use in a high-level language. Some languages may be able to use Parrot's C directly as their integer data type. Others may subclass C to add their own functionality, and others may implement their own high-level integer data type. The C PMC has a single attribute, the integer value. =head4 Integer Vtable Functions =over 4 =item C Initializes the C to 0. =item C and C Sets the C to the integer value of the PMC argument. =item C Set the C to the passed-in integer value. =item C, C, C, C Morphs the C PMC to a C, C, C, or C PMC, and sets the value from the passed in value. {{NOTE: the morphing behavior is currently under consideration and may be rejected.}} =item C Retrieves the integer value of the C. =item C Returns the boolean value of the C (false if 0, true otherwise). =item C Returns the integer value of the C as a floating-point number. =item C Returns the integer value of the C in a new C PMC. {{ NOTE: this vtable entry may be deprecated }} =item C and C Returns the integer value of the C as a string. =item C<[add|subtract|multiply|divide|floor_divide|modulus|pow]_int(INTVAL b, PMC *dest)> Adds/subtracts/multiplies/divides/moduluses/exponents an integer value with the C PMC, and returns the result as a new PMC. (The C parameter is unused). Overflow of the native integer storage auto-promotes the result PMC to a C. Note that these are multidispatched. =item C Adds/subtracts/multiplies/divides/moduluses/exponents an integer value with the C PMC, and sets the C to the resulting value. Overflow of the native integer storage auto-promotes the C to a C. Note that these are multidispatched. {{NOTE: there is some discussion of having this promotion of storage happen purely internally (perhaps by swapping vtables), rather than converting to a different PMC type.}} =item C Add/subtract/multiply/divide/modulus/exponent an integer value with the C PMC, and set the C to the resulting value, morphing it to a C. Note that these are multidispatched. =item C Adds 1 to the value of the integer. This may autopromote the PMC to a C. =item C Subtracts 1 from the value of the integer. This may autopromote the PMC to a C. =item C Returns an C PMC set to the absolute value of the current C. =item C Sets the C to the absolute value of itself. =item C Freezes the C PMC for storage. =item C Thaws the C PMC from storage. =back =head4 Integer Multis Many of the math vtable functions are defined as multiple dispatch functions. =over 4 =item C<[add|subtract|multiply|divide|floor_divide|modulus|pow](PMC *value, PMC *dest)> Performs the addition/subtraction/multiplication/division/modulus/exponent operation, and returns a new PMC containing the resulting value. Multiple dispatch variants are defined for C, C, C, C, and C. Overflow of the native integer storage auto-promotes the result PMC to a C. =item C Performs the addition/subtraction/multiplication/division/modulus/exponent operation, morphing the C to the passed in type, and setting it to the result. Multiple dispatch variants are defined for C, C, C, and C. Overflow of the native integer storage auto-promotes the C to a C. =item C Compares the C to the passed in PMC, returning true (1) if they are equal, and false (0) otherwise. Multiple dispatch variants are defined for C and C. {{NOTE: Presumably the C, C, and C cases are all covered by C.}} =item C Compares the C to the passed in PMC, returning 1 if C is greater, -1 if the PMC is greater, and 0 if they are equal. Multiple dispatch variants are defined for C, C, and C. {{NOTE: Presumably the C and C cases are covered by C.}} =item C Compares the C to the passed in PMC, returning 1 if C is greater, -1 if the PMC is greater, and 0 if they are equal. Multiple dispatch variants are defined for C, C, and C. {{NOTE: Presumably the C and C cases are covered by C.}} =back =head4 Integer Methods =over 4 =item C Converts the decimal integer to another base (anything from base 2 to base 36), returning the result as a STRING. =back =head3 Float PMC =head3 BigInt PMC The bigint library provides Parrot with both a collection of (nearly) infinite precision numeric types and an implementation of an extended decimal arithmetic (EDA). =head3 Why decimal arithmetic? There are benefits in using the big number library to provide both values of effectively unlimited precision and a defined arithmetic, complete with rounding and exceptional conditions, for values which are otherwise easily represented using standard low-level types. Both require the same range of operations but differ in the environment under which those operations occur. The effort required to produce a library which implements a decimal arithmetic is not much greater than that needed to provide a base-2 big number library. There is a trade-off in both space and speed, but given the nature of dynamic languages, this should not present too great a burden. =head3 Numeric types provided The bignumber library provides the following data types to Parrot: =over 4 =item Big integers (BigInt) Whole numbers with no limits on their size. =item Big floats (BigNum) Numbers with decimal fractional parts, again with no limit on size. =item Big floats with fixed fractional parts Numbers with a fixed maximum number of digits in their fractional part, again with no limit on size;. i.e BigRat. =back The library implements these different forms of numbers using the same internal representation, and differentiates between them only when performing rounding operations. A number has the following abstract form: [ sign, string of digits, exponent ] If sign is zero, the number is positive. If equal to one, the number is negative. The number has the value: sign, string of digits * 10 ** exponent A big integer must always have a non-negative exponent. A big float may have any exponent, and a float with a fixed fractional part will have an exponent greater than a given (negative) number. These limits are not attached to a numeric value, but instead are enforced by giving any operation involving the numbers a I. In general, Parrot functions will not need to care about what the bignum objects are or do. They should merely be used as arguments to big number functions. The objects will be managed by Parrot's garbage collection in a similar manner to strings. =head3 Special Values Additionally the library provides special values which represent the result of otherwise undefined operations (division by zero, for instance). Positive and negative infinity (C or C<+Inf> and C<-Inf>, respectively) and both quiet and signalling Not a Number (C) are available. In general, the result of an operation with at least one argument which is C will be C. If the argument is a signalling C, an exception will also be raised. See the EDA for full details. =head3 Context All operations occur within a defined context. This tells the operations how they should treat their arguments, what sort of rounding to perform, and what to do if rounding loses information. The context provides the environment in which an operation occurs, in particular the following options are available: =over 4 =item precision A positive I requires the use of big floats. These cannot have more than I digits in their coefficient before or after any operation. Arguments to operations with more than I digits will be truncated and rounded appropriately. Results of operations will not have more than I digits in their coefficients, with any extra digits accumulated during the calculation of the operation being truncated and rounded as required. A I of zero requires the use of integer operations. Arguments to operations are rounded so that they have no fractional part, and the result of all operations will be rounded to be integers. A negative value of I requires the use of a fixed number of fractional digits, with arguments and results being truncated after those digits. With non-positive values of I, the total number of digits in the coefficient is limited only by available memory. =item rounding The rounding part of the context defines the rounding algorithm to apply when truncating digits from a number's coefficient. The available rounding forms are outlined below. =item traps and flags The I part of the context defines how the library raises exceptions. Seven distinct classes of error can occur. If the corresponding trap is set (enabled), the library raises an exception. Otherwise, execution continues with the exception class recorded in flags. For more details, see the extended decimal arithmetic standard. =back The current I determines the numeric type during a particular operation. This makes it easy to upgrade from one numeric form to another and also allows for considerable code-reuse within the library. =head3 Exception Classes The following exception classes are available: =over 4 =item Lost Digits Non-zero digits have been removed from an argument to a function during rounding before the operation. =item Division By Zero Division by zero was attempted. =item Inexact Because arguments were rounded, or because the result of an operation has lost significant digits, the result is inexact. =item Invalid Operation An invalid operation was attempted, for instance when C is present as an argument to a function. This also covers recoverable errors such as 0/0, which signals Invalid Operation and can return C. =item Overflow The exponent of a number has overflowed. =item Rounded An argument has been rounded. =item Underflow The exponent of a number has underflowed. =back =head3 Rounding The rounding part of the context defines the rounding algorithm to used. The following contexts are available (examples assume a precision of 5): =over 4 =item Round down Any unwanted digits are simply truncated from the coefficient. This rounds towards zero. [0, 1234567, 10] => [0, 12345, 12] =item Round half up The first lost digit is examined. If this is in the range 0-4, the coefficient is truncated directly. If in the range 5-9, one is added to the final digit of the coefficient. If this leads to a coefficient with more than I digits, the number is rounded again, removing the trailing zero. This is essentially rounding to nearest. [0, 1234567, 10] => [0, 12346, 12] [0, 1234549, 10] => [0, 12345, 12] [0, 9999950, 10] => [0, 10000, 13] =item Round half even The first lost digit is examined. If it lies in the range 0-4, the coefficient is truncated directly. If in the range 6-9, the coefficient is rounded up. If the first lost digit is equal to 5 and the remaining lost digits in the coefficient are non-zero, the number is also rounded up. If the lost digits are equal to exactly half, the number is rounded up if the least significant retained digit is odd, and rounded down if it is even. =item Round Floor If the digits to be discarded are non zero and the number is negative, the coefficient is rounded up, otherwise it remains the same. This is rounding towards C<-Inf>. =item Round Ceiling If the digits to be discarded are non zero, and the number is positive, the coefficient is rounded up, otherwise it remains the same. This is rounding towards C. =back =head3 Operations The library provides the following operations. They function exactly as those described in the Standard Decimal Arithmetic (SDA), with some extension to cope with integer and fixed fractional part numbers. Only the deviations are outlined here. In all cases, the sequence of rounding and promotion to zero outlined by the SDA are followed, even where the context implies integer operations. =over 4 =item Addition, Subtraction =item Multiplication =item Division Under integer conditions, division halts once the first fractional digit is calculated, with the result rounded to an integer and returned. Under fixed-fraction conditions, one more digit than needed is calculated, with the coefficient then rounded and returned. If a floating point value is required, or if inexact division by a very small number is attempted, it may be wise to follow big float arithmetic to limit the number of digits returned. It is safe to chose a precision at least as large as the largest number of digits of either argument to the division function. =item Integer division, Remainder For both integer and fixed-fraction numbers, the result returned by the remainder function will be an integer or fixed-fraction number. The result of integer division will be an integer. =item Rounding =item Plus / Minus =item Comparison Comparison returns a big number which is equal to 1, 0, or -1 if the first argument is larger, equal to, or smaller than the second. An alternate form returns an INTVAL. =item Rescale =item Power =item Square Root =back =head3 Conversion to and from strings A one to one conversion between the abstract representation above and a string is provided by the library, and acts as defined by the standard decimal arithmetic. Other conversation operations may also be implemented; these may not provide one to one mapping. A pedantic error checking conversion is available within the library, but only works with native strings. Versions which work with Parrot STRINGs will also be provided, although in a separate file to the rest of the library. (They will share a common private header file). =head2 Implementation Functions are provided which implement the arithmetic, conversion, creation and destruction of big numbers by dealing with otherwise opaque big number objects. =head3 Big number representation A big number is represented by the following structure, capable of being allocated, tracked, and destroyed by the Parrot garbage collection system. typedef struct { BN_NIB *buffer; /* string of nibbles */ UINTVAL nibs; /* nibs allocated, in sizeof(BN_NIB) */ UINTVAL flags; /* private flags store: 001 Inf, 010 qNAN, 110 sNAN */ INTVAL digits; /* digits used */ INTVAL expn; /* exponent of number */ int sign; /* sign of number, 0 => positive or zero, 1 => negative */ } parrot_bignum_t; Within the library, individual decimal digits can be accessed using macros. Outside the library, access must be made via exported functions. BN_NIB is likely to be a UINTVAL, but this is not essential. Special values are represented by setting I to zero and setting appropriate private I, using internal macros. Infinity has one flag field, NaN another flag field, and sNaN a third. In general the flags should not be examined directly, even within the module. =head3 Context typedef struct { INTVAL precision; /* number of digs to retain */ BN_ROUNDING rounding; /* rounding type to perform */ BOOLVAL extended; /* do we use extended or base semantics? */ unsigned char flags; /* records possible errors */ unsigned char traps; /* throw errors or not? */ } parrot_bignum_context; I is an enumeration of the possible rounding types as described earlier. I is a bitmask of exception traps. 0 implies that a trap is disabled and 1 implies it is enabled. I is a bitmask which records exceptional conditions and has the same fields at I. Language level types should implement big floats using a global floating point context available in an interpreter structure (and accessible). Big integers and fixed-fraction number are provided by creating a context with an appropriate precision whenever a call into the library is made. =head3 Exceptional Conditions When the module raises an exceptional condition, control passes to C. this examines the error which has occurred and the current context to determine which class of error has occurred. If the corresponding trap handler is not enabled, the context's flags are updated and control is returned to the bignumber library. Otherwise the exception becomes fatal. How this mechanism interacts with Parrot's own is yet to be decided. The possible exceptions are detailed in the extended decimal arithmetic. =head2 Tests The Standard Decimal Arithmetic provides a collection of tests for both its base and extended behavior. =head2 TODO Fill in the remaining functions from the EDA, verify that the test suite still passes, integrate the library into the rest of Parrot, provide PMC types and suitable opcodes. Conversion to and from Parrot strings, conversion to and from floating point types, sprintf output of bignumbers. =head2 References IBM's Standard Decimal Arithmetic, with tests (L) The Perl modules Math::BigInt and Math::BigFloat. Alex Gough's suggestions for bigint/bignum implementation. GNU gmp. That's we currently use: mpz and mpf. =cut __END__ Local Variables: fill-column:78 End: vim: expandtab tw=78 shiftwidth=4: arriter.rb000644000765000765 64111466337261 20433 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks#! ruby k = Array.new nk = Array.new ha = Hash.new 10.times { |i| s = (65 + i).chr k.push s } (0..3).each { |e| 10.times { |i| k.each{ |s| _nk = s + (65 + i).chr nk.push _nk } } k = nk nk = Array.new } puts k.length j = 0 k.each{ |s| j+=1 ha[s] = 1 } puts j puts ha.keys.length print ha["AAAAA"] print ha["ABCDE"] print ha["BBBBB"] print ha["CCCCC"] print ha["HHHHH"] print ha["IIIII"] puts tutorial.t000644000765000765 1034411533177644 16657 0ustar00brucebruce000000000000parrot-5.9.0/t/examples#!perl # Copyright (C) 2007-2010, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use ExtUtils::Manifest qw(maniread); use Test::More; use Parrot::Test; =head1 NAME t/examples/tutorial.t - Test examples in F =head1 SYNOPSIS % prove t/examples/tutorial.t =head1 DESCRIPTION Test the examples in F. =cut my $manifest = maniread('MANIFEST'); my %files; foreach my $file (keys %$manifest) { next unless $file =~ m{examples/tutorial/.*pir$}; $files{$file}=undef; } plan tests => scalar keys %files; # Set up expected output for examples my %expected = ( '01_temp_var.pir' => << 'END_EXPECTED', 42 3.14159 Hello Ford END_EXPECTED '02_local_var.pir' => << 'END_EXPECTED', 42 3.14159 Hello Ford END_EXPECTED '03_temp_var_basic_pmcs.pir' => << 'END_EXPECTED', 42 6.35 Foo Bar Baz END_EXPECTED '04_pod_comments.pir' => << 'END_EXPECTED', Ignored Pod comments. END_EXPECTED '10_math_ops.pir' => << 'END_EXPECTED', 7 5.2 END_EXPECTED '11_math_ops_self_mod.pir' => << 'END_EXPECTED', 6 5.61 END_EXPECTED '12_math_ops_pasm.pir' => << 'END_EXPECTED', 5 121 END_EXPECTED '13_logical_ops.pir' => << 'END_EXPECTED', 0 2 1 2 END_EXPECTED '20_string_ops.pir' => << 'END_EXPECTED', Hello, Zaphod! END_EXPECTED ##Note extra whitespace after 3rd hello '21_string_ops_repeat.pir' => << 'END_EXPECTED', Hello Hello Hello END_EXPECTED '22_string_ops_length.pir' => << 'END_EXPECTED', 5 13 END_EXPECTED '23_string_ops_substr.pir' => << 'END_EXPECTED', bc bc abcde aXYZde abcde END_EXPECTED '24_string_ops_clone.pir' => << 'END_EXPECTED', Ford Zaphod Zaphod END_EXPECTED '30_arrays_basic.pir' => << 'END_EXPECTED', Baz Foo Bar Bar' Bar Baz END_EXPECTED '31_array_ops_split.pir' => << 'END_EXPECTED', the brown END_EXPECTED '32_array_ops_sprintf.pir' => << 'END_EXPECTED', int 0x2a num +10.50 END_EXPECTED '33_hashes.pir' => << 'END_EXPECTED', 5 Integer String END_EXPECTED '34_multikey.pir' => << 'END_EXPECTED', 42 END_EXPECTED '40_file_ops.pir' => << 'END_EXPECTED', The quick brown fox jumps over the lazy dog. END_EXPECTED '50_goto.pir' => << 'END_EXPECTED', before branch after branch END_EXPECTED '51_if_unless.pir' => << 'END_EXPECTED', before if after if before unless is printed after unless -0.0 was false END_EXPECTED '52_if_compare.pir' => << 'END_EXPECTED', before if after if END_EXPECTED '53_loop.pir' => << 'END_EXPECTED', 120 END_EXPECTED '55_iterator.pir' => << 'END_EXPECTED', foo bar baz boz END_EXPECTED '56_defined.pir' => << 'END_EXPECTED', $P1 is defined $P3 is undefined END_EXPECTED '57_exists.pir' => << 'END_EXPECTED', my_array[0] is defined my_array[0] exists my_array[1] is not defined my_array[1] exists my_array[2] is not defined my_array[2] does not exist END_EXPECTED '60_subroutines.pir' => << 'END_EXPECTED', Hello, Zaphod END_EXPECTED '61_namespaces.pir' => << 'END_EXPECTED', Hello END_EXPECTED '62_namespaces.pir' => << 'END_EXPECTED', Hello, Zaphod END_EXPECTED '70_class_object.pir' => << 'END_EXPECTED', Hello 5 END_EXPECTED '81_continuation.pir' => << 'END_EXPECTED', got argument: 4 continuation called END_EXPECTED '82_coroutine.pir' => << 'END_EXPECTED', 2 3 END_EXPECTED '83_external_libraries.pir' => << 'END_EXPECTED', 22 END_EXPECTED '90_writing_tests.pir' => << 'END_EXPECTED', 1..4 ok 1 - first test ok 2 - second test ok 3 #skip skipped test ok 4 # TODO todo test END_EXPECTED ); # note any todos. if the sub returns undef or isn't present, the # test will be run. my %todo = ( '51_if_unless.pir' => sub { 'Failing on Win32' if $^O =~ /Win32/; } ); foreach my $tutorial (sort keys %files) { my $file = $tutorial; $file =~ s{.*/}{}; my @todo = (); if (exists $expected{$file}) { my $expected = $expected{$file}; if (exists $todo{$file}) { my $reason = $todo{$file}->(); @todo = (todo => $reason) if defined $reason; } example_output_is( $tutorial, $expected, @todo ); } else { fail($tutorial); } } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: revcomp.pir000644000765000765 431511533177635 20420 0ustar00brucebruce000000000000parrot-5.9.0/examples/shootout#!parrot # Copyright (C) 2005-2010, Parrot Foundation. # Reads from stdin a file in the format made by fasta.pir # ./parrot -R jit # N = 2500000 for fasta # 2.2 s on AMD@2000/512K cache # Original by Joshua Isom, heavily hacked by Leopold Toetsch # create tr table at compile-time # tr{wsatugcyrkmbdhvnATUGCYRKMBDHVN} # {WSTAACGRYMKVHDBNTAACGRYMKVHDBN}; .sub tr_00_init :immediate .local pmc tr_array tr_array = new 'FixedIntegerArray' # Todo char array tr_array = 256 # Python compat ;) .local string from, to from = 'wsatugcyrkmbdhvnATUGCYRKMBDHVN' to = 'WSTAACGRYMKVHDBNTAACGRYMKVHDBN' .local int i, ch, r, len len = length from null i loop: ch = ord from, i r = ord to, i tr_array[ch] = r inc i if i < len goto loop .return(tr_array) .end .sub main :main .local pmc stdin, stdout .local string line, seq $P0 = getinterp stdin = $P0.'stdin_handle'() stdout = $P0.'stdout_handle'() # stdout is linebuffered per default - make it block buffered stdout.'buffer_size'(8192) seq = '' beginwhile: line = stdin.'readline'() unless line goto endwhile $I0 = ord line unless $I0 == 62 goto else # '>' if seq == '' goto no_rev print_revcomp(seq) seq = '' no_rev: print line goto endif else: line = chopn line, 1 seq .= line endif: goto beginwhile endwhile: if seq == '' goto done print_revcomp(seq) done: .end .sub print_revcomp .param string line .local int i, linelen, ch .local string revline linelen = length line $P0 = new 'String' # $P0.'reverse'(line) # reverse is no longer available so i = linelen revline = '' rev_loop: i -= 1 $S0 = substr line, i, 1 revline .= $S0 if i > 0 goto rev_loop # $P0 = revline # # line was reversed in-place so we need line = revline # .const 'Sub' tr_00 = 'tr_00_init' line = $P0.'trans'(line, tr_00) i = 0 $S0 = 'x' print_loop: $S0 = substr line, i, 60 print $S0 print "\n" i += 60 if i >= linelen goto done goto print_loop done: $S0 = '' .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: string_cclass.t000644000765000765 2407111533177645 16455 0ustar00brucebruce000000000000parrot-5.9.0/t/op#!perl # Copyright (C) 2001-2005, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Test tests => 11; use Parrot::Config; =head1 NAME t/op/cclass.t - character class tests =head1 SYNOPSIS % prove t/op/cclass.t =head1 DESCRIPTION Tests find_cclass find_not_cclass, is_cclass. =cut pir_output_is( <<'CODE', <<'OUT', "find_cclass, ascii" ); .include "cclass.pasm" .sub main :main $S0 = ascii:"test_func(1)" test( .CCLASS_WORD, $S0 ) $S0 = ascii:"ab\nC_X34.\0 \t!" test( .CCLASS_NUMERIC, $S0 ) test( .CCLASS_LOWERCASE, $S0 ) test( .CCLASS_PUNCTUATION, $S0 ) .end .sub test .param int flags .param string str $I0 = 0 $I2 = length str loop: $I1 = find_cclass flags, str, $I0, 100 print $I1 print ";" inc $I0 if $I0 <= $I2 goto loop end: print "\n" .end CODE 0;1;2;3;4;5;6;7;8;10;10;12;12; 6;6;6;6;6;6;6;7;13;13;13;13;13;13; 0;1;13;13;13;13;13;13;13;13;13;13;13;13; 4;4;4;4;4;8;8;8;8;12;12;12;12;13; OUT pir_output_is( <<'CODE', <<'OUT', "find_not_cclass, ascii" ); .include "cclass.pasm" .sub main :main $S0 = ascii:"test_func(1)" test( .CCLASS_WORD, $S0 ) $S0 = ascii:"ab\nC_X34.\0 \t!" test( .CCLASS_NUMERIC, $S0 ) test( .CCLASS_LOWERCASE, $S0 ) test( .CCLASS_PUNCTUATION, $S0 ) .end .sub test .param int flags .param string str $I0 = 0 $I2 = length str loop: $I1 = find_not_cclass flags, str, $I0, 100 print $I1 print ";" inc $I0 if $I0 <= $I2 goto loop end: print "\n" .end CODE 9;9;9;9;9;9;9;9;9;9;11;11;12; 0;1;2;3;4;5;8;8;8;9;10;11;12;13; 2;2;2;3;4;5;6;7;8;9;10;11;12;13; 0;1;2;3;5;5;6;7;9;9;10;11;13;13; OUT pir_output_is( <<'CODE', <<'OUT', "find_cclass, iso-8859-1" ); .include "cclass.pasm" .sub main :main $S0 = iso-8859-1:"test_func(1)" test( .CCLASS_WORD, $S0 ) $S0 = iso-8859-1:"ab\nC_X34.\0 \t!" test( .CCLASS_NUMERIC, $S0 ) test( .CCLASS_LOWERCASE, $S0 ) test( .CCLASS_PUNCTUATION, $S0 ) .end .sub test .param int flags .param string str $I0 = 0 $I2 = length str loop: $I1 = find_cclass flags, str, $I0, 100 print $I1 print ";" inc $I0 if $I0 <= $I2 goto loop end: print "\n" .end CODE 0;1;2;3;4;5;6;7;8;10;10;12;12; 6;6;6;6;6;6;6;7;13;13;13;13;13;13; 0;1;13;13;13;13;13;13;13;13;13;13;13;13; 4;4;4;4;4;8;8;8;8;12;12;12;12;13; OUT pir_output_is( <<'CODE', <<'OUT', "find_not_cclass, iso-8859-1" ); .include "cclass.pasm" .sub main :main $S0 = iso-8859-1:"test_func(1)" test( .CCLASS_WORD, $S0 ) $S0 = iso-8859-1:"ab\nC_X34.\0 \t!" test( .CCLASS_NUMERIC, $S0 ) test( .CCLASS_LOWERCASE, $S0 ) test( .CCLASS_PUNCTUATION, $S0 ) .end .sub test .param int flags .param string str $I0 = 0 $I2 = length str loop: $I1 = find_not_cclass flags, str, $I0, 100 print $I1 print ";" inc $I0 if $I0 <= $I2 goto loop end: print "\n" .end CODE 9;9;9;9;9;9;9;9;9;9;11;11;12; 0;1;2;3;4;5;8;8;8;9;10;11;12;13; 2;2;2;3;4;5;6;7;8;9;10;11;12;13; 0;1;2;3;5;5;6;7;9;9;10;11;13;13; OUT pir_output_is( <<'CODE', <<'OUT', "is_cclass, ascii" ); .include "cclass.pasm" .sub main :main $S1 = ascii:"ab\nC_X34.\0 \t!" test1( $S1 ) .end .sub test1 .param string str test2( str, .CCLASS_UPPERCASE) test2( str, .CCLASS_LOWERCASE) test2( str, .CCLASS_ALPHABETIC) test2( str, .CCLASS_NUMERIC) test2( str, .CCLASS_HEXADECIMAL) test2( str, .CCLASS_WHITESPACE) test2( str, .CCLASS_PRINTING) test2( str, .CCLASS_GRAPHICAL) test2( str, .CCLASS_BLANK) test2( str, .CCLASS_CONTROL) test2( str, .CCLASS_PUNCTUATION) test2( str, .CCLASS_ALPHANUMERIC) test2( str, .CCLASS_NEWLINE) test2( str, .CCLASS_WORD) $I0 = .CCLASS_NEWLINE|.CCLASS_WHITESPACE test2( str, $I0) $I0 = .CCLASS_WHITESPACE|.CCLASS_LOWERCASE test2( str, $I0) $I0 = .CCLASS_UPPERCASE|.CCLASS_PUNCTUATION test2( str, $I0) .end .sub test2 .param string str .param int code $I1 = length str set $I0, 0 loop: $I2 = is_cclass code, str, $I0 print $I2 inc $I0 if $I0 <= $I1 goto loop print "\n" .end CODE 00010100000000 11000000000000 11010100000000 00000011000000 11010011000000 00100000001100 11011111101010 11011111100010 00000000001100 00100000010100 00001000100010 11010111000000 00100000000000 11011111000000 00100000001100 11100000001100 00011100100010 OUT pir_output_is( <<'CODE', <<'OUT', "is_cclass, iso-8859-1" ); .include "cclass.pasm" .sub main :main $S1 = iso-8859-1:"ab\nC_X34.\0 \t!" test1( $S1 ) .end .sub test1 .param string str test2( str, .CCLASS_UPPERCASE) test2( str, .CCLASS_LOWERCASE) test2( str, .CCLASS_ALPHABETIC) test2( str, .CCLASS_NUMERIC) test2( str, .CCLASS_HEXADECIMAL) test2( str, .CCLASS_WHITESPACE) test2( str, .CCLASS_PRINTING) test2( str, .CCLASS_GRAPHICAL) test2( str, .CCLASS_BLANK) test2( str, .CCLASS_CONTROL) test2( str, .CCLASS_PUNCTUATION) test2( str, .CCLASS_ALPHANUMERIC) test2( str, .CCLASS_NEWLINE) test2( str, .CCLASS_WORD) $I0 = .CCLASS_NEWLINE|.CCLASS_WHITESPACE test2( str, $I0) $I0 = .CCLASS_WHITESPACE|.CCLASS_LOWERCASE test2( str, $I0) $I0 = .CCLASS_UPPERCASE|.CCLASS_PUNCTUATION test2( str, $I0) .end .sub test2 .param string str .param int code $I1 = length str set $I0, 0 loop: $I2 = is_cclass code, str, $I0 print $I2 inc $I0 if $I0 <= $I1 goto loop print "\n" .end CODE 00010100000000 11000000000000 11010100000000 00000011000000 11010011000000 00100000001100 11011111101010 11011111100010 00000000001100 00100000010100 00001000100010 11010111000000 00100000000000 11011111000000 00100000001100 11100000001100 00011100100010 OUT ## setup for unicode whitespace tests ## see http://www.unicode.org/Public/UNIDATA/PropList.txt for White_Space list ## see also t/p6rules/metachars.t my $ws = { horizontal_ascii => [qw/ \u0009 \u0020 \u00a0 /], horizontal_unicode => [ qw/ \u1680 \u180e \u2000 \u2001 \u2002 \u2003 \u2004 \u2005 \u2006 \u2007 \u2008 \u2009 \u200a \u202f \u205f \u3000 / ], vertical_ascii => [qw/ \u000a \u000b \u000c \u000d \u0085 /], vertical_unicode => [qw/ \u2028 \u2029 /], }; push @{ $ws->{horizontal} } => @{ $ws->{horizontal_ascii} }, @{ $ws->{horizontal_unicode} }; push @{ $ws->{vertical} } => @{ $ws->{vertical_ascii} }, @{ $ws->{vertical_unicode} }; push @{ $ws->{whitespace_ascii} } => @{ $ws->{horizontal_ascii} }, @{ $ws->{vertical_ascii} }; push @{ $ws->{whitespace_unicode} } => @{ $ws->{horizontal_unicode} }, @{ $ws->{vertical_unicode} }; push @{ $ws->{whitespace} } => @{ $ws->{whitespace_ascii} }, @{ $ws->{whitespace_unicode} }; sub string { my $which = shift; 'utf8:"' . join( '', @{ $ws->{$which} } ) . '"'; } my $all_ws = string('whitespace'); SKIP: { skip 'unicode support unavailable' => 3 unless $PConfig{has_icu}; pir_output_is( <<"CODE", <<'OUT', "unicode is_cclass whitespace" ); .sub main :main .include "cclass.pasm" .local int result, char, len, i .local string s s = $all_ws len = length s i = 0 loop: result = is_cclass .CCLASS_WHITESPACE, s, i print result if result goto ok \$S0 = substr s, i \$I0 = ord \$S0 \$P0 = new 'ResizablePMCArray' push \$P0, \$I0 \$S0 = sprintf "\\nchar %#x not reported as ws\\n", \$P0 print \$S0 ok: inc i if i < len goto loop print "\\n" .end CODE 11111111111111111111111111 OUT pir_output_is( <<"CODE", <<'OUT', "unicode find_ccclass whitespace" ); .sub main :main .include "cclass.pasm" .local int result, char, len, i .local string s s = $all_ws s = utf8:"abc" . s len = length s result = find_cclass .CCLASS_WHITESPACE, s, 0, len print result print "\\n" .end CODE 3 OUT pir_output_is( <<"CODE", <<'OUT', "unicode find_not_ccclass whitespace" ); .sub main :main .include "cclass.pasm" .local int result, char, len, i .local string s s = $all_ws s .= utf8:"abc" len = length s result = find_not_cclass .CCLASS_WHITESPACE, s, 0, len print len print ' ' print result print "\\n" .end CODE 29 26 OUT } # The following should pass even if ICU is unavailable (pmichaud, 2005-11-3) pir_output_is( <<"CODE", <<'OUT', "unicode 0-127 find_*_cclass whitespace" ); .sub main :main .include "cclass.pasm" .local int result, char, len, i .local string s s = utf8:"abc def" len = length s result = find_cclass .CCLASS_WHITESPACE, s, 0, len print len print ' ' print result result = find_not_cclass .CCLASS_WHITESPACE, s, 3, len print ' ' print result print "\\n" .end CODE 9 3 6 OUT pir_output_is( <<'CODE', <<'OUT', "is_cclass, unicode first codepage" ); .include "cclass.pasm" .sub main :main $S1 = utf8:"ab\nC_X34.\0 \t!" test1( $S1 ) .end .sub test1 .param string str test2( str, .CCLASS_UPPERCASE) test2( str, .CCLASS_LOWERCASE) test2( str, .CCLASS_ALPHABETIC) test2( str, .CCLASS_NUMERIC) test2( str, .CCLASS_HEXADECIMAL) test2( str, .CCLASS_WHITESPACE) test2( str, .CCLASS_PRINTING) test2( str, .CCLASS_GRAPHICAL) test2( str, .CCLASS_BLANK) test2( str, .CCLASS_CONTROL) test2( str, .CCLASS_PUNCTUATION) test2( str, .CCLASS_ALPHANUMERIC) test2( str, .CCLASS_NEWLINE) test2( str, .CCLASS_WORD) $I0 = .CCLASS_NEWLINE|.CCLASS_WHITESPACE test2( str, $I0) $I0 = .CCLASS_WHITESPACE|.CCLASS_LOWERCASE test2( str, $I0) $I0 = .CCLASS_UPPERCASE|.CCLASS_PUNCTUATION test2( str, $I0) .end .sub test2 .param string str .param int code $I1 = length str set $I0, 0 loop: $I2 = is_cclass code, str, $I0 print $I2 inc $I0 if $I0 <= $I1 goto loop print "\n" .end CODE 00010100000000 11000000000000 11010100000000 00000011000000 11010011000000 00100000001100 11011111101010 11011111100010 00000000001100 00100000010100 00001000100010 11010111000000 00100000000000 11011111000000 00100000001100 11100000001100 00011100100010 OUT # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: eval.t000644000765000765 543711533177643 17634 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/imcc/syn#!perl # Copyright (C) 2001-2005, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Config; use Parrot::Test tests => 7; SKIP: { skip( "changed eval semantics - see t/pmc/eval.t", 7 ); ############################## pir_output_is( <<'CODE', <<'OUT', "eval pasm" ); .sub test :main $S0 = 'set S1, "in eval\n"' concat $S0, "\n" concat $S0, "print S1\nend\n" compreg $P0, "PASM" compile P0, $P0, $S0 invoke print "back\n" end .end CODE in eval back OUT pir_output_is( <<'CODE', <<'OUT', "eval pir" ); .sub test :main $S1 = ".sub _foo\n" concat $S1, '$S1 = "42\n"' concat $S1, "\nprint $S1\nend\n" concat $S1, "\n.end\n" compreg $P0, "PIR" compile P0, $P0, $S1 invoke print "back\n" end .end CODE 42 back OUT pir_output_is( <<'CODE', <<'OUT', "intersegment branch" ); # #! perl -w # my $i= 5; # LAB: # $i++; # eval("goto LAB if ($i==6)"); # print "$i\n"; # # 7 ##### .sub test :main I1 = 5 $S0 = ".sub _e\nif I1 == 6 goto LAB\nend\n.end\n" compreg P2, "PIR" compile P0, P2, $S0 LAB: inc I1 invoke print I1 print "\n" end .end CODE 7 OUT pir_output_is( <<'CODE', <<'OUT', "intersegment branch 2" ); .sub test :main I1 = 4 $S0 = ".sub _e\nif I1 <= 6 goto LAB\nend\n.end\n" compreg P2, "PIR" compile P0, P2, $S0 LAB: inc I1 invoke print I1 print "\n" end .end CODE 7 OUT pir_output_is( <<'CODE', <<'OUT', "intersegment branch 3" ); .sub test :main I1 = 4 compreg P2, "PIR" $S0 = ".sub _e\nif I1 <= 5 goto LAB\nend\n.end\n" compile P0, P2, $S0 $S0 = ".sub _e\nif I1 <= 6 goto LAB\nend\n.end\n" compile P1, P2, $S0 LAB: inc I1 invoke set P0, P1 invoke print I1 print "\n" end .end CODE 7 OUT pir_output_is( <<'CODE', <<'OUT', "intersegment branch 4" ); .sub test :main I1 = 4 compreg P2, "PIR" $S0 = ".sub _e\nif I1 <= 5 goto LAB\nend\n.end\n" compile P0, P2, $S0 $S0 = ".sub _e\nif I1 <= 6 goto LAB\nend\n.end\n" compile P1, P2, $S0 LAB: inc I1 invoke set P0, P1 invoke if I1 <= 7 goto LAB print I1 print "\n" end .end CODE 8 OUT pir_output_is( <<'CODE', <<'OUT', "eval - same constants" ); .sub test :main print "hello" print "\n" $S0 = 'print "hello"' concat $S0, "\n" concat $S0, 'print "\n"' concat $S0, "\nend\n" compreg $P0, "PASM" compile P0, $P0, $S0 invoke print "back\n" end .end CODE hello hello back OUT } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: test.bef000644000765000765 50611533177634 20164 0ustar00brucebruce000000000000parrot-5.9.0/examples/pir/befunge< p 04 "v" ^ > I @ _v !, _ 2! | : . \- %2/36 `21 $ < ^< "<- then everything is ok!" +37 ! # 3 > < v , _ ^# -8 : g20 "f you can see a 4 here ->" 8 4 > :8- ^ Test.pm000644000765000765 1262712140013540 16361 0ustar00brucebruce000000000000parrot-5.9.0/t/native_pbc#! perl # Copyright (C) 2001-2012, Parrot Foundation. package t::native_pbc::Test; use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Config; use Parrot::BuildUtil; require Parrot::Test; require Exporter; our @ISA = qw(Exporter); our @EXPORT = ('test_native_pbc'); sub int_arch { return $PConfig{intvalsize} . "_" . (substr($PConfig{byteorder},0,2) eq '12' ? "le" : "be"); } sub num_arch { return $PConfig{ptrsize} . "_". $PConfig{numvalsize} . "_" . (substr($PConfig{byteorder},0,2) eq '12' ? "le" : "be"); } sub pbc_version { my $f = shift; my $b; open my $F, "<", "$f" or return "Can't open $f: $!"; binmode $F; seek $F, 11, 0; read $F, $b, 3; my ($major, $minor, $patch) = unpack "ccc", $b; return ($major . "." . $minor . ".". $patch); } sub pbc_bc_version { my $f = shift; my $b; open my $F, "<", "$f" or return "Can't open $f: $!"; binmode $F; seek $F, 14, 0; read $F, $b, 8; my ($bc_major, $bc_minor) = unpack "cc", $b; return ($bc_major . "." . $bc_minor); } my ( $bc_major, $bc_minor ) = Parrot::BuildUtil::get_bc_version(); my $bc = ($bc_major . "." . $bc_minor); my $version = $PConfig{MAJOR}.".".$PConfig{MINOR}.".".$PConfig{PATCH}; my $arch = int_arch(); sub test_native_pbc { my $id = shift; my $type = shift; my $expected = shift; my $desc = shift; my $skip = shift; my $todo = shift; my $file = "t/native_pbc/${type}_${id}.pbc"; if ($type eq 'number') { $arch = num_arch(); } my $cvt = "$id=>$arch"; my $pbc_version = pbc_version($file); my $pbc_bc_version = pbc_bc_version($file); my $skip_msg; my $skip_msgv = "$file has old v$pbc_version. " . "Try tools/dev/pbc_header.pl --update-fingerprint $file"; # check if this a platform where we can produce the needed file if ($id eq $arch) { $skip_msg = "$file has old PBC_COMPAT $pbc_bc_version. " . "Regenerate with tools/dev/mk_native_pbc --noconf"; } else { $skip_msg = "$file has old PBC_COMPAT $pbc_bc_version. " . "Need $id platform to generate it."; } if ($type eq 'number' and $cvt =~ /^8_16_[bl]e=>4_8_/) { # 16 -> 8 drops some mantissa bits $expected =~ s/1\.12589990684262e\+15/1.12589990684058e+15/; } # check if skip or todo SKIP: { # TODO: -r requires -o *.pbc. We could add and run it if ($ENV{TEST_PROG_ARGS} and $ENV{TEST_PROG_ARGS} =~ /(--run-pbc|-r)\b/) { skip "$cvt --run-pbc", 1; } elsif ( $skip->{$id} ) { my $skip_msg = $skip->{$id}; if (length $skip_msg > 2) { skip "$cvt $skip_msg", 1; } else { skip "$cvt not yet implemented", 1; } } elsif ( $todo->{$id} ) { skip $skip_msg, 1 if $bc ne $pbc_bc_version; local $TODO = $skip_msgv if $version ne $pbc_version; my $todo_msg = $todo->{$id}; if (length $todo_msg > 2) { $todo_msg = "$cvt $todo_msg"; } else { $todo_msg = "$cvt yet untested. Please report success."; } Parrot::Test::pbc_output_is( $file, $expected, "$cvt $desc", todo => "$todo_msg" ); } else { skip $skip_msg, 1 if $bc ne $pbc_bc_version; local $TODO = $skip_msgv if $version ne $pbc_version; Parrot::Test::pbc_output_is( $file, $expected, "$cvt $desc" ); } } } =head1 NAME t/native_pbc/Test.pm - Native PBC test helper functions =head1 DESCRIPTION Tests word-size/endian-ness for different architectures. We test 32+64bit (i.e. 4+8 byte opcode_t and 4+8 byte integers) and 4,8,12 and 16 byte floats with le and be. These tests usually only work on updated native pbc test files. See F to create the platform-specific native pbcs on 4 different machines. =head1 PLATFORMS i386 32 bit opcode_t, 2 byte intval, 8 byte double (linux-gcc-ix86, freebsd-gcc, cygwin) i386 32 bit opcode_t, 2 byte intval, 12 bit long double --floatval="long double" x86_64 64 bit opcode_t, 4 byte intval, 8 byte double (linux-gcc-x86_64, solaris-cc-64int) x86_64 64 bit opcode_t, 4 byte intval, 16 byte long double --floatval="long double" big-endian 32 bit opcode_t, 2 byte intval, 8 byte double (darwin-ppc, sparc32 or mips32) big-endian 32 bit opcode_t, 2 byte intval, 16 byte long double --floatval="long double" big-endian 64 bit opcode_t, 4 byte intval, 8 byte double (Sparc64, mips64, ppc64) big-endian 64 bit opcode_t, 4 byte intval, 16 byte long double --floatval="long double" (skipped) i386 32 bit opcode_t, 2 byte intval, 4-byte single float --floatval=float (skipped) x86_64 64 bit opcode_t, 4 byte intval, 4-byte single float --floatval=float (skipped) big-endian 32 bit opcode_t, 2 byte intval, 4 byte single float --floatval=float =head2 Functions =over 4 =item C C<$type> is "integer", "number" or "string". Runs the tests against all pre-generated native pbc files, and tries to detect common errors, like not updated pbc files on uncommon platforms. See F for skip and todo. =item C Returns "4_le", "4_be", "8_le" or "8_be". For C<$type> "number" even more combinations. =back =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: Utils.pm000644000765000765 163211533177636 17643 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/Test/Pod# Copyright (C) 2007, Parrot Foundation. package Parrot::Test::Pod::Utils; use strict; use warnings; use Pod::Simple; use Pod::Simple::PullParser; our (@ISA, @EXPORT_OK); @ISA = qw( Exporter ); @EXPORT_OK = qw( file_pod_ok empty_description ); # Pulled from Test::Pod sub file_pod_ok { my $file = shift; my $checker = Pod::Simple->new; $checker->output_string( \my $trash ); # Ignore any output $checker->parse_file($file); return !$checker->any_errata_seen; } sub empty_description { my $file = shift; use Pod::Simple::PullParser; my $parser = Pod::Simple::PullParser->new; $parser->set_source( $file ); my $description = $parser->get_description; if ( $description =~ m{^\s*$}m ) { return 1; } return 0; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: manifest_generated.t000644000765000765 300612101554067 20271 0ustar00brucebruce000000000000parrot-5.9.0/t/distro#! perl # Copyright (C) 2010-2012, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; plan(tests => 4); =head1 NAME t/distro/manifest_generated.t - check sanity of MANIFEST.generated file =head1 SYNOPSIS % prove t/distro/manifest_generated.t =head1 DESCRIPTION Checks that MANIFEST.generated is in the required format and that it contains appropriate items (eg: PMC generated files). =cut ok( -e 'MANIFEST.generated', 'MANIFEST.generated exists' ); # slurp MANIFEST.generated, ignoring comment lines open my $fh, '<', 'MANIFEST.generated' or die "open MANIFEST.generated: $!"; my @contents = grep {!/^#/} map {chomp; $_} <$fh>; close $fh; # is_deeply([sort @contents], \@contents, 'MANIFEST.generated is sorted'); # parse records my @records; is_deeply( [grep { my $match = m/^ (\S+) \s+ (\[ \w* \] \w*) $/x; push @records, [$1, $2] if $match; not $match } @contents], [], 'MANIFEST.generated contains no irregular records' ); # check for appropriate contents my %contained_files = map {$$_[0] => 1} @records; is_deeply( [], [grep {not exists $contained_files{$_}} glob('include/pmc/*.h')], 'MANIFEST.generated lists all core PMC headers' ); is_deeply( [], [grep {not exists $contained_files{$_}} glob('src/pmc/*.dump')], 'MANIFEST.generated lists all core PMC dump files' ) # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: test.in000644000765000765 142411606346601 17125 0ustar00brucebruce000000000000parrot-5.9.0/config/auto/ipv6/* Copyright (C) 2010-2011, Parrot Foundation. */ #ifdef _WIN32 # include #else # include # include # include #endif #include #include #include int main(int argc, char *argv[]) { #ifdef _WIN32 struct WSAData sockinfo; #endif struct addrinfo hints; struct addrinfo *ai; #ifdef _WIN32 WSAStartup(2, &sockinfo); #endif memset(&hints, 0, sizeof (struct addrinfo)); hints.ai_family = PF_INET6; hints.ai_protocol = IPPROTO_TCP; getaddrinfo(NULL, "1234", &hints, &ai); if (socket(AF_INET6, SOCK_STREAM, 0) > 0) printf("OK\n"); return EXIT_SUCCESS; } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4: */ test_c.in000644000765000765 46311567202622 20355 0ustar00brucebruce000000000000parrot-5.9.0/config/auto/warnings/* Copyright (C) 2007-2009, Parrot Foundation. */ #include #include /* as long as the file compiles, everything is okay */ int main(void) { return EXIT_SUCCESS; } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ Default.pir000644000765000765 1506711567202624 23303 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library/YAML/Dumper =head1 TITLE YAML::Dumper::Default - The default output module of YAML::Dumper. =head1 VERSION version 0.20 =head1 SYNOPSIS TDB =head1 DESCRIPTION This module provides the default output style of C. =cut .sub __library_data_dumper_default_onload :load .local pmc ydb_class ydb_class = get_class ['YAML'; 'Dumper'; 'Default'] if null ydb_class goto create_ydb goto END create_ydb: load_bytecode 'YAML/Dumper/Base.pbc' get_class $P0, ['YAML'; 'Dumper'; 'Base'] subclass $P0, $P0, ['YAML'; 'Dumper'; 'Default'] END: .return () .end .namespace ['YAML'; 'Dumper'; 'Default'] =head1 METHODS A YAML::Dumper::Default object has the following methods: =over 4 =item style."dumpWithName"( shortname, name, dump ) =cut .sub dumpWithName :method .param string shortname .param string name .param pmc dump .local int ret .local string indent .local string subindent (subindent, indent) = self."newIndent"() print subindent print "\"" print shortname print "\" : " ret = self."yaml"( name, dump ) self."deleteIndent"() .return ( ret ) .end =item style."dumpCached"( name, dump ) =cut .sub dumpCached :method .param string name .param pmc dump print "\\" print name .return ( 1 ) .end =item style."dumpProperties"( name, dump ) =cut .sub dumpProperties :method .param string paramName .param pmc dump .local string name .local pmc prop .local int ret ret = 1 if_null dump, END prophash prop, dump if_null prop, END print " with-properties: " clone name, paramName name = concat name, ".properties()" ret = self."yaml"( name, prop ) END: .return ( ret ) .end =item style.genericHash( name, hash ) Dumps a 'generic' Hash. =cut .sub genericHash :method .param string name .param pmc hash .local pmc it .local string key .local pmc val .local pmc keys .local string name2 $S0 = typeof hash print "!" print $S0 print " {" new keys, "ResizablePMCArray" it = iter hash iter_loop: unless it, iter_end shift key, it push keys, key branch iter_loop iter_end: keys."sort"() dump_loop: unless keys, dump_end print "\n" shift key, keys new val, "ResizablePMCArray" push val, name push val, key sprintf name2, "%s[\"%s\"]", val set val, hash[key] self."dumpWithName"( key, name2, val ) print "," unless keys, dump_end branch dump_loop dump_end: .local string indent .local string subindent (subindent, indent) = self."newIndent"() print "\n" print indent print "}" self."deleteIndent"() .return ( 1 ) .end =item style."dumpStringEscaped"( string, escapeChar ) Escape any characters in a string so we can re-use it as a literal. =cut .sub dumpStringEscaped :method .param pmc var .param string char .local string str str = var str = escape str print str .return ( 1 ) .end =item style."pmcDefault"( name, dump ) =cut .sub pmcDefault :method .param string name .param pmc dump .local pmc class .local string type type = typeof dump print "!" print type print " " $I0 = can dump, "__yaml" if $I0 goto CAN_DUMP print "{ ... }" branch END CAN_DUMP: dump."__yaml"( self, name ) END: .return ( 1 ) .end =item style."pmcIntList"( name, array ) Dumps an IntList PMC. =cut .sub pmcIntList :method .param string name .param pmc array .local string indent .local string subindent .local int size .local int pos .local pmc val .local string name2 .local int tmp (subindent, indent) = self."newIndent"() typeof name2, array print name2 print "[" set size, array set pos, 0 unless size, iter_end iter_loop: print "\n" print subindent new val, "ResizablePMCArray" push val, name push val, pos sprintf name2, "%s[%d]", val $I0 = array[pos] print $I0 # next array member inc pos print "," if pos >= size goto iter_end # elements left? branch iter_loop iter_end: print "\n" print indent print "]" self."deleteIndent"() .return ( 1 ) .end =item style."genericArray"( name, array ) Dumps any pmc that implements an Array interface. =cut .sub genericArray :method .param string name .param pmc array .local string indent .local string subindent .local int size .local int pos .local pmc val .local string name2 .local int tmp (subindent, indent) = self."newIndent"() typeof name2, array print '!' print name2 print " [" size = array pos = 0 unless size, iter_end iter_loop: print "\n" print subindent val = new 'ResizablePMCArray' push val, name push val, pos sprintf name2, "%s[%d]", val set val, array[pos] self."yaml"( name2, val ) # next array member inc pos print "," if pos >= size goto iter_end # elements left? branch iter_loop iter_end: print "\n" print indent print "]" self."deleteIndent"() .return ( 1 ) .end =item style."genericString"( name, str ) Dumps any string-like PMC. =cut .sub genericString :method .param string name .param pmc str .local string name2 typeof name2, str print '!' print name2 print ' [ "' self."dumpStringEscaped"( str, "\"" ) print '" ]' .return ( 1 ) .end =item style."genericNumber" Dumps a generic numeric PMC. =cut .sub genericNumber :method .param string name .param pmc val .local string name2 typeof name2, val print '!' print name2 print ' [ ' print val print ' ]' .return ( 1 ) .end =item style."genericUndef"( name, val ) Dumps any undef PMC. =cut .sub genericUndef :method .param string name .param pmc val .local string name2 typeof name2, val print '!' print name2 print ' [ ' print "" print ' ]' .return ( 1 ) .end =item style."pmcNull"( name, val ) Dumps a Null PMC. =cut .sub pmcNull :method .param string name .param pmc val print "null" .return ( 1 ) .end =back =head1 AUTHOR Jens Rieks Eparrot at jensbeimsurfen dot deE is the author and maintainer. Please send patches and suggestions to the Perl 6 Internals mailing list. =head1 COPYRIGHT Copyright (C) 2004-2008, Parrot Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: tgc.pir000644000765000765 600212101554066 16554 0ustar00brucebruce000000000000parrot-5.9.0/compilers/tge# Copyright (C) 2006-2009, Parrot Foundation. =head1 TITLE tgc.pir - The TGE rules compiler =head1 SYNOPSIS > ./parrot compilers/tge/tgc.pir [OPTIONS] FILE =head1 DESCRIPTION This program takes a tree grammar, specified in B, and compiles it into the PIR code needed to execute that grammar. This PIR code is then suitable for inclusion or compilation into other larger programs. =head1 OPTIONS =over 4 =item --output OUTFILE Send the output to OUTFILE. By default, output is directed to STDOUT. =cut .sub "main" :main .param pmc args .local string prog .local string infile, outfile load_bytecode "TGE.pbc" load_bytecode "Getopt/Obj.pbc" # Grab program name for error reporting prog = shift args # Sanity check parameters $I0 = args unless $I0 >= 1 goto ERR_TOO_FEW_ARGS # Grab the final argument infile = pop args # Process command line options .local pmc getopts getopts = new ["Getopt";"Obj"] getopts."notOptStop"(1) push getopts, "output|o=s" push getopts, "help|h" .local pmc opts opts = getopts."get_options"( args ) .local string help help = opts['help'] if help goto USAGE .local pmc outfh .local int ck_output ck_output = exists opts['output'] if ck_output goto OUTPUT_FILE OUTPUT_STDOUT: $P0 = getinterp outfh = $P0.'stdout_handle'() goto OUTPUT_DONE OUTPUT_FILE: outfile = opts['output'] outfh = new ['FileHandle'] outfh.'open'(outfile, 'w') unless outfh goto ERR_NO_OUTFILE OUTPUT_DONE: # Read grammar file and compile here .local pmc infh infh = new ['FileHandle'] infh.'open'(infile, 'r') unless infh goto ERR_NO_INFILE .local string source source = infh.'read'(65535) infh.'close'() .local pmc grammar grammar = new ['TGE';'Compiler'] .local string compiled_source compiled_source = grammar.'precompile'(source, infile) print outfh, compiled_source unless ck_output goto END # Close the output file and check result $I0 = outfh.'close'() unless $I0 goto END die 'Error: close output failed' goto END USAGE: $P0 = getinterp $P1 = $P0.'stderr_handle'() $P1.'print'("Usage: ") $P1.'print'(prog) $P1.'print'(" [OPTIONS] FILE\n") $P1.'print'(<<"OPTIONS") Options: --output=OUTFILE -- redirect output to OUTFILE --help -- print this message OPTIONS exit 1 ERR_TOO_FEW_ARGS: $P0 = getinterp $P1 = $P0.'stderr_handle'() $P1.'print'("Error: too few arguments\n\n") goto USAGE ERR_NO_INFILE: $P0 = getinterp $P1 = $P0.'stderr_handle'() $P1.'print'("Error: file not found: ") $P1.'print'(infile) $P1.'print'("\n\n") goto USAGE ERR_NO_OUTFILE: $P0 = getinterp $P1 = $P0.'stderr_handle'() $P1.'print'("Error: file not found: ") $P1.'print'(outfile) $P1.'print'("\n\n") goto USAGE END: .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: test_c.in000644000765000765 74511567202622 20447 0ustar00brucebruce000000000000parrot-5.9.0/config/auto/backtrace/* Copyright (C) 2007-2009, Parrot Foundation. figure out if libc has backtrace() & backtrace_symbols() */ #include #include int main(int argc, char **argv) { void *array[10]; size_t size; char **strings; size = backtrace(array, 10); strings = backtrace_symbols(array, size); free(strings); return EXIT_SUCCESS; } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ quine_ord.pir000644000765000765 24244211533177634 17704 0ustar00brucebruce000000000000parrot-5.9.0/examples/pir# Copyright (C) 2006-2010, Parrot Foundation. # ATT no autoexpanding svn markers please # XXX currently broken .loadlib 'io_ops' .sub quine :main .param pmc argv .local pmc code_as_data code_as_data = new 'ResizableIntegerArray' # ------ Start of data section ------ push code_as_data, 35 push code_as_data, 32 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 32 push code_as_data, 69 push code_as_data, 110 push code_as_data, 100 push code_as_data, 32 push code_as_data, 111 push code_as_data, 102 push code_as_data, 32 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 32 push code_as_data, 115 push code_as_data, 101 push code_as_data, 99 push code_as_data, 116 push code_as_data, 105 push code_as_data, 111 push code_as_data, 110 push code_as_data, 32 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 84 push code_as_data, 104 push code_as_data, 101 push code_as_data, 32 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 32 push code_as_data, 115 push code_as_data, 101 push code_as_data, 99 push code_as_data, 116 push code_as_data, 105 push code_as_data, 111 push code_as_data, 110 push code_as_data, 32 push code_as_data, 97 push code_as_data, 98 push code_as_data, 111 push code_as_data, 118 push code_as_data, 101 push code_as_data, 32 push code_as_data, 99 push code_as_data, 97 push code_as_data, 110 push code_as_data, 32 push code_as_data, 98 push code_as_data, 101 push code_as_data, 32 push code_as_data, 103 push code_as_data, 101 push code_as_data, 110 push code_as_data, 101 push code_as_data, 114 push code_as_data, 97 push code_as_data, 116 push code_as_data, 101 push code_as_data, 100 push code_as_data, 32 push code_as_data, 119 push code_as_data, 105 push code_as_data, 116 push code_as_data, 104 push code_as_data, 32 push code_as_data, 45 push code_as_data, 45 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 45 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 45 push code_as_data, 97 push code_as_data, 115 push code_as_data, 45 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 83 push code_as_data, 101 push code_as_data, 101 push code_as_data, 32 push code_as_data, 68 push code_as_data, 69 push code_as_data, 83 push code_as_data, 67 push code_as_data, 82 push code_as_data, 73 push code_as_data, 80 push code_as_data, 84 push code_as_data, 73 push code_as_data, 79 push code_as_data, 78 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 108 push code_as_data, 111 push code_as_data, 97 push code_as_data, 100 push code_as_data, 95 push code_as_data, 98 push code_as_data, 121 push code_as_data, 116 push code_as_data, 101 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 32 push code_as_data, 34 push code_as_data, 71 push code_as_data, 101 push code_as_data, 116 push code_as_data, 111 push code_as_data, 112 push code_as_data, 116 push code_as_data, 47 push code_as_data, 79 push code_as_data, 98 push code_as_data, 106 push code_as_data, 46 push code_as_data, 112 push code_as_data, 98 push code_as_data, 99 push code_as_data, 34 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 115 push code_as_data, 104 push code_as_data, 105 push code_as_data, 102 push code_as_data, 116 push code_as_data, 32 push code_as_data, 110 push code_as_data, 97 push code_as_data, 109 push code_as_data, 101 push code_as_data, 32 push code_as_data, 111 push code_as_data, 102 push code_as_data, 32 push code_as_data, 116 push code_as_data, 104 push code_as_data, 101 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 111 push code_as_data, 103 push code_as_data, 114 push code_as_data, 97 push code_as_data, 109 push code_as_data, 44 push code_as_data, 32 push code_as_data, 115 push code_as_data, 111 push code_as_data, 32 push code_as_data, 116 push code_as_data, 104 push code_as_data, 97 push code_as_data, 116 push code_as_data, 32 push code_as_data, 97 push code_as_data, 114 push code_as_data, 103 push code_as_data, 118 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 110 push code_as_data, 116 push code_as_data, 97 push code_as_data, 105 push code_as_data, 110 push code_as_data, 115 push code_as_data, 32 push code_as_data, 111 push code_as_data, 110 push code_as_data, 108 push code_as_data, 121 push code_as_data, 32 push code_as_data, 111 push code_as_data, 112 push code_as_data, 116 push code_as_data, 105 push code_as_data, 111 push code_as_data, 110 push code_as_data, 115 push code_as_data, 32 push code_as_data, 97 push code_as_data, 110 push code_as_data, 100 push code_as_data, 32 push code_as_data, 101 push code_as_data, 120 push code_as_data, 116 push code_as_data, 114 push code_as_data, 97 push code_as_data, 32 push code_as_data, 112 push code_as_data, 97 push code_as_data, 114 push code_as_data, 97 push code_as_data, 109 push code_as_data, 115 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 115 push code_as_data, 116 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 111 push code_as_data, 103 push code_as_data, 114 push code_as_data, 97 push code_as_data, 109 push code_as_data, 95 push code_as_data, 110 push code_as_data, 97 push code_as_data, 109 push code_as_data, 101 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 111 push code_as_data, 103 push code_as_data, 114 push code_as_data, 97 push code_as_data, 109 push code_as_data, 95 push code_as_data, 110 push code_as_data, 97 push code_as_data, 109 push code_as_data, 101 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 115 push code_as_data, 104 push code_as_data, 105 push code_as_data, 102 push code_as_data, 116 push code_as_data, 32 push code_as_data, 97 push code_as_data, 114 push code_as_data, 103 push code_as_data, 118 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 83 push code_as_data, 112 push code_as_data, 101 push code_as_data, 99 push code_as_data, 105 push code_as_data, 102 push code_as_data, 105 push code_as_data, 99 push code_as_data, 97 push code_as_data, 116 push code_as_data, 105 push code_as_data, 111 push code_as_data, 110 push code_as_data, 32 push code_as_data, 111 push code_as_data, 102 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 109 push code_as_data, 109 push code_as_data, 97 push code_as_data, 110 push code_as_data, 100 push code_as_data, 32 push code_as_data, 108 push code_as_data, 105 push code_as_data, 110 push code_as_data, 101 push code_as_data, 32 push code_as_data, 97 push code_as_data, 114 push code_as_data, 103 push code_as_data, 117 push code_as_data, 109 push code_as_data, 101 push code_as_data, 110 push code_as_data, 116 push code_as_data, 115 push code_as_data, 46 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 112 push code_as_data, 109 push code_as_data, 99 push code_as_data, 32 push code_as_data, 103 push code_as_data, 101 push code_as_data, 116 push code_as_data, 111 push code_as_data, 112 push code_as_data, 116 push code_as_data, 115 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 103 push code_as_data, 101 push code_as_data, 116 push code_as_data, 111 push code_as_data, 112 push code_as_data, 116 push code_as_data, 115 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 110 push code_as_data, 101 push code_as_data, 119 push code_as_data, 32 push code_as_data, 91 push code_as_data, 34 push code_as_data, 71 push code_as_data, 101 push code_as_data, 116 push code_as_data, 111 push code_as_data, 112 push code_as_data, 116 push code_as_data, 34 push code_as_data, 59 push code_as_data, 34 push code_as_data, 79 push code_as_data, 98 push code_as_data, 106 push code_as_data, 34 push code_as_data, 93 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 117 push code_as_data, 115 push code_as_data, 104 push code_as_data, 32 push code_as_data, 103 push code_as_data, 101 push code_as_data, 116 push code_as_data, 111 push code_as_data, 112 push code_as_data, 116 push code_as_data, 115 push code_as_data, 44 push code_as_data, 32 push code_as_data, 34 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 45 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 45 push code_as_data, 97 push code_as_data, 115 push code_as_data, 45 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 34 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 76 push code_as_data, 111 push code_as_data, 111 push code_as_data, 107 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 32 push code_as_data, 97 push code_as_data, 116 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 109 push code_as_data, 109 push code_as_data, 97 push code_as_data, 110 push code_as_data, 100 push code_as_data, 32 push code_as_data, 108 push code_as_data, 105 push code_as_data, 110 push code_as_data, 101 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 112 push code_as_data, 109 push code_as_data, 99 push code_as_data, 32 push code_as_data, 111 push code_as_data, 112 push code_as_data, 116 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 111 push code_as_data, 112 push code_as_data, 116 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 103 push code_as_data, 101 push code_as_data, 116 push code_as_data, 111 push code_as_data, 112 push code_as_data, 116 push code_as_data, 115 push code_as_data, 46 push code_as_data, 34 push code_as_data, 103 push code_as_data, 101 push code_as_data, 116 push code_as_data, 95 push code_as_data, 111 push code_as_data, 112 push code_as_data, 116 push code_as_data, 105 push code_as_data, 111 push code_as_data, 110 push code_as_data, 115 push code_as_data, 34 push code_as_data, 40 push code_as_data, 97 push code_as_data, 114 push code_as_data, 103 push code_as_data, 118 push code_as_data, 41 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 100 push code_as_data, 111 push code_as_data, 95 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 95 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 100 push code_as_data, 111 push code_as_data, 95 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 95 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 100 push code_as_data, 101 push code_as_data, 102 push code_as_data, 105 push code_as_data, 110 push code_as_data, 101 push code_as_data, 100 push code_as_data, 32 push code_as_data, 111 push code_as_data, 112 push code_as_data, 116 push code_as_data, 91 push code_as_data, 34 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 45 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 45 push code_as_data, 97 push code_as_data, 115 push code_as_data, 45 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 34 push code_as_data, 93 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 117 push code_as_data, 110 push code_as_data, 108 push code_as_data, 101 push code_as_data, 115 push code_as_data, 115 push code_as_data, 32 push code_as_data, 100 push code_as_data, 111 push code_as_data, 95 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 95 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 32 push code_as_data, 103 push code_as_data, 111 push code_as_data, 116 push code_as_data, 111 push code_as_data, 32 push code_as_data, 68 push code_as_data, 79 push code_as_data, 95 push code_as_data, 81 push code_as_data, 85 push code_as_data, 73 push code_as_data, 78 push code_as_data, 69 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 95 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 40 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 111 push code_as_data, 103 push code_as_data, 114 push code_as_data, 97 push code_as_data, 109 push code_as_data, 95 push code_as_data, 110 push code_as_data, 97 push code_as_data, 109 push code_as_data, 101 push code_as_data, 32 push code_as_data, 41 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 101 push code_as_data, 110 push code_as_data, 100 push code_as_data, 10 push code_as_data, 10 push code_as_data, 10 push code_as_data, 68 push code_as_data, 79 push code_as_data, 95 push code_as_data, 81 push code_as_data, 85 push code_as_data, 73 push code_as_data, 78 push code_as_data, 69 push code_as_data, 58 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 70 push code_as_data, 105 push code_as_data, 114 push code_as_data, 115 push code_as_data, 116 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 116 push code_as_data, 104 push code_as_data, 101 push code_as_data, 32 push code_as_data, 115 push code_as_data, 116 push code_as_data, 117 push code_as_data, 102 push code_as_data, 102 push code_as_data, 32 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 32 push code_as_data, 115 push code_as_data, 101 push code_as_data, 99 push code_as_data, 116 push code_as_data, 105 push code_as_data, 111 push code_as_data, 110 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 34 push code_as_data, 35 push code_as_data, 32 push code_as_data, 67 push code_as_data, 111 push code_as_data, 112 push code_as_data, 121 push code_as_data, 114 push code_as_data, 105 push code_as_data, 103 push code_as_data, 104 push code_as_data, 116 push code_as_data, 32 push code_as_data, 40 push code_as_data, 67 push code_as_data, 41 push code_as_data, 32 push code_as_data, 50 push code_as_data, 48 push code_as_data, 48 push code_as_data, 54 push code_as_data, 45 push code_as_data, 50 push code_as_data, 48 push code_as_data, 49 push code_as_data, 48 push code_as_data, 44 push code_as_data, 32 push code_as_data, 80 push code_as_data, 97 push code_as_data, 114 push code_as_data, 114 push code_as_data, 111 push code_as_data, 116 push code_as_data, 32 push code_as_data, 70 push code_as_data, 111 push code_as_data, 117 push code_as_data, 110 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 105 push code_as_data, 111 push code_as_data, 110 push code_as_data, 46 push code_as_data, 92 push code_as_data, 110 push code_as_data, 34 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 34 push code_as_data, 35 push code_as_data, 32 push code_as_data, 65 push code_as_data, 84 push code_as_data, 84 push code_as_data, 32 push code_as_data, 110 push code_as_data, 111 push code_as_data, 32 push code_as_data, 97 push code_as_data, 117 push code_as_data, 116 push code_as_data, 111 push code_as_data, 101 push code_as_data, 120 push code_as_data, 112 push code_as_data, 97 push code_as_data, 110 push code_as_data, 100 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 32 push code_as_data, 115 push code_as_data, 118 push code_as_data, 110 push code_as_data, 32 push code_as_data, 109 push code_as_data, 97 push code_as_data, 114 push code_as_data, 107 push code_as_data, 101 push code_as_data, 114 push code_as_data, 115 push code_as_data, 32 push code_as_data, 112 push code_as_data, 108 push code_as_data, 101 push code_as_data, 97 push code_as_data, 115 push code_as_data, 101 push code_as_data, 92 push code_as_data, 110 push code_as_data, 34 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 34 push code_as_data, 92 push code_as_data, 110 push code_as_data, 34 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 34 push code_as_data, 46 push code_as_data, 115 push code_as_data, 117 push code_as_data, 98 push code_as_data, 32 push code_as_data, 113 push code_as_data, 117 push code_as_data, 105 push code_as_data, 110 push code_as_data, 101 push code_as_data, 32 push code_as_data, 58 push code_as_data, 109 push code_as_data, 97 push code_as_data, 105 push code_as_data, 110 push code_as_data, 92 push code_as_data, 110 push code_as_data, 34 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 34 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 112 push code_as_data, 97 push code_as_data, 114 push code_as_data, 97 push code_as_data, 109 push code_as_data, 32 push code_as_data, 112 push code_as_data, 109 push code_as_data, 99 push code_as_data, 32 push code_as_data, 97 push code_as_data, 114 push code_as_data, 103 push code_as_data, 118 push code_as_data, 92 push code_as_data, 110 push code_as_data, 34 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 34 push code_as_data, 92 push code_as_data, 110 push code_as_data, 34 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 34 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 112 push code_as_data, 109 push code_as_data, 99 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 92 push code_as_data, 110 push code_as_data, 34 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 34 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 110 push code_as_data, 101 push code_as_data, 119 push code_as_data, 32 push code_as_data, 39 push code_as_data, 82 push code_as_data, 101 push code_as_data, 115 push code_as_data, 105 push code_as_data, 122 push code_as_data, 97 push code_as_data, 98 push code_as_data, 108 push code_as_data, 101 push code_as_data, 73 push code_as_data, 110 push code_as_data, 116 push code_as_data, 101 push code_as_data, 103 push code_as_data, 101 push code_as_data, 114 push code_as_data, 65 push code_as_data, 114 push code_as_data, 114 push code_as_data, 97 push code_as_data, 121 push code_as_data, 39 push code_as_data, 92 push code_as_data, 110 push code_as_data, 34 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 34 push code_as_data, 35 push code_as_data, 32 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 32 push code_as_data, 83 push code_as_data, 116 push code_as_data, 97 push code_as_data, 114 push code_as_data, 116 push code_as_data, 32 push code_as_data, 111 push code_as_data, 102 push code_as_data, 32 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 32 push code_as_data, 115 push code_as_data, 101 push code_as_data, 99 push code_as_data, 116 push code_as_data, 105 push code_as_data, 111 push code_as_data, 110 push code_as_data, 32 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 92 push code_as_data, 110 push code_as_data, 34 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 78 push code_as_data, 111 push code_as_data, 119 push code_as_data, 32 push code_as_data, 116 push code_as_data, 104 push code_as_data, 101 push code_as_data, 32 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 40 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 32 push code_as_data, 41 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 78 push code_as_data, 111 push code_as_data, 119 push code_as_data, 32 push code_as_data, 116 push code_as_data, 104 push code_as_data, 101 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 40 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 32 push code_as_data, 41 push code_as_data, 10 push code_as_data, 46 push code_as_data, 101 push code_as_data, 110 push code_as_data, 100 push code_as_data, 10 push code_as_data, 10 push code_as_data, 46 push code_as_data, 115 push code_as_data, 117 push code_as_data, 98 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 95 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 112 push code_as_data, 97 push code_as_data, 114 push code_as_data, 97 push code_as_data, 109 push code_as_data, 32 push code_as_data, 115 push code_as_data, 116 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 111 push code_as_data, 103 push code_as_data, 114 push code_as_data, 97 push code_as_data, 109 push code_as_data, 95 push code_as_data, 110 push code_as_data, 97 push code_as_data, 109 push code_as_data, 101 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 105 push code_as_data, 110 push code_as_data, 99 push code_as_data, 108 push code_as_data, 117 push code_as_data, 100 push code_as_data, 101 push code_as_data, 32 push code_as_data, 34 push code_as_data, 115 push code_as_data, 116 push code_as_data, 97 push code_as_data, 116 push code_as_data, 46 push code_as_data, 112 push code_as_data, 97 push code_as_data, 115 push code_as_data, 109 push code_as_data, 34 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 112 push code_as_data, 109 push code_as_data, 99 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 95 push code_as_data, 102 push code_as_data, 104 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 115 push code_as_data, 105 push code_as_data, 122 push code_as_data, 101 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 115 push code_as_data, 105 push code_as_data, 122 push code_as_data, 101 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 115 push code_as_data, 116 push code_as_data, 97 push code_as_data, 116 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 111 push code_as_data, 103 push code_as_data, 114 push code_as_data, 97 push code_as_data, 109 push code_as_data, 95 push code_as_data, 110 push code_as_data, 97 push code_as_data, 109 push code_as_data, 101 push code_as_data, 44 push code_as_data, 32 push code_as_data, 46 push code_as_data, 83 push code_as_data, 84 push code_as_data, 65 push code_as_data, 84 push code_as_data, 95 push code_as_data, 70 push code_as_data, 73 push code_as_data, 76 push code_as_data, 69 push code_as_data, 83 push code_as_data, 73 push code_as_data, 90 push code_as_data, 69 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 95 push code_as_data, 102 push code_as_data, 104 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 111 push code_as_data, 112 push code_as_data, 101 push code_as_data, 110 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 111 push code_as_data, 103 push code_as_data, 114 push code_as_data, 97 push code_as_data, 109 push code_as_data, 95 push code_as_data, 110 push code_as_data, 97 push code_as_data, 109 push code_as_data, 101 push code_as_data, 44 push code_as_data, 32 push code_as_data, 39 push code_as_data, 114 push code_as_data, 39 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 115 push code_as_data, 116 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 114 push code_as_data, 101 push code_as_data, 97 push code_as_data, 100 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 95 push code_as_data, 102 push code_as_data, 104 push code_as_data, 44 push code_as_data, 32 push code_as_data, 115 push code_as_data, 105 push code_as_data, 122 push code_as_data, 101 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 73 push code_as_data, 103 push code_as_data, 110 push code_as_data, 111 push code_as_data, 114 push code_as_data, 101 push code_as_data, 32 push code_as_data, 101 push code_as_data, 118 push code_as_data, 101 push code_as_data, 114 push code_as_data, 121 push code_as_data, 116 push code_as_data, 104 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 32 push code_as_data, 117 push code_as_data, 112 push code_as_data, 32 push code_as_data, 116 push code_as_data, 111 push code_as_data, 32 push code_as_data, 101 push code_as_data, 110 push code_as_data, 100 push code_as_data, 32 push code_as_data, 111 push code_as_data, 102 push code_as_data, 32 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 32 push code_as_data, 115 push code_as_data, 101 push code_as_data, 99 push code_as_data, 116 push code_as_data, 105 push code_as_data, 111 push code_as_data, 110 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 101 push code_as_data, 110 push code_as_data, 100 push code_as_data, 95 push code_as_data, 111 push code_as_data, 102 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 95 push code_as_data, 112 push code_as_data, 111 push code_as_data, 115 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 101 push code_as_data, 110 push code_as_data, 100 push code_as_data, 95 push code_as_data, 111 push code_as_data, 102 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 95 push code_as_data, 112 push code_as_data, 111 push code_as_data, 115 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 105 push code_as_data, 110 push code_as_data, 100 push code_as_data, 101 push code_as_data, 120 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 44 push code_as_data, 32 push code_as_data, 34 push code_as_data, 35 push code_as_data, 32 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 32 push code_as_data, 69 push code_as_data, 110 push code_as_data, 100 push code_as_data, 32 push code_as_data, 111 push code_as_data, 102 push code_as_data, 32 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 32 push code_as_data, 115 push code_as_data, 101 push code_as_data, 99 push code_as_data, 116 push code_as_data, 105 push code_as_data, 111 push code_as_data, 110 push code_as_data, 32 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 34 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 114 push code_as_data, 101 push code_as_data, 112 push code_as_data, 108 push code_as_data, 97 push code_as_data, 99 push code_as_data, 101 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 44 push code_as_data, 32 push code_as_data, 48 push code_as_data, 44 push code_as_data, 32 push code_as_data, 101 push code_as_data, 110 push code_as_data, 100 push code_as_data, 95 push code_as_data, 111 push code_as_data, 102 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 95 push code_as_data, 112 push code_as_data, 111 push code_as_data, 115 push code_as_data, 44 push code_as_data, 32 push code_as_data, 39 push code_as_data, 39 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 115 push code_as_data, 116 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 115 push code_as_data, 116 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 83 push code_as_data, 72 push code_as_data, 73 push code_as_data, 70 push code_as_data, 84 push code_as_data, 95 push code_as_data, 78 push code_as_data, 69 push code_as_data, 88 push code_as_data, 84 push code_as_data, 95 push code_as_data, 67 push code_as_data, 72 push code_as_data, 65 push code_as_data, 82 push code_as_data, 58 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 117 push code_as_data, 110 push code_as_data, 108 push code_as_data, 101 push code_as_data, 115 push code_as_data, 115 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 32 push code_as_data, 103 push code_as_data, 111 push code_as_data, 116 push code_as_data, 111 push code_as_data, 32 push code_as_data, 70 push code_as_data, 73 push code_as_data, 78 push code_as_data, 73 push code_as_data, 83 push code_as_data, 72 push code_as_data, 95 push code_as_data, 83 push code_as_data, 72 push code_as_data, 73 push code_as_data, 70 push code_as_data, 84 push code_as_data, 95 push code_as_data, 67 push code_as_data, 72 push code_as_data, 65 push code_as_data, 82 push code_as_data, 83 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 115 push code_as_data, 116 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 115 push code_as_data, 117 push code_as_data, 98 push code_as_data, 115 push code_as_data, 116 push code_as_data, 114 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 44 push code_as_data, 32 push code_as_data, 48 push code_as_data, 44 push code_as_data, 32 push code_as_data, 49 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 114 push code_as_data, 101 push code_as_data, 112 push code_as_data, 108 push code_as_data, 97 push code_as_data, 99 push code_as_data, 101 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 44 push code_as_data, 32 push code_as_data, 48 push code_as_data, 44 push code_as_data, 32 push code_as_data, 49 push code_as_data, 44 push code_as_data, 32 push code_as_data, 39 push code_as_data, 39 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 111 push code_as_data, 114 push code_as_data, 100 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 115 push code_as_data, 116 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 39 push code_as_data, 112 push code_as_data, 117 push code_as_data, 115 push code_as_data, 104 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 44 push code_as_data, 32 push code_as_data, 39 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 34 push code_as_data, 92 push code_as_data, 110 push code_as_data, 34 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 103 push code_as_data, 111 push code_as_data, 116 push code_as_data, 111 push code_as_data, 32 push code_as_data, 83 push code_as_data, 72 push code_as_data, 73 push code_as_data, 70 push code_as_data, 84 push code_as_data, 95 push code_as_data, 78 push code_as_data, 69 push code_as_data, 88 push code_as_data, 84 push code_as_data, 95 push code_as_data, 67 push code_as_data, 72 push code_as_data, 65 push code_as_data, 82 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 70 push code_as_data, 73 push code_as_data, 78 push code_as_data, 73 push code_as_data, 83 push code_as_data, 72 push code_as_data, 95 push code_as_data, 83 push code_as_data, 72 push code_as_data, 73 push code_as_data, 70 push code_as_data, 84 push code_as_data, 95 push code_as_data, 67 push code_as_data, 72 push code_as_data, 65 push code_as_data, 82 push code_as_data, 83 push code_as_data, 58 push code_as_data, 10 push code_as_data, 10 push code_as_data, 46 push code_as_data, 101 push code_as_data, 110 push code_as_data, 100 push code_as_data, 10 push code_as_data, 10 push code_as_data, 46 push code_as_data, 115 push code_as_data, 117 push code_as_data, 98 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 112 push code_as_data, 97 push code_as_data, 114 push code_as_data, 97 push code_as_data, 109 push code_as_data, 32 push code_as_data, 112 push code_as_data, 109 push code_as_data, 99 push code_as_data, 32 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 105 push code_as_data, 110 push code_as_data, 99 push code_as_data, 108 push code_as_data, 117 push code_as_data, 100 push code_as_data, 101 push code_as_data, 32 push code_as_data, 34 push code_as_data, 105 push code_as_data, 116 push code_as_data, 101 push code_as_data, 114 push code_as_data, 97 push code_as_data, 116 push code_as_data, 111 push code_as_data, 114 push code_as_data, 46 push code_as_data, 112 push code_as_data, 97 push code_as_data, 115 push code_as_data, 109 push code_as_data, 34 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 112 push code_as_data, 109 push code_as_data, 99 push code_as_data, 32 push code_as_data, 105 push code_as_data, 116 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 105 push code_as_data, 116 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 105 push code_as_data, 116 push code_as_data, 101 push code_as_data, 114 push code_as_data, 32 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 105 push code_as_data, 116 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 46 push code_as_data, 73 push code_as_data, 84 push code_as_data, 69 push code_as_data, 82 push code_as_data, 65 push code_as_data, 84 push code_as_data, 69 push code_as_data, 95 push code_as_data, 70 push code_as_data, 82 push code_as_data, 79 push code_as_data, 77 push code_as_data, 95 push code_as_data, 83 push code_as_data, 84 push code_as_data, 65 push code_as_data, 82 push code_as_data, 84 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 114 push code_as_data, 101 push code_as_data, 115 push code_as_data, 101 push code_as_data, 116 push code_as_data, 32 push code_as_data, 105 push code_as_data, 116 push code_as_data, 101 push code_as_data, 114 push code_as_data, 97 push code_as_data, 116 push code_as_data, 111 push code_as_data, 114 push code_as_data, 44 push code_as_data, 32 push code_as_data, 98 push code_as_data, 101 push code_as_data, 103 push code_as_data, 105 push code_as_data, 110 push code_as_data, 32 push code_as_data, 97 push code_as_data, 116 push code_as_data, 32 push code_as_data, 115 push code_as_data, 116 push code_as_data, 97 push code_as_data, 114 push code_as_data, 116 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 73 push code_as_data, 84 push code_as_data, 69 push code_as_data, 82 push code_as_data, 95 push code_as_data, 76 push code_as_data, 79 push code_as_data, 79 push code_as_data, 80 push code_as_data, 58 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 117 push code_as_data, 110 push code_as_data, 108 push code_as_data, 101 push code_as_data, 115 push code_as_data, 115 push code_as_data, 32 push code_as_data, 105 push code_as_data, 116 push code_as_data, 32 push code_as_data, 103 push code_as_data, 111 push code_as_data, 116 push code_as_data, 111 push code_as_data, 32 push code_as_data, 73 push code_as_data, 84 push code_as_data, 69 push code_as_data, 82 push code_as_data, 95 push code_as_data, 69 push code_as_data, 78 push code_as_data, 68 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 119 push code_as_data, 104 push code_as_data, 105 push code_as_data, 108 push code_as_data, 101 push code_as_data, 32 push code_as_data, 40 push code_as_data, 101 push code_as_data, 110 push code_as_data, 116 push code_as_data, 114 push code_as_data, 105 push code_as_data, 101 push code_as_data, 115 push code_as_data, 41 push code_as_data, 32 push code_as_data, 46 push code_as_data, 46 push code_as_data, 46 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 115 push code_as_data, 104 push code_as_data, 105 push code_as_data, 102 push code_as_data, 116 push code_as_data, 32 push code_as_data, 105 push code_as_data, 116 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 103 push code_as_data, 101 push code_as_data, 116 push code_as_data, 32 push code_as_data, 101 push code_as_data, 110 push code_as_data, 116 push code_as_data, 114 push code_as_data, 121 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 39 push code_as_data, 112 push code_as_data, 117 push code_as_data, 115 push code_as_data, 104 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 44 push code_as_data, 32 push code_as_data, 39 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 34 push code_as_data, 92 push code_as_data, 110 push code_as_data, 34 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 103 push code_as_data, 111 push code_as_data, 116 push code_as_data, 111 push code_as_data, 32 push code_as_data, 73 push code_as_data, 84 push code_as_data, 69 push code_as_data, 82 push code_as_data, 95 push code_as_data, 76 push code_as_data, 79 push code_as_data, 79 push code_as_data, 80 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 73 push code_as_data, 84 push code_as_data, 69 push code_as_data, 82 push code_as_data, 95 push code_as_data, 69 push code_as_data, 78 push code_as_data, 68 push code_as_data, 58 push code_as_data, 10 push code_as_data, 46 push code_as_data, 101 push code_as_data, 110 push code_as_data, 100 push code_as_data, 10 push code_as_data, 10 push code_as_data, 46 push code_as_data, 115 push code_as_data, 117 push code_as_data, 98 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 95 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 95 push code_as_data, 97 push code_as_data, 115 push code_as_data, 95 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 112 push code_as_data, 97 push code_as_data, 114 push code_as_data, 97 push code_as_data, 109 push code_as_data, 32 push code_as_data, 112 push code_as_data, 109 push code_as_data, 99 push code_as_data, 32 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 105 push code_as_data, 110 push code_as_data, 99 push code_as_data, 108 push code_as_data, 117 push code_as_data, 100 push code_as_data, 101 push code_as_data, 32 push code_as_data, 34 push code_as_data, 105 push code_as_data, 116 push code_as_data, 101 push code_as_data, 114 push code_as_data, 97 push code_as_data, 116 push code_as_data, 111 push code_as_data, 114 push code_as_data, 46 push code_as_data, 112 push code_as_data, 97 push code_as_data, 115 push code_as_data, 109 push code_as_data, 34 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 112 push code_as_data, 109 push code_as_data, 99 push code_as_data, 32 push code_as_data, 105 push code_as_data, 116 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 105 push code_as_data, 116 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 105 push code_as_data, 116 push code_as_data, 101 push code_as_data, 114 push code_as_data, 32 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 105 push code_as_data, 116 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 46 push code_as_data, 73 push code_as_data, 84 push code_as_data, 69 push code_as_data, 82 push code_as_data, 65 push code_as_data, 84 push code_as_data, 69 push code_as_data, 95 push code_as_data, 70 push code_as_data, 82 push code_as_data, 79 push code_as_data, 77 push code_as_data, 95 push code_as_data, 83 push code_as_data, 84 push code_as_data, 65 push code_as_data, 82 push code_as_data, 84 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 114 push code_as_data, 101 push code_as_data, 115 push code_as_data, 101 push code_as_data, 116 push code_as_data, 32 push code_as_data, 105 push code_as_data, 116 push code_as_data, 101 push code_as_data, 114 push code_as_data, 97 push code_as_data, 116 push code_as_data, 111 push code_as_data, 114 push code_as_data, 44 push code_as_data, 32 push code_as_data, 98 push code_as_data, 101 push code_as_data, 103 push code_as_data, 105 push code_as_data, 110 push code_as_data, 32 push code_as_data, 97 push code_as_data, 116 push code_as_data, 32 push code_as_data, 115 push code_as_data, 116 push code_as_data, 97 push code_as_data, 114 push code_as_data, 116 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 115 push code_as_data, 116 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 115 push code_as_data, 116 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 73 push code_as_data, 84 push code_as_data, 69 push code_as_data, 82 push code_as_data, 95 push code_as_data, 76 push code_as_data, 79 push code_as_data, 79 push code_as_data, 80 push code_as_data, 58 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 117 push code_as_data, 110 push code_as_data, 108 push code_as_data, 101 push code_as_data, 115 push code_as_data, 115 push code_as_data, 32 push code_as_data, 105 push code_as_data, 116 push code_as_data, 32 push code_as_data, 103 push code_as_data, 111 push code_as_data, 116 push code_as_data, 111 push code_as_data, 32 push code_as_data, 73 push code_as_data, 84 push code_as_data, 69 push code_as_data, 82 push code_as_data, 95 push code_as_data, 69 push code_as_data, 78 push code_as_data, 68 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 119 push code_as_data, 104 push code_as_data, 105 push code_as_data, 108 push code_as_data, 101 push code_as_data, 32 push code_as_data, 40 push code_as_data, 101 push code_as_data, 110 push code_as_data, 116 push code_as_data, 114 push code_as_data, 105 push code_as_data, 101 push code_as_data, 115 push code_as_data, 41 push code_as_data, 32 push code_as_data, 46 push code_as_data, 46 push code_as_data, 46 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 115 push code_as_data, 104 push code_as_data, 105 push code_as_data, 102 push code_as_data, 116 push code_as_data, 32 push code_as_data, 105 push code_as_data, 116 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 35 push code_as_data, 32 push code_as_data, 103 push code_as_data, 101 push code_as_data, 116 push code_as_data, 32 push code_as_data, 101 push code_as_data, 110 push code_as_data, 116 push code_as_data, 114 push code_as_data, 121 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 115 push code_as_data, 116 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 32 push code_as_data, 61 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 114 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 95 push code_as_data, 115 push code_as_data, 116 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 103 push code_as_data, 111 push code_as_data, 116 push code_as_data, 111 push code_as_data, 32 push code_as_data, 73 push code_as_data, 84 push code_as_data, 69 push code_as_data, 82 push code_as_data, 95 push code_as_data, 76 push code_as_data, 79 push code_as_data, 79 push code_as_data, 80 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 73 push code_as_data, 84 push code_as_data, 69 push code_as_data, 82 push code_as_data, 95 push code_as_data, 69 push code_as_data, 78 push code_as_data, 68 push code_as_data, 58 push code_as_data, 10 push code_as_data, 46 push code_as_data, 101 push code_as_data, 110 push code_as_data, 100 push code_as_data, 10 push code_as_data, 10 push code_as_data, 61 push code_as_data, 104 push code_as_data, 101 push code_as_data, 97 push code_as_data, 100 push code_as_data, 49 push code_as_data, 32 push code_as_data, 78 push code_as_data, 65 push code_as_data, 77 push code_as_data, 69 push code_as_data, 10 push code_as_data, 10 push code_as_data, 113 push code_as_data, 117 push code_as_data, 105 push code_as_data, 110 push code_as_data, 101 push code_as_data, 95 push code_as_data, 111 push code_as_data, 114 push code_as_data, 100 push code_as_data, 46 push code_as_data, 112 push code_as_data, 105 push code_as_data, 114 push code_as_data, 32 push code_as_data, 45 push code_as_data, 32 push code_as_data, 97 push code_as_data, 32 push code_as_data, 113 push code_as_data, 117 push code_as_data, 105 push code_as_data, 110 push code_as_data, 101 push code_as_data, 32 push code_as_data, 116 push code_as_data, 104 push code_as_data, 97 push code_as_data, 116 push code_as_data, 32 push code_as_data, 115 push code_as_data, 116 push code_as_data, 111 push code_as_data, 114 push code_as_data, 101 push code_as_data, 32 push code_as_data, 116 push code_as_data, 104 push code_as_data, 101 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 32 push code_as_data, 105 push code_as_data, 110 push code_as_data, 32 push code_as_data, 97 push code_as_data, 32 push code_as_data, 82 push code_as_data, 101 push code_as_data, 115 push code_as_data, 105 push code_as_data, 122 push code_as_data, 97 push code_as_data, 98 push code_as_data, 108 push code_as_data, 101 push code_as_data, 73 push code_as_data, 110 push code_as_data, 116 push code_as_data, 101 push code_as_data, 103 push code_as_data, 101 push code_as_data, 114 push code_as_data, 65 push code_as_data, 114 push code_as_data, 114 push code_as_data, 97 push code_as_data, 121 push code_as_data, 10 push code_as_data, 10 push code_as_data, 61 push code_as_data, 104 push code_as_data, 101 push code_as_data, 97 push code_as_data, 100 push code_as_data, 49 push code_as_data, 32 push code_as_data, 68 push code_as_data, 69 push code_as_data, 83 push code_as_data, 67 push code_as_data, 82 push code_as_data, 73 push code_as_data, 80 push code_as_data, 84 push code_as_data, 73 push code_as_data, 79 push code_as_data, 78 push code_as_data, 10 push code_as_data, 10 push code_as_data, 87 push code_as_data, 104 push code_as_data, 101 push code_as_data, 110 push code_as_data, 32 push code_as_data, 109 push code_as_data, 97 push code_as_data, 107 push code_as_data, 105 push code_as_data, 110 push code_as_data, 103 push code_as_data, 32 push code_as_data, 99 push code_as_data, 104 push code_as_data, 97 push code_as_data, 110 push code_as_data, 103 push code_as_data, 101 push code_as_data, 115 push code_as_data, 44 push code_as_data, 32 push code_as_data, 100 push code_as_data, 101 push code_as_data, 108 push code_as_data, 101 push code_as_data, 116 push code_as_data, 101 push code_as_data, 32 push code_as_data, 116 push code_as_data, 104 push code_as_data, 101 push code_as_data, 32 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 32 push code_as_data, 98 push code_as_data, 101 push code_as_data, 116 push code_as_data, 119 push code_as_data, 101 push code_as_data, 101 push code_as_data, 110 push code_as_data, 32 push code_as_data, 116 push code_as_data, 104 push code_as_data, 101 push code_as_data, 32 push code_as_data, 32 push code_as_data, 39 push code_as_data, 35 push code_as_data, 32 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 45 push code_as_data, 39 push code_as_data, 32 push code_as_data, 109 push code_as_data, 97 push code_as_data, 114 push code_as_data, 107 push code_as_data, 101 push code_as_data, 114 push code_as_data, 115 push code_as_data, 32 push code_as_data, 97 push code_as_data, 110 push code_as_data, 100 push code_as_data, 32 push code_as_data, 114 push code_as_data, 117 push code_as_data, 110 push code_as_data, 10 push code_as_data, 10 push code_as_data, 32 push code_as_data, 32 push code_as_data, 46 push code_as_data, 46 push code_as_data, 47 push code_as_data, 46 push code_as_data, 46 push code_as_data, 47 push code_as_data, 112 push code_as_data, 97 push code_as_data, 114 push code_as_data, 114 push code_as_data, 111 push code_as_data, 116 push code_as_data, 32 push code_as_data, 113 push code_as_data, 117 push code_as_data, 105 push code_as_data, 110 push code_as_data, 101 push code_as_data, 95 push code_as_data, 111 push code_as_data, 114 push code_as_data, 100 push code_as_data, 46 push code_as_data, 112 push code_as_data, 105 push code_as_data, 114 push code_as_data, 32 push code_as_data, 45 push code_as_data, 45 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 110 push code_as_data, 116 push code_as_data, 45 push code_as_data, 99 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 45 push code_as_data, 97 push code_as_data, 115 push code_as_data, 45 push code_as_data, 100 push code_as_data, 97 push code_as_data, 116 push code_as_data, 97 push code_as_data, 10 push code_as_data, 10 push code_as_data, 80 push code_as_data, 97 push code_as_data, 115 push code_as_data, 116 push code_as_data, 101 push code_as_data, 32 push code_as_data, 116 push code_as_data, 104 push code_as_data, 101 push code_as_data, 32 push code_as_data, 111 push code_as_data, 117 push code_as_data, 116 push code_as_data, 112 push code_as_data, 117 push code_as_data, 116 push code_as_data, 32 push code_as_data, 105 push code_as_data, 110 push code_as_data, 32 push code_as_data, 116 push code_as_data, 104 push code_as_data, 101 push code_as_data, 32 push code_as_data, 97 push code_as_data, 112 push code_as_data, 112 push code_as_data, 114 push code_as_data, 111 push code_as_data, 112 push code_as_data, 114 push code_as_data, 105 push code_as_data, 97 push code_as_data, 116 push code_as_data, 101 push code_as_data, 32 push code_as_data, 108 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 116 push code_as_data, 105 push code_as_data, 111 push code_as_data, 110 push code_as_data, 46 push code_as_data, 10 push code_as_data, 10 push code_as_data, 61 push code_as_data, 104 push code_as_data, 101 push code_as_data, 97 push code_as_data, 100 push code_as_data, 49 push code_as_data, 32 push code_as_data, 65 push code_as_data, 85 push code_as_data, 84 push code_as_data, 72 push code_as_data, 79 push code_as_data, 82 push code_as_data, 10 push code_as_data, 10 push code_as_data, 66 push code_as_data, 101 push code_as_data, 114 push code_as_data, 110 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 100 push code_as_data, 32 push code_as_data, 83 push code_as_data, 99 push code_as_data, 104 push code_as_data, 109 push code_as_data, 97 push code_as_data, 108 push code_as_data, 104 push code_as_data, 111 push code_as_data, 102 push code_as_data, 101 push code_as_data, 114 push code_as_data, 32 push code_as_data, 45 push code_as_data, 32 push code_as_data, 60 push code_as_data, 66 push code_as_data, 101 push code_as_data, 114 push code_as_data, 110 push code_as_data, 104 push code_as_data, 97 push code_as_data, 114 push code_as_data, 100 push code_as_data, 46 push code_as_data, 83 push code_as_data, 99 push code_as_data, 104 push code_as_data, 109 push code_as_data, 97 push code_as_data, 108 push code_as_data, 104 push code_as_data, 111 push code_as_data, 102 push code_as_data, 101 push code_as_data, 114 push code_as_data, 64 push code_as_data, 103 push code_as_data, 109 push code_as_data, 120 push code_as_data, 46 push code_as_data, 100 push code_as_data, 101 push code_as_data, 62 push code_as_data, 10 push code_as_data, 10 push code_as_data, 61 push code_as_data, 104 push code_as_data, 101 push code_as_data, 97 push code_as_data, 100 push code_as_data, 49 push code_as_data, 32 push code_as_data, 83 push code_as_data, 69 push code_as_data, 69 push code_as_data, 32 push code_as_data, 65 push code_as_data, 76 push code_as_data, 83 push code_as_data, 79 push code_as_data, 10 push code_as_data, 10 push code_as_data, 76 push code_as_data, 60 push code_as_data, 104 push code_as_data, 116 push code_as_data, 116 push code_as_data, 112 push code_as_data, 58 push code_as_data, 47 push code_as_data, 47 push code_as_data, 119 push code_as_data, 119 push code_as_data, 119 push code_as_data, 46 push code_as_data, 109 push code_as_data, 97 push code_as_data, 100 push code_as_data, 111 push code_as_data, 114 push code_as_data, 101 push code_as_data, 46 push code_as_data, 111 push code_as_data, 114 push code_as_data, 103 push code_as_data, 47 push code_as_data, 126 push code_as_data, 100 push code_as_data, 97 push code_as_data, 118 push code_as_data, 105 push code_as_data, 100 push code_as_data, 47 push code_as_data, 99 push code_as_data, 111 push code_as_data, 109 push code_as_data, 112 push code_as_data, 117 push code_as_data, 116 push code_as_data, 101 push code_as_data, 114 push code_as_data, 115 push code_as_data, 47 push code_as_data, 113 push code_as_data, 117 push code_as_data, 105 push code_as_data, 110 push code_as_data, 101 push code_as_data, 46 push code_as_data, 104 push code_as_data, 116 push code_as_data, 109 push code_as_data, 108 push code_as_data, 62 push code_as_data, 10 push code_as_data, 10 push code_as_data, 61 push code_as_data, 99 push code_as_data, 117 push code_as_data, 116 push code_as_data, 10 push code_as_data, 10 push code_as_data, 35 push code_as_data, 32 push code_as_data, 76 push code_as_data, 111 push code_as_data, 99 push code_as_data, 97 push code_as_data, 108 push code_as_data, 32 push code_as_data, 86 push code_as_data, 97 push code_as_data, 114 push code_as_data, 105 push code_as_data, 97 push code_as_data, 98 push code_as_data, 108 push code_as_data, 101 push code_as_data, 115 push code_as_data, 58 push code_as_data, 10 push code_as_data, 35 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 109 push code_as_data, 111 push code_as_data, 100 push code_as_data, 101 push code_as_data, 58 push code_as_data, 32 push code_as_data, 112 push code_as_data, 105 push code_as_data, 114 push code_as_data, 10 push code_as_data, 35 push code_as_data, 32 push code_as_data, 32 push code_as_data, 32 push code_as_data, 102 push code_as_data, 105 push code_as_data, 108 push code_as_data, 108 push code_as_data, 45 push code_as_data, 99 push code_as_data, 111 push code_as_data, 108 push code_as_data, 117 push code_as_data, 109 push code_as_data, 110 push code_as_data, 58 push code_as_data, 32 push code_as_data, 49 push code_as_data, 48 push code_as_data, 48 push code_as_data, 10 push code_as_data, 35 push code_as_data, 32 push code_as_data, 69 push code_as_data, 110 push code_as_data, 100 push code_as_data, 58 push code_as_data, 10 push code_as_data, 35 push code_as_data, 32 push code_as_data, 118 push code_as_data, 105 push code_as_data, 109 push code_as_data, 58 push code_as_data, 32 push code_as_data, 101 push code_as_data, 120 push code_as_data, 112 push code_as_data, 97 push code_as_data, 110 push code_as_data, 100 push code_as_data, 116 push code_as_data, 97 push code_as_data, 98 push code_as_data, 32 push code_as_data, 115 push code_as_data, 104 push code_as_data, 105 push code_as_data, 102 push code_as_data, 116 push code_as_data, 119 push code_as_data, 105 push code_as_data, 100 push code_as_data, 116 push code_as_data, 104 push code_as_data, 61 push code_as_data, 52 push code_as_data, 32 push code_as_data, 102 push code_as_data, 116 push code_as_data, 61 push code_as_data, 112 push code_as_data, 105 push code_as_data, 114 push code_as_data, 58 push code_as_data, 10 # ------ End of data section ------ # The data section above can be generated with --print-code-as-data # See DESCRIPTION load_bytecode "Getopt/Obj.pbc" # shift name of the program, so that argv contains only options and extra params .local string program_name program_name = shift argv # Specification of command line arguments. .local pmc getopts getopts = new ["Getopt";"Obj"] push getopts, "print-code-as-data" # Looking at command line .local pmc opt opt = getopts."get_options"(argv) .local int do_print_code_as_data do_print_code_as_data = defined opt["print-code-as-data"] unless do_print_code_as_data goto DO_QUINE print_code_as_data( program_name ) end DO_QUINE: # First print the stuff data section print "# Copyright (C) 2006-2010, Parrot Foundation.\n" print "# ATT no autoexpanding svn markers please\n" print "\n" print ".sub quine :main\n" print " .param pmc argv\n" print "\n" print " .local pmc code_as_data\n" print " code_as_data = new 'ResizableIntegerArray'\n" print "# ------ Start of data section ------\n" # Now the data print_data_as_data( code_as_data ) # Now the code print_data_as_code( code_as_data ) .end .sub print_code_as_data .param string program_name .include "stat.pasm" .local pmc code_fh .local int size size = stat program_name, .STAT_FILESIZE code_fh = open program_name, 'r' .local string code code = read code_fh, size # Ignore everything up to end of data section .local int end_of_data_pos end_of_data_pos = index code, "# ------ End of data section ------" code = replace code, 0, end_of_data_pos, '' .local string char_string .local int char_int SHIFT_NEXT_CHAR: unless code goto FINISH_SHIFT_CHARS char_string = substr code, 0, 1 code = replace code, 0, 1, '' char_int = ord char_string print 'push code_as_data, ' print char_int print "\n" goto SHIFT_NEXT_CHAR FINISH_SHIFT_CHARS: .end .sub print_data_as_data .param pmc data .include "iterator.pasm" .local pmc it .local int char_int it = iter data it = .ITERATE_FROM_START # reset iterator, begin at start ITER_LOOP: unless it goto ITER_END # while (entries) ... char_int = shift it # get entry print 'push code_as_data, ' print char_int print "\n" goto ITER_LOOP ITER_END: .end .sub print_data_as_code .param pmc data .include "iterator.pasm" .local pmc it it = iter data it = .ITERATE_FROM_START # reset iterator, begin at start .local int char_int .local string char_string ITER_LOOP: unless it goto ITER_END # while (entries) ... char_int = shift it # get entry char_string = chr char_int print char_string goto ITER_LOOP ITER_END: .end =head1 NAME quine_ord.pir - a quine that store the code in a ResizableIntegerArray =head1 DESCRIPTION When making changes, delete the code between the '# ------' markers and run ../../parrot quine_ord.pir --print-code-as-data Paste the output in the appropriate location. =head1 AUTHOR Bernhard Schmalhofer - =head1 SEE ALSO L =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: Output.pir000644000765000765 1015211715102034 23501 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library/Test/Builder =head1 NAME Test::Builder::Output - manages output for Test::Builder =head1 SYNOPSIS See L. =head1 DESCRIPTION This class controls the output filehandles for Test::Builder. You probably do not need to use it directly. =head1 METHODS This class defines the following methods: =over 4 =cut .namespace [ 'Test'; 'Builder'; 'Output' ] .sub _initialize :load .local pmc tbo_class newclass tbo_class, [ 'Test'; 'Builder'; 'Output' ] addattribute tbo_class, 'output' addattribute tbo_class, 'diag_output' .end =item C Initializes a new Test::Builder::Output object (when you create it with C), passing optional arguments in C. They are: =over 4 =item C An IO PMC for the filehandle to which normal output should go. This uses STDOUT by default. =item C An IO PMC for the filehandle to which diagnostic output should go. This uses STDERR by default. =back =cut .sub init_pmc :vtable :method .param pmc args .local pmc output .local pmc diag_output output = args['output'] unless null output goto CHECK_ERROR_OUTPUT $P0 = getinterp output = $P0.'stdout_handle'() CHECK_ERROR_OUTPUT: diag_output = args['diag_output'] unless null diag_output goto SET_OUTPUT $P0 = getinterp diag_output = $P0.'stdout_handle'() SET_OUTPUT: setattribute self, "output", output setattribute self, "diag_output", diag_output .end .sub output :method .local pmc output getattribute output, self, "output" .return( output ) .end .sub diag_output :method .local pmc diag_output getattribute diag_output, self, "diag_output" .return( diag_output ) .end =item C Writes the string C to the output filehandle, TAP-escaping any unescaped newlines. =cut .sub write :method .param string message .local int message_length message_length = length message if message_length > 0 goto HAVE_MESSAGE .return() HAVE_MESSAGE: message = self.'escape_newlines'( message ) .local pmc output output = self.'output'() output.'print'( message ) .end .sub escape_newlines :method .param string message .local pmc lines lines = new 'ResizableStringArray' .local int newline_index .local string line SPLIT_LOOP: newline_index = index message, "\n" if newline_index == -1 goto END_LOOP inc newline_index line = substr message, 0, newline_index message = replace message, 0, newline_index, '' push lines, line if message goto SPLIT_LOOP END_LOOP: push lines, message # loop from 0 to index of final element, # so keep i less than num_lines .local int num_lines num_lines = lines .local int i i = 0 .local string first_char LOOP: if i == 0 goto LINE_OK line = lines[i] first_char = substr line, 0, 1 if first_char == '#' goto LINE_OK .local string new_line new_line = '# ' new_line = concat new_line, line lines[i] = new_line LINE_OK: inc i if i < num_lines goto LOOP message = join '', lines message = concat message, "\n" .return( message ) .end =item C Writes the string C to the diagnostic filehandle, TAP-escaping any unescaped newlines. =cut .sub diag :method .param pmc args :slurpy .local string message message = join '', args .local int message_length message_length = length message if message_length > 0 goto HAVE_MESSAGE .return() HAVE_MESSAGE: message = self.'escape_newlines'( message ) .local string first_char first_char = substr message, 0, 1 if first_char == '#' goto WRITE_MESSAGE message = concat '# ', message WRITE_MESSAGE: .local pmc diag_output diag_output = self.'diag_output'() .tailcall diag_output.'print'( message ) .end =back =head1 AUTHOR Written and maintained by chromatic, C<< chromatic at wgz dot org >>, based on the Perl 6 port he wrote, based on the original Perl 5 version he wrote with ideas from Michael G. Schwern. Please send patches, feedback, and suggestions to the Perl 6 internals mailing list. =head1 COPYRIGHT Copyright (C) 2005-2008, Parrot Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: trans-infnan.t000644000765000765 1377312135343346 17601 0ustar00brucebruce000000000000parrot-5.9.0/t/dynoplibs#!./parrot # Copyright (C) 2010, Parrot Foundation. =head1 NAME t/dynoplibs/trans-infnan.t - Test Trans Dynops =head1 SYNOPSIS %prove t/dynoplibs/trans-infnan.t =head1 DESCRIPTION Tests for C and C handling of transcendental ops in the C dynlib. =cut .loadlib 'trans_ops' .sub main :main .include 'test_more.pir' plan(68) test_exp() test_sin() test_sinh() test_asin() test_cos() test_cosh() test_acos() test_tan() test_tanh() test_atan() test_cot() test_coth() test_acot() test_sec() test_csc() test_sech() test_asec() test_ln() test_log10() test_log2() test_pow() .end .sub test_exp $N0 = 'Inf' $N1 = exp $N0 is($N1, 'Inf', 'exp: exp Inf') $N0 = '-Inf' $N1 = exp $N0 is($N1, 0, '... exp -Inf') $N0 = 'NaN' $N1 = exp $N0 is($N1, 'NaN', '... exp NaN') .end .sub test_sin $N0 = 'Inf' $N1 = sin $N0 is($N1, 'NaN', 'sin: sin Inf') $N0 = '-Inf' $N1 = sin $N0 is($N1, 'NaN', '... sin -Inf') $N0 = 'NaN' $N1 = sin $N0 is($N1, 'NaN', '... sin NaN') .end .sub test_sinh $N0 = 'Inf' $N1 = sinh $N0 is($N1, 'Inf', 'sinh: sinh Inf') $N0 = '-Inf' $N1 = sinh $N0 is($N1, '-Inf', '... sinh -Inf') $N0 = 'NaN' $N1 = sinh $N0 is($N1, 'NaN', '... sinh NaN') .end .sub test_asin $N0 = 'Inf' $N1 = asin $N0 is($N1, 'NaN', 'asin: asin Inf') $N0 = '-Inf' $N1 = asin $N0 is($N1, 'NaN', '... asin -Inf') $N0 = 'NaN' $N1 = asin $N0 is($N1, 'NaN', '... asin NaN') $N0 = '-2' $N1 = asin $N0 is($N1, 'NaN', '... asin -2') $N0 = '2' $N1 = asin $N0 is($N1, 'NaN', '... asin 2') .end .sub test_acos $N0 = 'Inf' $N1 = acos $N0 is($N1, 'NaN', 'acos: acos Inf') $N0 = '-Inf' $N1 = acos $N0 is($N1, 'NaN', '... acos -Inf') $N0 = 'NaN' $N1 = acos $N0 is($N1, 'NaN', '... acos NaN') $N0 = '-2' $N1 = acos $N0 is($N1, 'NaN', '... acos -2') $N0 = '2' $N1 = acos $N0 is($N1, 'NaN', '... acos 2') .end .sub test_cosh $N0 = 'Inf' $N1 = cosh $N0 is($N1, 'Inf', 'cosh: cosh Inf') $N0 = '-Inf' $N1 = cosh $N0 is($N1, 'Inf', '... cosh -Inf') $N0 = 'NaN' $N1 = cosh $N0 is($N1, 'NaN', '... cosh NaN') .end .sub test_cos $N0 = 'Inf' $N1 = cos $N0 is($N1, 'NaN', 'cos: cos Inf') $N0 = '-Inf' $N1 = cos $N0 is($N1, 'NaN', '... cos -Inf') $N0 = 'NaN' $N1 = cos $N0 is($N1, 'NaN', '... cos NaN') .end .sub test_tan $N0 = 'Inf' $N1 = tan $N0 is($N1, 'NaN', 'tan: tan Inf') $N0 = '-Inf' $N1 = tan $N0 is($N1, 'NaN', '... tan -Inf') $N0 = 'NaN' $N1 = tan $N0 is($N1, 'NaN', '... tan NaN') .end .sub test_tanh $N0 = 'Inf' $N1 = tanh $N0 is($N1, 1, 'tanh: tanh Inf') $N0 = '-Inf' $N1 = tanh $N0 is($N1, -1, '... tanh -Inf') $N0 = 'NaN' $N1 = tanh $N0 is($N1, 'NaN', '... tanh NaN') .end .sub test_atan $N0 = 'Inf' $N1 = atan $N0 $P1 = new 'Float' $P1 = $N1 is($P1, 1.5707963, 'atan: atan Inf',1e-6) $N0 = '-Inf' $N1 = atan $N0 $P1 = new 'Float' $P1 = $N1 is($P1, -1.5707963, '... atan -Inf',1e-6) $N0 = 'NaN' $N1 = atan $N0 is($N1, 'NaN', '... atan NaN') .end .sub test_coth $N0 = 'Inf' $N1 = coth $N0 $P1 = new 'Float' $P1 = $N1 is($P1, 1, 'coth: coth Inf') $N0 = '-Inf' $N1 = coth $N0 is($N1, -1, '... coth -Inf') $N0 = 'NaN' $N1 = coth $N0 is($N1, 'NaN', '... coth NaN') .end .sub test_acot $N0 = 'Inf' $N1 = acot $N0 is($N1, '0', 'acot: acot Inf') $N0 = '-Inf' $N1 = acot $N0 is($N1, '-0', '... acot -Inf') $N0 = 'NaN' $N1 = acot $N0 is($N1, 'NaN', '... acot NaN') .end .sub test_sec $N0 = 'Inf' $N1 = sec $N0 is($N1, 'NaN', 'sec: sec Inf') $N0 = '-Inf' $N1 = sec $N0 is($N1, 'NaN', '... sec -Inf') $N0 = 'NaN' $N1 = sec $N0 is($N1, 'NaN', '... sec NaN') .end .sub test_csc $N0 = 'Inf' $N1 = csc $N0 is($N1, 'NaN', 'csc: csc Inf') $N0 = '-Inf' $N1 = csc $N0 is($N1, 'NaN', '... csc -Inf') $N0 = 'NaN' $N1 = csc $N0 is($N1, 'NaN', '... csc NaN') .end .sub test_sech $N0 = 'Inf' $N1 = sech $N0 is($N1, 0, 'sech: sech Inf') $N0 = '-Inf' $N1 = sech $N0 is($N1, 0, '... sech -Inf') $N0 = 'NaN' $N1 = sech $N0 is($N1, 'NaN', '... sech NaN') .end .sub test_asec $N0 = 'Inf' $N1 = asec $N0 $P1 = new 'Float' $P1 = $N1 is($P1, 1.5707963, 'asec: asec Inf',1e-6) $N0 = '-Inf' $N1 = asec $N0 $P1 = $N1 is($P1, 1.5707963, '... asec -Inf',1e-6) $N0 = 'NaN' $N1 = asec $N0 is($N1, 'NaN', 'asec NaN') .end .sub test_ln $N0 = 'Inf' $N1 = ln $N0 is($N1, 'Inf', 'ln: ln Inf') $N0 = '-Inf' $N1 = ln $N0 is($N1, 'NaN', '... ln Inf') $N0 = 'NaN' $N1 = ln $N0 is($N1, 'NaN', '... ln NaN') .end .sub test_log10 $N0 = 'Inf' $N1 = log10 $N0 is($N1, 'Inf', 'log10: log10 Inf') $N0 = '-Inf' $N1 = log10 $N0 is($N1, 'NaN', '... log10 -Inf') $N0 = 'NaN' $N1 = log10 $N0 is($N1, 'NaN', '... log10 NaN') .end .sub test_log2 $N0 = 'Inf' $N1 = log2 $N0 is($N1, 'Inf', 'log2: log2 Inf') $N0 = '-Inf' $N1 = log2 $N0 is($N1, 'NaN', '... log2 -Inf') $N0 = 'NaN' $N1 = log2 $N0 is($N1, 'NaN', '... log2 -Inf') .end .sub test_cot $N0 = 'Inf' $N1 = cot $N0 is($N1, 'NaN', 'cot: cot Inf') $N0 = '-Inf' $N1 = cot $N0 is($N1, 'NaN', '... cot -Inf') $N0 = 'NaN' $N1 = cot $N0 is($N1, 'NaN', '... cot NaN') .end .sub test_pow $N0 = 'Inf' pow $N1, $N0, 2 is($N1, 'Inf', 'pow: Inf ^ 2') pow $N1, 2, $N0 is($N1, 'Inf', '...: 2 ^ Inf') $N0 = 'NaN' pow $N1, $N0, 2 is($N1, 'NaN', '...: NaN ^ 2') pow $N1, 2, $N0 is($N1, 'NaN', '...: 2 ^ NaN') .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: string_pmc_bitwise.t000644000765000765 1327211533177644 21077 0ustar00brucebruce000000000000parrot-5.9.0/t/dynoplibs#!./parrot # Copyright (C) 2010, Parrot Foundation. =head1 NAME t/dynoplibs/string_pmc_bitwise.t - Bitwise dynops on String PMC =head1 SYNOPSIS % prove t/dynoplibs/string-pmc_bitwise.t =head1 DESCRIPTION Test C dynops lib on C PMC. =cut .loadlib 'bit_ops' .sub main :main .include 'test_more.pir' plan(47) bands_null_string() test_bands_2() test_bands_3() bors_null_string() test_bors_2() test_bors_3() bxors_null_string() bxors_2() bxors_3() bnots_null_string() .end .sub bands_null_string new $P1, ['String'] new $P2, ['String'] new $P3, ['String'] null $S1 set $P1, $S1 set $S2, "abc" set $P2, $S2 bands $P1, $P2 null $S3 set $P3, $S3 is( $P1, $P3, 'band null, "abc" -> null' ) set $P1, "" bands $P1, $P2 nok( $P1, 'band "", "abc" -> false' ) null $S2 set $P2, $S2 set $P1, "abc" bands $P1, $P2 null $S3 set $P3, $S3 is( $P1, $P3, 'bands "abc", null -> null' ) set $P2, "" bands $P1, $P2 nok( $P1, 'bans "abc", "" -> false' ) .end .sub test_bands_2 new $P1, ['String'] new $P2, ['String'] set $P1, "abc" set $P2, "EE" bands $P1, $P2 is( $P1, "A@", 'bands "abc", "EE" -> "A@"' ) is( $P2, "EE", '$2 is unchanged' ) .end .sub test_bands_3 new $P1, ['String'] new $P2, ['String'] new $P0, ['String'] set $P1, "abc" set $P2, "EE" bands $P0, $P1, $P2 is( $P0, "A@", 'bands "abc", "EE" -> "A@"' ) is( $P1, "abc", '$2 is unchanged' ) is( $P2, "EE", '$3 is unchanged' ) .end .sub bors_null_string new $P1, ['String'] new $P2, ['String'] new $P3, ['String'] null $S1 null $S2 set $P1, $S1 set $P2, $S2 bors $P1, $P2 null $S3 set $P3, $S3 is( $P1, $P3, 'bors null, null -> null' ) null $S1 set $P1, $S1 set $P2, "" bors $P1, $P2 null $S3 set $P3, $S3 is( $P1, $P3, 'bors null, "" -> null' ) bors $P2, $P1 is( $P2, $P3, 'bors "", null -> null' ) null $S1 set $P1, $S1 set $P2, "def" bors $P1, $P2 is( $P1, "def", 'bors null, "def" -> "def" / true' ) null $S2 set $P2, $S2 bors $P1, $P2 is( $P1, "def", 'bors "def", null -> "def" / true' ) null $S1 null $S2 set $P1, $S1 set $P2, $S2 bors $P3, $P1, $P2 null $S4 is( $P3, $S4, 'bors null, null -> null' ) set $P1, "" bors $P3, $P1, $P2 is( $P3, $S4, 'bors "", null -> null' ) bors $P3, $P2, $P1 is( $P3, $S4, 'bors null, "" -> null' ) set $P1, "def" bors $P3, $P1, $P2 is( $P3, "def", 'bors "def", null -> "def"' ) bors $P3, $P2, $P1 is( $P3, "def", 'bors null, "def" -> "def"' ) .end .sub test_bors_2 new $P1, ['String'] new $P2, ['String'] set $P1, "abc" set $P2, "EE" bors $P1, $P2 is( $P1, "egc", 'bors "abc", "EE" -> "egc"' ) is( $P2, "EE", '$2 is unchanged' ) .end .sub test_bors_3 new $P1, ['String'] new $P2, ['String'] new $P0, ['String'] set $P1, "abc" set $P2, "EE" bors $P0, $P1, $P2 is( $P0, "egc", 'bors "abc", "EE" -> "egc"' ) is( $P1, "abc", '$2 unchanged' ) is( $P2, "EE", '$3 unchanged' ) .end .sub bxors_null_string new $P1, ['String'] new $P2, ['String'] new $P3, ['String'] null $S1 null $S2 set $P1, $S1 set $P2, $S2 bxors $P1, $P2 null $S3 is( $P1, $S3, 'bxors null, null -> null' ) null $S1 set $P1, $S1 set $P2, "" bxors $P1, $P2 null $S3 is( $P1, $S3, 'bxors null, "" -> null' ) bxors $P2, $P1 is( $S2, $S3, 'bxors "", null -> null' ) null $S1 set $P1, $S1 set $P2, "abc" bxors $P1, $P2 is( $P1, "abc", 'bxors null, "abc" -> "abc"' ) null $S2 set $P2, $S2 bxors $P1, $P2 is( $P1, "abc", 'bxors "abc", "null, -> "abc"' ) null $S1 null $S2 set $P1, $S1 set $P2, $S2 bxors $P3, $P1, $P2 null $S4 is( $P3, $S4, 'bxors3 null, null -> null' ) set $P1, "" bxors $P3, $P1, $P2 is( $P3, $S4, 'bxors3 "", null -> null' ) bxors $P3, $P2, $P1 is( $P3, $S4, 'bxors3 null, null -> null' ) set $P1, "abc" bxors $P3, $P1, $P2 is( $P3, "abc", 'bxors3 "abc", null -> "abc"' ) bxors $P3, $P2, $P1 is( $P3, "abc", 'bxors3 null, "abc" -> "abc"' ) .end .sub bxors_2 new $P1, ['String'] new $P2, ['String'] new $P3, ['String'] set $P1, "a2c" set $P2, "Dw" bxors $P1, $P2 is( $P1, "%Ec", 'bxors "a2c", "Dw" -> "%Ec"' ) is( $P2, "Dw", '... $2 unchanged' ) set $P1, "abc" set $P2, " X" bxors $P1, $P2 is( $P1, "ABCX", 'bxors "abc", " X" -> "ABCX"' ) is( $P2, " X", '... $2 unchanged' ) .end .sub bxors_3 new $P1, ['String'] new $P2, ['String'] new $P0, ['String'] set $P1, "a2c" set $P2, "Dw" bxors $P0, $P1, $P2 is( $P0, "%Ec", 'bxors "a2c", "Dw" -> "%Ec"' ) is( $P1, "a2c", '... $2 unchanged' ) is( $P2, "Dw", '... $3 unchanged' ) set $P1, "abc" set $P2, " Y" bxors $P0, $P1, $P2 is( $P0, "ABCY", 'bxors "abc", " Y" -> "ABCY"' ) is( $P1, "abc", '... $2 unchanged' ) is( $P2, " Y", '... $3 unchanged' ) .end .sub bnots_null_string new $P1, ['String'] new $P2, ['String'] new $P3, ['String'] null $S1 null $S2 set $P1, $S1 set $P2, $S2 bnots $P1, $P2 null $S3 is( $P1, $S3, 'bnots null, null -> null' ) null $S1 set $P1, $S1 set $P2, "" bnots $P1, $P2 null $S3 is( $P1, $S3, 'bnots null, "" -> null' ) bnots $P2, $P1 is( $S2, $S3, 'bnots "", null -> null' ) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: euclid.pir000644000765000765 205111533177634 17112 0ustar00brucebruce000000000000parrot-5.9.0/examples/pir# Copyright (C) 2001-2008, Parrot Foundation. # This program is free software. It is subject to the same # license as Perl itself. =head1 NAME examples/pir/euclid.pir - Euclid's algorithm =head1 SYNOPSIS % ./parrot examples/pir/euclid.pir =head1 DESCRIPTION Implements Euclid's algorithm (http://www.cut-the-knot.org/blue/Euclid.shtml) and uses it to compute C. Knuth, Donald E. I. Third Edition. Section 1.1 Algorithm E (Euclid's algorithm) Page 2: I1: m I2: n I4: r E1: Find remainder. E2: Is it zero? E3: Reduce. =cut .sub 'example' :main $I1 = 96 $I2 = 64 print "Algorithm E (Euclid's algorithm)\n" e1: $I4 = mod $I1, $I2 e2: unless $I4 goto done e3: $I1 = $I2 $I2 = $I4 branch e1 done: print "The greatest common denominator of 96 and 64 is " print $I2 print ".\n" .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: handle.t000644000765000765 234411533177645 15172 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc#!./parrot # Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME t/pmc/handle.t - Handle basic type =head1 SYNOPSIS % prove t/pmc/handle.t =head1 DESCRIPTION Tests the Handle PMC. Handle is abstract, so no real tests of functionality here. =cut .sub main :main .include 'test_more.pir' plan(3) 'test_create'() 'test_does_tt_1473'() .end .sub 'test_create' push_eh cant_instantiate $P0 = new 'Handle' ok(0, "Can instantiate an abstract type") pop_eh goto create_end cant_instantiate: ok(1, "Cannot instantiate an abstract type") pop_eh create_end: $P1 = new ['String'] push_eh cant_instantiate_arg $P0 = new ['Handle'], $P1 ok(0, "Can instantiate an abstract type with arg") pop_eh goto create_end_arg cant_instantiate_arg: ok(1, "Cannot instantiate an abstract type with arg") pop_eh create_end_arg: .end .sub 'test_does_tt_1473' push_eh cant_do_does $P0 = get_class 'Handle' $I0 = does $P0, 'Handle' ok($I0, "Handle does Handle") goto does_end cant_do_does: ok(0, "Does throws an exception") does_end: pop_eh .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: inf_nan.t000644000765000765 1131111715102034 15176 0ustar00brucebruce000000000000parrot-5.9.0/t/op#!./parrot # Copyright (C) 2009-2010, Parrot Foundation. =head1 NAME t/op/inf_nan.t - Test math properties of Inf and NaN =head1 SYNOPSIS % prove t/op/inf_nan.t =head1 DESCRIPTION Tests for mathematical operations with Inf and Nan. =cut .sub main :main .include 'test_more.pir' plan(42) test_basic_arith() test_sqrt() test_neg() test_mix_nan_inf() test_is_inf_or_nan() test_rounding_n() test_rounding_i() test_nan_complex() test_fdiv_integer_pmc_nan() test_fdiv_float_pmc_nan() test_fdiv_float_integer_pmc_nan() test_mod_float_integer_pmc_nan() .end .sub test_basic_arith $N0 = 'Inf' is($N0, 'Inf', 'basic arithmetic: =') $N0 -= $N0 is($N0, 'NaN', '... -=') $N0 *= -1 is($N0, 'NaN', '... *= -1') $N0 *= 0 is($N0, 'NaN', '... *= 0') $N0 += 5 is($N0, 'NaN', '... += 5') $N0 -= 42 is($N0, 'NaN', '... -= 42') inc $N0 is($N0, 'NaN', '... inc') dec $N0 is($N0, 'NaN', '... dec') $N2 = abs $N0 is($N2, 'NaN', '... abs NaN') $N1 = 'Inf' $N3 = abs $N1 is($N3, 'Inf', '... abs Inf') $N1 = '-Inf' $N3 = abs $N1 is($N3, 'Inf', '... abs -Inf') .end .sub test_sqrt $N0 = 'Inf' $N1 = $N0 is($N1, 'Inf', 'sqrt: assignment') $N0 = '-Inf' $N1 = sqrt $N0 is($N1, 'NaN', '... sqrt -Inf') $N0 = 'NaN' $N1 = sqrt $N0 is($N1, 'NaN', '... sqrt NaN') $N0 = -1 $N1 = sqrt $N0 is($N1, 'NaN', '... sqrt -1') .end .sub test_neg $N0 = 'Inf' $N1 = neg $N0 is($N1, '-Inf', 'negative: neg Inf') $N0 = '-Inf' $N1 = neg $N0 is($N1, 'Inf', '... neg -Inf') $N0 = 'NaN' $N1 = neg $N0 is($N1, 'NaN', '... neg NaN') .end .sub test_mix_nan_inf $N0 = 'NaN' $N1 = 'Inf' $N0 *= $N1 is($N0, 'NaN', 'mixing NaN and Inf: NaN * Inf') $N0 /= $N1 is($N0, 'NaN', '... NaN / Inf') $N0 -= $N1 is($N0, 'NaN', '... NaN - Inf') $N0 += $N1 is($N0, 'NaN', '... NaN + Inf') .end .sub test_rounding_n $N0 = 'NaN' $N1 = floor $N0 is($N1, 'NaN', 'rounding n: floor NaN') $N2 = ceil $N0 is($N2, 'NaN', '... ceil NaN') $N0 = 'Inf' $N1 = floor $N0 is($N1, 'Inf', '... floor Inf') $N2 = ceil $N0 is($N2, 'Inf', '... ceil Inf') $N0 = '-Inf' $N1 = floor $N0 is($N1, '-Inf', '... floor -Inf') $N2 = ceil $N0 is($N2, '-Inf', '... ceil -Inf') .end .sub test_is_inf_or_nan $N0 = 'NaN' $I0 = is_inf_or_nan $N0 ok($I0, 'is_inf_or_nan NaN') $N0 = 'Inf' $I0 = is_inf_or_nan $N0 ok($I0, 'is_inf_or_nan Inf') $N0 = '-Inf' $I0 = is_inf_or_nan $N0 ok($I0, 'is_inf_or_nan -Inf') $N0 = 0 $I0 = is_inf_or_nan $N0 $I1 = not $I0 ok($I1, 'is_inf_or_nan 0') $N0 = 123.4e5 $I0 = is_inf_or_nan $N0 $I1 = not $I0 ok($I1, 'is_inf_or_nan 123.4e5') .end #pir_output_is(<<'CODE',<s. This includes read, write, allocate, and deallocate operations. Bounds checking is implemented where the pointer class reports a non-zero bound. Recursive definition through nesting is not supported but can be emulated by interpreting pointer or buffer elements as structs once dereferenced. Elements are get/set using keyed access of the form C<[Ptr; Idx]>, which will interpret the C PMC and lookup the C'th element. =head2 Vtables and Methods =over 4 =cut */ #include "pmc/pmc_ptrobj.h" BEGIN_PMC_HEADER_PREAMBLE typedef enum { int_access = 1, unaligned_access, num_access, str_access, pmc_access } elt_access_t; typedef struct elt_desc_t { elt_access_t access; PARROT_DATA_TYPE type; size_t byte_offset; unsigned char bit_offset; size_t size; } elt_desc_t; END_PMC_HEADER_PREAMBLE /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_DOES_NOT_RETURN static void buffer_too_small(PARROT_INTERP, size_t self_size, size_t buf_size) __attribute__nonnull__(1); static void deallocate_ptrobj(PARROT_INTERP, PMC *obj, ARGFREE(void *ptr)); PARROT_DOES_NOT_RETURN static void dereference_null(PARROT_INTERP) __attribute__nonnull__(1); PARROT_DOES_NOT_RETURN static void dereference_unaligned(PARROT_INTERP, ARGIN(const void *base_ptr), size_t align) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_DOES_NOT_RETURN static void index_out_of_bounds(PARROT_INTERP, INTVAL i) __attribute__nonnull__(1); #define ASSERT_ARGS_buffer_too_small __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_deallocate_ptrobj __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) #define ASSERT_ARGS_dereference_null __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_dereference_unaligned __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(base_ptr)) #define ASSERT_ARGS_index_out_of_bounds __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ #define ALIGN_UP(addr, align) (((addr) + ((align) - 1)) & ~((align) - 1)) #define MAX(x, y) ((y) > (x) ? (y) : (x)) #define BEGIN_KEYED(interp, s, k) \ size_t n_elts; \ elt_desc_t *elts; \ PMC *ptr_pmc; \ void *ptr, *base_ptr; \ INTVAL i; \ PMC *orig_k = (k); \ GETATTR_StructView_n_elts((interp), (s), n_elts); \ GETATTR_StructView_elts((interp), (s), elts); \ ptr_pmc = Parrot_key_pmc((interp), (k)); \ (k) = Parrot_key_next((interp), (k)); \ i = Parrot_key_integer((interp), (k)); \ (k) = orig_k; \ if (i < 0 || n_elts <= (size_t)i) \ index_out_of_bounds((interp), i); \ base_ptr = VTABLE_get_pointer((interp), ptr_pmc); \ ptr = ((char *)base_ptr) + elts[i].byte_offset; \ /* guard against null pointer dereference */ \ if (!base_ptr) \ dereference_null((interp)); \ /* guard against out of bounds access */ \ { \ size_t buf_size = VTABLE_get_integer((interp), ptr_pmc); \ size_t self_size; \ GETATTR_StructView_size((interp), (s), self_size); \ if (buf_size && buf_size < self_size) \ buffer_too_small((interp), self_size, buf_size); \ } \ /* guard against unaligned access */ \ { \ size_t align; \ GETATTR_StructView_align((interp), (s), align); \ if ((size_t)base_ptr != ALIGN_UP((size_t)base_ptr, align)) \ dereference_unaligned((interp), base_ptr, align); \ } pmclass StructView auto_attrs { ATTR PARROT_DATA_TYPE pack_type; ATTR size_t n_elts; ATTR elt_desc_t *elts; ATTR size_t align; ATTR size_t size; /* =item C Creating an instance without an initializer is dissallowed and will throw an exception. =cut */ VTABLE void init() { Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Meaningless creation of %Ss without initializer", SELF->vtable->whoami); } /* =item C Create a new StructView for viewing buffers as described by the initializer. An initializer is an array-aggregate of integers. For example, C will work for this purpose. The first element of the initializer is interpreted as the type of the C. There are three supported types of view: struct, indicated with the C flag; union, indicated with the C flag; and custom, indicated with the C flag. The second element of the initializer is interpreted as the number of elements contained within the view. If using a custom view, the third and fourth elements are interpreted as the size and alignment in bytes respectively. The remainder of the initializer is interpreted as a description of the elements of the view. For struct and union views, elements are described by a single integer flag from C, with layout being determined automatically identical to what your C compiler would have done. For custom views, elements are represented by a 3-tuple of C<{type, byte-offset, bit-offset}>, which can be used for arbitrary layouts. Note, however, that unaligned access is only supported on unsigned integers, and even then, it is inefficient. You have been warned. Supported element types are include: =over 4 =item Parrot Types C, C, C, and C =item C-Native Types Integer: C, C, C, C, C, C, C, C, C (*), and C (*) Float: C, C, C PMC: data pointer (C), function pointer (C), buffer (C) (**) (*) Only available if your C system sports a C type. (**) Requires 2 additional following parameters - buffer size and alignment. =item Explicitly Sized Types C (also known as C), C, C, C, C, C, C, C, C(*), and C(*) (*) Only available if your C system sports a 64 bit integer type. =back =cut */ VTABLE void init_pmc(PMC *p) { const INTVAL init_len = VTABLE_elements(INTERP, p); const PARROT_DATA_TYPE pack_type = (PARROT_DATA_TYPE) VTABLE_get_integer_keyed_int(INTERP, p, 0); const INTVAL n_elts = VTABLE_get_integer_keyed_int(INTERP, p, 1); elt_desc_t *elt_ary; size_t bit_cursor = 0; size_t byte_cursor = 0; size_t size, align; int incr, i, j; switch (pack_type) { case enum_type_struct: case enum_type_union: size = 0; align = 1; /* sorry, no sub-byte alignment */ incr = 1; i = 2; break; case enum_type_sized: size = VTABLE_get_integer_keyed_int(INTERP, p, 2); align = VTABLE_get_integer_keyed_int(INTERP, p, 3); incr = 3; i = 4; break; default: Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Unknown struct type `%Ss'", Parrot_dt_get_datatype_name(INTERP, pack_type)); } if (init_len < n_elts + i) Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Initializer too short (%d) for struct type `%Ss' with %d elements", init_len, Parrot_dt_get_datatype_name(INTERP, pack_type), n_elts); elt_ary = mem_gc_allocate_n_zeroed_typed(INTERP, n_elts, elt_desc_t); PObj_custom_destroy_SET(SELF); SET_ATTR_pack_type(INTERP, SELF, pack_type); SET_ATTR_elts(INTERP, SELF, elt_ary); SET_ATTR_n_elts(INTERP, SELF, n_elts); for (/* i already initialized */ j = 0; i < init_len && j < n_elts; i += incr, j++) { elt_desc_t * const elt = &elt_ary[j]; const PARROT_DATA_TYPE elt_type = (PARROT_DATA_TYPE) VTABLE_get_integer_keyed_int(INTERP, p, i); size_t elt_size, elt_align; elt_access_t elt_access; if ((elt_type & ~enum_type_ref_flag) < enum_first_type || (elt_type & ~enum_type_ref_flag) >= enum_last_type) Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Invalid type flag for struct element (%d)", elt_type); elt->type = elt_type; elt_size = data_types[elt_type - enum_first_type].size; elt_align = data_types[elt_type - enum_first_type].align; switch (elt_type) { /* aligned integer types */ case enum_type_INTVAL: case enum_type_char: case enum_type_short: case enum_type_int: case enum_type_long: #if PARROT_HAS_LONGLONG case enum_type_longlong: #endif case enum_type_int8: case enum_type_int16: case enum_type_int32: #if PARROT_HAS_INT64 case enum_type_int64: #endif case enum_type_uchar: case enum_type_ushort: case enum_type_uint: case enum_type_ulong: #if PARROT_HAS_LONGLONG case enum_type_ulonglong: #endif case enum_type_uint8: case enum_type_uint16: case enum_type_uint32: #if PARROT_HAS_INT64 case enum_type_uint64: #endif elt_access = int_access; break; /* unaligned integer types */ case enum_type_uint1: case enum_type_uint4: elt_access = unaligned_access; break; /* float types */ case enum_type_FLOATVAL: case enum_type_float: case enum_type_double: case enum_type_longdouble: elt_access = num_access; break; /* other types */ case enum_type_STRING: elt_access = str_access; break; case enum_type_sized: /* arbitrary buffers extended with size and align fields */ elt->size = elt_size = VTABLE_get_integer_keyed_int(INTERP, p, ++i); elt_align = VTABLE_get_integer_keyed_int(INTERP, p, ++i); /* fallthrough */ case enum_type_PMC: case enum_type_ptr: case enum_type_func_ptr: elt_access = pmc_access; break; /* locally unsupported types */ #if !PARROT_HAS_LONGLONG case enum_type_longlong: case enum_type_ulonglong: #endif #if !PARROT_HAS_INT64 case enum_type_int64: case enum_type_uint64: #endif Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Unsupported struct element type `%Ss' (index %d)", Parrot_dt_get_datatype_name(INTERP, elt_type), j); default: Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Unknown struct element type `%Ss' (index %i)", Parrot_dt_get_datatype_name(INTERP, elt_type), j); } switch (pack_type) { case enum_type_struct: elt->access = elt_access; align = MAX(align, elt_align); switch (elt_access) { case int_access: case num_access: case pmc_access: if (bit_cursor) { byte_cursor += 1; bit_cursor = 0; } elt->byte_offset = ALIGN_UP(byte_cursor, elt_align); byte_cursor = elt->byte_offset + elt_size; break; case unaligned_access: elt->byte_offset = byte_cursor; elt->bit_offset = bit_cursor; byte_cursor = (bit_cursor + 1) / 8; bit_cursor = (bit_cursor + 1) % 8; break; default: break; } break; case enum_type_union: elt->access = elt_access; size = MAX(size, elt_size); align = MAX(align, elt_align); /* all union elements are at 0 offset */ break; case enum_type_sized: elt->byte_offset = VTABLE_get_integer_keyed_int(INTERP, p, i + 1); elt->bit_offset = VTABLE_get_integer_keyed_int(INTERP, p, i + 2); switch (elt_access) { case num_access: case str_access: case pmc_access: if (align < elt_align || elt->bit_offset || elt->byte_offset % elt_align) Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Unaligned access unsupported on type `%Ss' (index: %i)", Parrot_dt_get_datatype_name(INTERP, elt_type), j); elt->access = elt_access; break; case int_access: if (align < elt_align || elt->bit_offset || elt->byte_offset % elt_align) { switch (elt_type) { case enum_type_uchar: case enum_type_ushort: case enum_type_uint: case enum_type_ulong: #if PARROT_HAS_LONGLONG case enum_type_ulonglong: #endif case enum_type_uint8: case enum_type_uint16: case enum_type_uint32: #if PARROT_HAS_INT64 case enum_type_uint64: #endif elt->access = unaligned_access; break; default: Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Unaligned access unsupported on type `%Ss' (index: %i)", Parrot_dt_get_datatype_name(INTERP, elt_type), j); } } else { elt->access = int_access; } break; case unaligned_access: elt->access = unaligned_access; break; default: break; } default: break; } } if (pack_type == enum_type_struct) { size = byte_cursor + !!bit_cursor; } SET_ATTR_align(INTERP, SELF, align); SET_ATTR_size(INTERP, SELF, size); } /* =item C Free internal offsets array. =cut */ VTABLE void destroy() { elt_desc_t *elts; GET_ATTR_elts(INTERP, SELF, elts); mem_gc_free(INTERP, elts); } /* =item C =item C Get/Set an integer-type element from a struct-pointer PMC. =cut */ VTABLE INTVAL get_integer_keyed(PMC *k) { BEGIN_KEYED(INTERP, SELF, k) switch (elts[i].access) { case int_access: switch (elts[i].type) { #define CASE_RET2(type, name) \ case enum_type_ ## name: return *(type *)ptr; #define CASE_RET1(type) \ CASE_RET2(type, type) \ CASE_RET2(unsigned type, u ## type) CASE_RET2(INTVAL, INTVAL) CASE_RET1(char); CASE_RET1(short); CASE_RET1(int); CASE_RET1(long); #if PARROT_HAS_LONGLONG CASE_RET2(long long, longlong); CASE_RET2(unsigned long long, ulonglong); #endif CASE_RET2(Parrot_Int1, int8); CASE_RET2(Parrot_UInt1, uint8); CASE_RET2(Parrot_Int2, int16); CASE_RET2(Parrot_UInt2, uint16); CASE_RET2(Parrot_Int4, int32); CASE_RET2(Parrot_UInt4, uint32); #if PARROT_HAS_INT64 CASE_RET2(Parrot_Int8, int64); CASE_RET2(Parrot_UInt8, uint64); #endif #undef CASE_RET1 #undef CASE_RET2 default: break; } /* should not get here - inserted to avoid compiler warnings */ return 0; case unaligned_access: { INTVAL acc = 0; size_t bits, n; unsigned char *cptr = (unsigned char *)ptr; switch (elts[i].type) { case enum_type_uint1: bits = 1; break; case enum_type_uint4: bits = 4; break; default: bits = 8 * data_types[elts[i].type - enum_first_type].size; break; } /* fetch hi bits of first byte */ acc = *cptr++ >> elts[i].bit_offset; n = 8 - elts[i].bit_offset; /* read whole bytes until complete */ while (n < bits) { acc |= ((UINTVAL)*cptr++) << n; n += 8; } /* mask off hi bits of last byte */ acc &= (~(UINTVAL)0) >> (sizeof (UINTVAL) * 8 - bits); return acc; } /* should not get here - inserted to avoid compiler warnings */ return 0; default: Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Not a valid integer type (`%Ss')", Parrot_dt_get_datatype_name(INTERP, elts[i].type)); } } VTABLE void set_integer_keyed(PMC *k, INTVAL x) { BEGIN_KEYED(INTERP, SELF, k) switch (elts[i].access) { case int_access: switch (elts[i].type) { #define CASE_SET2(type, name) \ case enum_type_ ## name: *(type *)ptr = x; return; #define CASE_SET1(type) \ CASE_SET2(type, type) \ CASE_SET2(unsigned type, u ## type) CASE_SET2(INTVAL, INTVAL) CASE_SET1(char); CASE_SET1(short); CASE_SET1(int); CASE_SET1(long); #if PARROT_HAS_LONGLONG CASE_SET2(long long, longlong); CASE_SET2(unsigned long long, ulonglong); #endif CASE_SET2(Parrot_Int1, int8); CASE_SET2(Parrot_UInt1, uint8); CASE_SET2(Parrot_Int2, int16); CASE_SET2(Parrot_UInt2, uint16); CASE_SET2(Parrot_Int4, int32); CASE_SET2(Parrot_UInt4, uint32); #if PARROT_HAS_INT64 CASE_SET2(Parrot_Int8, int64); CASE_SET2(Parrot_UInt8, uint64); #endif #undef CASE_SET1 #undef CASE_SET2 default: break; } break; case unaligned_access: { UINTVAL ux = x; size_t bits, n; unsigned char tempc = 0; unsigned char *cptr = (unsigned char *)ptr; switch (elts[i].type) { case enum_type_uint1: bits = 1; break; case enum_type_uint4: bits = 4; break; default: bits = 8 * data_types[elts[i].type - enum_first_type].size; break; } /* cache last byte (for restoring hi bits) */ if (bits > 1) { tempc = cptr[(bits + elts[i].bit_offset - 1)/8]; } /* write hi bits of first byte */ n = 8 - elts[i].bit_offset; *cptr &= (1 << elts[i].bit_offset) - 1; *cptr++ |= (ux & ((1 << n) - 1)) << elts[i].bit_offset; /* write whole bytes until complete */ while (n < bits) { *cptr++ = ux >> n; n += 8; } /* restore hi bits of last byte */ cptr--; n = 8 - (n - bits); /* how many bits of last byte we should have written */ *cptr &= (1 << n) - 1; *cptr |= tempc & ~((1 << n) - 1); } break; default: Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Not a valid integer type (`%Ss')", Parrot_dt_get_datatype_name(INTERP, elts[i].type)); } } /* =item C =item C Get/Set a float-like element from a struct-pointer PMC. =cut */ VTABLE FLOATVAL get_number_keyed(PMC *k) { BEGIN_KEYED(INTERP, SELF, k) switch (elts[i].access) { case num_access: switch (elts[i].type) { case enum_type_FLOATVAL: return *(FLOATVAL *)ptr; case enum_type_float: return *(float *)ptr; case enum_type_double: return *(double *)ptr; case enum_type_longdouble: return *(long double *)ptr; default: break; } default: Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Not a valid number type (`%Ss')", Parrot_dt_get_datatype_name(INTERP, elts[i].type)); } } VTABLE void set_number_keyed(PMC *k, FLOATVAL n) { BEGIN_KEYED(INTERP, SELF, k) switch (elts[i].access) { case num_access: switch (elts[i].type) { case enum_type_FLOATVAL: *(FLOATVAL *)ptr = n; return; case enum_type_float: *(float *)ptr = n; return; case enum_type_double: *(double *)ptr = n; return; case enum_type_longdouble: *(long double *)ptr = n; return; default: break; } default: Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Not a valid number type (`%Ss')", Parrot_dt_get_datatype_name(INTERP, elts[i].type)); } } /* =item C =item C Get/Set a string element from a struct-pointer PMC. =cut */ VTABLE STRING *get_string_keyed(PMC *k) { BEGIN_KEYED(INTERP, SELF, k) switch (elts[i].access) { case str_access: switch (elts[i].type) { case enum_type_STRING: return *(STRING **)ptr; default: break; } default: Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Not a valid string type (`%Ss')", Parrot_dt_get_datatype_name(INTERP, elts[i].type)); } } VTABLE void set_string_keyed(PMC *k, STRING *s) { BEGIN_KEYED(INTERP, SELF, k) switch (elts[i].access) { case str_access: switch (elts[i].type) { case enum_type_STRING: *(STRING **)ptr = s; return; default: break; } default: Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Not a valid string type (`%Ss')", Parrot_dt_get_datatype_name(INTERP, elts[i].type)); } } /* =item C =item C Get/Set a PMC-like element from a struct-pointer PMC or box/unbox values from any other type of element. =cut */ VTABLE PMC *get_pmc_keyed(PMC *k) { BEGIN_KEYED(INTERP, SELF, k) switch (elts[i].access) { case int_access: case unaligned_access: return Parrot_pmc_box_integer(INTERP, SELF.get_integer_keyed(k)); case num_access: return Parrot_pmc_box_number(INTERP, SELF.get_number_keyed(k)); case str_access: return Parrot_pmc_box_string(INTERP, SELF.get_string_keyed(k)); case pmc_access: { PMC *ret; switch (elts[i].type) { case enum_type_PMC: return *(PMC **)ptr; case enum_type_func_ptr: case enum_type_ptr: return Parrot_pmc_new_init_int(INTERP, enum_class_Ptr, (INTVAL)*(void **)ptr); case enum_type_sized: ret = Parrot_pmc_new_init_int(INTERP, enum_class_PtrBuf, (INTVAL)*(void **)ptr); VTABLE_set_integer_native(INTERP, ret, elts[i].size); return ret; default: /* should never get here - put in to quiet compiler warnings */ return NULL; } } default: /* should never get here - put in to quiet compiler warnings */ return NULL; } } VTABLE void set_pmc_keyed(PMC *k, PMC *p) { BEGIN_KEYED(INTERP, SELF, k) switch (elts[i].access) { case int_access: case unaligned_access: SELF.set_integer_keyed(k, VTABLE_get_integer(INTERP, p)); break; case num_access: SELF.set_number_keyed(k, VTABLE_get_number(INTERP, p)); break; case str_access: SELF.set_string_keyed(k, VTABLE_get_string(INTERP, p)); break; case pmc_access: { switch (elts[i].type) { case enum_type_PMC: *(PMC **)ptr = p; break; case enum_type_func_ptr: case enum_type_ptr: *(void **)ptr = VTABLE_get_pointer(INTERP, p); break; case enum_type_sized: if (VTABLE_does(INTERP, p, CONST_STRING(INTERP, "buffer"))) { void * const q = VTABLE_get_pointer(INTERP, p); size_t len = VTABLE_get_integer(INTERP, p); if (len == 0 || len > elts[i].size) len = elts[i].size; memcpy(ptr, q, len); break; } else { Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Type `%Ss' unsuitable for buffer assignment", p->vtable->whoami); } default: break; } } default: break; } } /* =item C =item C Get the size (in bytes) required for one instance. =cut */ VTABLE INTVAL get_integer() { size_t size; GET_ATTR_size(INTERP, SELF, size); return size; } METHOD size() { size_t size; GET_ATTR_size(INTERP, SELF, size); RETURN(INTVAL size); } /* =item C Get the alignment (in bytes) required for an instance. =cut */ METHOD align() { size_t align; GET_ATTR_align(INTERP, SELF, align); RETURN(INTVAL align); } /* =item C Get the size of one instance plus the pad bytes to align a subsequent instance. =cut */ METHOD aligned_size() { size_t size, align; INTVAL ret; GET_ATTR_size(INTERP, SELF, size); GET_ATTR_align(INTERP, SELF, align); ret = ALIGN_UP(size, align); RETURN(INTVAL ret); } /* =item C Allocate an instance, or an array of instances when C has been provided. =cut */ METHOD alloc(INTVAL n :optional, int has_n :opt_flag) { size_t size, align; PMC *ret; void *buf; GET_ATTR_size(INTERP, SELF, size); if (has_n) { GET_ATTR_align(INTERP, SELF, align); size = ALIGN_UP(size, align) * n; } buf = mem_sys_allocate_zeroed(size); ret = Parrot_pmc_new_init_int(INTERP, enum_class_PtrObj, (INTVAL)buf); SETATTR_PtrObj_destroy(INTERP, ret, deallocate_ptrobj); RETURN(PMC ret); } /* =item C Return a C to the Cth element of an array of structs. =cut */ METHOD array_offs(PMC *array, INTVAL n) { void * const p = VTABLE_get_pointer(INTERP, array); const INTVAL array_size = VTABLE_get_integer(INTERP, array); PMC *ret; size_t size, align; GET_ATTR_size(INTERP, SELF, size); GET_ATTR_align(INTERP, SELF, align); /* sanity checks */ if (!p) dereference_null(INTERP); if (array_size && array_size < (int)size * n) Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Buffer length too small for struct array " "(at least %d required, got %d)", size * n, array_size); if ((size_t)p != ALIGN_UP((size_t)p, align)) dereference_unaligned(INTERP, p, align); size = ALIGN_UP(size, align); ret = Parrot_pmc_new_init_int(INTERP, enum_class_Ptr, (INTVAL)((char *)p + size * n)); RETURN(PMC ret); } /* =item C Return a C to the Cth element of a struct. =cut */ METHOD elt_offs(PMC *array, INTVAL n) { void *p = VTABLE_get_pointer(INTERP, array); PMC *ret; size_t n_elts; elt_desc_t *elts; GET_ATTR_n_elts(INTERP, SELF, n_elts); GET_ATTR_elts(INTERP, SELF, elts); /* sanity checks */ if (n < 0 || n_elts <= (size_t)n) index_out_of_bounds(INTERP, n); if (!p) dereference_null(INTERP); { const size_t buf_size = VTABLE_get_integer(INTERP, array); size_t self_size; GET_ATTR_size(INTERP, SELF, self_size); if (buf_size && buf_size < self_size) Parrot_ex_throw_from_c_args(INTERP, NULL, 0, "Buffer length too small for struct " "(at least %d required, got %d)", self_size, buf_size); } { size_t align; GET_ATTR_align(INTERP, SELF, align); if ((size_t)p != ALIGN_UP((size_t)p, align)) dereference_unaligned(INTERP, p, align); } p = ((char *)p) + elts[n].byte_offset; ret = Parrot_pmc_new_init_int(INTERP, enum_class_Ptr, (INTVAL)p); RETURN(PMC ret); } /* =item C Obtain an integer array which describes the shape of this object. The returned array is of the same format as the one used for C. =cut */ METHOD get_shape() { int i, j; size_t n; elt_desc_t *elts; PARROT_DATA_TYPE pack_type; PMC *result; GET_ATTR_n_elts(INTERP, SELF, n); GET_ATTR_elts(INTERP, SELF, elts); GET_ATTR_pack_type(INTERP, SELF, pack_type); switch (pack_type) { case enum_type_struct: case enum_type_union: result = Parrot_pmc_new_init_int(INTERP, enum_class_ResizableIntegerArray, n + 2); VTABLE_set_integer_keyed_int(INTERP, result, 0, pack_type); VTABLE_set_integer_keyed_int(INTERP, result, 1, n); break; case enum_type_sized: result = Parrot_pmc_new_init_int(INTERP, enum_class_ResizableIntegerArray, n * 3 + 4); { size_t s; VTABLE_set_integer_keyed_int(INTERP, result, 0, pack_type); VTABLE_set_integer_keyed_int(INTERP, result, 1, n); GET_ATTR_size(INTERP, SELF, s); VTABLE_set_integer_keyed_int(INTERP, result, 2, s); GET_ATTR_align(INTERP, SELF, s); VTABLE_set_integer_keyed_int(INTERP, result, 3, s); } break; default: break; } for (i = 1, j = 1; i <= (int)n; i++) { switch (pack_type) { case enum_type_struct: case enum_type_union: VTABLE_set_integer_keyed_int(INTERP, result, i + j, elts[i - 1].type); if (elts[i - 1].type == enum_type_sized) { VTABLE_set_integer_keyed_int(interp, result, i + ++j, elts[i - 1].size); VTABLE_set_integer_keyed_int(interp, result, i + ++j, 0); } break; case enum_type_sized: VTABLE_set_integer_keyed_int(INTERP, result, i * 3 + j, elts[i - 1].type); if (elts[i - 1].type == enum_type_sized) { VTABLE_set_integer_keyed_int(interp, result, i * 3 + ++j, elts[i - 1].size); VTABLE_set_integer_keyed_int(interp, result, i * 3 + ++j, 0); } VTABLE_set_integer_keyed_int(INTERP, result, i * 3 + j + 1, elts[i - 1].byte_offset); VTABLE_set_integer_keyed_int(INTERP, result, i * 3 + j + 2, elts[i - 1].bit_offset); default: break; } } RETURN(PMC result); } /* =item C =item C Implement the freeze/thaw API. =cut */ VTABLE void freeze(PMC *v) { PMC *shape; Parrot_pcc_invoke_method_from_c_args(INTERP, SELF, CONST_STRING(INTERP, "get_shape"), "->P", &shape); VTABLE_freeze(INTERP, shape, v); } VTABLE void thaw(PMC *v) { PMC *shape = Parrot_pmc_new_noinit(INTERP, enum_class_ResizableIntegerArray); VTABLE_thaw(INTERP, shape, v); SELF.init_pmc(shape); } } /* =back =head2 Auxiliary functions =over 4 =item C Deallocation function to be attached to allocated instances. =item C Throw an exception relating to attempting to derefence a NULL pointer. =item C Throw an exception about attempting to index outside the data. =item C Throw an exception about a buffer being too small. =item C Throw an exception relating to attempting to derefence an un-aligned pointer. =cut */ static void deallocate_ptrobj(SHIM_INTERP, SHIM(PMC *obj), ARGFREE(void *ptr)) { ASSERT_ARGS(deallocate_ptrobj) mem_sys_free(ptr); } PARROT_DOES_NOT_RETURN static void dereference_null(PARROT_INTERP) { ASSERT_ARGS(dereference_null) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNEXPECTED_NULL, "Attempt to derefrence null pointer"); } PARROT_DOES_NOT_RETURN static void index_out_of_bounds(PARROT_INTERP, INTVAL i) { ASSERT_ARGS(index_out_of_bounds) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS, "Struct index out of bounds (%d)", i); } PARROT_DOES_NOT_RETURN static void buffer_too_small(PARROT_INTERP, size_t self_size, size_t buf_size) { ASSERT_ARGS(buffer_too_small) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_BAD_BUFFER_SIZE, "Buffer length too small for struct (at least %d required, got %d)", self_size, buf_size); } PARROT_DOES_NOT_RETURN static void dereference_unaligned(PARROT_INTERP, ARGIN(const void *base_ptr), size_t align) { ASSERT_ARGS(dereference_unaligned) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Attempt to dereference unaligned pointer (%x, required alignment: %d)", base_ptr, align); } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ context.c000644000765000765 5620212101554067 16071 0ustar00brucebruce000000000000parrot-5.9.0/src/call/* Copyright (C) 2009-2012, Parrot Foundation. =head1 NAME src/context.c =head1 DESCRIPTION Parrot_Context functions. =cut */ #include "parrot/parrot.h" #include "parrot/call.h" #include "pmc/pmc_sub.h" #include "pmc/pmc_callcontext.h" #include "pmc/pmc_continuation.h" #include "pmc/pmc_proxy.h" /* =head2 Context and register frame layout +----------++----+------+------------+----+ | context || N | I | P | S + +----------++----+------+------------+----+ ^ ^ ^ ^ | | ctx.bp ctx.bp_ps ctx.state opt padding Registers are addressed as usual via the register base pointer ctx.bp. The macro CONTEXT() hides these details =cut */ #define ALIGNED_CTX_SIZE (((sizeof (Parrot_Context) + NUMVAL_SIZE - 1) \ / NUMVAL_SIZE) * NUMVAL_SIZE) /* =head2 Allocation Size Round register allocation size up to the nearest multiple of 8. A granularity of 8 is arbitrary, it could have been some bigger power of 2. A "slot" is an index into the free_list array. Each slot in free_list has a linked list of pointers to already allocated contexts available for (re)use. The slot where an available context is stored corresponds to the size of the context. =cut */ #define SLOT_CHUNK_SIZE 8 #define ROUND_ALLOC_SIZE(size) ((((size) + SLOT_CHUNK_SIZE - 1) \ / SLOT_CHUNK_SIZE) * SLOT_CHUNK_SIZE) #define CALCULATE_SLOT_NUM(size) ((size) / SLOT_CHUNK_SIZE) /* HEADERIZER HFILE: include/parrot/call.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void allocate_registers(PARROT_INTERP, ARGIN(PMC *pmcctx), ARGIN(const UINTVAL *number_regs_used)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3); PARROT_WARN_UNUSED_RESULT PARROT_PURE_FUNCTION static size_t calculate_registers_size(PARROT_INTERP, ARGIN(const UINTVAL *number_regs_used)) __attribute__nonnull__(2); static void clear_regs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*ctx); PARROT_CANNOT_RETURN_NULL static PMC* init_context(ARGMOD(PMC *pmcctx), ARGIN_NULLOK(PMC *pmcold)) __attribute__nonnull__(1) FUNC_MODIFIES(*pmcctx); PARROT_WARN_UNUSED_RESULT PARROT_PURE_FUNCTION static size_t Parrot_pcc_calculate_registers_size(PARROT_INTERP, ARGIN(const UINTVAL *number_regs_used)) __attribute__nonnull__(1) __attribute__nonnull__(2); static void set_context(PARROT_INTERP, ARGIN(PMC *ctx)) __attribute__nonnull__(1) __attribute__nonnull__(2); #define ASSERT_ARGS_allocate_registers __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(pmcctx) \ , PARROT_ASSERT_ARG(number_regs_used)) #define ASSERT_ARGS_calculate_registers_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(number_regs_used)) #define ASSERT_ARGS_clear_regs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(ctx)) #define ASSERT_ARGS_init_context __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(pmcctx)) #define ASSERT_ARGS_Parrot_pcc_calculate_registers_size \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(number_regs_used)) #define ASSERT_ARGS_set_context __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(ctx)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =head2 Context API Functions =over 4 =item C Get Sub executed inside Context. =cut */ PARROT_EXPORT PARROT_PURE_FUNCTION PARROT_CAN_RETURN_NULL PMC* Parrot_pcc_get_sub(SHIM_INTERP, ARGIN(const PMC *ctx)) { ASSERT_ARGS(Parrot_pcc_get_sub) const Parrot_Context * const c = CONTEXT_STRUCT(ctx); return c->current_sub; } /* =item C Set Sub executed inside Context. =cut */ PARROT_EXPORT void Parrot_pcc_set_sub(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN_NULLOK(PMC *sub)) { ASSERT_ARGS(Parrot_pcc_set_sub) Parrot_Context * const c = CONTEXT_STRUCT(ctx); c->current_sub = sub; if (sub && !PMC_IS_NULL(sub)) { Parrot_Sub_attributes *subattr; PMC_get_sub(interp, sub, subattr); c->current_pc = subattr->seg->base.data + subattr->start_offs; c->current_HLL = subattr->HLL_id; #ifdef THREAD_DEBUG PARROT_ASSERT( PObj_is_shared_TEST(sub) || subattr->namespace_stash == NULL || subattr->namespace_stash->orig_interp == interp); #endif c->current_namespace = subattr->namespace_stash; } } /* =back =head2 Context and Register Allocation Functions =over 4 =item C Creates the interpreter's initial context. =cut */ void create_initial_context(PARROT_INTERP) { ASSERT_ARGS(create_initial_context) static const UINTVAL num_regs[] = {32, 32, 32, 32}; PMC *ignored; /* Create some initial free_list slots. */ #define INITIAL_FREE_SLOTS 8 /* For now create context with 32 regs each. Some src tests (and maybe * other extenders) assume the presence of these registers */ ignored = Parrot_set_new_context(interp, num_regs); UNUSED(ignored); } /* =item C Initializes a freshly allocated or recycled context and returns the new one. =cut */ PARROT_CANNOT_RETURN_NULL static PMC* init_context(ARGMOD(PMC *pmcctx), ARGIN_NULLOK(PMC *pmcold)) { ASSERT_ARGS(init_context) Parrot_Context * const ctx = CONTEXT_STRUCT(pmcctx); PARROT_ASSERT_MSG(!PMC_IS_NULL(pmcctx), "Can't initialise Null CallContext"); PARROT_ASSERT(PMC_IS_NULL(pmcold) || pmcold->vtable->base_type == enum_class_CallContext); /* * FIXME Invoking corotine shouldn't initialise context. So just * check ctx->current_sub. If it's not null return from here */ if (!PMC_IS_NULL(ctx->current_sub)) return pmcctx; ctx->lex_pad = PMCNULL; ctx->outer_ctx = NULL; ctx->current_cont = NULL; ctx->handlers = PMCNULL; ctx->caller_ctx = NULL; ctx->current_sig = PMCNULL; ctx->current_sub = PMCNULL; if (PMC_IS_NULL(pmcold)) { ctx->num_constants = NULL; ctx->str_constants = NULL; ctx->pmc_constants = NULL; ctx->warns = 0; ctx->errors = 0; ctx->trace_flags = 0; ctx->current_HLL = 0; ctx->current_namespace = PMCNULL; ctx->recursion_depth = 0; } else { Parrot_Context *old = CONTEXT_STRUCT(pmcold); /* some items should better be COW copied */ ctx->num_constants = old->num_constants; ctx->str_constants = old->str_constants; ctx->pmc_constants = old->pmc_constants; ctx->warns = old->warns; ctx->errors = old->errors; ctx->trace_flags = old->trace_flags; ctx->current_HLL = old->current_HLL; PARROT_ASSERT_INTERP(old->current_namespace, pmcctx->orig_interp); ctx->current_namespace = old->current_namespace; /* end COW */ ctx->recursion_depth = old->recursion_depth; ctx->caller_ctx = pmcold; } return pmcctx; } /* =item C Creates and sets the current context to a new context, remembering the old context in C. Suitable to use with C. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_push_context(PARROT_INTERP, ARGIN(const UINTVAL *n_regs_used)) { ASSERT_ARGS(Parrot_push_context) PMC * const old = CURRENT_CONTEXT(interp); PMC * const ctx = Parrot_set_new_context(interp, n_regs_used); /* doesn't change */ Parrot_pcc_set_sub(interp, ctx, Parrot_pcc_get_sub(interp, old)); /* copy more ? */ return ctx; } /* =item C Frees the context created with C and restores the previous context (the caller context). =cut */ PARROT_EXPORT void Parrot_pop_context(PARROT_INTERP) { ASSERT_ARGS(Parrot_pop_context) PMC * const ctx = CURRENT_CONTEXT(interp); PMC * const old = Parrot_pcc_get_caller_ctx(interp, ctx); /* restore old, set cached interpreter base pointers */ set_context(interp, old); } /* =item C Calculate memory size required for registers. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_PURE_FUNCTION static size_t calculate_registers_size(SHIM_INTERP, ARGIN(const UINTVAL *number_regs_used)) { ASSERT_ARGS(calculate_registers_size) return ROUND_ALLOC_SIZE( sizeof (INTVAL) * number_regs_used[REGNO_INT] + sizeof (FLOATVAL) * number_regs_used[REGNO_NUM] + sizeof (STRING *) * number_regs_used[REGNO_STR] + sizeof (PMC *) * number_regs_used[REGNO_PMC]); } /* =item C Calculate size of Context. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_PURE_FUNCTION static size_t Parrot_pcc_calculate_registers_size(PARROT_INTERP, ARGIN(const UINTVAL *number_regs_used)) { ASSERT_ARGS(Parrot_pcc_calculate_registers_size) return calculate_registers_size(interp, number_regs_used); } /* =item C Allocate registers inside Context. =cut */ static void allocate_registers(PARROT_INTERP, ARGIN(PMC *pmcctx), ARGIN(const UINTVAL *number_regs_used)) { ASSERT_ARGS(allocate_registers) Parrot_CallContext_attributes *ctx = PARROT_CALLCONTEXT(pmcctx); const size_t size_i = sizeof (INTVAL) * number_regs_used[REGNO_INT]; const size_t size_n = sizeof (FLOATVAL) * number_regs_used[REGNO_NUM]; const size_t size_s = sizeof (STRING *) * number_regs_used[REGNO_STR]; const size_t size_p = sizeof (PMC *) * number_regs_used[REGNO_PMC]; const size_t size_nip = size_n + size_i + size_p; const size_t all_regs_size = size_n + size_i + size_p + size_s; const size_t reg_alloc = ROUND_ALLOC_SIZE(all_regs_size); ctx->n_regs_used[REGNO_INT] = number_regs_used[REGNO_INT]; ctx->n_regs_used[REGNO_NUM] = number_regs_used[REGNO_NUM]; ctx->n_regs_used[REGNO_STR] = number_regs_used[REGNO_STR]; ctx->n_regs_used[REGNO_PMC] = number_regs_used[REGNO_PMC]; if (!reg_alloc) { ctx->registers = NULL; return; } /* don't allocate any storage if there are no registers */ ctx->registers = (Parrot_Context *)Parrot_gc_allocate_fixed_size_storage(interp, reg_alloc); /* ctx.bp points to I0, which has Nx on the left */ ctx->bp.regs_i = (INTVAL *)((char *)ctx->registers + size_n); /* ctx.bp_ps points to S0, which has Px on the left */ ctx->bp_ps.regs_s = (STRING **)((char *)ctx->registers + size_nip); clear_regs(interp, ctx); } /* =item C Clears all registers in a context. PMC and STRING registers contain PMCNULL and NULL, respectively. Integer and float registers contain negative flag values, for debugging purposes. =cut */ static void clear_regs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx)) { ASSERT_ARGS(clear_regs) UINTVAL i; const UINTVAL s_regs = ctx->n_regs_used[REGNO_STR]; const UINTVAL p_regs = ctx->n_regs_used[REGNO_PMC]; /* NULL out registers - P/S have to be NULL for GC */ for (i = 0; i < s_regs; ++i) ctx->bp_ps.regs_s[i] = STRINGNULL; for (i = 0; i < p_regs; ++i) ctx->bp_ps.regs_p[-1L - i] = PMCNULL; if (Interp_debug_TEST(interp, PARROT_REG_DEBUG_FLAG)) { /* depending on -D40, set int and num to identifiable garbage values */ for (i = 0; i < ctx->n_regs_used[REGNO_INT]; ++i) ctx->bp.regs_i[i] = -999; for (i = 0; i < ctx->n_regs_used[REGNO_NUM]; ++i) ctx->bp.regs_n[-1L - i] = -99.9; } } /* =item C Allocate registers in Context. =cut */ void Parrot_pcc_allocate_registers(PARROT_INTERP, ARGIN(PMC *pmcctx), ARGIN(const UINTVAL *number_regs_used)) { ASSERT_ARGS(Parrot_pcc_allocate_registers) if (number_regs_used[0] || number_regs_used[1] || number_regs_used[2] || number_regs_used[3]) allocate_registers(interp, pmcctx, number_regs_used); } /* =item C Free memory allocated for registers in Context. =cut */ void Parrot_pcc_free_registers(PARROT_INTERP, ARGIN(PMC *pmcctx)) { ASSERT_ARGS(Parrot_pcc_free_registers) Parrot_CallContext_attributes * const ctx = PARROT_CALLCONTEXT(pmcctx); const size_t reg_size = Parrot_pcc_calculate_registers_size(interp, ctx->n_regs_used); if (reg_size) Parrot_gc_free_fixed_size_storage(interp, reg_size, ctx->registers); } /* =item C Allocates and returns a new context. Does not set this new context as the current context. Note that the register usage C is copied. Use the init flag to indicate whether you want to initialize the new context (setting its default values and clearing its registers). TODO: Remove this function! =cut */ PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT PMC * Parrot_alloc_context(PARROT_INTERP, ARGIN(const UINTVAL *number_regs_used), ARGIN_NULLOK(PMC *old)) { ASSERT_ARGS(Parrot_alloc_context) PMC * const pmcctx = Parrot_pmc_new(interp, enum_class_CallContext); allocate_registers(interp, pmcctx, number_regs_used); return init_context(pmcctx, old); } /* =item C Allocates and returns a new context. Does not set this new context as the current context. =cut */ PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT PMC * Parrot_pcc_allocate_empty_context(PARROT_INTERP, ARGIN_NULLOK(PMC *old)) { ASSERT_ARGS(Parrot_pcc_allocate_empty_context) PMC * const pmcctx = Parrot_pmc_new(interp, enum_class_CallContext); return init_context(pmcctx, old); } /* =item C Initialise new context from old. =cut */ PARROT_CANNOT_RETURN_NULL PMC * Parrot_pcc_init_context(SHIM_INTERP, ARGIN(PMC *ctx), ARGIN_NULLOK(PMC *old)) { ASSERT_ARGS(Parrot_pcc_init_context) return init_context(ctx, old); } /* =item C Allocates and returns a new context as the current context. Note that the register usage C is copied. =cut */ PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT PMC * Parrot_set_new_context(PARROT_INTERP, ARGIN(const UINTVAL *number_regs_used)) { ASSERT_ARGS(Parrot_set_new_context) PMC * const old = CURRENT_CONTEXT(interp); PMC * const ctx = Parrot_alloc_context(interp, number_regs_used, old); set_context(interp, ctx); return ctx; } /* =back =head2 Register Stack Functions =over 4 =cut =item C Get pointer to INTVAL register. Notice that this pointer IS NOT intended for long term use. This pointer is tied to the lifetime of the Context, and if the Context is destroyed the memory for the registers will be freed and possibly even recycled. This pointer should be used for an immediate set or fetch and should not be cached. =cut */ PARROT_EXPORT PARROT_PURE_FUNCTION PARROT_CANNOT_RETURN_NULL INTVAL * Parrot_pcc_get_INTVAL_reg(PARROT_INTERP, ARGIN(const PMC *ctx), UINTVAL idx) { ASSERT_ARGS(Parrot_pcc_get_INTVAL_reg) PARROT_ASSERT(Parrot_pcc_get_regs_used(interp, ctx, REGNO_INT) > idx); return &(CONTEXT_STRUCT(ctx)->bp.regs_i[idx]); } /* =item C Get pointer to FLOATVAL register. Notice that this pointer IS NOT intended for long term use. This pointer is tied to the lifetime of the Context, and if the Context is destroyed the memory for the registers will be freed and possibly even recycled. This pointer should be used for an immediate set or fetch and should not be cached. =cut */ PARROT_EXPORT PARROT_PURE_FUNCTION PARROT_CANNOT_RETURN_NULL FLOATVAL * Parrot_pcc_get_FLOATVAL_reg(PARROT_INTERP, ARGIN(const PMC *ctx), UINTVAL idx) { ASSERT_ARGS(Parrot_pcc_get_FLOATVAL_reg) PARROT_ASSERT(Parrot_pcc_get_regs_used(interp, ctx, REGNO_NUM) > idx); return &(CONTEXT_STRUCT(ctx)->bp.regs_n[-1L - idx]); } /* =item C Get pointer to STRING register. Notice that this pointer IS NOT intended for long term use. This pointer is tied to the lifetime of the Context, and if the Context is destroyed the memory for the registers will be freed and possibly even recycled. This pointer should be used for an immediate set or fetch and should not be cached. =cut */ PARROT_EXPORT PARROT_PURE_FUNCTION PARROT_CANNOT_RETURN_NULL STRING ** Parrot_pcc_get_STRING_reg(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL idx) { ASSERT_ARGS(Parrot_pcc_get_STRING_reg) PARROT_ASSERT(Parrot_pcc_get_regs_used(interp, ctx, REGNO_STR) > idx); PARROT_GC_WRITE_BARRIER(interp, ctx); return &(CONTEXT_STRUCT(ctx)->bp_ps.regs_s[idx]); } /* =item C Get pointer to PMC register. Notice that this pointer IS NOT intended for long term use. This pointer is tied to the lifetime of the Context, and if the Context is destroyed the memory for the registers will be freed and possibly even recycled. This pointer should be used for an immediate set or fetch and should not be cached. =cut */ PARROT_EXPORT PARROT_PURE_FUNCTION PARROT_CANNOT_RETURN_NULL PMC ** Parrot_pcc_get_PMC_reg(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL idx) { ASSERT_ARGS(Parrot_pcc_get_PMC_reg) PMC **res; PARROT_ASSERT(Parrot_pcc_get_regs_used(interp, ctx, REGNO_PMC) > idx); PARROT_GC_WRITE_BARRIER(interp, ctx); res = &(CONTEXT_STRUCT(ctx)->bp_ps.regs_p[-1L - idx]); PARROT_ASSERT(!*res || !PObj_on_free_list_TEST(*res)); return res; } /* =item C Return number of used registers of particular type. =cut */ PARROT_EXPORT PARROT_PURE_FUNCTION UINTVAL Parrot_pcc_get_regs_used(SHIM_INTERP, ARGIN(const PMC *ctx), int type) { ASSERT_ARGS(Parrot_pcc_get_regs_used) return CONTEXT_STRUCT(ctx)->n_regs_used[type]; } /* =item C Get pointer to FLOANFAL and INTVAL registers. =cut */ PARROT_EXPORT PARROT_PURE_FUNCTION PARROT_CANNOT_RETURN_NULL Regs_ni* Parrot_pcc_get_regs_ni(SHIM_INTERP, ARGIN(const PMC *ctx)) { ASSERT_ARGS(Parrot_pcc_get_regs_ni) return &(CONTEXT_STRUCT(ctx)->bp); } /* =item C Copy Regs_ni into Context. =cut */ PARROT_EXPORT PARROT_CANNOT_RETURN_NULL void Parrot_pcc_set_regs_ni(SHIM_INTERP, ARGIN(PMC *ctx), ARGIN(Regs_ni *bp)) { ASSERT_ARGS(Parrot_pcc_set_regs_ni) CONTEXT_STRUCT(ctx)->bp = *bp; } /* =item C Get pointer to PMC and STRING registers. =cut */ PARROT_EXPORT PARROT_PURE_FUNCTION PARROT_CANNOT_RETURN_NULL Regs_ps* Parrot_pcc_get_regs_ps(SHIM_INTERP, ARGIN(PMC *ctx)) { ASSERT_ARGS(Parrot_pcc_get_regs_ps) return &(CONTEXT_STRUCT(ctx)->bp_ps); } /* =item C Copy Regs_ps into Context. =cut */ PARROT_EXPORT PARROT_CANNOT_RETURN_NULL void Parrot_pcc_set_regs_ps(SHIM_INTERP, ARGIN(PMC *ctx), ARGIN(Regs_ps *bp_ps)) { ASSERT_ARGS(Parrot_pcc_set_regs_ps) CONTEXT_STRUCT(ctx)->bp_ps = *bp_ps; } /* =item C Set new Context to interpreter. =cut */ PARROT_EXPORT void Parrot_pcc_set_context_func(PARROT_INTERP, ARGIN(PMC *ctx)) { ASSERT_ARGS(Parrot_pcc_set_context_func) set_context(interp, ctx); } /* =item C Try to reuse old Continuation for subsequent calls from same CallContext. =cut */ PARROT_EXPORT void Parrot_pcc_reuse_continuation(PARROT_INTERP, ARGIN(PMC *call_context), ARGIN_NULLOK(opcode_t *next)) { ASSERT_ARGS(Parrot_pcc_reuse_continuation) Parrot_CallContext_attributes * const c = CONTEXT_STRUCT(call_context); INTVAL reuse = 0; if (!PMC_IS_NULL(c->continuation)) { PMC * const cont = c->continuation; INTVAL invoked; GETATTR_Continuation_invoked(interp, cont, invoked); /* Reuse if invoked. And not tailcalled? */ reuse = invoked && !(PObj_get_FLAGS(cont) |= SUB_FLAG_TAILCALL); } if (!reuse) { c->continuation = Parrot_pmc_new(interp, enum_class_Continuation); } VTABLE_set_pointer(interp, c->continuation, next); interp->current_cont = c->continuation; } /* =item C Helper function to set breakpoint to. =cut */ static void set_context(PARROT_INTERP, ARGIN(PMC *ctx)) { ASSERT_ARGS(set_context) CURRENT_CONTEXT(interp) = ctx; } /* =item C CallContext cannot be properly proxied across threads because of direct field accesses. Instead, create a new CallContext which acts like a proxy but can be used with direct accesses. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_pcc_unproxy_context(PARROT_INTERP, ARGIN(PMC * proxy)) { ASSERT_ARGS(Parrot_pcc_unproxy_context) PMC * const ctx_pmc = Parrot_pcc_allocate_empty_context(interp, PMCNULL); PMC * const target_ctx_pmc = PARROT_PROXY(proxy)->target; Parrot_Context * const ctx = CONTEXT_STRUCT(ctx_pmc); Parrot_Context * const target_ctx = CONTEXT_STRUCT(target_ctx_pmc); Parrot_Interp const target_interp = PARROT_PROXY(proxy)->interp; ctx->caller_ctx = PMCNULL; /* TODO: Double-check this */ ctx->outer_ctx = PMCNULL; ctx->lex_pad = Parrot_thread_create_proxy(target_interp, interp, target_ctx->lex_pad); ctx->handlers = Parrot_thread_create_proxy(target_interp, interp, target_ctx->handlers); ctx->current_cont = PMCNULL; ctx->current_namespace = PMCNULL; ctx->current_sig = PMCNULL; ctx->type_tuple = PMCNULL; ctx->arg_flags = PMCNULL; ctx->return_flags = PMCNULL; return ctx_pmc; } /* =back */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ 03-lines_to_files.t000644000765000765 1773311631440404 21215 0ustar00brucebruce000000000000parrot-5.9.0/t/tools/install#! perl # Copyright (C) 2007, Parrot Foundation. # 03-lines_to_files.t use strict; use warnings; use Test::More tests => 8; use Carp; use Cwd; use File::Copy; use File::Temp qw( tempdir ); use lib qw( lib ); use Parrot::Install qw( install_files create_directories lines_to_files ); use IO::CaptureOutput qw( capture ); my $cwd = cwd(); my $testsourcedir = qq{$cwd/t/tools/install/testlib}; my $parrotdir = q{}; my %metatransforms = ( doc => { optiondir => 'doc', transform => sub { my($dest) = @_; # resources go in the top level of docs $dest =~ s/^docs\/resources/resources/; # other docs are actually raw Pod $dest =~ s/^docs/pod/; $parrotdir, $dest; }, }, '.*' => { optiondir => 'foo', transform => sub { return($_[0]); } } ); my(@transformorder) = ('doc', '.*'); my %badmetatransforms = ( doc => { optiondir => 'doc', transform => sub { my($dest) = @_; $dest =~ s/^docs\/resources/resources/; # resources go in the top level of docs $dest =~ s/^docs/pod/; # other docs are actually raw Pod $parrotdir, $dest; }, }, '.*' => { optiondir => 'foo', transform => sub { return(@_); } } ); my @manifests = qw(MANIFEST MANIFEST.generated); my %options = ( packages => 'main', ); my ($files_ref, $directories_ref, %badtransformorder); eval { ($files_ref, $directories_ref) = lines_to_files( \%metatransforms, \@transformorder, {}, \%options, $parrotdir, ); }; like($@, qr/Manifests must be listed in an array reference/, "Correctly detected lack of array ref as 3rd argument" ); eval { ($files_ref, $directories_ref) = lines_to_files( \%metatransforms, \@transformorder, [], \%options, $parrotdir, ); }; like($@, qr/No manifests specified/, "Correctly detected lack of manifest files" ); eval { ($files_ref, $directories_ref) = lines_to_files( \%metatransforms, \%badtransformorder, [ qw( MANIFEST MANIFEST.generated ) ], \%options, $parrotdir, ); }; like($@, qr/Transform order should be an array of keys/, "Correctly detected incorrect type for transform order" ); { my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or die "Unable to change to testing directory: $!"; copy qq{$testsourcedir/manifest_pseudo} => qq{$tdir/MANIFEST} or die "Unable to copy file to tempdir for testing: $!"; copy qq{$testsourcedir/generated_pseudo} => qq{$tdir/MANIFEST.generated} or die "Unable to copy file to tempdir for testing: $!"; my ($stdout, $stderr); eval { ($files_ref, $directories_ref) = lines_to_files( \%badmetatransforms, \@transformorder, [ qw( MANIFEST MANIFEST.generated ) ], \%options, $parrotdir, ); }; like($@, qr/transform didn't return a hash for key/, "Correctly detected transform with a bad return value" ); chdir $cwd or die "Unable to return to starting directory: $!"; } { my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or die "Unable to change to testing directory: $!"; copy qq{$testsourcedir/manifest_pseudo} => qq{$tdir/MANIFEST} or die "Unable to copy file to tempdir for testing: $!"; copy qq{$testsourcedir/generated_pseudo_with_dupe} => qq{$tdir/MANIFEST.generated} or die "Unable to copy file to tempdir for testing: $!"; my ($stdout, $stderr); eval { capture( sub { ($files_ref, $directories_ref) = lines_to_files( \%metatransforms, \@transformorder, [ qw( MANIFEST MANIFEST.generated ) ], \%options, $parrotdir, ); }, \$stdout, \$stderr, ); }; like($stderr, qr/MANIFEST\.generated:\d+:\s+Duplicate entry/, "Detected duplicate entries in one or more manifest files" ); is( scalar(grep { $_->{Installable} } @$files_ref), 0, "No installable executables in this test" ); chdir $cwd or die "Unable to return to starting directory: $!"; } { my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or die "Unable to change to testing directory: $!"; my $defective_man = q{MANIFEST.1defective}; copy qq{$testsourcedir/$defective_man} => qq{$tdir/MANIFEST} or die "Unable to copy file to tempdir for testing: $!"; eval { ($files_ref, $directories_ref) = lines_to_files( \%metatransforms, \@transformorder, [ q{MANIFEST} ], \%options, $parrotdir, ); }; like($@, qr/Malformed line in MANIFEST: ChangeLog/, "Got expected error message with defective manifest" ); chdir $cwd or die "Unable to return to starting directory: $!"; } pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME 03-lines_to_files.t - test subroutines exported by C =head1 SYNOPSIS % prove t/tools/install/03-lines_to_files.t =head1 DESCRIPTION The files in this directory test functionality used by the scripts F, F and F and are exported by F. =head1 AUTHOR James E Keenan and Timothy S Nelson =head1 SEE ALSO Parrot::Install, F, F =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: __END__ # Can't safely run lines_to_files() more than once in a program until it's been fixed, # and we can't fix it until its tested, so I've commented most of these out until we've # fixed lines_to_files() not to use @ARGV ## In the code below: ## - othertransforms needs to be merged into metatransforms ## - transformorder needs to be added ## - $installable_exe needs to be removed #{ # my($metatransforms, $transformorder, $manifests, $options, $parrotdir, # $files, $installable_exe, $directories); # # # First lines_to_files test ## eval { lines_to_files(); }; ## $@ or die "lines_to_files didn't die with no parameters\n"; ## ok($@ =~ /^.manifests must be an array reference$/, 'lines_to_files dies with bad parameters'); # # # Second lines_to_files test ## eval { lines_to_files( ## $metatransforms, $transformorder, ## [qw(MANIFEST MANIFEST.generated)], ## $options, $parrotdir ## ); }; ## ok($@ =~ /^Unknown install location in MANIFEST for file/, 'fails for install locations not specified in transforms'); # # # Third lines_to_files test # $metatransforms = { # doc => { # optiondir => 'doc', # transform => sub { # my($dest) = @_; # $dest =~ s/^docs\/resources/resources/; # resources go in the top level of docs # $dest =~ s/^docs/pod/; # other docs are actually raw Pod # $parrotdir, $dest; # }, # }, # }; # $othertransforms = { # '.*' => { # optiondir => 'foo', # transform => sub { # return(@_); # } # } # }; # # ($files, $installable_exe, $directories) = lines_to_files( # $metatransforms, $othertransforms, # [qw(MANIFEST MANIFEST.generated)], # { packages => 'main' }, $parrotdir # ); # ok((ref($files) and ref($installable_exe) and ref($directories)), 'lines_to_files returns something vaguely sensible'); # ok(1, 'lines_to_files passed all tests'); #} exit.c000644000765000765 1357312101554067 14447 0ustar00brucebruce000000000000parrot-5.9.0/src/* Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME src/exit.c - Exit Handling =head1 DESCRIPTION Parrot's version of C, C, and friends. C allows you register exit handlers which will be called by C when the interpreter exits. =head2 Functions =over 4 =cut */ #include #include "parrot/parrot.h" /* HEADERIZER HFILE: include/parrot/exit.h */ /* =item C Register the specified function to be called on interpreter exit. =cut */ PARROT_EXPORT void Parrot_x_on_exit(PARROT_INTERP, ARGIN(exit_handler_f function), ARGIN_NULLOK(void *arg)) { ASSERT_ARGS(Parrot_x_on_exit) handler_node_t * const new_node = mem_internal_allocate_typed(handler_node_t); new_node->function = function; new_node->arg = arg; new_node->next = interp->exit_handler_list; interp->exit_handler_list = new_node; } /* =item C Jumps out returning to the caller api function. Do not execute registered on-exit handlers. If an interpreter is not provided, or if the interpreter does not have a jump buffer registered, force an exit back to the system (which may be very bad for the client application). =cut */ PARROT_EXPORT PARROT_DOES_NOT_RETURN PARROT_COLD void Parrot_x_jump_out(NULLOK_INTERP, int status) { ASSERT_ARGS(Parrot_x_jump_out) if (interp && interp->api_jmp_buf) longjmp(*(interp->api_jmp_buf), 1); else PARROT_FORCE_EXIT(status); } /* =item C Normal interpreter exit. Execute any registered exit handlers and jump back out to the last API call-in routine. =cut */ PARROT_EXPORT PARROT_DOES_NOT_RETURN PARROT_COLD void Parrot_x_exit(PARROT_INTERP, int status) { ASSERT_ARGS(Parrot_x_exit) Parrot_x_execute_on_exit_handlers(interp, status); Parrot_x_jump_out(interp, status); } /* =item C Execute all registered on-exit callback functions. This must be done before the interpreter is destroyed. =cut */ PARROT_COLD PARROT_NO_ADDRESS_SAFETY_ANALYSIS void Parrot_x_execute_on_exit_handlers(PARROT_INTERP, int status) { ASSERT_ARGS(Parrot_x_execute_on_exit_handlers) /* call all the exit handlers */ handler_node_t *node; node = interp->exit_handler_list; /* Block GC. We don't want any shenanigans while we are executing our callbacks */ Parrot_block_GC_mark(interp); Parrot_block_GC_sweep(interp); while (node) { handler_node_t * const next = node->next; (node->function)(interp, status, node->arg); mem_internal_free(node); node = next; } /* It could be that the interpreter already is destroyed. See issue 765 */ interp->exit_handler_list = NULL; interp->final_exception = NULL; /* Re-enable GC, which we will want if GC finalizes */ Parrot_unblock_GC_mark(interp); Parrot_unblock_GC_sweep(interp); } /* =item C Error handler of last resort, under normal circumstances. Print out an error message to C and exit from the interpreter. If possible attempt to jump out of libparrot. If not, hard exit back to the system. =cut */ PARROT_DOES_NOT_RETURN PARROT_COLD void Parrot_x_force_error_exit(NULLOK_INTERP, int exitcode, ARGIN(const char * format), ...) { ASSERT_ARGS(Parrot_x_force_error_exit) va_list arglist; va_start(arglist, format); vfprintf(stderr, format, arglist); fprintf(stderr, "\n"); fflush(stderr); va_end(arglist); Parrot_x_jump_out(interp, exitcode); } /* =item C Panic handler. Things have gone very wrong in an unexpected way. Print out an error message and instructions for the user to report the error to the developers. Perform a full core dump and force exit back to the system. =cut */ PARROT_EXPORT PARROT_DOES_NOT_RETURN PARROT_COLD void Parrot_x_panic_and_exit(NULLOK_INTERP, ARGIN_NULLOK(const char *message), ARGIN_NULLOK(const char *file), unsigned int line) { ASSERT_ARGS(Parrot_x_panic_and_exit) /* Note: we can't format any floats in here--Parrot_sprintf ** may panic because of floats. ** and we don't use Parrot_sprintf or such, because we are ** already in panic --leo */ fprintf(stderr, "Parrot VM: PANIC: %s!\n", message ? message : "(no message available)"); fprintf(stderr, "C file %s, line %u\n", file ? file : "(not available)", line); fprintf(stderr, "Parrot file (not available), "); fprintf(stderr, "line (not available)\n"); fprintf(stderr, "\n\ We highly suggest you notify the Parrot team if you have not been working on\n\ Parrot. Use parrotbug (located in parrot's root directory) or send an\n\ e-mail to parrot-dev@lists.parrot.org.\n\ Include the entire text of this error message and the text of the script that\n\ generated the error. If you've made any modifications to Parrot, please\n\ describe them as well.\n\n"); fprintf(stderr, "Version : %s\n", PARROT_VERSION); fprintf(stderr, "Configured : %s\n", PARROT_CONFIG_DATE); fprintf(stderr, "Architecture: %s\n", PARROT_ARCHNAME); if (interp) fprintf(stderr, "Interp Flags: %#x\n", (unsigned int)interp->flags); else fprintf(stderr, "Interp Flags: (no interpreter)\n"); fprintf(stderr, "Exceptions : %s\n", "(missing from core)"); fprintf(stderr, "\nDumping Core...\n"); DUMPCORE(); } /* =back =head1 SEE ALSO F and F. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ shootout.t000644000765000765 520011567202625 16646 0ustar00brucebruce000000000000parrot-5.9.0/t/examples#!perl # Copyright (C) 2005-2008, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Config; use vars qw($EXT $DIR @shootouts); # find dynamically all shootouts from dir listing BEGIN { # to be run before declaring the number of tests $EXT = '_output'; $DIR = "examples/shootout"; opendir( DIR, $DIR ) or die "can't opendir $DIR: $!"; @shootouts = grep { -e "$DIR/$_$EXT" } sort grep { /\.pir$/ } readdir(DIR); closedir DIR; } use Parrot::Test tests => scalar(@shootouts); =head1 NAME t/examples/shootout.t - Test the shootout examples in "examples/shootout/*.pir". =head1 SYNOPSIS % prove t/examples/shootout.t =head1 DESCRIPTION Test the PIR shootout examples in 'examples/shootout/*.pir'. To add a new test, you do not have to modify this script: 1. add your script (toto.pir) to examples/shootout 2. put parrot options in the first line (e.g "#!./parrot -Oc") 3. make sure you have default argument values 4. put the expected output as a file : toto.pir_output 5. if you need an input file (to be read from stdin), call it toto.pir_input See the explanation of benchmarks and sample data for reduced N benches at http://shootout.alioth.debian.org/sandbox/ =cut my %skips = ( 'pidigits.pir' => [ 'not exists $PConfig{HAS_GMP}', 'needs GMP' ], ); my $INPUT_EXT = '_input'; foreach my $script (@shootouts) { my $skip = $skips{$script}; if ($skip) { my ( $cond, $reason ) = @{$skip}; if ( eval "$cond" ) { Test::More->builder->skip("$script $reason"); next; } } my $file = "$DIR/$script"; # parse first line open( my $FILE, '<', $file ) or die "unable to open file [$file] : $!"; my $shebang = <$FILE>; close $FILE; my $expected = slurp_file("$file$EXT"); my $args = ""; if ( $shebang =~ /^\#.+parrot\s+(.+)$/ ) { $args = $1; # parrot options } $args =~ s/-j/-C/; $args =~ s/-Cj/-C/; $args =~ s/-Cj/-j/; # Remove any plain -C option. $args =~ s/(^|\s)-C(\s|$)/$1$2/; # Remove any extra Cs still floating around $args =~ s/C//; # look for input files my $input = "$file$INPUT_EXT"; if ( -e $input ) { $args .= " < $input "; } $ENV{TEST_PROG_ARGS} = $args; warn "$file $args\n" if $ENV{TEST_VERBOSE}; my @todo; # this is an example of todo syntax # @todo = ( todo => 'known GC segfault' ) if $file =~ /regexdna.pir/; example_output_is( $file, $expected, @todo ); } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: harmonic.pir000644000765000765 172611533177635 20550 0ustar00brucebruce000000000000parrot-5.9.0/examples/shootout# Copyright (C) 2005-2009, Parrot Foundation. =head1 NAME examples/shootout/harmonic.pir - Partial sum of Harmonic series =head1 SYNOPSIS % ./parrot examples/shootout/harmonic.pir -R jit 10000000 =head1 DESCRIPTION Seemed to be deprecated, no longer found on shootout site (Karl), so could not find an expected output file. Translated from C code by Greg Buchholz into PIR by Peter Baylies . The C code is at: The Great Computer Language Shootout http://shootout.alioth.debian.org/ =cut .sub 'main' :main .param pmc argv .local int argc .local int n .local num i, sum i = 1 sum = 0 argc = argv n = 10000000 if argc <= 1 goto NREDO $S0 = argv[1] n = $S0 NREDO: $N1 = 1 / i sum += $N1 inc i dec n if n goto NREDO $P0 = new 'FixedFloatArray' $P0 = 1 $P0[0] = sum $S0 = sprintf "%.9f\n", $P0 print $S0 end .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: 90_writing_tests.pir000644000765000765 167412101554066 22133 0ustar00brucebruce000000000000parrot-5.9.0/examples/tutorial# Copyright (C) 2007-2012, Parrot Foundation. =pod =head1 DESCRIPTION A tutorial lesson about writing tests in Parrot. =head1 WRITING TESTS This example demonstrates writing tests using the PIR version of Test::More. (Worth explaining a little of how ok, is, skip, and todo work.) Also demonstrates exporting from one namespace to another (should be updated to use particle's Exporter). =cut .sub _main :main load_bytecode 'Test/More.pbc' .local pmc exports, curr_namespace, test_namespace curr_namespace = get_namespace test_namespace = get_namespace [ 'Test'; 'More' ] exports = split " ", "plan ok is isa_ok skip todo" test_namespace.'export_to'(curr_namespace, exports) plan( 4 ) ok(1, "first test") $I0 = 2 is($I0, 2, "second test") skip(1, "skipped test") todo(1, 42, "todo test") .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: cage_cleaners_guide.pod000644000765000765 2722612101554066 21574 0ustar00brucebruce000000000000parrot-5.9.0/docs/project# Copyright (C) 2007-2012, Parrot Foundation. =pod =head1 NAME docs/project/cage_cleaners_guide.pod - Cage Cleaner Guide. =head1 DESCRIPTION From F: Fixes failing tests, makes sure coding standards are implemented, reviews documentation and examples. A class of tickets in the tracking system (Trac) has been created for use by this group. This is an entry level position, and viewed as a good way to get familiar with parrot internals. =head1 TESTING PARROT AFTER MAKING A CODE CLEANING CHANGE To be really I sure you're not breaking anything after doing code cleaning or attending to the newspaper at the bottom of our Parrot's cage here are is the process I (ptc) go through before committing a new change: make realclean > make_realclean.out 2>&1 perl Configure.pl > perl_configure.out 2>&1 make buildtools_tests > buildtools_tests.out 2>&1 make test > make_test.out 2>&1 Then I diff the C<*.out> files with copies of the C<*.out> files I made on a previous test run. If the diffs show nothing nasty is happening, you can be more sure that you've not broken anything and can commit the change. Then rename the C<*.out> files to something like C<*.out.old> so that you maintain reasonably up to date references for the diffs. This process should be put into a script and stored somewhere... =head1 PARROT CAGE CLEANERS' HIGH-LEVEL GOALS =head2 Smoke testing on many platforms with many compilers The more platforms we have, the more likely we are to find portability problems. Parrot has to be the most portable thing we've created. More platforms also means more compilers. Maybe your DEC compiler is more picky than gcc, and spews more warnings. Good! More opportunities for cleaning! =head3 icc C is the Intel C/C++ Compiler and is available for free for non-commercial use. To use C to build parrot, use the following arguments to C: perl Configure.pl --cc=icc --ld=icc (courtesy of Steve Peters, C). =head2 Compiler pickiness Use as many compiler warnings as we possibly can. The more warnings we enable, the less likely something will pass the watchful eye of the compiler. Note that warnings may not just be -W flags. Some warnings in gcc only show up when optimization is enabled. =head2 splint Splint (L) is a very very picky lint tool, and setup and configuration is a pain. Andy has tried to get Perl 5 running under it nicely, but has met with limited success. Maybe the Parrot will be nicer. =head2 Solaris lint Sun has made its dev tools freely available at L. Its lint is the best one out there, except from Gimpel's FlexeLint (L) which costs many dollars. =head2 Enforcing coding standards, naming conventions, etc =over 4 =item * Automatic standards checking The docs in F explains what our code should look like. Write something that automatically validates it in a .t file. =item * C checking Declaring variables as C wherever possible lets the compiler do lots of checking that wouldn't normally be possible. Walk the source code adding the C qualifier wherever possible. The biggest bang is always in passing pointers into functions. =back =head2 Why consting is good In Perl, we have the C pragma to define unchanging values. The L module extends this to allow arrays and hashes to be non-modifiable as well. In C, we have C numbers and pointers, and using them wherever possible lets us put safety checks in our code, and the compiler will watch over our shoulders. =head3 C numbers The easiest way to use the C qualifier is by flagging numbers that are set at the top of a block. For example: int max_elements; max_elements = nusers * ELEMENTS_PER_USER; ... array[max_elements++] = n; /* but you really meant array[max_elements] = n++; */ Adding a C qualifier means you can't accidentally modify C. const int max_elements = nusers * ELEMENTS_PER_USER; =head3 C pointers If a pointer is qualified as const, then its contents cannot be modified. This lets the compiler protect you from doing naughty things to yourself. Here are two examples for functions you're familiar with: int strlen( const char *str ); void memset( char *ptr, char value, int length ); In the case of C, the caller is guaranteed that any string passed in won't be modified. How terrible it would be if it was possible for C to modify what gets passed in! The const on C's parameter also lets the compiler know that C can't be initializing what's passed in. For example: char buffer[ MAX_LEN ]; int n = strlen( buffer ); The compiler knows that C hasn't been initialized, and that C can't be initializing it, so the call to C is on an uninitialized value. Without the const, the compiler assumes that the contents of any pointer are getting initialized or modified. =head3 C arrays Consting arrays makes all the values in the array non-modifiable. const int days_per_month[] = { 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 }; You don't want to be able to do C, right? (We'll ignore that about 25% of the time you want C to be 29.) =head3 Mixing C Combining Cs on a pointer and its contents can get confusing. It's important to know on which side of the asterisk that the C lies. To the left of the asterisk, the characters are constant. To the right of the asterisk, the pointer is constant. Note the difference between a pointer to constant characters: /* Pointer to constant characters */ const char *str = "Don't change me."; str++; /* legal, now points at "o" */ *str = "x"; /* not legal */ and a constant pointer to characters: /* Constant pointer to characters */ char * const str = buffer; str++; /* not legal */ *str = 'x'; /* buffer[0] is now 'x' */ Note the difference between which side of the asterisk that the C is on. You can also combine the two, with a constant pointer to constant characters: const char * const str = "Don't change me"; or even an array of constant pointers to constant characters: const char * const days[] = { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" }; If you see a declaration you don't understand, use C. It's standard in many C compiler suites, and is freely available around the net. $ cdecl Type `help' or `?' for help cdecl> explain const char * str; declare str as pointer to const char cdecl> explain char * const str; declare str as const pointer to char =head2 Decreasing the amount of repeated code PMD (L) has been used on C code, even though it's a Java tool. It looks for repeated strings of tokens that are candidates for either functions or macros. =head3 PMD usage General usage: pmd [directory] [report format] [ruleset file] To generate html output of unused code within parrot use: pmd . html rulesets/unusedcode.xml > unused_code.html Also distributed with PMD is the CPD (Copy/Paste Detector) which finds duplicate code. An easy way to get started with this tool is to use the gui (cpdgui). Set the root source directory to your parrot working directory, and choose the C option of the C menu. Then put C<.c> in the C box and click C. =head2 Automated source macros Perl5 has a lot of good source management techniques that we can use. =over 4 =item * Macro for interp argument A macro for declaring the interpreter argument, and maybe a macro for passing it BTW, our Perl experience teaches us that somebody is going to want to make the interpreter a C++ object for Windows environments, and it wouldn't hurt to make that possible, or at least work in that direction, as long as clarity doesn't suffer. =item * Parrot_xxx macros Automated processing that would make a macro to let us write somefunc(interp,a,b,c) while the linkage is Parrot_somefunc(interp,a,b,c) for namespace cleanup. This is straight out of F and F in Perl5. =back =head2 Automated generation of C headers This has started significantly with the F program. Right now, it extracts the function headers correctly, but now I have to have it create the F<.h> files. =head2 Creating automated code checking tools =head2 Documenting function behavior and structure members =head2 Developing coverage tools =head2 Automatically running the coverage tools =head2 Run on many different C compilers Most of Andy's work right now is with GCC 4.2 on Linux. We need many more. =head2 Run under valgrind Valgrind (L) is a profiler/debugger most notable for the way it magically monitors memory accesses and management. To run parrot under Valgrind, the following argument set should be helpful: valgrind --num-callers=500 \ --leak-check=full --leak-resolution=high --show-reachable=yes \ parrot --leak-test (adapted from a post to C by chromatic). See also the F and F files. C is a wrapper around running parrot with valgrind and uses a custom set of "valgrind suppressions". =head2 IMCC cleanup From #parrot: vsoni: there seems to be some dead code/feature....I had a chat with leo and I am going to send and email to p6i for deprecation of certain old features =head2 Help other contributors hack their patches into Parrot-style industrial-strength C code. From chip's comment at L We've just had contributed an improved register allocation implementation, but since the contributor is new to Parrot, there are some style and coding standards issues that need to be worked out. It'd be great if a Cage Cleaner could step up and help our new contributor bang the code into Parrotish form. =head2 Remove usage of deprecated features The F file lists features that are deprecated but not yet removed, as well as experimental features. A Trac ticket will document how this deprecated feature is to be replaced. Help prepare for the actual removal of the feature by replacing its usage. =head2 Clean up skipped tests Parrot has too many skipped tests. Pick a test file with a skipped test, disable the skip() line, then make it pass. The Parrot code may not compile, or you may have to modify it to bring it up to date. The test may not even be useful anymore; we won't know until you try. If you can make it pass, great! If you can make it run, great! Make it a TODO test instead. If neither, please report your findings so that everyone can decide what to do. =head1 HANDY CONFIGURATION TIPS =head2 Displaying trailing whitespace in vim and emacs =head3 Vim Add this to your C<.vimrc>: set list set listchars=trail:-,tab:\.\ B: there is a space character after the last backslash. It is very important! Contributed by Jerry Gay . =head3 Emacs Add this to your C<.emacs>: (setq-default show-trailing-whitespace t) Emacs 22 users can highlight tabs like this: (global-hi-lock-mode 1) (highlight-regexp "\t") Contributed by Eric Hanchrow . =head1 AUTHOR Paul Cochrane a.k.a. ptc; original document by Andy Lester =head1 SEE ALSO F, F and the list of Cage items in github L. =cut App.pir000644000765000765 1217511533177636 21067 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library/SDL =head1 NAME SDL::App - Parrot extension for SDL Applications =head1 SYNOPSIS # load this library load_bytecode 'SDL/App.pir' # create a new SDL::App object .local pmc app app = new ['SDL'; 'App'] # set the app's arguments .local pmc app_args app_args = new 'Hash' app_args[ 'height' ] = 480 app_args[ 'width' ] = 640 app_args[ 'bpp' ] = 0 app_args[ 'flags' ] = 1 # initialize the object and get the main surface .local pmc main_surface main_surface = app.'BUILD'( app_args ) # go to town filling, blitting, and updating the app # for example: main_surface.update() ... # then, shut down cleanly app.'quit'() =head1 DESCRIPTION The parrot SDL libraries require the C SDL library: See L for information on how to obtain and install this library. SDL::App is the entry point for all SDL Applications. It handles most of the other setup for you. Trust me, there's a little bit -- if you care, it will initialize the SDL library. This object represents the main window and the associated drawing surface. There should only be one of those per program. As this represents an L object, you can call any method of that class on objects of this class. B It's not yet complete. Please let me know if you have added or would like someone to add missing features. =head1 METHODS The SDL::App object has the following methods: =over 4 =cut .namespace [ 'SDL'; 'App' ] .sub _initialize :load .include 'datatypes.pasm' load_bytecode 'SDL.pir' load_bytecode 'SDL/Surface.pir' load_bytecode 'SDL/Constants.pir' .local pmc app_class newclass app_class, ['SDL'; 'App'] addattribute app_class, 'height' addattribute app_class, 'width' addattribute app_class, 'bpp' addattribute app_class, 'flags' addattribute app_class, 'surface' .return() .end =item init( [ width => xxx ], [ height => xxx ], [ bpp => xx ], [ flags => xx ]) Initialize the new object with the necessary arguments. The named arguments areas follows: =over 4 =item C the width of the main window, in pixels =item C the height of the main window, in pixels =item C the ideal bit depth of the screen to create. Note that you may receive a screen of different (possibly lesser) capabilities, as that's what SDL does. If you pass C<0> here, you'll receive the recommended bit depth. =item C an integer value representing the proper SDL constants from C. See that module for ideas on what to pass here, or give me a better suggestion about the interface here. =back =cut .sub 'init' :method .param int width :named('width') .param int height :named('height') .param int bpp :named('bpp') .param int flags :named('flags') .local pmc SetVideoMode SetVideoMode = get_hll_global ['SDL'; 'NCI'], 'SetVideoMode' .local pmc screen screen = SetVideoMode( width, height, bpp, flags ) # XXX - need to check this here somehow # defined $I0, screen .local pmc main_surface new main_surface, ['SDL'; 'Surface'] main_surface.'wrap_surface'( screen ) .local pmc intvalue intvalue = new 'Integer' set intvalue, height setattribute self, 'height', intvalue intvalue = new 'Integer' set intvalue, width setattribute self, 'width', intvalue intvalue = new 'Integer' set intvalue, bpp setattribute self, 'bpp', intvalue intvalue = new 'Integer' set intvalue, flags setattribute self, 'flags', intvalue setattribute self, 'surface', main_surface .return() .end =item surface() Returns the main surface. This is an L. =cut .sub surface :method .local pmc surface getattribute surface, self, 'surface' .return( surface ) .end =item quit() Quits the main window and shuts down SDL. You probably only have one shot at this. =cut .sub quit :method .local pmc SDL_Quit SDL_Quit = get_hll_global ['SDL'; 'NCI'], 'Quit' SDL_Quit() .end =item height() Returns the height of the main window, in pixels. This will likely move to L. =cut .sub height :method .local pmc height .local int result getattribute height, self, 'height' set result, height .return( result ) .end =item width() Returns the width of the main window, in pixels. This will likely move to L. =cut .sub width :method .local pmc width .local int result getattribute width, self, 'width' set result, width .return( result ) .end =item bpp() Returns the bit depth of the main window, in pixels. =cut .sub bpp :method .local pmc bpp .local int result getattribute bpp, self, 'bpp' set result, bpp .return( result ) .end =back =head1 AUTHOR Written and maintained by chromatic, Echromatic at wgz dot orgE, with suggestions from Jens Rieks. Please send patches, feedback, and suggestions to the Perl 6 Internals mailing list. =head1 COPYRIGHT Copyright (C) 2004-2008, Parrot Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: beta.pm000644000765000765 150011533177644 20626 0ustar00brucebruce000000000000parrot-5.9.0/t/configure/testlib/init# Copyright (C) 2001-2003, Parrot Foundation. =head1 NAME t/configure/testlib/init/beta.pm - Module used in configuration tests =head1 DESCRIPTION Nonsense module used only in testing the configuration system. =cut package init::beta; use strict; use warnings; use base qw(Parrot::Configure::Step); sub _init { my $self = shift; my %data; $data{description} = q{Determining if your computer does beta}; $data{args} = [ qw( verbose ) ]; $data{result} = q{}; return \%data; } sub runstep { my ( $self, $conf ) = @_; my $verbose = $conf->options->get('verbose'); print "\nbeta is verbose\n" if $verbose; print "\nYou've got beta\n"; return 1; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: Parrot.pm000644000765000765 1165011567202623 20656 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/Docs/Section# Copyright (C) 2004-2010, Parrot Foundation. =head1 NAME Parrot::Docs::Section::Parrot - Root documentation section =head1 SYNOPSIS use Parrot::Docs::Section::Parrot; Parrot::Docs::Section::Parrot->new->write_html; =head1 DESCRIPTION This is the top-level section for the HTML documentation for Parrot. =head2 Class Methods =over =cut package Parrot::Docs::Section::Parrot; use strict; use warnings; use base qw( Parrot::Docs::Section ); use Parrot::Distribution; use Parrot::Docs::Section::Developer; use Parrot::Docs::Section::PMCs; use Parrot::Docs::Section::Ops; use Parrot::Docs::Section::Tools; use Parrot::Docs::Section::Compilers; use Parrot::Docs::Section::PDDs; use Parrot::Docs::Section::PCT_Tutorial; =item C Returns a new section. =cut sub new { my $self = shift; return $self->SUPER::new( 'Home', 'index.html', 'This documentation is a snapshot from the Parrot source.', $self->new_group( 'Introduction', '', $self->new_item( 'Introduction to Parrot', 'docs/intro.pod'), $self->new_item( 'Getting Started', 'docs/book/pct/ch02_getting_started.pod'), $self->new_item( 'Navigating the Docs', 'docs/parrot.pod'), $self->new_item( 'Roles & Responsibilities', 'docs/project/roles_responsibilities.pod'), $self->new_item( 'Release History', 'docs/parrothist.pod'), $self->new_item( 'Donors', 'DONORS.pod'), $self->new_item( 'Glossary', 'docs/glossary.pod'), $self->new_item( 'Support Policy', 'docs/project/support_policy.pod'), ), $self->new_group( 'Working with Parrot', '', $self->new_item( 'Running Parrot', 'docs/running.pod'), $self->new_item( 'Testing Parrot', 'docs/tests.pod'), $self->new_item( 'Developer FAQ', 'docs/gettingstarted.pod'), $self->new_item( 'Submitting Bug Reports & Patches', 'docs/submissions.pod' ), ), $self->new_group( 'Implementing Languages on Parrot', '', $self->new_item( 'Parrot Compiler Tools', 'docs/book/pct/ch03_compiler_tools.pod'), Parrot::Docs::Section::PCT_Tutorial->new, $self->new_item( 'Parrot Grammar Engine', 'docs/book/pct/ch04_pge.pod'), $self->new_item( 'Not Quite Perl', 'docs/book/pct/ch05_nqp.pod'), $self->new_item( 'Compiler FAQ', 'docs/compiler_faq.pod'), ), $self->new_group( 'Design, Internals & Development', '', $self->new_item( 'Overview', 'docs/overview.pod'), Parrot::Docs::Section::PDDs->new, Parrot::Docs::Section::PMCs->new, Parrot::Docs::Section::Ops->new, Parrot::Docs::Section::Developer->new, Parrot::Docs::Section::Tools->new, $self->new_item( 'Syntax Highlighting for Vim & Emacs', 'editor/README.pod'), ), $self->new_group( 'PIR Book', '', $self->new_item( 'Chapter 1 Introduction', 'docs/book/pir/ch01_introduction.pod'), $self->new_item( 'Chapter 2 Getting Started', 'docs/book/pir/ch02_getting_started.pod'), $self->new_item( 'Chapter 3 Basic Syntax', 'docs/book/pir/ch03_basic_syntax.pod'), $self->new_item( 'Chapter 4 Variables', 'docs/book/pir/ch04_variables.pod'), $self->new_item( 'Chapter 5 Control Structures', 'docs/book/pir/ch05_control_structures.pod'), $self->new_item( 'Chapter 6 Subroutines', 'docs/book/pir/ch06_subroutines.pod'), $self->new_item( 'Chapter 7 Objects', 'docs/book/pir/ch07_objects.pod'), $self->new_item( 'Chapter 8 IO', 'docs/book/pir/ch08_io.pod'), $self->new_item( 'Chapter 9 Exceptions', 'docs/book/pir/ch09_exceptions.pod'), ), $self->new_group( 'PCT Book', '', $self->new_item( 'Chapter 1 Introduction', 'docs/book/pct/ch01_introduction.pod'), $self->new_item( 'Chapter 2 Getting Started', 'docs/book/pct/ch02_getting_started.pod'), $self->new_item( 'Chapter 3 Compiler Tools', 'docs/book/pct/ch03_compiler_tools.pod'), $self->new_item( 'Chapter 4 Grammar Engine', 'docs/book/pct/ch04_pge.pod'), $self->new_item( 'Chapter 5 Grammar Actions', 'docs/book/pct/ch05_nqp.pod'), ), ); } =back =head2 Instance Methods =over 4 =item C Writes the HTML documentation. If C<$silent> is true then progress is not reported. =cut sub write_docs { my $self = shift; my $silent = shift || 0; my $version = shift || ''; my $dist = Parrot::Distribution->new; $self->{VERSION} = $version; $self->write_html( $dist, $dist->html_docs_directory, $silent ); return; } =back =cut 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: capture.pmc000644000765000765 4607511716253436 16267 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME src/pmc/capture.pmc - Capture PMC =head1 DESCRIPTION These are the vtable functions for the Capture PMC. =head2 Functions =over 4 =cut */ /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* HEADERIZER END: static */ #define CAPTURE_array_CREATE(i, obj, arr) \ do { \ GETATTR_Capture_array((i), (obj), (arr)); \ if (!(arr)) { \ PObj_custom_mark_SET(obj); \ (arr) = Parrot_pmc_new((i), enum_class_ResizablePMCArray); \ SETATTR_Capture_array((i), (obj), (arr)); \ PARROT_GC_WRITE_BARRIER((i), (obj)); \ } \ } while (0) #define CAPTURE_hash_CREATE(i, obj, hsh) \ do { \ GETATTR_Capture_hash((i), (obj), (hsh)); \ if (!(hsh)) { \ PObj_custom_mark_SET(obj); \ (hsh) = Parrot_pmc_new((i), enum_class_Hash); \ SETATTR_Capture_hash((i), (obj), (hsh)); \ PARROT_GC_WRITE_BARRIER((i), (obj)); \ } \ } while (0) pmclass Capture auto_attrs { ATTR PMC *array; ATTR PMC *hash; /* =item C Creates an identical copy of the Capture. =cut */ VTABLE PMC *clone() { PMC *array, *hash; PMC * const dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF)); GET_ATTR_array(INTERP, SELF, array); GET_ATTR_hash(INTERP, SELF, hash); if (!PMC_IS_NULL(array)) { PObj_custom_mark_SET(dest); array = VTABLE_clone(INTERP, array); SET_ATTR_array(INTERP, dest, array); } if (!PMC_IS_NULL(hash)) { PObj_custom_mark_SET(dest); hash = VTABLE_clone(INTERP, hash); SET_ATTR_hash(INTERP, dest, hash); } /* clone of parts can trigger GC. Explicitely WB dest */ PARROT_GC_WRITE_BARRIER(INTERP, dest); return dest; } /* =item C =item C =item C =item C Sets a value in the array component of the Capture. =cut */ VTABLE void set_number_keyed_int(INTVAL key, FLOATVAL value) { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); VTABLE_set_number_keyed_int(INTERP, array, key, value); } VTABLE void set_integer_keyed_int(INTVAL key, INTVAL value) { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); VTABLE_set_integer_keyed_int(INTERP, array, key, value); } VTABLE void set_pmc_keyed_int(INTVAL key, PMC *value) { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); VTABLE_set_pmc_keyed_int(INTERP, array, key, value); } VTABLE void set_string_keyed_int(INTVAL key, STRING *value) { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); VTABLE_set_string_keyed_int(INTERP, array, key, value); } /* =item C =item C =item C =item C Retrieves a value in the array component of the Capture. =cut */ VTABLE FLOATVAL get_number_keyed_int(INTVAL key) { PMC *array; GET_ATTR_array(INTERP, SELF, array); if (!array) return 0.0; return VTABLE_get_number_keyed_int(INTERP, array, key); } VTABLE INTVAL get_integer_keyed_int(INTVAL key) { PMC *array; GET_ATTR_array(INTERP, SELF, array); if (!array) return 0; return VTABLE_get_integer_keyed_int(INTERP, array, key); } VTABLE PMC *get_pmc_keyed_int(INTVAL key) { PMC *array; GET_ATTR_array(INTERP, SELF, array); if (!array) return PMCNULL; return VTABLE_get_pmc_keyed_int(INTERP, array, key); } VTABLE STRING *get_string_keyed_int(INTVAL key) { PMC *array; GET_ATTR_array(INTERP, SELF, array); if (!array) return CONST_STRING(INTERP, ""); return VTABLE_get_string_keyed_int(INTERP, array, key); } /* =item C =item C =item C =item C Push a value onto the array component of the Capture. =item C =item C =item C =item C Unshift a value onto the array component of the Capture. =cut */ VTABLE void push_float(FLOATVAL value) { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); VTABLE_push_float(INTERP, array, value); } VTABLE void push_integer(INTVAL value) { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); VTABLE_push_integer(INTERP, array, value); } VTABLE void push_pmc(PMC *value) { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); VTABLE_push_pmc(INTERP, array, value); } VTABLE void push_string(STRING *value) { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); VTABLE_push_string(INTERP, array, value); } VTABLE void unshift_float(FLOATVAL value) { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); VTABLE_unshift_float(INTERP, array, value); } VTABLE void unshift_integer(INTVAL value) { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); VTABLE_unshift_integer(INTERP, array, value); } VTABLE void unshift_pmc(PMC *value) { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); VTABLE_unshift_pmc(INTERP, array, value); } VTABLE void unshift_string(STRING *value) { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); VTABLE_unshift_string(INTERP, array, value); } /* =item C =item C =item C =item C Pop a value from the array component of the Capture. =item C =item C =item C =item C Shift a value from the array component of the Capture. =cut */ VTABLE FLOATVAL pop_float() { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); return VTABLE_pop_float(INTERP, array); } VTABLE INTVAL pop_integer() { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); return VTABLE_pop_integer(INTERP, array); } VTABLE PMC *pop_pmc() { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); return VTABLE_pop_pmc(INTERP, array); } VTABLE STRING *pop_string() { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); return VTABLE_pop_string(INTERP, array); } VTABLE FLOATVAL shift_float() { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); return VTABLE_shift_float(INTERP, array); } VTABLE INTVAL shift_integer() { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); return VTABLE_shift_integer(INTERP, array); } VTABLE PMC *shift_pmc() { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); return VTABLE_shift_pmc(INTERP, array); } VTABLE STRING *shift_string() { PMC *array; CAPTURE_array_CREATE(INTERP, SELF, array); return VTABLE_shift_string(INTERP, array); } /* =item C Return the number of elements in the array component of the Capture. =item C Return true if element C of the array component is defined. =item C Return true if element C of the array component exists. =item C Delete the element corresponding to C in the array component. =cut */ VTABLE INTVAL elements() { PMC *array; GET_ATTR_array(INTERP, SELF, array); if (!array) return 0; return VTABLE_elements(INTERP, array); } VTABLE INTVAL defined_keyed_int(INTVAL key) { PMC *array; GET_ATTR_array(INTERP, SELF, array); if (!array) return 0; return VTABLE_defined_keyed_int(INTERP, array, key); } VTABLE INTVAL exists_keyed_int(INTVAL key) { PMC *array; GET_ATTR_array(INTERP, SELF, array); if (!array) return 0; return VTABLE_exists_keyed_int(INTERP, array, key); } VTABLE void delete_keyed_int(INTVAL key) { PMC *array; GET_ATTR_array(INTERP, SELF, array); if (array) VTABLE_delete_keyed_int(INTERP, array, key); } /* =item C =item C =item C =item C Sets a value in the hash component of the Capture. =cut */ VTABLE void set_number_keyed(PMC *key, FLOATVAL value) { PMC *hash; CAPTURE_hash_CREATE(INTERP, SELF, hash); VTABLE_set_number_keyed(INTERP, hash, key, value); } VTABLE void set_integer_keyed(PMC *key, INTVAL value) { PMC *hash; CAPTURE_hash_CREATE(INTERP, SELF, hash); VTABLE_set_integer_keyed(INTERP, hash, key, value); } VTABLE void set_pmc_keyed(PMC *key, PMC *value) { PMC *hash; CAPTURE_hash_CREATE(INTERP, SELF, hash); VTABLE_set_pmc_keyed(INTERP, hash, key, value); } VTABLE void set_string_keyed(PMC *key, STRING *value) { PMC *hash; CAPTURE_hash_CREATE(INTERP, SELF, hash); VTABLE_set_string_keyed(INTERP, hash, key, value); } /* =item C =item C =item C =item C Retrieves a value from the hash component of the Capture. =cut */ VTABLE FLOATVAL get_number_keyed(PMC *key) { PMC *hash; GET_ATTR_hash(INTERP, SELF, hash); if (!hash) return 0.0; return VTABLE_get_number_keyed(INTERP, hash, key); } VTABLE INTVAL get_integer_keyed(PMC *key) { PMC *hash; GET_ATTR_hash(INTERP, SELF, hash); if (!hash) return 0; return VTABLE_get_integer_keyed(INTERP, hash, key); } VTABLE PMC *get_pmc_keyed(PMC *key) { PMC *hash; GET_ATTR_hash(INTERP, SELF, hash); if (!hash) return PMCNULL; return VTABLE_get_pmc_keyed(INTERP, hash, key); } VTABLE STRING *get_string_keyed(PMC *key) { PMC *hash; GET_ATTR_hash(INTERP, SELF, hash); if (!hash) return CONST_STRING(INTERP, ""); return VTABLE_get_string_keyed(INTERP, hash, key); } /* =item C =item C =item C =item C Sets a value in the hash component of the Capture. =cut */ VTABLE void set_number_keyed_str(STRING *key, FLOATVAL value) { PMC *hash; CAPTURE_hash_CREATE(INTERP, SELF, hash); VTABLE_set_number_keyed_str(INTERP, hash, key, value); } VTABLE void set_integer_keyed_str(STRING *key, INTVAL value) { PMC *hash; CAPTURE_hash_CREATE(INTERP, SELF, hash); VTABLE_set_integer_keyed_str(INTERP, hash, key, value); } VTABLE void set_pmc_keyed_str(STRING *key, PMC *value) { PMC *hash; CAPTURE_hash_CREATE(INTERP, SELF, hash); VTABLE_set_pmc_keyed_str(INTERP, hash, key, value); } VTABLE void set_string_keyed_str(STRING *key, STRING *value) { PMC *hash; CAPTURE_hash_CREATE(INTERP, SELF, hash); VTABLE_set_string_keyed_str(INTERP, hash, key, value); } /* =item C =item C =item C =item C Retrieves a value in the hash component of the Capture. =cut */ VTABLE FLOATVAL get_number_keyed_str(STRING *key) { PMC *hash; GET_ATTR_hash(INTERP, SELF, hash); if (!hash) return 0.0; return VTABLE_get_number_keyed_str(INTERP, hash, key); } VTABLE INTVAL get_integer_keyed_str(STRING *key) { PMC *hash; GET_ATTR_hash(INTERP, SELF, hash); if (!hash) return 0; return VTABLE_get_integer_keyed_str(INTERP, hash, key); } VTABLE PMC *get_pmc_keyed_str(STRING *key) { PMC *hash; GET_ATTR_hash(INTERP, SELF, hash); if (!hash) return PMCNULL; return VTABLE_get_pmc_keyed_str(INTERP, hash, key); } VTABLE STRING *get_string_keyed_str(STRING *key) { PMC *hash; GET_ATTR_hash(INTERP, SELF, hash); if (!hash) return CONST_STRING(INTERP, ""); return VTABLE_get_string_keyed_str(INTERP, hash, key); } /* =item C Return true if element C of the hash component is defined. =item C Return true if element C of the hash component exists. =item C Delete the element corresponding to C in the hash component. =cut */ VTABLE INTVAL defined_keyed(PMC *key) { PMC *hash; GET_ATTR_hash(INTERP, SELF, hash); if (!hash) return 0; return VTABLE_defined_keyed(INTERP, hash, key); } VTABLE INTVAL exists_keyed(PMC *key) { PMC *hash; GET_ATTR_hash(INTERP, SELF, hash); if (!hash) return 0; return VTABLE_exists_keyed(INTERP, hash, key); } VTABLE void delete_keyed(PMC *key) { PMC *hash; GET_ATTR_hash(INTERP, SELF, hash); if (hash) VTABLE_delete_keyed(INTERP, hash, key); } /* =item C Return true if element C of the hash component is defined. =item C Return true if element C of the hash component exists. =item C Delete the element corresponding to C in the hash component. =cut */ VTABLE INTVAL defined_keyed_str(STRING *key) { PMC *hash; GET_ATTR_hash(INTERP, SELF, hash); if (!hash) return 0; return VTABLE_defined_keyed_str(INTERP, hash, key); } VTABLE INTVAL exists_keyed_str(STRING *key) { PMC *hash; GET_ATTR_hash(INTERP, SELF, hash); if (!hash) return 0; return VTABLE_exists_keyed_str(INTERP, hash, key); } VTABLE void delete_keyed_str(STRING *key) { PMC *hash; GET_ATTR_hash(INTERP, SELF, hash); if (hash) VTABLE_delete_keyed_str(INTERP, hash, key); } /* =item C Set this capture to hold the value of another. If set to PMCNULL, erase the contents of the array and hash components. =cut */ VTABLE void set_pmc(PMC *capture) { if (PMC_IS_NULL(capture)) { SET_ATTR_array(INTERP, SELF, NULL); SET_ATTR_hash(INTERP, SELF, NULL); } else if (VTABLE_isa(INTERP, capture, CONST_STRING(INTERP, "Capture"))) { PMC *array, *hash; GET_ATTR_array(INTERP, capture, array); GET_ATTR_hash(INTERP, capture, hash); SET_ATTR_array(INTERP, SELF, array); SET_ATTR_hash(INTERP, SELF, hash); if (!PMC_IS_NULL(array) || !PMC_IS_NULL(hash)) PObj_custom_mark_SET(SELF); } else Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "Can only set a capture to another capture."); } /* =item C Return a string representation of the hash, showing class and memory address. =cut */ VTABLE STRING *get_string() { const STRING * const classname = VTABLE_name(INTERP, SELF); return Parrot_sprintf_c(INTERP, "%S[0x%x]", classname, SELF); } /* =item C Mark the array. =cut */ VTABLE void mark() { PMC *array, *hash; GET_ATTR_array(INTERP, SELF, array); GET_ATTR_hash(INTERP, SELF, hash); Parrot_gc_mark_PMC_alive(INTERP, array); Parrot_gc_mark_PMC_alive(INTERP, hash); } /* =item C =item C Freeze/thaw Capture =cut */ VTABLE void freeze(PMC *info) { PMC *array, *hash; GET_ATTR_array(INTERP, SELF, array); GET_ATTR_hash(INTERP, SELF, hash); VTABLE_push_pmc(INTERP, info, array); VTABLE_push_pmc(INTERP, info, hash); } VTABLE void thaw(PMC *info) { PMC *tmp; tmp = VTABLE_shift_pmc(INTERP, info); if (!PMC_IS_NULL(tmp)) { SET_ATTR_array(INTERP, SELF, tmp); PObj_custom_mark_SET(SELF); } tmp = VTABLE_shift_pmc(INTERP, info); if (!PMC_IS_NULL(tmp)) { SET_ATTR_hash(INTERP, SELF, tmp); PObj_custom_mark_SET(SELF); } } /* =back =head2 Methods =over 4 =cut */ METHOD list() :manual_wb { PMC *array; PMC *capt; /* XXX: This workaround is for when we get here as part of a subclass of Capture */ if (PObj_is_object_TEST(SELF)) { PMC *classobj; PMC *ns = INTERP->root_namespace; ns = Parrot_ns_get_namespace_keyed_str(INTERP, ns, CONST_STRING(INTERP, "parrot")); ns = Parrot_ns_get_namespace_keyed_str(INTERP, ns, CONST_STRING(INTERP, "Capture")); classobj = Parrot_oo_get_class(INTERP, ns); capt = VTABLE_get_attr_keyed(INTERP, SELF, classobj, CONST_STRING(INTERP, "proxy")); } else capt = SELF; CAPTURE_array_CREATE(INTERP, capt, array); RETURN(PMC *array); } METHOD hash() :manual_wb { PMC *hash; PMC *capt; /* XXX: This workaround is for when we get here as part of a subclass of Capture */ if (PObj_is_object_TEST(SELF)) { STRING * const classname = CONST_STRING(INTERP, "Capture"); PMC * const classobj = Parrot_oo_get_class_str(INTERP, classname); capt = VTABLE_get_attr_keyed(INTERP, SELF, classobj, CONST_STRING(INTERP, "proxy")); } else capt = SELF; CAPTURE_hash_CREATE(INTERP, capt, hash); RETURN(PMC *hash); } } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ ptrbuf.pmc000644000765000765 213112101554067 16060 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2011-2012, Parrot Foundation. =head1 NAME src/pmc/ptrbuf.pmc - PtrBuf =head1 DESCRIPTION C is a pointer to a buffer. No affordances for memory management have been made. It has two things - a pointer and a size. =head2 VTABLEs =over 4 =cut */ /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* HEADERIZER END: static */ pmclass PtrBuf extends Ptr auto_attrs { ATTR UINTVAL size; /* =item C C is always C and manages its own attributes. Let C know about this. =cut */ VTABLE void init() { UNUSED(INTERP) PTR_FAT_SET(INTERP, SELF); } /* =item C =item C Get and set the buffer size. =cut */ VTABLE INTVAL get_integer() { INTVAL i; GET_ATTR_size(INTERP, SELF, i); return i; } VTABLE void set_integer_native(INTVAL i) { SET_ATTR_size(INTERP, SELF, i); } } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ genprog.bas000644000765000765 151411533177634 17264 0ustar00brucebruce000000000000parrot-5.9.0/examples/pir1 rem Copyright (C) 2008, Parrot Foundation. 3 rem 10 rem Hello 20 on error exit 1 100 rem ------------------ 110 rem Generating program 120 rem ------------------ 130 p = new("Program") 140 v = p.storeline(10, "rem Hello, world") 150 v = p.storeline(20, "hello = ""Hello, world""") 160 v = p.storeline(30, "print hello") 170 v = p.storeline(40, "?""Bye""") 180 v = p.storeline(100, "on error exit 42") 190 v = p.storeline(110, "error 10") 200 rem ------------------------------------------- 210 v= p.list(20, 40) 1000 rem ------------------------- 1010 rem Run the generated program 1020 rem ------------------------- 1030 r = new("Runner") 1040 v= r.set_program(p) 1050 print "----Running----" 1060 v= r.runloop(1) 1070 print "----Finished---" 1080 print "Exit code: "; v 1090 hello = r.get_var("hello") 1100 print "hello: "; hello 2000 exit addit.pl000644000765000765 176011533177634 20104 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks#! perl # Copyright (C) 2001-2003, Parrot Foundation. =head1 NAME examples/benchmarks/addit.pl - Variable Argument Subroutines =head1 SYNOPSIS % time perl examples/benchmarks/addit.pl =head1 DESCRIPTION Joe Wilson's original Perl version of his C subroutines benchmark. It calls an "add it" function 500000 times in a loop and prints the result (21001097.97). =cut use strict; use warnings; sub varargs_adder { my $sum = 0; for ( my $a = $#_ ; $a >= 0 ; --$a ) { $sum += $_[$a]; } return $sum; } my $result = 0; my @args; $args[0] = 1000; $args[1] = 7.100; $args[2] = 87; $args[3] = "3.87"; $args[4] = "21000000"; for ( my $x = 50000 ; $x >= 0 ; --$x ) { $result = varargs_adder(@args); } print "$result\n"; =head1 SEE ALSO F, F, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: api.c000644000765000765 1342511716253437 16374 0ustar00brucebruce000000000000parrot-5.9.0/compilers/imcc/* * * IMCC call-in routines for use with the Parrot embedding API * * Copyright (C) 2011, Parrot Foundation. */ /* =head1 NAME compilers/imcc/api.c =head1 DESCRIPTION IMCC call-in routines for use with the Parrot embedding API =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" #include "parrot/extend.h" #include "imcc/api.h" #include "imc.h" /* HEADERIZER HFILE: include/imcc/api.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT static PMC * get_compreg_pmc(PARROT_INTERP, int is_pasm, int add_compreg) __attribute__nonnull__(1); #define ASSERT_ARGS_get_compreg_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ #define GET_RAW_INTERP(p) Parrot_interp_get_from_pmc(p) #define GET_INTERP(p) (PMC_IS_NULL(p) ? NULL : GET_RAW_INTERP(p)) #define IMCC_API_CALLIN(p, i) \ Parrot_jump_buff env; \ if (setjmp(env)) { \ Interp * const __interp = GET_INTERP(p); \ __interp->api_jmp_buf = NULL; \ return !__interp->exit_code; \ } \ else { \ Interp * const (i) = GET_INTERP(p); \ void * _oldtop = (i)->lo_var_ptr; \ if (_oldtop == NULL) \ (i)->lo_var_ptr = &_oldtop; \ (i)->api_jmp_buf = &env; \ { #define IMCC_API_CALLOUT(p, i) \ } \ (i)->api_jmp_buf = NULL; \ if (!_oldtop) { \ PARROT_ASSERT((i)->lo_var_ptr == &_oldtop); \ (i)->lo_var_ptr = NULL; \ } \ return 1; \ } /* =item C Get a registerable compiler object for the "PIR" language. If C is 1, register that compiler with Parrot under the name "PIR". =cut */ PARROT_EXPORT PARROT_CANNOT_RETURN_NULL Parrot_Int imcc_get_pir_compreg_api(Parrot_PMC interp_pmc, int add_compreg, ARGOUT(Parrot_PMC *compiler)) { ASSERT_ARGS(imcc_get_pir_compreg_api) IMCC_API_CALLIN(interp_pmc, interp) *compiler = get_compreg_pmc(interp, 0, add_compreg); if (PMC_IS_NULL(*compiler)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNEXPECTED_NULL, "Could not create PIR compiler PMC"); IMCC_API_CALLOUT(interp_pmc, interp) } /* =item C Get a registerable compiler object for the "PASM" language. If C is 1, register that compiler with Parrot under the name "PASM". =cut */ PARROT_EXPORT Parrot_Int imcc_get_pasm_compreg_api(Parrot_PMC interp_pmc, int add_compreg, ARGOUT(Parrot_PMC *compiler)) { ASSERT_ARGS(imcc_get_pasm_compreg_api) IMCC_API_CALLIN(interp_pmc, interp) *compiler = get_compreg_pmc(interp, 1, add_compreg); if (PMC_IS_NULL(*compiler)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNEXPECTED_NULL, "Could not create PASM compiler PMC"); IMCC_API_CALLOUT(interp_pmc, interp) } /* =item C Get an IMCC compiler PMC. Register it under its preferred name if C is 1. =cut */ PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT static PMC * get_compreg_pmc(PARROT_INTERP, int is_pasm, int add_compreg) { ASSERT_ARGS(get_compreg_pmc) PMC * const comp = Parrot_pmc_new_init_int(interp, enum_class_IMCCompiler, is_pasm); if (add_compreg) { STRING * const name = VTABLE_get_string(interp, comp); Parrot_interp_set_compiler(interp, name, comp); } return comp; } /* =item C Compile a file using the given IMCCompiler PMC. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT Parrot_Int imcc_compile_file_api(Parrot_PMC interp_pmc, Parrot_PMC compiler, Parrot_String file, ARGOUT(Parrot_PMC *pbc)) { ASSERT_ARGS(imcc_compile_file_api) IMCC_API_CALLIN(interp_pmc, interp) STRING * const meth_name = Parrot_str_new(interp, "compile_file", 0); PMC * result = PMCNULL; Parrot_pcc_invoke_method_from_c_args(interp, compiler, meth_name, "S->P", file, &result); *pbc = result; IMCC_API_CALLOUT(interp_pmc, interp) } /* =item C Preprocess the specified file only, using the given IMCCompiler PMC. Currently the preprocessed text is dumped directly to stdout. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT Parrot_Int imcc_preprocess_file_api(Parrot_PMC interp_pmc, Parrot_PMC compiler, Parrot_String file) { ASSERT_ARGS(imcc_preprocess_file_api) IMCC_API_CALLIN(interp_pmc, interp) STRING * const meth_name = Parrot_str_new(interp, "preprocess", 0); Parrot_pcc_invoke_method_from_c_args(interp, compiler, meth_name, "S->", file); IMCC_API_CALLOUT(interp_pmc, interp) } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ pdd08_keys.pod000644000765000765 2410512101554066 20173 0ustar00brucebruce000000000000parrot-5.9.0/docs/pdds/draft# Copyright (C) 2001-2010, Parrot Foundation. =head1 [DRAFT] PDD 8: PMC Keys =head2 Abstract This PDD aims to clear up the confusion regarding the implementation of keyed access to PMCs in Parrot. =head2 Description First, let's define some terminology. An C is one which stores or references other values as elements. The aggregate PMC allows indexed access to element by implementing some of the C<_keyed> variants of VTABLE functions. These variants are called C operations, as they act on a specific indexed element of an aggregate PMC. Examples of a aggregate PMCs include C, C and C. Non-aggregates may also support C<_keyed> variants of the VTABLE functions, but they not do anything particularly clever. For instance, PMC types implementing Perl references will merely pass the index on to the referent. These aren't aggregates because they don't directly store or reference elements. Indexing operations take one or more aggregate B. At runtime these operations will index into the B using the C and return a B. Here is a well-known indexing operation in Perl 6: @a[12] = $b; The B here is the constant integer C<12> The aggregate is the C C<@a>. In the process of this assignment, Parrot will have to extract the PMC in element 12 of the array, producing a C. C<$b> is then assigned to this value. Now, how does this all get implemented? =head2 Implementation =head3 The key structure The key structure must bundle multiple keys. This is to allow indexing into multidimensional aggregate PMCs. These keys may be specified as integer, string, number or PMC. For this reason the following structure was produced. Individual keys (e.g. a single C or C) are stored in a C PMC. The type of the key is encoded in the private flags of the PMC as specified below. The value of the C PMC is stored in the PMC's data structure internally and can be accessed using the appropriate get_* VTABLE functions. For example, indexing the multidimensional array C<@foo[$a,12;"hi"]> produces three PMCs; one with a PMC type, one with an integer type and one with a string type. The key type is encoded in the PMC flags using 8 bits based on the following scheme (from includes/parrot/key.h): typedef enum { KEY_integer_FLAG = PObj_private0_FLAG, KEY_number_FLAG = PObj_private1_FLAG, KEY_hash_iterator_FLAGS = PObj_private0_FLAG | PObj_private1_FLAG, KEY_string_FLAG = PObj_private2_FLAG, KEY_pmc_FLAG = PObj_private3_FLAG, KEY_register_FLAG = PObj_private4_FLAG, KEY_type_FLAGS = KEY_integer_FLAG | KEY_number_FLAG | KEY_string_FLAG | KEY_pmc_FLAG | KEY_register_FLA G | KEY_hash_iterator_FLAGS } KEY_flags The C is used to indicate that value if the key is in a register. In this case, the Key PMC's data contains the integer number of the appropriate register in the current context. Parrot must also have a way to combine multiple keys into a key that can be treated as a single unit. This is done by forming a singly linked list such that each key points at the next. Within a single Key PMC, the pointer to the next key is stored in C. The linked list structure allows the use of partial keys in multidimensional lookups, since the next key can be generated while the aggregate PMC is being traversed. These definitions, along with declarations of support routines used to manipulate keys, can be found in F =head3 Aggregate and non-aggregate PMCs We've already said that what separates the aggregate PMCs from the non-aggregates is their implementation of the C<_keyed> vtable functions. So it is Hereby Decreed that the default vtable which everyone inherits from defines the C<_keyed> forms to throw an exception. =over 3 =item Todo Need discussion on whether C is a good exception for this, or whether something else should be used. It's really a compiler screw-up, since code which indexes a non-aggregate shouldn't be generated. =back =head3 C<_keyed> vtable functions So what of these magical C<_keyed> vtable functions? They are generated when you add the C tag to the appropriate entry in F. They are constructed by following B C argument with a second C argument which acts as the key for that argument; the name of the second C argument is formed by adding C<_key> onto the end of the first C argument. The reason why every PMC argument has an associated key is twofold. Firstly, it means that @a[$b] = $c and $a = @b[$c] use the same vtable function, reducing the multiplicity of methods. Secondly, a three-argument C as suggested by the code above would be ambiguous - the code above uses 3 PMCs in different ways. Also, operations which take an aggregate key for one of their arguments should take aggregate keys for B of their arguments. This is to avoid the following: void foo_keyed_i(PMC* x, PMC* x_key, INT a) void foo_keyed_n(PMC* x, PMC* x_key, NUM a) void foo_keyed_p(PMC* x, PMC* x_key, PMC a) void foo_keyed_p_keyed(PMC* x, PMC* x_key, PMC* a, PMC* a_key) These are all replaced with the single entry void foo_keyed(PMC* x, PMC* a_key, PMC* a, PMC* a_key) (Think how much worse it gets when there are three or more PMCs in an entry...) Yes. This means that you may need to turn some things into Cs that you didn't want to. Since the alternative is mega pollution and duplication in the vtable table, and since the majority of things that you'll deal with in a real world situation are expected to be Cs anyway, this shouldn't be too much of a problem. So, if you have a PMC in a C<_keyed> method which you don't want to index, pass in C instead of a real key. Code implementing these methods should understand C as meaning the entirety of C in some sense; this is trivial to understand if C is non-aggregate, and implementation-defined if C is aggregate. If you remember that a key PMC is really a linked list, you'll notice that after traversing down through the list, you'll reach a C which again means the entirety of whatever object you traversed to. Similarly, non-C<_keyed> methods on aggregates are implementation defined; for instance, a C on a C may be understood as setting C<@array.length>. Historically, we first implemented keys as two separate keyed methods per applicable method - C<..._index> and C<..._index_s> for integer and string indexing respectively. However, this didn't give us the flexibility and scalability that key structures give us. =head3 Input to the assembler There are several different valid specifications of an aggregate key to the assembler. These are: op arg, P1[1234] # Constant integer key op arg, P1[I1] # Integer key op arg, P1[12.34] # Constant number key - handled as constant key op arg, P1["foo"] # Constant string key - handled as constant key op arg, P1[I1;I2] # Multi-level key - handled as constant key op arg, P1[P1] # Register key (Rationale: fits programmer's expectation, easier to understand at a glance than C. Also, is C the same as C or C, or are these three separate PMCs?) In all there are four types of key. The first two are integer keys and constant integer keys which are optimisations for the common case of single level integer keys. The other two are constant keys, which can handle any combination of constants and registers with any number of levels; and register keys which are represented by a single PMC register that is assumed to contain a PMC of the Key class. =head3 What the assembler did next When the assembler sees an aggregate key, it "detaches" the key to form a separate argument. It then decides on the type of key. For integer keys (both constant and register) the data is encoded in the same way as an ordinary integer argument. For register keys the data is encoded as for an ordinary PMC register argument, while for constant keys a key constant is generated that encodes the list of constants and registers that make up the key and an appropriate index into the constant table is encoded as the argument. Next it selects the appropriate op. Register keys have the signature C and constant keys have the signature C. Integer register and constant keys are encoded as C and C respectively. =begin PIR_FRAGMENT set $P1["hi"], 1234 =end PIR_FRAGMENT finds an op named C. On the other hand, =begin PIR_FRAGMENT set $P1[$P1], 1234 =end PIR_FRAGMENT produces an op named C. Likewise, this: =begin PIR_FRAGMENT set $P1[1], 1234 =end PIR_FRAGMENT produces an op named C, and this: =begin PIR_FRAGMENT set $P1[$I1], 1234 =end PIR_FRAGMENT produces an op named C. =head3 Bytecode representation The bytecode representation of these keys are as follows: constant keys are treated just like another constant, and are an index into the packfile's constant table. Each key in that constant table consists of one word specifying its length in terms of number of keys. For instance, C<["hi"]> has length 1; C<["hi";P1;S1;123]> has length 4. Next, each key is specified using two words. The first word is a type specifier: 1 - Integer constant 2 - Number constant 4 - String constant 7 - Integer register 8 - Number register 9 - PMC register 10 - String register and the second word is either a value (for integer constants), a register number (for registers) or an index into the appropriate constant table. The type values shown above are actually the C values taken from F. =head2 References None. =cut __END__ Local Variables: fill-column:78 End: vim: expandtab shiftwidth=4: 026-options_test.t000644000765000765 1035411533177643 20216 0ustar00brucebruce000000000000parrot-5.9.0/t/configure#! perl # Copyright (C) 2007, Parrot Foundation. # 026-options_test.t use strict; use warnings; use Carp; use Cwd; use Test::More tests => 20; use lib qw( lib ); use IO::CaptureOutput qw| capture |; use Parrot::Configure::Options qw| process_options |; use Parrot::Configure::Options::Test; use Parrot::Configure::Options::Test::Prepare qw| get_preconfiguration_tests get_postconfiguration_tests |; ##### 1 ##### my ( $args, $step_list_ref ) = process_options( { argv => [], mode => q{configure}, } ); ok( defined $args, "process_options() returned successfully when no options were specified" ); my $opttest = Parrot::Configure::Options::Test->new($args); ok( defined $opttest, "Constructor returned successfully" ); { my $stdout; capture( sub { $opttest->run_configure_tests( get_preconfiguration_tests() ); }, \$stdout, ); ok( ! $stdout, "Nothing captured because no pre-configuration tests were run." ); } { my $stdout; capture( sub { $opttest->run_build_tests( get_postconfiguration_tests() ); }, \$stdout, ); ok( ! $stdout, "Nothing captured because no pre-build tests were run." ); } ##### 2 ##### ($args, $step_list_ref) = process_options( { argv => [q{--test=configure}], mode => q{configure}, } ); ok( defined $args, "process_options() returned successfully when '--test=configure' was specified" ); $opttest = Parrot::Configure::Options::Test->new($args); ok( defined $opttest, "Constructor returned successfully" ); ##### 3 ##### ($args, $step_list_ref) = process_options( { argv => [q{--test=build}], mode => q{configure}, } ); ok( defined $args, "process_options() returned successfully when '--test=build' was specified" ); $opttest = Parrot::Configure::Options::Test->new($args); ok( defined $opttest, "Constructor returned successfully" ); ##### 4 ##### my $badoption = q{foobar}; ($args, $step_list_ref) = process_options( { argv => [qq{--test=$badoption}], mode => q{configure}, } ); ok( defined $args, "process_options() returned successfully when '--test=$badoption' was specified" ); eval { $opttest = Parrot::Configure::Options::Test->new($args); }; like( $@, qr/'$badoption' is a bad value/, "Bad option to '--test' correctly detected" ); ##### 5 ##### ($args, $step_list_ref) = process_options( { argv => [], mode => q{configure}, } ); ok( defined $args, "process_options() returned successfully when no options were specified" ); $opttest = Parrot::Configure::Options::Test->new($args); ok( defined $opttest, "Constructor returned successfully" ); eval { $opttest->set( 'foobar' ); }; like($@, qr/Need 2 arguments to Parrot::Configure::Options::Test::set/, "Correctly detected lack of argument to set()"); $opttest->set( foo => 'bar' ); is($opttest->get( 'foo' ), 'bar', "set() set value correctly"); eval { $opttest->get( foo => 'bar' ); }; like($@, qr/Need 1 argument to Parrot::Configure::Options::Test::get/, "Correctly detected wrong number of arguments to get()"); ok(! defined $opttest->get( 'baz' ), "Correctly detected value which never was set"); eval { $opttest->set_run( 'foobar' ); }; like($@, qr/Need 2 arguments to Parrot::Configure::Options::Test::set_run/, "Correctly detected lack of argument to set_run()"); $opttest->set_run( foo => 'bar' ); is($opttest->get_run( 'foo' ), 'bar', "set_run() set value correctly"); eval { $opttest->get_run( foo => 'bar' ); }; like($@, qr/Need 1 argument to Parrot::Configure::Options::Test::get_run/, "Correctly detected wrong number of arguments to get_run()"); pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME 026-options_test.t - test Parrot::Configure::Options::Test =head1 SYNOPSIS % prove t/configure/026-options_test.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file test Parrot::Configure::Options::Test methods. =head1 AUTHOR James E Keenan =head1 SEE ALSO Parrot::Configure::Options, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: readline.pm000644000765000765 543311606346657 17072 0ustar00brucebruce000000000000parrot-5.9.0/config/auto# Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME config/auto/readline.pm - Probe for readline library =head1 DESCRIPTION Determines whether the platform supports readline. The GNU Project describes its version of the readline library as providing "... a set of functions for use by applications that allow users to edit command lines as they are typed in" (L). Other readline libraries are, however, available and usable with Parrot. =cut package auto::readline; use strict; use warnings; use base qw(Parrot::Configure::Step); use Parrot::Configure::Utils ':auto'; sub _init { my $self = shift; my %data; $data{description} = q{Does your platform support readline}; $data{result} = q{}; return \%data; } sub runstep { my ( $self, $conf ) = @_; my $without_opt = $conf->options->get('without-readline'); if ($without_opt) { $conf->data->set('HAS_READLINE' => 0); $self->set_result('not requested'); return 1; } my $cc = $conf->data->get('cc'); my $osname = $conf->data->get('osname'); my $extra_libs = $self->_select_lib( { conf => $conf, osname => $osname, cc => $cc, win32_nongcc => 'readline.lib', default => '-lreadline', } ); $conf->cc_gen('config/auto/readline/readline_c.in'); my $has_readline = 0; eval { $conf->cc_build( q{}, $extra_libs ) }; if ( !$@ ) { if ( $conf->cc_run() ) { $has_readline = $self->_evaluate_cc_run($conf); } _handle_readline($conf, $extra_libs); } else { # a second chance with ncurses $extra_libs .= ' '; $extra_libs .= $self->_select_lib( { conf => $conf, osname => $osname, cc => $cc, win32_nongcc => 'ncurses.lib', default => '-lncurses', } ); eval { $conf->cc_build( q{}, $extra_libs) }; if ( !$@ ) { if ( $conf->cc_run() ) { $has_readline = $self->_evaluate_cc_run($conf); } _handle_readline($conf, $extra_libs); } } $conf->data->set( HAS_READLINE => $has_readline ); $self->set_result($has_readline ? 'yes' : 'no'); return 1; } sub _evaluate_cc_run { my ($self, $conf) = @_; my $has_readline = 1; $conf->debug(" (yes) "); $self->set_result('yes'); return $has_readline; } sub _handle_readline { my ($conf, $libs) = @_; $conf->data->set( readline => 'define' ); $conf->data->add( ' ', libs => $libs ); return 1; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: mines.png000644000765000765 1106111466337261 21305 0ustar00brucebruce000000000000parrot-5.9.0/examples/sdl/minesweeper‰PNG  IHDRP@Çð6øIDATxœå›}PTç½Ç?ûʾ°,ì.pE@ÁØKRÁëLbŒZ“˜N›i2If2ÓÞÞöb“Î$þÑ™öÞNœVÚ´™›L§¤™Îd’ªMDÍh‡ hŒR4Ö¨ˆÈ È˲¼ì ìÛ9÷eW`Ù¹&ׯsF8<ßç<ç{~ÏóüžïsŽä‰'žY d2ÙÙÙüèG?⥗^Z(ýÿ_`6›ÉÏÏG¡P$TR©¤¤¤„ÜÜ\îv¾ ??ŸÚÚZ4MBH$t:2™Œ»/P(h4´ZmÂÌ|Zóñ‡‡axXŠF#b2‰¨TñùŠ$¶)Þ ¼‚7ØP…Ž UÉÊä¸|µ: ¯wg ŸÏ(Je(•ËP©ô(š„Û/¦ìSLÙ¦"ª Z“6‚/OH±@Àဃ•;¦ ¬,ÀÓO{ÈÍ?ÔN òεwølø3&¼Ȥ2îI¾‡Í9›yhùC,KZ“ïó¹èé9N_ßIŽ^ry))ùäæÖ’ý *UZB÷átÓùa'ÖãV$R æmfJž)‰(·ä^¹"åÿPpø°‚k×ädfŠx< ¾€.Ÿ û”,m«ÓVssü&­C­8¼LÕ9Õ1ù~ÿ$‡Q„ŒŒo •*½Æ­[gðùœ¨ÕF²²6Äm‡  |:€åC ¶Ïl$¥&a(3Ì[vɴ٤ܸ!chHŠÏ·0®QmdwÑn42 Z…–³·Î2Ò6BÇXm£mqT*uäåm!ðMGš„îî£LLXp8¬LMÙã¶!à`»h£¿¹Á' 6¨Ñþ’ ¸re€Çó2>.Án—.ˆ›¦Jã~Õýø>ÒUé(eJ$ÓÿâA¡Ð’™Y €Ý~ññ\®>d2%Ë–­@«?ŠB§ÕIב.ü“~Œ÷±_±3Ñ9•³äæå‰äåùinVÐÜüÅëžæŠý }®>²5Ù¥-ˆß×ׄÅr—«©TŽNgF«½'&ÇëôÒw²ÑŽQ²ÈFkÒâèqÄä,,DþŒLŽÐØÛHSoIÒ$ªî©b­~í‚êQ«õ¤¦®D«ÍF¸Ýýq»ðäÐ$½÷â´:qt;jÂÙãÄçòa»dÃÒ`aÒ69‹³ä(Š·Ðï‚<$’à 1Àðä0Íýͼã}ìSv¶.ßÊŽ;Ыõq¯í÷{ðzÇ‘É”¬X±ƒ¼¼‡èèø—/ÿ##W¿‰^¿&úõ½DAÄïöcý‡•ÀTϘ‡€'À@˹„”ü4™·óÅ%Ðn‡)ƒƒ•põjpB1™ô1tpz|Üû1½þW,ÖÖSZ€Óçäúèu ji1Ò©);}}MH$2’“s‰‰.Á\®E.çª3լܵ’)Û]ôŸêÇÙçÄ°ÎÀÊ]+Qgªgq–\ÀK—äüíoJZZd("7nÈxýu……?Ö•;49ÄGÝÑ>Ö€eÜ»íï"“ÊÈIÎáÛ+¿Í¦œMQù~¿‹[·Î06v©Tx<ã(•:L¦o’gUëÕ˜1‡3®¡ C¸Ý>c¹ó#fdrÙ,Ž\&“¡P(J¥Hbõ¯(˜ËW«!3SdýzÂå23EÔj"®1“¯”*)J+"IžqTU*Iò¤˜|ÆÀŠÛ°Ù>Ãå@ý¨T ådg?€J•³ýRYðAkÐb\oD¡&}u:Š¤Èµ²<;;›5kÖœœœðb@.ï\~M ÔÔˆ@`>¡ ŸŸ¦Hã†_,êú));YµjçæÏ„qãcL>¢ßï¿(îv¾äNø¼üòËÔÕÕ}íøKîšL& Ôˆššrrr¾ü›B»¥ Äa¡ÐéXµiÓÒù………<õÔS º™×ºãüÑQ¶vt ³x¿ Œ«€¬™HME91Å´Û‘ !™ššU™¨R! žá§}Ý¡ Ðú|H¼^œ@ 0ü š.£²CŸÁI2"”·´ |÷]¤ÝÝ •†—ÂòåxŸ|ÿ–-1#LX,Üxï=,‡ãèîF¦P°qß> Ÿ|2îÍdddDÖ9ݵ)--Éïííå/ù ‡Âjµ’œœLEEÏ?ÿ<•••1¼8 L'O/`Ê€‡ ÀÌF(E~ý:LLà߸azlôz„¬¬¹Å#àèéá“—_æÖéÓd®[GVe%©”ä¼¼¸\€çž{nÖï­­­\¸pNw;uˆßÿþ÷üéO¢¨¨ˆÝ»wÓÙÙÉÑ£Géîîæí·ßfÅŠQ¹)Å{hF§Ï÷‚Ñh&Ž€a$'(.Æ_Q¨Õ"¤§CZ|7×òÁô55‘[SCÙ+¯ ¿÷^$ÒÄ=‹W_}5ü³ßïgçÎ`NWSSƒÁÛŽhnnFzè!öìÙCKK ßûÞ÷°X,¸\®˜ÜA‚‘×<òÔSdddðÑGÑÖÖÆ0Ðäõ38Q”ØlÈ?þiW‚ÙŒ¯¢!;@‘k4üëõ×q `(/§øûßG—`†pâÄ ÎŸ?Off&Û·oGk!=5kÖÐÖÖÆJ¥hµZ¼^/[·nù.ó>!yz½“É4k²±G€í#qó(ø*+‘ #ñx·¶ÂùóHl6¼iiE±×“cmm Š ]¼ˆ*#w?ýÍÍŒwt°qß>4 DÀÀÀ¿þõ¯E‘o}ë[ÔÖÖ†gýXسg]]]\¾|™×^{ ¿ßOII Ï<ó éééQy#»¨wú÷ãÇ£V«éêêšUÎK°K‡e„€âb<™™HÇŽ¡øàä­­ø«ªâ (øýÈT*Ö¿ô…»wÓñþûœúÉOè?}š)›-!}> £££ÑÈ®]»HM\Ç·#GŽÐÕÕÅæÍ›1›Í455qõêUêëë),, ç~s±jú#A®]»QFÜ|=ŠÈÁI§CÌËC(,$°n5k@§CâñD¤6óA“™‰àó!øýH¤Rôk×"S©ð»ÝùÖÇ‘¸yó&GÅétRUUEEEEB<€?þñ8N¶nÝÊÏþs^|ñE4 /^dll,*/ XGp¶6Pe[€BnG`„€R‹Ys3²O?E~ö,²K—`rÁ` @ô˜*+|>úšš˜¢ïäI|.)+V H`ßÙãñÐØØÈÅ‹‘Édüð‡?L8Á‡`Êãóù¸t釃äädA@­VÇ–ë FØÌ™VA0Ü0}ÌDD–Z­(D:8’±1Äôtü••q»/À¿ýøÇŒ[,ôœ8åða¤r9º¼<¾ñƒ¥ûÌD{{;þóŸñx<<ûì³Ü{ï½q93ñ³ŸýŒúúzÞyçÞzë-¤R)z½žçž{.¼ôŒ†a ø €à„á%Øm·¯g'Š‹ñWW#»r‰Ë…˜‘¿¢U’"(}Õ*ª_{ ëñã8{{Q¦¤õÀ˜6l@¦TÆå»ÝnªªªØ´iÏ?ÿ|ÜòsñÝï~³Ù̹sç°Ûí¤¤¤P^^ÎÆINNŽ(/“ÉPètHRS1û|˜§Ïov½…+˜IJM%ôªE¤¸z5¬^Èí­pÙô1¡¤6##ƒšššYÝL»n9ëÖżÑhüššjjjbrcñ5 >ú(>úhBüììlŠ6mB1>ܸ™3ÁÉ"bîV©`Ãtg^¬fµZ¿0÷«À¿#~`èÉ/…Ÿf6›Ìôõõñ‡?ü}ûöÝQ¾ï§-ÖOôù|øýÑ7›æÂårqêÔ)zzzî8_A?íY¥ùÙ³¸ëëgþÍo~Þ={"*™9æEó¯^½ŠÝn§  “É>?×Oôûýx<ž¨ £££¯×Kee%Çvi¾lþ\Ìä‡ÓùÙ³$½ý6LNâ~ãpá#GŽÌPW[‹wÛ6Ø»7|.ä'J$\.:Žááa®\¹Âðð0Z­6,b4?±­­·ëë™ho'´ûjî)/çþª*<¢("Šó:‹å‹¢ˆÇãÁn·3>>Ž×ëE*•’ššJff&IIIáraÝB?¸ëëar’¤÷ÞCâvóðVCéééü¶®Žoh@ÚÛ;ïÅ!ÚgÏžÅáppæÌZZZðz½dffRZZÊ–-[(//j LNN’vý:5—.±rúÜG@шßïÇçu¯Åò¬V+~ø!çÎcll ¥RIqq1?ü06l@­Ž±±î~ã $n7ʆ6 ˆbà¾ýû‘“¯¼‚§®ŽùÖ:§ÓÉ¡C‡¸páBxétëÖ-zzzaùòå1]=°fúh'h3%ŠÅòÇÆÆp8¬\¹’@ ÀçŸNSS‰„ÜÜ\ fe„‘+‘€ÍÀS€¨Þþ ˜"GÄ †‡‡9sæ .\`Û¶m³ü4›ÍÆéÓ§ÉÊÊâW¿úUÔ˜ºf4¬ŸÛI"X,?77—;v V«ñx<:tˆ¿ÿýïX­Öy×Ò¾ÕÐ@AñvŒ¾b‚âý7P4gL áÚµk|þùçœ?ž±±±yý´‘‘Nœ8Á#ù„cÇŽqóæMÒÒÒX»v-÷Ýwß—Î/))A£Ñ`6›#R—™ (±ZÑ=ñÒÞ^Ü{÷254ÐÞÞNNQ®º:< $½÷¨Õð曕ŒŒ Õjyá…ÈÏÏçøñãø|>²²²¨®®¦¼¼œÞyäL ÑÒÒÂhnnÆãñ„MÑ={ö088H †Ã½X~kk+'Ož¤ººš¼¼¼y­°Yª÷ïGÖÞÎóꎋµµµ466#O­Æ_Q&ÎôóòòÈ›Þy«©©aëÖ­ô÷÷SVVF~~þ¼ ¸Ýn¦¦¦feøäÔ©S”——‡Ï{½^~ùË_2::Š^¯ÿÒøIIÁ÷§¦¦fm‰ºÝîpR.ùiòµk¡²éÓOÏJ’÷îÝ;{ÂxóÍà[~ ¼_WXXˆÉdÂd2EŒy!~__§NŠX‹ üñHÅ .þ;;;éêêúRùÛ·o‚Ñ8@bµZÅh;U‰Àb±———Жã|xñűZ­á…ýB±|ùò;Ê—ˆÑVÖ1ðUòãæ晉`É¿þ:ûqðø^x1~ØWÇ¿á‹øasù‰ ?Ú—39sù_Æ÷Ήò#é…úaw;"\¨v·#BÀ…úaw;"\¨v·#ê –‰úaw;¢¾{òÃt:]L?l©Ú5›{|U5õÃîvD0Q?ìnGÔ.ÜÚÚÊÁƒimmûvûÝ ùbý°XühXJþRï¼PÈë‡EãÇÂRò—ú{ç…ò%?ýéOů³÷ꫯ.Ê\¬Ÿù¿n¹‘K‘FzIEND®B`‚attributes.pm000644000765000765 533712101554066 17462 0ustar00brucebruce000000000000parrot-5.9.0/config/auto# Copyright (C) 2007-2012, Parrot Foundation. =head1 NAME config/auto/attributes.pm - Attributes detection =head1 DESCRIPTION Automagically detect what attributes, like HASATTRIBUTE_CONST, that the compiler can support. =cut package auto::attributes; use strict; use warnings; use base qw(Parrot::Configure::Step); use Parrot::Configure::Utils (); use Parrot::BuildUtil; sub _init { my $self = shift; my %data; $data{description} = q{Detect compiler attributes}; $data{result} = q{}; return \%data; } our @potential_attributes = qw( HASATTRIBUTE_CONST HASATTRIBUTE_DEPRECATED HASATTRIBUTE_FORMAT HASATTRIBUTE_MALLOC HASATTRIBUTE_NONNULL HASATTRIBUTE_NORETURN HASATTRIBUTE_PURE HASATTRIBUTE_UNUSED HASATTRIBUTE_WARN_UNUSED_RESULT HASATTRIBUTE_HOT HASATTRIBUTE_COLD HASATTRIBUTE_NEVER_WORKS ); # HASATTRIBUTE_NEVER_WORKS is at the end just to prove that it's possible to fail. sub runstep { my ( $self, $conf ) = @_; $conf->debug("\n"); for my $maybe_attr (@potential_attributes) { $self->try_attr( $conf, $maybe_attr); } return 1; } sub try_attr { my ( $self, $conf, $attr ) = @_; my $output_file = 'test.cco'; $conf->debug("trying attribute '$attr'\n"); my $cc = $conf->data->get('cc'); $conf->cc_gen('config/auto/attributes/test_c.in'); my $disable_warnings = ''; # work around msvc warning for unused variable if ( defined $conf->option_or_data('msvcversion') ) { $disable_warnings = '-wd4101'; } my $ccflags = $conf->data->get('ccflags'); my $tryflags = "$ccflags -D$attr $disable_warnings"; my $command_line = Parrot::Configure::Utils::_build_compile_command( $cc, $tryflags ); $conf->debug(" ", $command_line, "\n"); # Don't use cc_build, because failure is expected. my $exit_code = Parrot::Configure::Utils::_run_command( $command_line, $output_file, $output_file ); $conf->debug(" exit code: $exit_code\n"); $conf->cc_clean(); $conf->data->set( $attr => !$exit_code | 0 ); if ($exit_code) { unlink $output_file or die "Unable to unlink $output_file: $!"; $conf->debug("Rejecting bogus attribute: $attr\n"); return; } my $output = Parrot::BuildUtil::slurp_file($output_file); $conf->debug(" output: $output\n"); if ( $output !~ /error|warning/i ) { $conf->data->set( ccflags => $tryflags ); my $ccflags = $conf->data->get("ccflags"); $conf->debug(" ccflags: $ccflags\n"); } unlink $output_file or die "Unable to unlink $output_file: $!"; return; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: URI.pir000644000765000765 1355112101554067 20350 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library# Copyright (C) 2010-2012, Parrot Foundation. =head1 NAME URI- Uniform Resource Identifiers =head1 DESCRIPTION Simplified port of URI (version 1.54) see L =head3 Class URI =over 4 =cut .include 'cclass.pasm' .namespace ['URI'] .sub '' :init :load :anon $P0 = subclass 'String', 'URI' .end =item new_from_string =cut .sub 'new_from_string' .param string str .local string scheme $I0 = index str, ':' scheme = substr str, 0, $I0 $P1 = new 'Key' set $P1, 'URI' $P2 = new 'Key' set $P2, scheme push $P1, $P2 $P0 = get_class $P1 unless null $P0 goto L1 $P0 = get_class ['URI';'_generic'] L1: $P0 = new $P0 set $P0, str .return ($P0) .end =item scheme =cut .sub 'scheme' :method $S0 = self $S1 = '' $I0 = index $S0, ':' if $I0 < 0 goto L1 $S1 = substr $S0, 0, $I0 L1: .return ($S1) .end =item opaque =cut .sub 'opaque' :method $S0 = self $I2 = 0 $I0 = index $S0, ':' if $I0 < 0 goto L1 $I2 = $I0 + 1 L1: $I1 = length $S0 $I3 = $I1 - $I2 $I0 = index $S0, '#', $I2 if $I0 < 0 goto L2 $I3 = $I0 - $I2 L2: $S1 = substr $S0, $I2, $I3 .return ($S1) .end =item fragment =cut .sub 'fragment' :method $S0 = self $I0 = index $S0, '#' $S1 = '' if $I0 < 0 goto L1 inc $I0 $S1 = substr $S0, $I0 L1: .return ($S1) .end =back =head3 Class URI,_generic =over 4 =cut .namespace ['URI';'_generic'] .sub '' :init :load :anon $P0 = subclass ['URI'], ['URI';'_generic'] .end =item authority =cut .sub 'authority' :method $S0 = self $S1 = '' $I1 = 0 $I0 = index $S0, ':' if $I0 < 0 goto L1 $I1 = $I0 + 1 L1: $I0 = index $S0, '//', $I1 unless $I0 == $I1 goto L2 $I1 += 2 $I2 = length $S0 $I0 = index $S0, '/', $I1 if $I0 < 0 goto L3 $I2 = $I0 L3: $I0 = index $S0, '?', $I1 if $I0 < 0 goto L4 unless $I0 < $I2 goto L4 $I2 = $I0 L4: $I0 = index $S0, '#', $I1 if $I0 < 0 goto L5 unless $I0 < $I2 goto L5 $I2 = $I0 L5: $I3 = $I2 - $I1 $S1 = substr $S0, $I1, $I3 L2: .return ($S1) .end =item path =cut .sub 'path' :method $S0 = self $S1 = '' $I1 = 0 $I0 = index $S0, ':' if $I0 < 0 goto L1 $I1 = $I0 + 1 L1: $I0 = index $S0, '//', $I1 unless $I0 == $I1 goto L2 $I1 += 2 $I2 = length $S0 $I0 = index $S0, '/', $I1 if $I0 < 0 goto L3 $I2 = $I0 L3: $I0 = index $S0, '?', $I1 if $I0 < 0 goto L4 unless $I0 < $I2 goto L4 $I2 = $I0 L4: $I0 = index $S0, '#', $I1 if $I0 < 0 goto L5 unless $I0 < $I2 goto L5 $I2 = $I0 L5: $I1 = $I2 L2: $I2 = length $S0 $I0 = index $S0, '?', $I1 if $I0 < 0 goto L6 $I2 = $I0 L6: $I0 = index $S0, '#', $I1 if $I0 < 0 goto L7 unless $I0 < $I2 goto L7 $I2 = $I0 L7: $I3 = $I2 - $I1 $S1 = substr $S0, $I1, $I3 .return ($S1) .end =item path_query =cut .sub 'path_query' :method $S0 = self $S1 = '' $I1 = 0 $I0 = index $S0, ':' if $I0 < 0 goto L1 $I1 = $I0 + 1 L1: $I0 = index $S0, '//', $I1 unless $I0 == $I1 goto L2 $I1 += 2 $I2 = length $S0 $I0 = index $S0, '/', $I1 if $I0 < 0 goto L3 $I2 = $I0 L3: $I0 = index $S0, '?', $I1 if $I0 < 0 goto L4 unless $I0 < $I2 goto L4 $I2 = $I0 L4: $I0 = index $S0, '#', $I1 if $I0 < 0 goto L5 unless $I0 < $I2 goto L5 $I2 = $I0 L5: $I1 = $I2 L2: $I2 = length $S0 $I0 = index $S0, '#', $I1 if $I0 < 0 goto L6 $I2 = $I0 L6: $I3 = $I2 - $I1 $S1 = substr $S0, $I1, $I3 .return ($S1) .end =back =head3 Class URI,file =over 4 =cut .namespace ['URI';'file'] .sub '' :init :load :anon $P0 = subclass ['URI';'_generic'], ['URI';'file'] .end =item path =cut .sub 'path' :method .tailcall self.'path_query'() .end =item host =cut .sub 'host' :method .tailcall self.'authority'() .end =back =head3 Class URI,_server =over 4 =cut .namespace ['URI';'_server'] .sub '' :init :load :anon $P0 = subclass ['URI';'_generic'], ['URI';'_server'] .end =item userinfo =cut .sub 'userinfo' :method $S0 = self.'authority'() $I0 = index $S0, '@' if $I0 < 0 goto L1 $S0 = substr $S0, 0, $I0 .return ($S0) L1: .return ('') .end =item host =cut .sub 'host' :method $S0 = self.'authority'() $I0 = index $S0, '@' if $I0 < 0 goto L1 inc $I0 $S0 = substr $S0, $I0 L1: .local int pos, lastpos lastpos = length $S0 pos = 0 L2: pos = index $S0, ':', pos if pos < 0 goto L3 $I1 = pos inc pos $I0 = is_cclass .CCLASS_NUMERIC, $S0, pos unless $I0 goto L2 $I0 = find_not_cclass .CCLASS_NUMERIC, $S0, pos, lastpos unless $I0 == lastpos goto L2 $S0 = substr $S0, 0, $I1 L3: .return ($S0) .end =item port =cut .sub 'port' :method $S0 = self.'authority'() .local int pos, lastpos lastpos = length $S0 pos = 0 L1: pos = index $S0, ':', pos if pos < 0 goto L2 inc pos $I0 = is_cclass .CCLASS_NUMERIC, $S0, pos unless $I0 goto L1 $I0 = find_not_cclass .CCLASS_NUMERIC, $S0, pos, lastpos unless $I0 == lastpos goto L1 $S1 = substr $S0, pos .return ($S1) L2: .tailcall self.'default_port'() .end .sub 'default_port' :method .return ('') .end =back =head3 Class URI;http =cut .namespace ['URI';'http'] .sub '' :init :load :anon $P0 = subclass ['URI';'_server'], ['URI';'http'] .end .sub 'default_port' :method .return ('80') .end =head3 Class URI;https =cut .namespace ['URI';'https'] .sub '' :init :load :anon $P0 = subclass ['URI';'http'], ['URI';'https'] .end .sub 'default_port' :method .return ('443') .end =head1 AUTHOR Francois Perrad =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: 39-pointy.t000644000765000765 50712101554067 17522 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx/t/nqp#!./parrot-nqp plan(6); my $count := 1; my $x := -> $a, $b { ok($a == $count++, $b); } $x(1, 'basic pointy block'); my $y := -> $a, $b = 2 { ok($b == $count++, $a); } $y('pointy block with optional'); $y('pointy block with optional + arg', 3); for <4 pointy4 5 pointy5 6 pointy6> -> $a, $b { ok($a == $count++, $b); } 07-boolean.t000644000765000765 70612101554066 17612 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx/t/nqp#!./parrot-nqp # Testing boolean context operators, ! and ? plan(8); ##Negation ok(!0, 'prefix negation on integer 0'); ok(!"0", 'prefix negation on string 0'); if !1 { print("not"); } ok(1, "negating integer 1"); ok(!!1, 'double negation on 1'); ##Boolean context ok(?1, 'prefix negation on integer 1'); ok(?"10", 'prefix negation on string 10'); if ?0 { print("not"); } ok(1, "boolean integer 0"); ok(!?!?1, 'spaghetti chaining'); foo-04.t000644000765000765 140211606346660 15444 0ustar00brucebruce000000000000parrot-5.9.0/t/dynpmc#!./parrot # Copyright (C) 2011, Parrot Foundation. .sub main :main .include 'test_more.pir' plan(1) ## get cwd in $S0. .include "iglobals.pasm" $P11 = getinterp $P12 = $P11[.IGLOBALS_CONFIG_HASH] $S0 = $P12["prefix"] ## convert cwd to an absolute pathname without the extension, and load it. ## this should always find the version in the build directory, since that's ## the only place "make test" will work. $S0 .= "/runtime/parrot/dynext/foo_group" loadlib $P1, $S0 ## ensure that we can still make Foo instances. $P1 = new "Foo" $I1 = $P1 is($I1, 42, 'loadlib with absolute pathname, no ext') .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: find_hacks.pl000755000765000765 770711644422131 17071 0ustar00brucebruce000000000000parrot-5.9.0/tools/dev#! perl # Copyright (C) 2010, Parrot Foundation. use strict; use warnings; use HTML::Entities; =head1 NAME tools/dev/find_hacks.pl - Generates a TracWiki formatted list of 'hack' comments in Parrot source. =head1 SYNOPSIS $ perl tools/dev/find_hacks.pl =head1 DESCRIPTION This script greps through all text files in the directory that it's run in, and looks for all instances of the word 'hack' in the source. It then outputs a TracWiki formatted page that can be copied and pasted into Trac directly, complete with links to the relevant source file on github. If run with a non-clean source tree, generated files have a chance of matching, so this tool is best run after a `make realclean'. =cut # Open our grep stream and then print a header. open(my $hacks, '-|', 'grep -rIn hack .') || die "Could not grep! $!\n"; print '= Parrot HACK List =' . "\n\n"; while(<$hacks>) { if(/^.\/(.+?):([0-9]+):(.*hack.*)$/i) { # Save the regex data. my $filename = $1, my $linenum = $2, my $context = $3; # Make sure we're not triggering for 'hacker', though. next if $context =~ /hacker/; # And this script should not trigger. next if $filename =~ /find_hacks.pl$/; # Process context for HTML, then do some stuff to it too. $context = encode_entities($context); $context =~ s/hack/hack<\/font><\/strong>/ig; # See if we have an incomplete multi-line comment. my $begin = $context =~ /\/\*/ && !($context =~ /\*\//); my $end = $context =~ /\*\// && !($context =~ /\/\*/); # Print out the main line data. print " * [https://github.com/parrot/parrot/blob/master/$filename#L$linenum $filename:$linenum][[br]]\n{{{\n#!html\n"; print "

    "; if($begin) { # First print out the beginning $context =~ s/ / /g; print $context . "
    \n"; # Open the file and just slurp the entirety. open(my $SOURCEFILE, '<', $filename) or die $!; my $terminator = $/; undef $/; my $sourcefile = <$SOURCEFILE>; $/ = $terminator; # Split based on newline and then keep printing until we get an end. my @lines = split(/$terminator/, $sourcefile); my $someline = $linenum; do { $lines[$someline] = encode_entities($lines[$someline]); $lines[$someline] =~ s/ / /g; print $lines[$someline] . "
    \n"; } while !($lines[$someline++] =~ /\*\//); close $SOURCEFILE; } elsif($end) { # Open the file and read fully. open(my $SOURCEFILE, '<', $filename) or die $!; my $terminator = $/; undef $/; my $sourcefile = <$SOURCEFILE>; $/ = $terminator; # Go back until we found the beginning of the comment. my @lines = split(/$terminator/, $sourcefile); my $someline = $linenum; while (!($lines[--$someline] =~ /\/\*/)) { } # And print from there to just before our line. for(; $someline < ($linenum - 1); $someline++) { $lines[$someline] = encode_entities($lines[$someline]); $lines[$someline] =~ s/ / /g; print $lines[$someline] . "
    \n"; } # Print out the last line. print $context . "
    \n"; close $SOURCEFILE; } else { $context =~ s/^\s+//; $context =~ s/\s+$//; print $context . "
    \n"; } print "
    \n}}}\n\n"; } } # Print a footer. print '{{{ #!comment Automatically generated by tools/dev/find_hacks.pl }}}'; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: thread-01.t000644000765000765 541612101554067 16743 0ustar00brucebruce000000000000parrot-5.9.0/t/steps/auto#! perl # Copyright (C) 2009-2013, Parrot Foundation. use strict; use warnings; use Test::More tests => 20; use Carp; use lib qw( lib t/configure/testlib ); use_ok('config::auto::thread'); use Parrot::Configure::Options qw( process_options ); use Parrot::Configure::Step::Test; use Parrot::Configure::Test qw( test_step_constructor_and_description ); ########## --without-threads ########## my ($args, $step_list_ref) = process_options( { argv => [ q{--without-threads} ], mode => q{configure}, } ); my $conf = Parrot::Configure::Step::Test->new; $conf->include_config_results( $args ); my $pkg = q{auto::thread}; $conf->add_steps($pkg); my $serialized = $conf->pcfreeze(); $conf->options->set( %{$args} ); my $step = test_step_constructor_and_description($conf); my $ret = $step->runstep($conf); ok( $ret, "runstep() returned true value" ); is($conf->data->get('HAS_THREADS'), 0, "Got expected value for 'HAS_THREADS'"); is($step->result(), q{skipped}, "Expected result was set"); $conf->replenish($serialized); ($args, $step_list_ref) = process_options( { argv => [ ], mode => q{configure}, } ); $conf->options->set('without-threads' => undef); $conf->add_steps($pkg); $conf->options->set( %{$args} ); $step = test_step_constructor_and_description($conf); $conf->data->set(osname => 'MSWin32'); $ret = $step->runstep($conf); ok( $ret, "runstep() returned true value" ); is($conf->data->get('HAS_THREADS'), 1, "Got expected value for 'HAS_THREADS' on MSWin32"); is($step->result(), q{yes}, "Expected result was set"); $conf->data->set(osname => 'linux'); $conf->data->set(i_pthread => 'define'); $ret = $step->runstep($conf); ok( $ret, "runstep() returned true value" ); is($conf->data->get('HAS_THREADS'), 1, "Got expected value for 'HAS_THREADS' on non-MSWin32"); is($step->result(), q{yes}, "Expected result was set"); $conf->data->set(osname => 'linux'); $conf->data->set(i_pthread => 'not defined'); $ret = $step->runstep($conf); ok( $ret, "runstep() returned true value" ); is($conf->data->get('HAS_THREADS'), 0, "Got expected value for 'HAS_THREADS' on non-MSWin32 non-define i_pthread"); is($step->result(), q{no}, "Expected result was set"); pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME auto/thread-01.t - test auto::thread =head1 SYNOPSIS % prove t/steps/auto/thread-01.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file test auto::thread. =head1 HISTORY Mostly taken from F. =head1 AUTHOR Francois Perrad =head1 SEE ALSO config::auto::thread, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: TODO000644000765000765 32511715102031 13150 0ustar00brucebruce000000000000parrot-5.9.0 All todo items should have a corresponding github issue. See the current list: https://github.com/parrot/parrot/issues?labels=todo To open a new todo ticket, use https://github.com/parrot/parrot/issues/new streams.t000644000765000765 1763412101554067 16471 0ustar00brucebruce000000000000parrot-5.9.0/t/examples#!perl # Copyright (C) 2005-2006, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Test tests => 12; use Parrot::Config; =head1 NAME t/examples/streams.t - Test examples in F =head1 SYNOPSIS % prove t/examples/streams.t =head1 DESCRIPTION Test the examples in F. =head1 SEE ALSO F =head1 AUTHOR Bernhard Schmalhofer - =cut # map examples to expected output, organized by io type (file|stream) # NOTE: examples using file io must have 'svn:eol-style' set to 'LF' # to work properly on all platforms. my %expected = ( stream => { 'Combiner.pir' => <<'EXP_COMBINER', read:[1 hello] read:[2 world!] read:[3 parrot] read:[4 is cool] EXP_COMBINER 'Coroutine.pir' => <<'EXP_COROUTINE', read:[0] read:[1] read:[2] read:[3] read:[4] read:[5] read:[6] read:[7] read:[8] read:[9] EXP_COROUTINE 'Filter.pir' => <<'EXP_FILTER', read:[0 * 2 = 0] read:[1 * 2 = 2] read:[2 * 2 = 4] read:[3 * 2 = 6] read:[5 * 2 = 10] read:[6 * 2 = 12] read:[7 * 2 = 14] read:[8 * 2 = 16] read:[9 * 2 = 18] EXP_FILTER 'Include.pir' => <<'EXP_INCLUDE', read:[0] read:[1] read:[2] read:[3] read:[4] read:[hello] read:[A] read:[B] read:[C] read:[D] read:[E] read:[F] read:[world] read:[5] read:[6] read:[7] read:[8] read:[9] EXP_INCLUDE 'Lines.pir' => <<'EXP_LINES', read:[this] read:[is a] read:[Stream::Lines] read:[testcase] EXP_LINES 'SubCounter.pir' => <<'EXP_SUBCOUNTER', read:[0] read:[1] read:[2] read:[3] read:[4] read:[5] read:[6] read:[7] read:[8] read:[9] EXP_SUBCOUNTER 'SubHello.pir' => <<'EXP_SUBHELLO', read:[hello] read:[world!] read:[parrot] read:[is cool] EXP_SUBHELLO }, file => { 'FileLines.pir' => <<'EXP_FILELINES', read:[ 1 =head1 DESCRIPTION] read:[ 2 ] read:[ 3 This is an advanced example.] read:[ 4 ] read:[ 5 It uses a file stream (Stream::ParrotIO) that is processed linewise with] read:[ 6 Stream::Lines. A counter stream creates line numbers, both are combined to] read:[ 7 one stream and then dumped.] read:[ 8 ] read:[ 9 =head1 NOTE] read:[ 10 ] read:[ 11 When updating this file, be sure to verify L, as its] read:[ 12 tests rely on the content of this file.] read:[ 13 ] read:[ 14 =head1 FUNCTIONS] read:[ 15 ] read:[ 16 =over 4] read:[ 17 ] read:[ 18 =item _main] read:[ 19 ] read:[ 20 Opens this file (or the one specified at the command line) and creates a lines] read:[ 21 stream for it. Then it combines the stream with a stream providing line numbers.] read:[ 22 ] read:[ 23 =cut] read:[ 24 ] read:[ 25 .sub _main :main] read:[ 26 .param pmc argv] read:[ 27 .local int argc] read:[ 28 .local pmc file] read:[ 29 .local pmc lines] read:[ 30 .local pmc counter] read:[ 31 .local pmc combiner] read:[ 32 .local string name] read:[ 33 ] read:[ 34 # get the name of the file to open] read:[ 35 name = \"examples/streams/FileLines.pir\"] read:[ 36 argc = argv] read:[ 37 if argc < 2 goto NO_NAME] read:[ 38 name = argv[1]] read:[ 39 NO_NAME:] read:[ 40 ] read:[ 41 load_bytecode 'Stream/ParrotIO.pbc'] read:[ 42 load_bytecode 'Stream/Lines.pbc'] read:[ 43 load_bytecode 'Stream/Sub.pbc'] read:[ 44 load_bytecode 'Stream/Combiner.pbc'] read:[ 45 ] read:[ 46 # create a file stream] read:[ 47 file = new ['Stream'; 'ParrotIO']] read:[ 48 file.\"open\"( name, 'r' )] read:[ 49 ] read:[ 50 # process it one line per read] read:[ 51 lines = new ['Stream'; 'Lines']] read:[ 52 assign lines, file] read:[ 53 ] read:[ 54 # endless counter] read:[ 55 counter = new ['Stream'; 'Sub']] read:[ 56 .const 'Sub' temp = \"_counter\"] read:[ 57 assign counter, temp] read:[ 58 ] read:[ 59 # combine the counter and the file's lines] read:[ 60 combiner = new ['Stream'; 'Combiner']] read:[ 61 assign combiner, counter] read:[ 62 assign combiner, lines] read:[ 63 ] read:[ 64 # dump the stream] read:[ 65 combiner.\"dump\"()] read:[ 66 ] read:[ 67 end] read:[ 68 .end] read:[ 69 ] read:[ 70 =item _counter] read:[ 71 ] read:[ 72 This sub is the source of the counter stream. It just endlessly writes] read:[ 73 line numbers followed by a space to its stream.] read:[ 74 ] read:[ 75 =cut] read:[ 76 ] read:[ 77 .sub _counter] read:[ 78 .param pmc stream] read:[ 79 .local int i] read:[ 80 .local string str] read:[ 81 .local pmc array] read:[ 82 ] read:[ 83 i = 0] read:[ 84 array = new 'ResizablePMCArray'] read:[ 85 ] read:[ 86 LOOP:] read:[ 87 inc i] read:[ 88 array[0] = i] read:[ 89 sprintf str, \"%5d \", array] read:[ 90 stream.\"write\"( str )] read:[ 91 branch LOOP] read:[ 92 .end] read:[ 93 ] read:[ 94 =back] read:[ 95 ] read:[ 96 =head1 AUTHOR] read:[ 97 ] read:[ 98 Jens Rieks Eparrot at jensbeimsurfen dot deE is the author] read:[ 99 and maintainer.] read:[ 100 Please send patches and suggestions to the Perl 6 Internals mailing list.] read:[ 101 ] read:[ 102 =head1 COPYRIGHT] read:[ 103 ] read:[ 104 Copyright (C) 2004-2009, Parrot Foundation.] read:[ 105 ] read:[ 106 =cut] read:[ 107 ] read:[ 108 # Local Variables:] read:[ 109 # mode: pir] read:[ 110 # fill-column: 100] read:[ 111 # End:] read:[ 112 # vim: expandtab shiftwidth=4 ft=pir:] EXP_FILELINES 'ParrotIO.pir' => <<'EXP_PARROTIO', read:[=head1 DESCRIPTION\n\nThis small example shows the u] read:[sage of C.\n\nIt reads this file w] read:[ith a default block size.\n\nYou can specify another] read:[ block size with the C method.\nC called without an integer parameter will retu] read:[rn the\ncurrent block size.\n\nEach time the C ] read:[method is called, the next block is read from\nthe ] read:[underlying ParrotIO, until EOF, where the stream w] read:[ill be disconnected.\n\nInstead of using the C] read:[ method, you can also assign your own ParrotIO\nPMC] read:[ to the stream with the C op.\n\n=cut\n\n.sub ] read:[_main :main\n .local pmc stream\n\n load_byteco] read:[de 'Stream/ParrotIO.pbc'\n\n # create the ParrotI] read:[O stream\n stream = new ['Stream'; 'ParrotIO']\n\n] read:[ # open this file\n stream.\"open\"( \"examples/] read:[streams/ParrotIO.pir\", 'r' )\n\n # you can specif] read:[y a custom block size with\n # stream.\"blockSize] read:[\"( 10 )\n\n # dump the stream\n stream.\"dump\"()] read:[\n\n end\n.end\n\n=head1 AUTHOR\n\nJens Rieks Epar] read:[rot at jensbeimsurfen dot deE is the author\nan] read:[d maintainer.\nPlease send patches and suggestions ] read:[to the Perl 6 Internals mailing list.\n\n=head1 COPY] read:[RIGHT\n\nCopyright (C) 2004-2009, Parrot Foundation.] read:[\n\n=cut\n\n# Local Variables:\n# mode: pir\n# fill-] read:[column: 100\n# End:\n# vim: expandtab shiftwidth=4 f] read:[t=pir:\n] EXP_PARROTIO }, ); #=for comment # 'ParrotIO.pir t/examples/test.txt' => do{ # local $/ = 60; # my $file = # @lines=map {} <>; # }, #=cut for my $io ( sort keys %expected ) { while ( my ( $example, $expected ) = each %{ $expected{$io} } ) { if ( $^O eq 'MSWin32' ) { if ( grep { $_ eq $example } qw/ParrotIO.pir FileLines.pir/ ) { local $TODO = 'not testable on windows yet'; fail($example); next; } } example_output_is( "examples/streams/$example", $expected ); } } TODO: { local $TODO = 'some examples not testable yet'; fail('Bytes.pir'); fail('Replay.pir'); fail('Writer.pir'); } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: yaml_dumper.t000644000765000765 4621411533177644 17165 0ustar00brucebruce000000000000parrot-5.9.0/t/library#!perl # Copyright (C) 2008, Parrot Foundation. use strict; use warnings; use lib qw( lib ); use Test::More; use Parrot::Test tests => 26; =head1 NAME t/library/yaml_dumper.t - test dumping of data in YAML format =head1 SYNOPSIS % prove t/library/yaml_dumper.t =head1 DESCRIPTION Tests data dumping in YAML format. =cut pir_output_is( <<'CODE', <<'OUT', "dumping array of sorted numbers" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array new array, 'ResizablePMCArray' push array, 0 push array, 1 push array, 2 push array, 3 push array, 4 push array, 5 push array, 6 push array, 7 push array, 8 push array, 9 yaml( array, "array" ) .end CODE --- { "array" : !ResizablePMCArray [ !Integer [ 0 ], !Integer [ 1 ], !Integer [ 2 ], !Integer [ 3 ], !Integer [ 4 ], !Integer [ 5 ], !Integer [ 6 ], !Integer [ 7 ], !Integer [ 8 ], !Integer [ 9 ], ], } OUT pir_output_is( <<'CODE', <<'OUT', "dumping unsorted numbers" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array new array, 'ResizablePMCArray' push array, 6 push array, 1 push array, 8 push array, 3 push array, 2 push array, 9 push array, 7 push array, 4 push array, 0 push array, 5 yaml( array, "array" ) .end CODE --- { "array" : !ResizablePMCArray [ !Integer [ 6 ], !Integer [ 1 ], !Integer [ 8 ], !Integer [ 3 ], !Integer [ 2 ], !Integer [ 9 ], !Integer [ 7 ], !Integer [ 4 ], !Integer [ 0 ], !Integer [ 5 ], ], } OUT pir_output_is( <<'CODE', <<'OUT', "dumping sorted strings" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array new array, 'ResizablePMCArray' push array, "alpha" push array, "bravo" push array, "charlie" push array, "delta" push array, "echo" push array, "foxtrot" push array, "golf" push array, "hotel" yaml( array, "strings" ) .end CODE --- { "strings" : !ResizablePMCArray [ !String [ "alpha" ], !String [ "bravo" ], !String [ "charlie" ], !String [ "delta" ], !String [ "echo" ], !String [ "foxtrot" ], !String [ "golf" ], !String [ "hotel" ], ], } OUT pir_output_is( <<'CODE', <<'OUT', "sorting unsorted strings" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array new array, 'ResizablePMCArray' push array, "charlie" push array, "hotel" push array, "alpha" push array, "delta" push array, "foxtrot" push array, "golf" push array, "bravo" push array, "echo" yaml( array, "strings" ) .end CODE --- { "strings" : !ResizablePMCArray [ !String [ "charlie" ], !String [ "hotel" ], !String [ "alpha" ], !String [ "delta" ], !String [ "foxtrot" ], !String [ "golf" ], !String [ "bravo" ], !String [ "echo" ], ], } OUT pir_output_is( <<'CODE', <<'OUT', "dumping different types" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array new array, 'ResizablePMCArray' push array, 0.1 push array, "charlie" push array, 2 push array, "hotel" push array, 5 push array, "alpha" push array, 0.2 push array, "delta" push array, 4 push array, "foxtrot" push array, 0.5 push array, 0.4 push array, 1 push array, "golf" push array, 0.3 push array, 3 push array, "bravo" push array, 0.0 push array, 0 push array, "echo" yaml( array, "array" ) .end CODE --- { "array" : !ResizablePMCArray [ !Float [ 0.1 ], !String [ "charlie" ], !Integer [ 2 ], !String [ "hotel" ], !Integer [ 5 ], !String [ "alpha" ], !Float [ 0.2 ], !String [ "delta" ], !Integer [ 4 ], !String [ "foxtrot" ], !Float [ 0.5 ], !Float [ 0.4 ], !Integer [ 1 ], !String [ "golf" ], !Float [ 0.3 ], !Integer [ 3 ], !String [ "bravo" ], !Float [ 0 ], !Integer [ 0 ], !String [ "echo" ], ], } OUT pir_output_is( <<'CODE', <<'OUT', "dumping complex data" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc hash1 .local pmc hash2 .local pmc hash3 .local pmc array1 .local pmc array2 new hash1, 'Hash' new hash2, 'Hash' new hash3, 'Hash' new array1, 'ResizablePMCArray' new array2, 'ResizablePMCArray' yaml( hash1,"hash1" ) $S0 = "hello" $S1 = "world" set hash1[$S0], $S1 yaml( hash1,"hash1" ) $S0 = "hello2" $S1 = "world2" set hash1[$S0], $S1 yaml( hash1,"hash1" ) $S0 = "hash2" set hash1[$S0], hash2 yaml( hash1,"hash1" ) $S0 = "hello3" $S1 = "world3" set hash2[$S0], $S1 yaml( hash1,"hash1" ) $S0 = "name" $S1 = "parrot" set hash3[$S0], $S1 $S0 = "is" $S1 = "cool" set hash3[$S0], $S1 push array1, "this" push array1, "is" push array1, "a" push array1, "test" push array1, hash3 $S0 = "array1" set hash2[$S0], array1 yaml( hash1,"hash1" ) .end CODE --- { "hash1" : !Hash { }, } --- { "hash1" : !Hash { "hello" : !String [ "world" ], }, } --- { "hash1" : !Hash { "hello" : !String [ "world" ], "hello2" : !String [ "world2" ], }, } --- { "hash1" : !Hash { "hash2" : !Hash { }, "hello" : !String [ "world" ], "hello2" : !String [ "world2" ], }, } --- { "hash1" : !Hash { "hash2" : !Hash { "hello3" : !String [ "world3" ], }, "hello" : !String [ "world" ], "hello2" : !String [ "world2" ], }, } --- { "hash1" : !Hash { "hash2" : !Hash { "array1" : !ResizablePMCArray [ !String [ "this" ], !String [ "is" ], !String [ "a" ], !String [ "test" ], !Hash { "is" : !String [ "cool" ], "name" : !String [ "parrot" ], }, ], "hello3" : !String [ "world3" ], }, "hello" : !String [ "world" ], "hello2" : !String [ "world2" ], }, } OUT pir_output_is( <<'CODE', <<'OUT', "properties", todo => 'not yet implemented' ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc str .local pmc array new array, 'ResizablePMCArray' push array, "test1" push array, "test2" new str, 'String' set str, "value1" setprop array, "key1", str new str, 'String' set str, "value2" setprop array, "key2", str yaml( array ) .end CODE --- { "VAR1" : !ResizablePMCArray [ !"key1" : !String [ "value1" ], !"key2" : !String [ "value2" ], "test1", "test2", ], } OUT pir_output_is( <<'CODE', <<'OUT', "indent string", todo => 'not supported' ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc hash1 .local pmc hash2 .local pmc array1 .local pmc array2 .local string name .local string indent new hash1, 'Hash' new hash2, 'Hash' new array1, 'ResizablePMCArray' new array2, 'ResizablePMCArray' set hash1["hash2"], hash2 set hash2["array"], array1 set hash1["test1"], "test1" set hash2["test2"], "test2" push array1, 1 push array1, array2 push array2, "test" setprop hash1, "array2", array2 name = "hash" indent = "| " yaml( hash1, name, indent ) yaml( hash1, name, indent ) print "name = '" print name print "'\nindent = '" print indent print "'\n" .end CODE "hash" : Hash { | "hash2" : Hash { | | "array" : ResizablePMCArray (size:2) [ | | | 1, | | | ResizablePMCArray (size:1) [ | | | | "test" | | | ] | | ], | | "test2" : "test2" | }, | "test1" : "test1" } with-properties: Hash { | "array2" : \hash["hash2"]["array"][1] } "hash" : Hash { | "hash2" : Hash { | | "array" : ResizablePMCArray (size:2) [ | | | 1, | | | ResizablePMCArray (size:1) [ | | | | "test" | | | ] | | ], | | "test2" : "test2" | }, | "test1" : "test1" } with-properties: Hash { | "array2" : \hash["hash2"]["array"][1] } name = 'hash' indent = '| ' OUT pir_output_is( <<'CODE', <<'OUT', "back-referencing properties", todo => 'not yet implemented' ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc hash new hash, 'Hash' set hash["hello"], "world" setprop hash, "backref", hash yaml( hash ) .end CODE "VAR1" : Hash { "hello" : "world" } with-properties: Hash { "backref" : \VAR1 } OUT pir_output_is( <<'CODE', <<'OUT', "self-referential properties (1)", todo => 'not yet implemented' ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc hash .local pmc prop new hash, 'Hash' set hash["hello"], "world" setprop hash, "self", hash prophash prop, hash setprop hash, "self", prop yaml( hash ) .end CODE "VAR1" : Hash { "hello" : "world" } with-properties: Hash { "self" : \VAR1.properties() } OUT pir_output_is( <<'CODE', <<'OUT', "self-referential properties (2)", todo => 'not yet implemented' ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array .local pmc hash1 .local pmc hash2 .local pmc prop new array, 'ResizablePMCArray' new hash1, 'Hash' new hash2, 'Hash' set hash1["hello1"], "world1" set hash2["hello2"], "world2" setprop hash1, "das leben", hash2 prophash prop, hash1 set prop["das leben"], "ist schoen" setprop hash2, "hash1prop", prop push array, hash1 push array, hash2 push array, prop prophash prop, hash2 push array, prop yaml( array ) .end CODE "VAR1" : ResizablePMCArray (size:4) [ Hash { "hello1" : "world1" } with-properties: Hash { "das leben" : "ist schoen" }, Hash { "hello2" : "world2" } with-properties: Hash { "hash1prop" : \VAR1[0].properties() }, \VAR1[0].properties(), \VAR1[1].properties() ] OUT pir_output_is( <<'CODE', <<'OUT', "dumping objects" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc temp .local pmc array newclass temp, "TestClass" new array, 'ResizablePMCArray' temp = new "TestClass" push array, temp $P0 = get_class 'TestClass' temp = new $P0 push array, temp yaml( array ) .end .namespace ["TestClass"] .sub __yaml :method .param pmc dumper .param string dname .local string subindent .local string indent .local string name (subindent, indent) = dumper."newIndent"() print "{\n" print subindent print "this is\n" print subindent print "_" typeof name, self print name print "::__yaml,\n" print indent print "}" dumper."deleteIndent"() .begin_return .end_return .end .namespace [] CODE --- { "VAR1" : !ResizablePMCArray [ !TestClass { this is _TestClass::__yaml, }, !TestClass { this is _TestClass::__yaml, }, ], } OUT pir_output_is( <<'CODE', <<'OUT', "dumping 'null'" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array .local pmc temp new array, 'ResizablePMCArray' push array, 0 push array, "0" null temp push array, temp new temp, 'Integer' set temp, 0 push array, temp new temp, 'String' set temp, "0" push array, temp yaml( array, "array" ) .end CODE --- { "array" : !ResizablePMCArray [ !Integer [ 0 ], !String [ "0" ], null, !Integer [ 0 ], !String [ "0" ], ], } OUT pir_output_is( << 'CODE', << 'OUT', "dumping strings" ); .sub _test :main load_bytecode "yaml_dumper.pbc" .local pmc array array = new 'ResizablePMCArray' .local pmc pmc_string, pmc_perl_string .local string string_1 pmc_string = new 'String' pmc_string = "This is a String PMC" push array, pmc_string pmc_perl_string = new 'String' pmc_perl_string = "This is a String PMC" push array, pmc_perl_string string_1 = "This is a String" push array, string_1 yaml( array, "array of various strings" ) .end CODE --- { "array of various strings" : !ResizablePMCArray [ !String [ "This is a String PMC" ], !String [ "This is a String PMC" ], !String [ "This is a String" ], ], } OUT pir_output_is( <<'CODE', <<'OUT', "dumping complex data in Hash" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc hash1 .local pmc hash2 .local pmc hash3 .local pmc array1 new hash1, 'Hash' new hash2, 'Hash' new hash3, 'Hash' new array1, 'ResizablePMCArray' yaml( hash1,"hash1" ) $S0 = "hello" $S1 = "world" set hash1[$S0], $S1 yaml( hash1,"hash1" ) $S0 = "hello2" $S1 = "world2" set hash1[$S0], $S1 yaml( hash1,"hash1" ) $S0 = "hash2" set hash1[$S0], hash2 yaml( hash1,"hash1" ) $S0 = "hello3" $S1 = "world3" set hash2[$S0], $S1 yaml( hash1,"hash1" ) $S0 = "name" $S1 = "parrot" set hash3[$S0], $S1 $S0 = "is" $S1 = "cool" set hash3[$S0], $S1 array1 = 5 array1[0] = "this" array1[1] = "is" array1[2] = "a" array1[3] = "test" array1[4] = hash3 $S0 = "array1" set hash2[$S0], array1 yaml( hash1,"hash1" ) .end CODE --- { "hash1" : !Hash { }, } --- { "hash1" : !Hash { "hello" : !String [ "world" ], }, } --- { "hash1" : !Hash { "hello" : !String [ "world" ], "hello2" : !String [ "world2" ], }, } --- { "hash1" : !Hash { "hash2" : !Hash { }, "hello" : !String [ "world" ], "hello2" : !String [ "world2" ], }, } --- { "hash1" : !Hash { "hash2" : !Hash { "hello3" : !String [ "world3" ], }, "hello" : !String [ "world" ], "hello2" : !String [ "world2" ], }, } --- { "hash1" : !Hash { "hash2" : !Hash { "array1" : !ResizablePMCArray [ !String [ "this" ], !String [ "is" ], !String [ "a" ], !String [ "test" ], !Hash { "is" : !String [ "cool" ], "name" : !String [ "parrot" ], }, ], "hello3" : !String [ "world3" ], }, "hello" : !String [ "world" ], "hello2" : !String [ "world2" ], }, } OUT pir_output_is( <<'CODE', <<'OUTPUT', "dumping Integer PMC" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc int1 new int1, 'Integer' int1 = 12345 yaml( int1, "Int" ) .end CODE --- { "Int" : !Integer [ 12345 ], } OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "dumping Float PMC" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc float1 new float1, 'Float' float1 = 12345.678 yaml( float1, "Float" ) .end CODE --- { "Float" : !Float [ 12345.678 ], } OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "dumping ResizablePMCArray PMC" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array new array, 'ResizablePMCArray' push array, 12345 push array, "hello" yaml( array, "array" ) .end CODE --- { "array" : !ResizablePMCArray [ !Integer [ 12345 ], !String [ "hello" ], ], } OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "dumping ResizableStringArray PMC" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array new array, 'ResizableStringArray' push array, "hello" push array, "world" yaml( array, "array:" ) .end CODE --- { "array:" : !ResizableStringArray [ !String [ "hello" ], !String [ "world" ], ], } OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "dumping ResizableIntegerArray PMC" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array new array, 'ResizableIntegerArray' push array, 12345 push array, 67890 yaml( array, "array:" ) .end CODE --- { "array:" : !ResizableIntegerArray [ !Integer [ 12345 ], !Integer [ 67890 ], ], } OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "dumping ResizableFloatArray PMC" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array new array, 'ResizableFloatArray' push array, 123.45 push array, 67.89 yaml( array, "array:" ) .end CODE --- { "array:" : !ResizableFloatArray [ !Float [ 123.45 ], !Float [ 67.89 ], ], } OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "dumping FixedPMCArray PMC" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array new array, 'FixedPMCArray' array = 2 array[0] = 12345 array[1] = "hello" yaml( array, "array:" ) .end CODE --- { "array:" : !FixedPMCArray [ !Integer [ 12345 ], !String [ "hello" ], ], } OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "dumping FixedStringArray PMC" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array new array, 'FixedStringArray' array = 2 array[0] = "hello" array[1] = "world" yaml( array, "array:" ) .end CODE --- { "array:" : !FixedStringArray [ !String [ "hello" ], !String [ "world" ], ], } OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "dumping FixedIntegerArray PMC" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array new array, 'FixedIntegerArray' array = 2 array[0] = 12345 array[1] = 67890 yaml( array, "array:" ) .end CODE --- { "array:" : !FixedIntegerArray [ !Integer [ 12345 ], !Integer [ 67890 ], ], } OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "dumping FixedFloatArray PMC" ); .sub test :main load_bytecode "yaml_dumper.pbc" .local pmc array new array, 'FixedFloatArray' array = 2 array[0] = 123.45 array[1] = 67.89 yaml( array, "array:" ) .end CODE --- { "array:" : !FixedFloatArray [ !Float [ 123.45 ], !Float [ 67.89 ], ], } OUTPUT pir_output_is( <<'CODE', <<'OUTPUT', "custom dumper", todo => 'not yet implemented'); .sub main :main load_bytecode "yaml_dumper.pbc" .local pmc o, cl cl = subclass 'ResizablePMCArray', 'bar' o = new cl yaml(o) .end .namespace ["bar"] .sub init :vtable :method .local pmc ar ar = getattribute self, ['ResizablePMCArray'], 'proxy' push ar, 1 push ar, 2 .end .sub __yaml :method .param pmc dumper .param string label print " {\n" .local pmc ar ar = getattribute self, ['ResizablePMCArray'], 'proxy' dumper.'yaml'('attr', ar) print "\n}" .end .namespace [] CODE --- { "VAR1" : !bar { !ResizablePMCArray [ !Integer [ 1 ], !Integer [ 2 ], ], }, } OUTPUT # pir_output_is(<<'CODE', <<'OUTPUT', "dumping IntegerArray PMC"); # pir_output_is(<<'CODE', <<'OUTPUT', "dumping FloatValArray PMC"); # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: libnci_test.def000644000765000765 103211606346603 16260 0ustar00brucebruce000000000000parrot-5.9.0/srcLIBRARY libnci_test DESCRIPTION 'Shared lib for testing the Parrot Native Call Interface' EXPORTS nci_c nci_csc nci_d nci_dd nci_f nci_fff nci_i nci_iiii nci_isc nci_ip nci_l nci_p nci_pi nci_pii nci_piiii nci_pip nci_pp nci_s nci_ssc nci_v nci_vP nci_vpii nci_vv nci_vp nci_cb_C1 nci_cb_C2 nci_cb_C3 nci_cb_D1 nci_cb_D2 nci_cb_D3 nci_cb_D4 nci_dlvar_int nci_dlvar_double nci_dlvar_float int_cb_D4 test_server.pir000644000765000765 315311567202625 20272 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc/testlib#!./parrot # Copyright (C) 2011, Parrot Foundation. =head1 NAME t/pmc/testlib/test_server.pir - Test server for the Socket PMC =head1 DESCRIPTION This server process is launched from t/pmc/socket.t to test the Socket PMC. It listens on localhost:1234 and accepts only one connection. It echoes everything it reads from that connection back to the client. Upon successful startup the string "Server started" is printed to stdout. After a timeout of 3 seconds, the process exits so it doesn't wait forever in case of test failures. =cut .include 'socket.pasm' .sub main :main .local pmc sock, address, conn .local string str .local int len, status, port sock = new 'Socket' sock.'socket'(.PIO_PF_INET, .PIO_SOCK_STREAM, .PIO_PROTO_TCP) port = 1234 push_eh error retry: address = sock.'sockaddr'('localhost', port) sock.'bind'(address) goto started error: inc port if port < 1244 goto retry pop_eh say "couldn't bind to a free port, exiting" exit 1 started: pop_eh sock.'listen'(5) print 'Server started, listening on port ' say port status = sock.'poll'(1, 3, 0) # timeout if status == 0 goto conn_done conn = sock.'accept'() # echo incoming data recv_loop: status = conn.'poll'(1, 3, 0) # timeout if status == 0 goto recv_done str = conn.'recv'() len = length str if len == 0 goto recv_done conn.'send'(str) goto recv_loop recv_done: conn.'close'() conn_done: sock.'close'() .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: coroutine.pmc000644000765000765 2112412101554067 16610 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME src/pmc/coroutine.pmc - Co-Routine PMC =head1 DESCRIPTION C extends C to provide a subroutine that can stop in the middle, and start back up later at the point at which it stopped. See the L for more information. =head2 Flags =over 4 =item private0 call flip flop =item private3 restore current sub after "flop". Used by generators. =back =head2 Methods =over 4 =cut */ #include "parrot/oplib/ops.h" /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void print_sub_name(PARROT_INTERP, ARGIN(PMC *sub_pmc)) __attribute__nonnull__(1) __attribute__nonnull__(2); #define ASSERT_ARGS_print_sub_name __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(sub_pmc)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C static function to print coroutine information (for tracing/debugging) =cut */ static void print_sub_name(PARROT_INTERP, ARGIN(PMC *sub_pmc)) { /* It's actually a Parrot_coroutine, but this avoids casting warnings. */ PMC *ctx; Interp * const tracer = (interp->pdb && interp->pdb->debugger) ? interp->pdb->debugger : interp; GETATTR_Coroutine_ctx(interp, sub_pmc, ctx); Parrot_io_eprintf(tracer, "# %s coroutine '%Ss'", !(PObj_get_FLAGS(sub_pmc) & SUB_FLAG_CORO_FF) ? "Calling" : "yielding from", Parrot_sub_full_sub_name(interp, sub_pmc)); if (!PMC_IS_NULL(ctx) && (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_CORO_FF)) { Parrot_io_eprintf(tracer, " to '%Ss'", Parrot_sub_full_sub_name(interp, Parrot_pcc_get_sub(interp, Parrot_pcc_get_caller_ctx(interp, ctx)))); } Parrot_io_eprintf(tracer, "\n# "); print_pbc_location(interp); } pmclass Coroutine extends Sub provides invokable auto_attrs { ATTR INTVAL yield; /* yield in process */ ATTR opcode_t *address; /* next address to run - toggled each time */ ATTR PackFile_ByteCode *caller_seg; /* bytecode segment */ /* =item C Initializes the coroutine. =item C Clone the coroutine. =cut */ VTABLE void init() { SET_ATTR_seg(INTERP, SELF, INTERP->code); SET_ATTR_ctx(INTERP, SELF, PMCNULL); PObj_custom_mark_destroy_SETALL(SELF); } /* =item C Clones the coroutine. =cut */ VTABLE PMC *clone() { PMC * const ret = Parrot_pmc_new(INTERP, SELF->vtable->base_type); PObj_custom_mark_destroy_SETALL(ret); memcpy((Parrot_Coroutine_attributes *)PMC_data(ret), (Parrot_Coroutine_attributes *)PMC_data(SELF), sizeof (Parrot_Coroutine_attributes)); return ret; } /* =item C Signals the start of a yield. =cut */ VTABLE void increment() { SET_ATTR_yield(INTERP, SELF, 1); } /* =item C Swaps the "context". =cut */ VTABLE opcode_t *invoke(void *next) { PMC *ctx; opcode_t *dest; PackFile_ByteCode *wanted_seg; PMC * const signature = Parrot_pcc_get_signature(INTERP, CURRENT_CONTEXT(INTERP)); if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG)) print_sub_name(INTERP, SELF); GET_ATTR_ctx(INTERP, SELF, ctx); if (PMC_IS_NULL(ctx)) { PackFile_ByteCode *seg; size_t start_offs; const UINTVAL *n_regs_used; PMC *lex_info; PMC * const caller_ctx = CURRENT_CONTEXT(INTERP); PMC *ccont = INTERP->current_cont; PARROT_ASSERT(!PMC_IS_NULL(ccont)); ctx = Parrot_pcc_get_signature(INTERP, caller_ctx); if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "tail call to coroutine not allowed"); /* first time set current sub, cont, object */ if (PMC_IS_NULL(ctx)) ctx = Parrot_pmc_new(INTERP, enum_class_CallContext); Parrot_pcc_set_context(INTERP, ctx); GET_ATTR_n_regs_used(INTERP, SELF, n_regs_used); Parrot_pcc_allocate_registers(INTERP, ctx, n_regs_used); Parrot_pcc_set_caller_ctx(INTERP, ctx, caller_ctx); Parrot_pcc_init_context(INTERP, ctx, caller_ctx); SET_ATTR_ctx(INTERP, SELF, ctx); SETATTR_Continuation_from_ctx(INTERP, ccont, ctx); Parrot_pcc_set_sub(INTERP, ctx, SELF); Parrot_pcc_set_continuation(INTERP, ctx, ccont); INTERP->current_cont = PMCNULL; GET_ATTR_lex_info(INTERP, SELF, lex_info); /* create pad if needed */ if (!PMC_IS_NULL(lex_info)) { const INTVAL hlltype = Parrot_hll_get_ctx_HLL_type(INTERP, enum_class_LexPad); PMC * const lexpad = Parrot_pmc_new_init(INTERP, hlltype, lex_info); Parrot_pcc_set_lex_pad(INTERP, ctx, lexpad); VTABLE_set_pointer(INTERP, lexpad, ctx); } GET_ATTR_seg(INTERP, SELF, seg); PObj_get_FLAGS(SELF) |= SUB_FLAG_CORO_FF; wanted_seg = seg; GET_ATTR_start_offs(INTERP, SELF, start_offs); SET_ATTR_caller_seg(INTERP, SELF, INTERP->code); SET_ATTR_address(INTERP, SELF, seg->base.data + start_offs); } /* if calling the Coro we need the segment of the Coro */ else if (!(PObj_get_FLAGS(SELF) & SUB_FLAG_CORO_FF)) { PackFile_ByteCode *seg; PMC *ccont; GET_ATTR_ctx(INTERP, SELF, ctx); ccont = Parrot_pcc_get_continuation(INTERP, ctx); PObj_get_FLAGS(SELF) |= SUB_FLAG_CORO_FF; GET_ATTR_seg(INTERP, SELF, seg); wanted_seg = seg; /* remember segment of caller */ SET_ATTR_caller_seg(INTERP, SELF, INTERP->code); /* and the recent call context */ SETATTR_Continuation_to_ctx(INTERP, ccont, CURRENT_CONTEXT(INTERP)); Parrot_pcc_set_caller_ctx(INTERP, ctx, CURRENT_CONTEXT(INTERP)); /* set context to coroutine context */ Parrot_pcc_set_context(INTERP, ctx); } else { INTVAL yield; PMC *ccont, *to_ctx; PackFile_ByteCode *caller_seg; GET_ATTR_yield(INTERP, SELF, yield); if (!yield) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "Cannot resume dead coroutine."); SET_ATTR_yield(INTERP, SELF, 0); GET_ATTR_ctx(INTERP, SELF, ctx); ccont = Parrot_pcc_get_continuation(INTERP, ctx); GETATTR_Continuation_to_ctx(INTERP, ccont, to_ctx); PObj_get_FLAGS(SELF) &= ~SUB_FLAG_CORO_FF; GET_ATTR_caller_seg(INTERP, SELF, caller_seg); /* switch back to last remembered code seg and context */ wanted_seg = caller_seg; if (PMC_IS_NULL(to_ctx)) { /* This still isn't quite right, but it beats segfaulting. See the "Call an exited coroutine" case in t/pmc/coroutine.t; the problem is that the defunct coroutine yields up one more result before we get here. -- rgr, 7-Oct-06. * This may be unneeded after the yield fix, see TT #1003 */ Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "Cannot resume dead coroutine."); } Parrot_pcc_set_context(INTERP, to_ctx); } Parrot_pcc_set_signature(INTERP, CURRENT_CONTEXT(INTERP), signature); /* toggle address */ GET_ATTR_address(INTERP, SELF, dest); SET_ATTR_address(INTERP, SELF, (opcode_t *)next); if (INTERP->code != wanted_seg) Parrot_switch_to_cs(INTERP, wanted_seg, 1); return dest; } } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ primes2.py000644000765000765 203111533177634 20405 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks""" Copyright (C) 2001-2003, Parrot Foundation. =head1 NAME examples/benchmarks/primes.py - Calculate prime numbers < 5000 =head1 SYNOPSIS % time python examples/benchmarks/primes.py =head1 DESCRIPTION Calculates all the prime numbers up to 50000 and prints out the number of primes and the last one found. =cut """ # import os,sys def isprime1(input): if input < 1: return 0 n = input-1 while n > 1: if input%n == 0: return 0 n = n - 1 return 1 def main(): i = 0 l = 0 i6 = 0 i7 = 0 max = 500 while 1: if isprime1(i): i6 = i6 + 1 i7 = i i = i + 1 if i == max: break print "N primes calculated to ",max, i6 print "last is:", i7 if __name__ == "__main__": main() """ =head1 SEE ALSO F, F, F, F, F, F, F. =cut """ knucleotide.pir000644000765000765 432111533177635 21250 0ustar00brucebruce000000000000parrot-5.9.0/examples/shootout# Copyright (C) 2005-2010, Parrot Foundation. .loadlib 'io_ops' .sub main :main .local pmc stdin .local string line stdin = getstdin # Skip to block THREE beginwhile_1: line = readline stdin $S0 = chopn line, -6 if $S0 != ">THREE" goto beginwhile_1 line = '' .local string seq beginwhile_2: line = chopn line, 1 seq .= line line = readline stdin $I0 = length line unless $I0 goto endwhile_2 $S0 = chopn line, -1 if $S0 != ">" goto beginwhile_2 endwhile_2: seq = upcase seq sort_seq(seq, 1) sort_seq(seq, 2) find_seq(seq, "GGT") find_seq(seq, "GGTA") find_seq(seq, "GGTATT") find_seq(seq, "GGTATTTTAATT") find_seq(seq, "GGTATTTTAATTTATAGT") .end .sub sort_seq .param string seq .param int len .local int i, seqend .local pmc table table = new 'Hash' i = 0 seqend = length seq beginfor: unless i < seqend goto endfor $S0 = substr seq, i, len $I1 = length $S0 if $I1 < len goto endfor $I0 = table[$S0] inc $I0 table[$S0] = $I0 inc i goto beginfor endfor: sort_n_print(table, i) print "\n" .end .include "iterator.pasm" .sub sort_n_print .param pmc table .param int seqlen .local int i .local pmc array array = new 'FixedPMCArray' $I0 = elements table array = $I0 .local pmc it it = iter table set it, .ITERATE_FROM_START i = 0 iter_loop_1: unless it goto iter_end_1 $S0 = shift it $I0 = table[$S0] $P0 = new 'FixedPMCArray' $P0 = 2 array[i] = $P0 array[i;0] = $S0 array[i;1] = $I0 inc i goto iter_loop_1 iter_end_1: $P0 = get_global "sort" array."sort"($P0) $I0 = array i = 0 beginfor: unless i < $I0 goto endfor $S0 = array[i;0] $N0 = array[i;1] print $S0 print " " $P0 = new 'FixedFloatArray' $P0 = 1 $N1 = seqlen $N0 /= $N1 $N0 *= 100 $P0[0] = $N0 $S0 = sprintf "%.3f\n", $P0 print $S0 inc i goto beginfor endfor: .end .sub sort .param pmc a .param pmc b $I0 = a[1] $I1 = b[1] $I2 = cmp $I1, $I0 .return($I2) .end .sub find_seq .param string seq .param string s .local int i i = 0 $I0 = 0 beginwhile: $I2 = $I0 + 1 $I0 = index seq, s, $I2 if $I0 == -1 goto endwhile inc i goto beginwhile endwhile: print i print "\t" print s print "\n" .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: tap_parser.t000644000765000765 4456511533177644 17016 0ustar00brucebruce000000000000parrot-5.9.0/t/library#!./parrot # Copyright (C) 2010, Parrot Foundation. =head1 NAME t/library/tap_parser.t =head1 DESCRIPTION Test the TAP/Parser library =head1 SYNOPSIS % prove t/library/tap_parser.t =cut .sub 'main' :main .include 'test_more.pir' load_bytecode 'TAP/Parser.pir' plan(203) test_grammar_plan() test_grammar_bailout() test_grammar_comment() test_grammar_tests() test_grammar_version() test_tap() test_tap_with_blank_lines() test_tap_has_problem() test_tap_version_wrong_place() test_tap_trailing_plan() test_aggregator() .end .sub 'test_grammar_plan' .local pmc grammar, token grammar = new ['TAP';'Parser';'Grammar'] token = grammar.'tokenize'("1..42") $P0 = get_class ['TAP';'Parser';'Result';'Plan'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, "1..42") $P0 = getattribute token, 'plan' is($P0, "1..42") $P0 = getattribute token, 'tests_planned' is($P0, 42, "tests_planned") token = grammar.'tokenize'("1..0 # SKIP why not?") $P0 = get_class ['TAP';'Parser';'Result';'Plan'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, "1..0 # SKIP why not?") $P0 = getattribute token, 'plan' is($P0, "1..0") $P0 = getattribute token, 'tests_planned' is($P0, 0, "tests_planned") $P0 = getattribute token, 'directive' is($P0, 'SKIP', "directive") $P0 = getattribute token, 'explanation' is($P0, 'why not?', "explanation") token = grammar.'tokenize'("1..0") $P0 = get_class ['TAP';'Parser';'Result';'Plan'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, "1..0") $P0 = getattribute token, 'plan' is($P0, "1..0") $P0 = getattribute token, 'tests_planned' is($P0, 0, "tests_planned") $P0 = getattribute token, 'directive' is($P0, 'SKIP', "directive") .end .sub 'test_grammar_bailout' .local pmc grammar, token grammar = new ['TAP';'Parser';'Grammar'] token = grammar.'tokenize'("Bail out!") $P0 = get_class ['TAP';'Parser';'Result';'Bailout'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, "Bail out!") $P0 = getattribute token, 'explanation' is($P0, '', "no explanation") token = grammar.'tokenize'("Bail out! some explanation") $P0 = get_class ['TAP';'Parser';'Result';'Bailout'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, "Bail out! some explanation") $P0 = getattribute token, 'explanation' is($P0, "some explanation", "explanation") .end .sub 'test_grammar_comment' .local pmc grammar, token grammar = new ['TAP';'Parser';'Grammar'] token = grammar.'tokenize'("# this is a comment") $P0 = get_class ['TAP';'Parser';'Result';'Comment'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, "# this is a comment") $P0 = getattribute token, 'comment' is($P0, 'this is a comment', "comment") .end .sub 'test_grammar_tests' .local pmc grammar, token grammar = new ['TAP';'Parser';'Grammar'] token = grammar.'tokenize'("ok 1 this is a test") $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, "ok 1 this is a test") $P0 = getattribute token, 'ok' is($P0, 'ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 1, "test_num") $P0 = getattribute token, 'description' is($P0, 'this is a test', "description") token = grammar.'tokenize'("not ok 2 this is a test # TODO whee!") $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, "not ok 2 this is a test # TODO whee!") $P0 = getattribute token, 'ok' is($P0, 'not ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 2, "test_num") $P0 = getattribute token, 'description' is($P0, 'this is a test', "description") $P0 = getattribute token, 'directive' is($P0, 'TODO', "directive") $P0 = getattribute token, 'explanation' is($P0, 'whee!', "explanation") token = grammar.'tokenize'("ok 22 this is a test \\# TODO whee!") $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, "ok 22 this is a test \\# TODO whee!") $P0 = getattribute token, 'ok' is($P0, 'ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 22, "test_num") $P0 = getattribute token, 'description' is($P0, 'this is a test \# TODO whee!', "description") token = grammar.'tokenize'("not ok") $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, "not ok") $P0 = getattribute token, 'ok' is($P0, 'not ok', "ok") $P0 = getattribute token, 'test_num' null $P1 is($P0, $P1, "test_num") $P0 = getattribute token, 'description' null $P1 is($P0, $P1, "description") token = grammar.'tokenize'("ok 42") $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, "ok 42") $P0 = getattribute token, 'ok' is($P0, 'ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 42, "test_num") $P0 = getattribute token, 'description' null $P1 is($P0, $P1, "description") .end .sub 'test_grammar_version' .local pmc grammar, token grammar = new ['TAP';'Parser';'Grammar'] token = grammar.'tokenize'("TAP version 12") $P0 = get_class ['TAP';'Parser';'Result';'Version'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, "TAP version 12") $P0 = getattribute token, 'version' is($P0, 12, "version") .end .sub '_get_results' .param pmc parser .local pmc result result = new 'ResizablePMCArray' $P0 = get_hll_global ['TAP';'Parser'], 'next' .local pmc coro coro = newclosure $P0 L1: $P0 = coro(parser) if null $P0 goto L2 push result, $P0 goto L1 L2: .return (result) .end .sub 'test_tap' .local pmc parser, result, token parser = new ['TAP';'Parser'] parser.'tap'(<<'END_TAP') TAP version 13 1..7 ok 1 - input file opened ... this is junk not ok first line of the input valid # todo some data # this is a comment ok 3 - read the rest of the file not ok 4 - this is a real failure ok 5 # skip we have no description ok 6 - you shall not pass! # TODO should have failed not ok 7 - Gandalf wins. Game over. # TODO 'bout time! END_TAP result = _get_results(parser) $I0 = elements result is($I0, 11, "elements") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Version'] isa_ok(token, $P0) $P0 = getattribute token, 'version' is($P0, 13, "version") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Plan'] isa_ok(token, $P0) $P0 = getattribute token, 'plan' is($P0, "1..7", "plan") $P0 = getattribute token, 'tests_planned' is($P0, 7, "tests_planned") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'ok' is($P0, 'ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 1, "test_num") $P0 = getattribute token, 'description' is($P0, '- input file opened', "description") $I0 = token.'is_ok'() ok($I0) $I0 = token.'is_actual_ok'() ok($I0) $I0 = token.'has_todo'() nok($I0) $I0 = token.'has_skip'() nok($I0) token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Unknown'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, '... this is junk', "raw") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'ok' is($P0, 'not ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 2, "test_num") $P0 = getattribute token, 'description' is($P0, 'first line of the input valid', "description") $I0 = token.'is_ok'() ok($I0) $I0 = token.'is_actual_ok'() nok($I0) $I0 = token.'has_todo'() ok($I0) $I0 = token.'has_skip'() nok($I0) $P0 = getattribute token, 'explanation' is($P0, 'some data', "explanation") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Comment'] isa_ok(token, $P0) $P0 = getattribute token, 'comment' is($P0, 'this is a comment', "comment") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'ok' is($P0, 'ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 3, "test_num") $P0 = getattribute token, 'description' is($P0, '- read the rest of the file', "description") $I0 = token.'is_ok'() ok($I0) $I0 = token.'is_actual_ok'() ok($I0) $I0 = token.'has_todo'() nok($I0) $I0 = token.'has_skip'() nok($I0) token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'ok' is($P0, 'not ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 4, "test_num") $P0 = getattribute token, 'description' is($P0, '- this is a real failure', "description") $I0 = token.'is_ok'() nok($I0) $I0 = token.'is_actual_ok'() nok($I0) $I0 = token.'has_todo'() nok($I0) $I0 = token.'has_skip'() nok($I0) token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'ok' is($P0, 'ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 5, "test_num") $I0 = token.'is_ok'() ok($I0) $I0 = token.'is_actual_ok'() ok($I0) $I0 = token.'has_todo'() nok($I0) $I0 = token.'has_skip'() ok($I0) $P0 = getattribute token, 'explanation' is($P0, 'we have no description', "explanation") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'ok' is($P0, 'ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 6, "test_num") $P0 = getattribute token, 'description' is($P0, '- you shall not pass!', "description") $I0 = token.'is_ok'() ok($I0) $I0 = token.'is_actual_ok'() ok($I0) $I0 = token.'has_todo'() ok($I0) $I0 = token.'has_skip'() nok($I0) $P0 = getattribute token, 'explanation' is($P0, 'should have failed', "explanation") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'ok' is($P0, 'not ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 7, "test_num") $P0 = getattribute token, 'description' is($P0, '- Gandalf wins. Game over.', "description") $I0 = token.'is_ok'() ok($I0) $I0 = token.'is_actual_ok'() nok($I0) $I0 = token.'has_todo'() ok($I0) $I0 = token.'has_skip'() nok($I0) $P0 = getattribute token, 'explanation' is($P0, "'bout time!", "explanation") $P0 = getattribute parser, 'passed' $S0 = join ', ', $P0 is($S0, "1, 2, 3, 5, 6, 7", "passed") $P0 = getattribute parser, 'failed' $S0 = join ', ', $P0 is($S0, "4", "failed") $P0 = getattribute parser, 'actual_passed' $S0 = join ', ', $P0 is($S0, "1, 3, 5, 6", "actual_passed") $P0 = getattribute parser, 'actual_failed' $S0 = join ', ', $P0 is($S0, "2, 4, 7", "actual_failed") $P0 = getattribute parser, 'todo' $S0 = join ', ', $P0 is($S0, "2, 6, 7", "todo") $P0 = getattribute parser, 'skipped' $S0 = join ', ', $P0 is($S0, "5", "skipped") $P0 = getattribute parser, 'todo_passed' $S0 = join ', ', $P0 is($S0, "6", "todo_passed") $P0 = getattribute parser, 'plan' is($P0, "1..7", "plan") $P0 = getattribute parser, 'tests_planned' is($P0, 7, "tests_planned") .end .sub 'test_tap_with_blank_lines' .local pmc parser, result, token parser = new ['TAP';'Parser'] parser.'tap'(<<'END_TAP') 1..2 ok 1 - input file opened ok 2 - read the rest of the file END_TAP result = _get_results(parser) $I0 = elements result is($I0, 5, "elements") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Plan'] isa_ok(token, $P0) $P0 = getattribute token, 'plan' is($P0, "1..2", "plan") $P0 = getattribute token, 'tests_planned' is($P0, 2, "tests_planned") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'ok' is($P0, 'ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 1, "test_num") $P0 = getattribute token, 'description' is($P0, '- input file opened', "description") $I0 = token.'is_ok'() ok($I0) $I0 = token.'is_actual_ok'() ok($I0) $I0 = token.'has_todo'() nok($I0) $I0 = token.'has_skip'() nok($I0) token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Unknown'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, '', "raw") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Unknown'] isa_ok(token, $P0) $P0 = getattribute token, 'raw' is($P0, '', "raw") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'ok' is($P0, 'ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 2, "test_num") $P0 = getattribute token, 'description' is($P0, '- read the rest of the file', "description") $I0 = token.'is_ok'() ok($I0) $I0 = token.'is_actual_ok'() ok($I0) $I0 = token.'has_todo'() nok($I0) $I0 = token.'has_skip'() nok($I0) .end .sub 'test_tap_has_problem' .local pmc parser parser = new ['TAP';'Parser'] parser.'tap'(<<'END_TAP') TAP version 13 1..2 ok 1 - input file opened ok 2 - Gandalf wins. Game over. # TODO 'bout time! END_TAP parser.'run'() $I0 = parser.'failed'() is($I0, 0, "not failed") $I0 = parser.'todo_passed'() is($I0, 1, "todo_passed") $I0 = parser.'has_problems'() nok($I0, "has not problem") parser = new ['TAP';'Parser'] parser.'tap'(<<'END_TAP') TAP version 13 1..2 SMACK END_TAP parser.'run'() $I0 = parser.'failed'() is($I0, 0, "not failed") $I0 = parser.'todo_passed'() is($I0, 0, "todo_passed") $I0 = parser.'parse_errors'() is($I0, 2, "parse_errors") $I0 = parser.'has_problems'() ok($I0, "has_problems") .end .sub 'test_tap_version_wrong_place' .local pmc parser parser = new ['TAP';'Parser'] parser.'tap'(<<'END_TAP') 1..2 ok 1 - input file opened TAP version 12 ok 2 - Gandalf wins END_TAP parser.'run'() $I0 = parser.'failed'() is($I0, 0, "not failed") $I0 = parser.'parse_errors'() is($I0, 1, "parse_errors") $P0 = getattribute parser, 'parse_errors' $S0 = shift $P0 is($S0, "If TAP version is present it must be the first line of output") .end .sub 'test_tap_trailing_plan' .local pmc parser, result, token parser = new ['TAP';'Parser'] parser.'tap'(<<'END_TAP') ok 1 - input file opened ok 2 - Gandalf wins 1..2 END_TAP result = _get_results(parser) $I0 = elements result is($I0, 3, "elements") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'ok' is($P0, 'ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 1, "test_num") $P0 = getattribute token, 'description' is($P0, '- input file opened', "description") $I0 = token.'is_ok'() ok($I0) $I0 = token.'is_actual_ok'() ok($I0) $I0 = token.'is_unplanned'() nok($I0, "unplanned") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Test'] isa_ok(token, $P0) $P0 = getattribute token, 'ok' is($P0, 'ok', "ok") $P0 = getattribute token, 'test_num' is($P0, 2, "test_num") $P0 = getattribute token, 'description' is($P0, '- Gandalf wins', "description") $I0 = token.'is_ok'() ok($I0) $I0 = token.'is_actual_ok'() ok($I0) $I0 = token.'is_unplanned'() nok($I0, "unplanned") token = shift result $P0 = get_class ['TAP';'Parser';'Result';'Plan'] isa_ok(token, $P0) $P0 = getattribute token, 'plan' is($P0, "1..2", "plan") $P0 = getattribute token, 'tests_planned' is($P0, 2, "tests_planned") $I0 = parser.'passed'() is($I0, 2, "passed") $I0 = parser.'failed'() is($I0, 0, "failed") $I0 = parser.'parse_errors'() is($I0, 0, "parse_errors") $I0 = parser.'has_problems'() is($I0, 0, "has_problems") $P0 = getattribute parser, 'plan' is($P0, "1..2", "plan") $P0 = getattribute parser, 'tests_planned' is($P0, 2, "tests_planned") .end .sub 'test_aggregator' .local pmc parser1, parser2, agg parser1 = new ['TAP';'Parser'] parser1.'tap'(<<'END_TAP') 1..5 ok 1 - input file opened ... this is junk not ok first line of the input valid # todo some data # this is a comment ok 3 - read the rest of the file not ok 4 - this is a real failure ok 5 # skip we have no description END_TAP parser1.'run'() parser2 = new ['TAP';'Parser'] parser2.'tap'(<<'END_TAP') 1..7 ok 1 - gentlemen, start your engines not ok first line of the input valid # todo some data # this is a comment ok 3 - read the rest of the file not ok 4 - this is a real failure ok 5 ok 6 - you shall not pass! # TODO should have failed not ok 7 - Gandalf wins. Game over. # TODO 'bout time! END_TAP parser2.'run'() agg = new ['TAP';'Parser';'Aggregator'] agg.'add'('tap1', parser1) agg.'add'('tap2', parser2) $P0 = agg.'descriptions'() $I0 = elements $P0 is($I0, 2, "descriptions") $P0 = getattribute agg, 'passed' is($P0, 10, "passed") $P0 = getattribute agg, 'failed' is($P0, 2, "failed") $P0 = getattribute agg, 'todo' is($P0, 4, "todo") $P0 = getattribute agg, 'skipped' is($P0, 1, "skipped") $P0 = getattribute agg, 'parse_errors' is($P0, 1, "parse_errors") $P0 = getattribute agg, 'todo_passed' is($P0, 1, "todo_passed") $P0 = getattribute agg, 'total' is($P0, 12, "total") $P0 = getattribute agg, 'planned' is($P0, 12, "planned") $I0 = agg.'has_problems'() ok($I0, "has_problems") $I0 = agg.'has_errors'() ok($I0, "has_errors") $S0 = agg.'get_status'() is($S0, 'FAIL', "status") $I0 = agg.'all_passed'() nok($I0, "all_passed") .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: rand.t000644000765000765 170211533177644 15544 0ustar00brucebruce000000000000parrot-5.9.0/t/library#!./parrot # Copyright (C) 2009-2010, Parrot Foundation. =head1 NAME t/library/rand.t =head1 DESCRIPTION Test the Math::Rand PBC =head1 SYNOPSIS % prove t/library/rand.t =cut .sub main :main load_bytecode 'Math/Rand.pbc' .include 'test_more.pir' plan(7) test_rand_srand() test_rand_max() .end .sub test_rand_srand .local pmc rand rand = get_global [ 'Math'; 'Rand' ], 'rand' .local pmc srand srand = get_global [ 'Math'; 'Rand' ], 'srand' $I0 = rand() is($I0,16838) $I0 = rand() is($I0,5758) $I0 = rand() is($I0,10113) $I0 = rand() is($I0,17515) srand(1) $I0 = rand() is($I0,16838) $I0 = rand() is($I0,5758) .end .sub test_rand_max .local pmc rand_max rand_max = get_global [ 'Math'; 'Rand' ], 'RAND_MAX' $I0 = rand_max() is($I0,32767) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: gmt_utc.t000644000765000765 337311533177643 16601 0ustar00brucebruce000000000000parrot-5.9.0/t/codingstd#! perl # Copyright (C) 2006-2009, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use ExtUtils::Manifest qw(maniread); use Parrot::Distribution; # set up how many tests to run plan tests => 1; =head1 NAME t/codingstd/gmt_utc.t - checks for GMT/UTC timezone in generated files =head1 SYNOPSIS # test all files % prove t/codingstd/gmt_utc.t # test specific files % perl t/codingstd/gmt_utc.t src/foo.c include/parrot/bar.h =head1 DESCRIPTION Generated files which have timezone information should have this as either GMT or UTC. =head1 SEE ALSO L =cut my $DIST = Parrot::Distribution->new; my @files = @ARGV ? <@ARGV> : source_files(); my @failures; foreach my $file (@files) { my $buf = $DIST->slurp($file); # trim out SVN Id line $buf =~ s{\$Id:.*}{}g; # if we have a timezone, check to see if it is GMT/UTC push @failures => "$file\n" if $buf =~ m{ \d:\d\d:\d\d # a time-looking string (?! .*? (GMT|UTC)) # not GMT or UTC }x; } ok( !scalar(@failures), 'Generated timestamps correct' ) or diag( "Non GMT/UTC timestamp found in " . scalar @failures . " files:\n@failures" ); exit; sub source_files { my $manifest = maniread('MANIFEST.generated'); my @test_files; # grab names of files to test (except binary files) foreach my $filename ( sort keys %$manifest ) { next if !( -e $filename ); push @test_files, $filename if ( $filename =~ m/\.(c|h|pod|pl|pm)$/ ); } return @test_files; } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: pmcs.json000644000765000765 151611567202622 16413 0ustar00brucebruce000000000000parrot-5.9.0/docs/index{ "page" : "pmc", "content" : [ { "source" : [ "tools/dev/gen_class.pl" ], "title" : "Tools" }, { "source" : [ "src/pmc/default.pmc", "src/pmc/scalar.pmc" ], "title" : "Abstract PMCs" }, { "source" : "src/pmc/*.pmc", "title" : "Abstract PMCs", "exclude" : [ "src/pmc/default.pmc", "src/pmc/scalar.pmc" ] }, { "source" : "src/dynpmc/*.pmc", "title" : "Dynamic PMCs", "exclude" : [ "src/dynpmc/rotest.pmc", "src/dynpmc/subproxy.pmc", "src/dynpmc/pccmethod_test.pmc", "src/dynpmc/foo.pmc", "src/dynpmc/foo2.pmc" ] } ], "title" : "PMCs" } mops_intval.pasm000644000765000765 261111567202623 21665 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks# Copyright (C) 2001-2003, Parrot Foundation. =head1 NAME examples/benchmarks/mops_intval.pasm - Calculate a benchmark =head1 SYNOPSIS % ./parrot examples/benchmarks/mops_intval.pasm =head1 DESCRIPTION Calculates a value for M ops/s (million operations per second) using integer arithmetic. =cut set I2, 0 set I3, 1 set I4, 100000000 print "Iterations: " print I4 print "\n" set I1, 2 mul I5, I4, I1 print "Estimated ops: " print I5 print "\n" time N1 REDO: sub I4, I4, I3 if I4, REDO DONE: time N5 sub N2, N5, N1 print "Elapsed time: " print N2 print "\n" if I4, BUG set N1, I5 div N1, N1, N2 set N2, 1000000.0 div N1, N1, N2 print "M op/s: " print N1 print "\n" end BUG: print "This can't happen\n" end =head1 SEE ALSO F, F, F, F, F, F, F, F, F, F. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: vtable.tbl000644000765000765 1475212101554067 15312 0ustar00brucebruce000000000000parrot-5.9.0/src# [MAIN] #default section name # MMD_EQ ... MMD_STRCMP must be in one block # see src/multidispatch.c # INPLACE MMD variant must always be normal op + 1 # NOTE: VTABLE functions that modify their PMC must be marked with :write to # work properly with the generational GC. void init() :write # init must be first for JITed vtable meths void init_pmc(PMC* initializer) :write PMC* instantiate(PMC* sig) void morph(PMC* type) :write void mark() void destroy() PMC* get_namespace() INTVAL type() STRING* name() PMC* clone() PMC* clone_pmc(PMC* args) PMC* find_method(STRING* method_name) [FETCH] INTVAL get_integer() INTVAL get_integer_keyed(PMC* key) INTVAL get_integer_keyed_int(INTVAL key) INTVAL get_integer_keyed_str(STRING* key) FLOATVAL get_number() FLOATVAL get_number_keyed(PMC* key) FLOATVAL get_number_keyed_int(INTVAL key) FLOATVAL get_number_keyed_str(STRING* key) STRING* get_string() STRING* get_repr() STRING* get_string_keyed(PMC* key) STRING* get_string_keyed_int(INTVAL key) STRING* get_string_keyed_str(STRING* key) INTVAL get_bool() PMC* get_pmc() PMC* get_pmc_keyed(PMC* key) PMC* get_pmc_keyed_int(INTVAL key) PMC* get_pmc_keyed_str(STRING* key) void* get_pointer() void* get_pointer_keyed(PMC* key) void* get_pointer_keyed_int(INTVAL key) void* get_pointer_keyed_str(STRING* key) [STORE] :write void set_integer_native(INTVAL value) void set_integer_keyed(PMC* key, INTVAL value) void set_integer_keyed_int(INTVAL key, INTVAL value) void set_integer_keyed_str(STRING* key, INTVAL value) void set_number_native(FLOATVAL value) void set_number_keyed(PMC* key, FLOATVAL value) void set_number_keyed_int(INTVAL key, FLOATVAL value) void set_number_keyed_str(STRING* key, FLOATVAL value) void set_string_native(STRING* value) void assign_string_native(STRING* value) void set_string_keyed(PMC* key, STRING* value) void set_string_keyed_int(INTVAL key, STRING* value) void set_string_keyed_str(STRING* key, STRING* value) void set_bool(INTVAL value) void set_pmc(PMC* value) void assign_pmc(PMC* value) void set_pmc_keyed(PMC* key, PMC* value) void set_pmc_keyed_int(INTVAL key, PMC* value) void set_pmc_keyed_str(STRING* key, PMC* value) void set_pointer(void* value) void set_pointer_keyed(PMC* key, void* value) void set_pointer_keyed_int(INTVAL key, void* value) void set_pointer_keyed_str(STRING* key, void* value) [FETCHSIZE] INTVAL elements() [POP] :write INTVAL pop_integer() FLOATVAL pop_float() STRING* pop_string() PMC* pop_pmc() [PUSH] :write void push_integer(INTVAL value) void push_float(FLOATVAL value) void push_string(STRING* value) void push_pmc(PMC* value) [SHIFT] :write INTVAL shift_integer() FLOATVAL shift_float() STRING* shift_string() PMC* shift_pmc() [UNSHIFT] :write void unshift_integer(INTVAL value) void unshift_float(FLOATVAL value) void unshift_string(STRING* value) void unshift_pmc(PMC* value) ## void splice ??? [SPLICE] :write void splice(PMC* value, INTVAL offset, INTVAL count) # XXX marking writing here? [MATH] PMC* add(PMC* value, PMC* dest) PMC* add_int(INTVAL value, PMC* dest) PMC* add_float(FLOATVAL value, PMC* dest) void i_add(PMC* value) :write void i_add_int(INTVAL value) :write void i_add_float(FLOATVAL value) :write PMC* subtract(PMC* value, PMC* dest) PMC* subtract_int(INTVAL value, PMC* dest) PMC* subtract_float(FLOATVAL value, PMC* dest) void i_subtract(PMC* value) :write void i_subtract_int(INTVAL value) :write void i_subtract_float(FLOATVAL value) :write PMC* multiply(PMC* value, PMC* dest) PMC* multiply_int(INTVAL value, PMC* dest) PMC* multiply_float(FLOATVAL value, PMC* dest) void i_multiply(PMC* value) :write void i_multiply_int(INTVAL value) :write void i_multiply_float(FLOATVAL value) :write PMC* divide(PMC* value, PMC* dest) PMC* divide_int(INTVAL value, PMC* dest) PMC* divide_float(FLOATVAL value, PMC* dest) void i_divide(PMC* value) :write void i_divide_int(INTVAL value) :write void i_divide_float(FLOATVAL value) :write PMC* floor_divide(PMC* value, PMC* dest) PMC* floor_divide_int(INTVAL value, PMC* dest) PMC* floor_divide_float(FLOATVAL value, PMC* dest) void i_floor_divide(PMC* value) :write void i_floor_divide_int(INTVAL value) :write void i_floor_divide_float(FLOATVAL value) :write PMC* modulus(PMC* value, PMC* dest) PMC* modulus_int(INTVAL value, PMC* dest) PMC* modulus_float(FLOATVAL value, PMC* dest) void i_modulus(PMC* value) :write void i_modulus_int(INTVAL value) :write void i_modulus_float(FLOATVAL value) :write void increment() :write void decrement() :write PMC* absolute(PMC* dest) void i_absolute() :write PMC* neg(PMC* dest) void i_neg() :write [CMP] INTVAL is_equal(PMC* value) INTVAL is_equal_num(PMC* value) INTVAL is_equal_string(PMC* value) INTVAL is_same(PMC* value) INTVAL cmp(PMC* value) INTVAL cmp_num(PMC* value) INTVAL cmp_string(PMC* value) PMC* cmp_pmc(PMC* value) [STRING] PMC* concatenate(PMC* value, PMC* dest) PMC* concatenate_str(STRING* value, PMC* dest) void i_concatenate(PMC* value) :write void i_concatenate_str(STRING* value) :write PMC* repeat(PMC* value, PMC* dest) PMC* repeat_int(INTVAL value, PMC* dest) void i_repeat(PMC* value) :write void i_repeat_int(INTVAL value) :write STRING* substr(INTVAL offset, INTVAL length) [EXISTS] INTVAL exists_keyed(PMC* key) INTVAL exists_keyed_int(INTVAL key) INTVAL exists_keyed_str(STRING* key) [MAIN] INTVAL defined() INTVAL defined_keyed(PMC* key) INTVAL defined_keyed_int(INTVAL key) INTVAL defined_keyed_str(STRING* key) [DELETE] :write void delete_keyed(PMC* key) void delete_keyed_int(INTVAL key) void delete_keyed_str(STRING* key) [MAIN] PMC* get_iter() INTVAL hashvalue() opcode_t* invoke(void* next) INTVAL does_pmc(PMC* role) INTVAL does(STRING* role) INTVAL isa_pmc(PMC* _class) INTVAL isa(STRING* _class) PMC* get_attr_str(STRING* idx) PMC* get_attr_keyed(PMC* key, STRING* idx) void set_attr_str(STRING* idx, PMC* value) :write void set_attr_keyed(PMC* key, STRING* idx, PMC* value) :write PMC* get_class() void add_parent(PMC* parent) :write void remove_parent(PMC* parent) :write void add_role(PMC* role) :write void remove_role(PMC* role) :write void add_attribute(STRING* name, PMC* type) :write void remove_attribute(STRING* name) :write void add_method(STRING* method_name, PMC* sub_pmc) :write void remove_method(STRING* method_name) :write void add_vtable_override(STRING* vtable_name, PMC* sub_pmc) :write void remove_vtable_override(STRING* vtable_name) :write PMC* inspect() PMC* inspect_str(STRING* what) void freeze(PMC* info) void thaw(PMC* info) :write void thawfinish(PMC* info) :write void visit(PMC* info) void init_int(INTVAL initializer) :write 60_subroutines.pir000644000765000765 170012101554066 21573 0ustar00brucebruce000000000000parrot-5.9.0/examples/tutorial# Copyright (C) 2007-2012, Parrot Foundation. =pod =head1 DESCRIPTION A tutorial lesson about Parrot's subroutines. =head1 SUBROUTINES PIR is a subroutine-based or "procedural" programming language. Subroutines are used to break large tasks into smaller chunks. These chunks can be used and reused throughout the program. Subroutines are defined with the C<.sub> directive and continue until the C<.end> directive. Subroutines can take any number of input parameters, and can return any number of output parameters. In practice, we recommend you don't go overboard with creating huge argument lists because it gets very messy and difficult to deal with very quickly. =cut .sub main :main $S0 = foo("Zaphod") say $S0 .end .sub foo .param string name .local string greeting greeting = "Hello, " . name .return (greeting) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: isa.t000644000765000765 1127111533177644 14367 0ustar00brucebruce000000000000parrot-5.9.0/t/oo#!./parrot # Copyright (C) 2007-2008, Parrot Foundation. =head1 NAME t/oo/isa.t - Test OO inheritance =head1 SYNOPSIS % prove t/oo/isa.t =head1 DESCRIPTION Tests OO features related to the isa opcode, comparing for inheritance and composition. =cut .sub main :main .include 'test_more.pir' plan(30) isa_by_string_name() isa_by_class_object() subclass_isa_by_string_name() subclass_isa_by_class_object() string_isa_and_pmc_isa_have_same_result() string_register_and_string_pmc_isa_have_same_result() isa_accepts_rsa() .end .sub isa_by_string_name $P1 = newclass "Foo" $S1 = typeof $P1 is( 'Class', $S1, 'typeof newclass retval') $I3 = isa $P1, "Class" ok( $I3, 'isa newclass retval a Class') $P2 = new $P1 $S1 = typeof $P2 is ( 'Foo', $S1, 'typeof instance of our class') $I3 = isa $P2, "Foo" ok ( $I3, 'isa instance of our class') $I3 = isa $P2, "Object" ok ( $I3, 'isa instance of object') .end .sub isa_by_class_object .local pmc foo_class foo_class = newclass "Foo2" $S1 = typeof foo_class is( 'Class', $S1, 'typeof newclass retval') .local pmc class_class class_class = get_class "Class" $I3 = isa foo_class, class_class ok ($I3, 'isa newclass retval a Class') $P2 = new foo_class $S1 = typeof $P2 is ( 'Foo2', $S1, 'typeof new our class?') $I3 = isa $P2, foo_class ok ( $I3, 'isa instance of our class') .local pmc object_class object_class = get_class "Object" $I3 = isa $P2, object_class ok ( $I3, 'isa instance of Object') .end .sub subclass_isa_by_string_name .local pmc foo_class, bar_class foo_class = newclass "Foo3" bar_class = subclass "Foo3", "Bar3" $I3 = isa bar_class, "Class" ok ($I3, 'does subclass generate class objects') $P2 = new bar_class $S1 = typeof $P2 is ('Bar3', $S1, 'does new give us an obj of our type') $I3 = isa $P2, "Bar3" ok ($I3, 'does new give us an obj that isa our type') $I3 = isa $P2, "Foo3" ok ($I3, 'does new give us an obj that isa our parent type') $I3 = isa $P2, "Object" ok ($I3, 'does new give us an obj that isa Object') .end .sub subclass_isa_by_class_object .local pmc foo_class, bar_class, sub_sub_class, my_sub_class foo_class = newclass "Foo4" bar_class = subclass "Foo4", "Bar4" sub_sub_class = subclass 'Sub', 'SubSub' my_sub_class = subclass 'SubSub', 'MySub' .local pmc class_class class_class = get_class "Class" $I3 = isa bar_class, class_class ok ($I3, 'is the class of a subclass Class') $P2 = new bar_class $S1 = typeof $P2 is ('Bar4', $S1, 'typeof new class our class') $I3 = isa $P2, bar_class ok ($I3, 'new class isa our class') $I3 = isa $P2, foo_class ok ($I3, 'new class isa our parent class') .local pmc object_class object_class = get_class "Object" $I3 = isa $P2, object_class ok ($I3, 'new class isa Object') .local pmc sub_class sub_class = get_class 'Sub' $P2 = new sub_sub_class $I3 = isa $P2, sub_class ok( $I3, 'new class isa Sub' ) $P2 = new my_sub_class $I3 = isa $P2, sub_class ok( $I3, 'new subclass isa Sub' ) .end .sub string_isa_and_pmc_isa_have_same_result .local pmc class, obj class = new 'Class' obj = class.'new'() $I0 = isa obj, 'Object' ok ($I0, 'isa Class instance an Object') .local pmc cl cl = new 'String' cl = 'Object' $I1 = isa obj, cl ok ($I1, 'isa String instance an Object') .end .sub string_register_and_string_pmc_isa_have_same_result .local pmc xyzns, xyzclass, xyzobj xyzns = get_root_namespace ['foo';'XYZ'] xyzclass = newclass xyzns xyzobj = new xyzclass # prove that it's the correct type $S0 = xyzobj.'abc'() is( $S0, 'XYZ::abc', 'sanity check for correct method and type' ) # test two forms of isa $P0 = new 'String' $P0 = 'XYZ' $I0 = isa xyzobj, 'XYZ' ok( $I0, 'isa given string register should return true when it isa' ) $I0 = isa xyzobj, 'ZYX' $I0 = not $I0 ok( $I0, '... and false when it is not' ) $I0 = isa xyzobj, $P0 ok( $I0, 'isa given string PMC should return true when it isa' ) $P0 = 'ZYX' $I0 = isa xyzobj, $P0 $I0 = not $I0 ok( $I0, '... and false when it is not' ) .end .sub isa_accepts_rsa $P0 = newclass ['Foo';'Buz'] $P1 = new $P0 $P0 = split "::", "Foo::Buz" $I0 = isa $P1, $P0 ok($I0, "isa accepts a ResizablePMCArray") .end .HLL 'foo' .namespace ['XYZ'] .sub 'abc' :method .return( 'XYZ::abc' ) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: fixedpmcarray.pmc000644000765000765 4210212171255037 17440 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME src/pmc/fixedpmcarray.pmc - fixed size array for PMCs only =head1 DESCRIPTION This class, FixedPMCArray, implements an array of fixed size which stores PMCs. It puts things into Integer, Float, or String PMCs as appropriate =head2 Note The flag C is used in the C PMC and should never be set for user arrays. =head2 Functions =over 4 =cut */ #define PMC_size(x) ((Parrot_FixedPMCArray_attributes *)PMC_data(x))->size #define PMC_array(x) ((Parrot_FixedPMCArray_attributes *)PMC_data(x))->pmc_array /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_DOES_NOT_RETURN static void cannot_autovivify_nested(PARROT_INTERP) __attribute__nonnull__(1); #define ASSERT_ARGS_cannot_autovivify_nested __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ pmclass FixedPMCArray auto_attrs provides array { ATTR INTVAL size; /* number of elements in the array */ ATTR PMC **pmc_array; /* pointer to PMC array */ /* =item C Sort this array, optionally using the provided cmp_func =cut */ METHOD sort(PMC *cmp_func :optional) { const INTVAL n = SELF.elements(); if (n > 1) { /* XXX Workaround for TT #218 */ if (PObj_is_object_TEST(SELF)) { PMC * const parent = SELF.get_attr_str(CONST_STRING(INTERP, "proxy")); Parrot_pcc_invoke_method_from_c_args(INTERP, parent, CONST_STRING(INTERP, "sort"), "P->", cmp_func); } else Parrot_util_quicksort(INTERP, (void **)PMC_array(SELF), n, cmp_func, "PP->I"); } RETURN(PMC *SELF); } /* =item C Reverse the contents of the array. =cut */ METHOD reverse() { INTVAL n = SELF.elements(); if (n > 1) { PMC *val; PMC **data = PMC_array(SELF); INTVAL i; for (i = 0; i <= --n; i++) { val = data[i]; data[i] = data[n]; data[n] = val; } } } /* =back =head2 Methods =over 4 =item C Initializes the array. =cut */ VTABLE void init_int(INTVAL size) { if (size < 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, _("FixedPMCArray: Cannot set array size to a negative number (%d)"), size); SELF.set_integer_native(size); } /* =item C Destroys the array. =cut */ VTABLE void destroy() { if (PMC_array(SELF)) mem_gc_free(INTERP, PMC_array(SELF)); } /* =item C Creates and returns a copy of the array. =cut */ VTABLE PMC *clone() { PMC * const dest = Parrot_pmc_new(INTERP, SELF->vtable->base_type); const INTVAL size = PMC_size(SELF); if (size) { PMC_size(dest) = size; PMC_array(dest) = mem_gc_allocate_n_typed(INTERP, size, PMC *); mem_copy_n_typed(PMC_array(dest), PMC_array(SELF), size, PMC *); PObj_custom_mark_destroy_SETALL(dest); } return dest; } /* =item C Returns whether the array has any elements (meaning been initialized, for a fixed sized array). =cut */ VTABLE INTVAL get_bool() { const INTVAL size = SELF.elements(); return (INTVAL)(size != 0); } /* =item C =cut */ VTABLE INTVAL elements() { UNUSED(INTERP) return PMC_size(SELF); } /* =item C Returns the number of elements in the array. =cut */ VTABLE INTVAL get_integer() { return SELF.elements(); } /* =item C Returns the number of elements in the array. =cut */ VTABLE FLOATVAL get_number() { const INTVAL e = SELF.elements(); return (FLOATVAL)e; } /* =item C Returns the number of elements in the array as a Parrot string. (??? -leo) =item C Returns a string representation of the array contents. TT #1229: implement freeze/thaw and use that instead. =cut */ VTABLE STRING *get_string() { return Parrot_str_from_int(INTERP, SELF.elements()); } VTABLE STRING *get_repr() { STRING *res = CONST_STRING(INTERP, "("); const INTVAL n = VTABLE_elements(INTERP, SELF); INTVAL i; for (i = 0; i < n; ++i) { PMC * const val = SELF.get_pmc_keyed_int(i); if (i > 0) res = Parrot_str_concat(INTERP, res, CONST_STRING(INTERP, ", ")); res = Parrot_str_concat(INTERP, res, VTABLE_get_repr(INTERP, val)); } res = Parrot_str_concat(INTERP, res, CONST_STRING(INTERP, ")")); return res; } /* =item C Returns the integer value of the element at index C. =cut */ VTABLE INTVAL get_integer_keyed_int(INTVAL key) { PMC * const tempPMC = SELF.get_pmc_keyed_int(key); if (PMC_IS_NULL(tempPMC)) return 0; return VTABLE_get_integer(INTERP, tempPMC); } /* =item C Returns the integer value of the element at index C<*key>. =cut */ VTABLE INTVAL get_integer_keyed(PMC *key) { PMC * const tempPMC = SELF.get_pmc_keyed(key); return VTABLE_get_integer(INTERP, tempPMC); } /* =item C Returns the floating-point value of the element at index C. =cut */ VTABLE FLOATVAL get_number_keyed_int(INTVAL key) { PMC * const tempPMC = SELF.get_pmc_keyed_int(key); return VTABLE_get_number(INTERP, tempPMC); } /* =item C Returns the floating-point value of the element at index C<*key>. =cut */ VTABLE FLOATVAL get_number_keyed(PMC *key) { PMC * const tempPMC = SELF.get_pmc_keyed(key); return VTABLE_get_number(INTERP, tempPMC); } /* =item C Returns the Parrot string value of the element at index C. =cut */ VTABLE STRING *get_string_keyed_int(INTVAL key) { PMC * const retval = SELF.get_pmc_keyed_int(key); if (PMC_IS_NULL(retval)) return CONST_STRING(INTERP, ""); return VTABLE_get_string(INTERP, retval); } /* =item C Returns the Parrot string value of the element at index C<*key>. =cut */ VTABLE STRING *get_string_keyed(PMC *key) { PMC * const tempPMC = SELF.get_pmc_keyed(key); return VTABLE_get_string(INTERP, tempPMC); } /* =item C Returns the PMC value of the element at index C. =cut */ VTABLE PMC *get_pmc_keyed_int(INTVAL key) { PMC **data; if (key < 0 || key >= PMC_size(SELF)) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, _("FixedPMCArray: index out of bounds!")); data = PMC_array(SELF); return data[key]; } /* =item C Returns the PMC value of the element at index C<*key>. =cut */ VTABLE PMC *get_pmc_keyed(PMC *key) { const INTVAL k = VTABLE_get_integer(INTERP, key); PMC * const nextkey = Parrot_key_next(INTERP, key); PMC *box; if (!nextkey) return SELF.get_pmc_keyed_int(k); box = SELF.get_pmc_keyed_int(k); /* TT #1561, return NULL early if we must autovivify. */ if (PMC_IS_NULL(box)) return PMCNULL; return VTABLE_get_pmc_keyed(INTERP, box, nextkey); } /* =item C Sizes the array to C elements. Can't be used to resize an array. =cut */ VTABLE void set_integer_native(INTVAL size) { int i; PMC **data; if (PMC_size(SELF) && size) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, _("FixedPMCArray: Can't resize!")); if (!size) return; if (size < 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, _("FixedPMCArray: Cannot set array size to a negative number")); PMC_size(SELF) = size; data = mem_gc_allocate_n_typed(INTERP, size, PMC *); for (i = 0; i < size; ++i) data[i] = PMCNULL; PObj_custom_mark_destroy_SETALL(SELF); PMC_array(SELF) = data; } /* =item C Sets the integer value of the element at index C to C. =cut */ VTABLE void set_integer_keyed_int(INTVAL key, INTVAL value) { PMC * const val = Parrot_pmc_new(INTERP, Parrot_hll_get_ctx_HLL_type(INTERP, enum_class_Integer)); VTABLE_set_integer_native(INTERP, val, value); SELF.set_pmc_keyed_int(key, val); } /* =item C Sets the integer value of the element at index C to C. =cut */ VTABLE void set_integer_keyed(PMC *key, INTVAL value) { PMC * const val = Parrot_pmc_new(INTERP, Parrot_hll_get_ctx_HLL_type(INTERP, enum_class_Integer)); VTABLE_set_integer_native(INTERP, val, value); /* Let set_pmc_keyed worry about multi keys */ SELF.set_pmc_keyed(key, val); } /* =item C Sets the floating-point value of the element at index C to C. =cut */ VTABLE void set_number_keyed_int(INTVAL key, FLOATVAL value) { PMC * const val = Parrot_pmc_new(INTERP, Parrot_hll_get_ctx_HLL_type(INTERP, enum_class_Float)); VTABLE_set_number_native(INTERP, val, value); SELF.set_pmc_keyed_int(key, val); } /* =item C Sets the floating-point value of the element at index C to C. =cut */ VTABLE void set_number_keyed(PMC *key, FLOATVAL value) { const INTVAL k = VTABLE_get_integer(INTERP, key); PMC * const nextkey = Parrot_key_next(INTERP, key); if (nextkey == NULL) { SELF.set_number_keyed_int(k, value); } else { PMC * const box = SELF.get_pmc_keyed_int(k); if (PMC_IS_NULL(box)) cannot_autovivify_nested(INTERP); VTABLE_set_number_keyed(INTERP, box, nextkey, value); } } /* =item C Sets the Parrot string value of the element at index C to C. =cut */ VTABLE void set_string_keyed_int(INTVAL key, STRING *value) { PMC * const val = Parrot_pmc_new(INTERP, Parrot_hll_get_ctx_HLL_type(INTERP, enum_class_String)); VTABLE_set_string_native(INTERP, val, value); SELF.set_pmc_keyed_int(key, val); } /* =item C Sets the string value of the element at index C to C. =cut */ VTABLE void set_string_keyed(PMC *key, STRING *value) { PMC * const val = Parrot_pmc_new(INTERP, Parrot_hll_get_ctx_HLL_type(INTERP, enum_class_String)); VTABLE_set_string_native(INTERP, val, value); /* Let set_pmc_keyed worry about multi keys */ SELF.set_pmc_keyed(key, val); } /* =item C Sets the PMC value of the element at index C to C<*src>. =cut */ VTABLE void set_pmc_keyed_int(INTVAL key, PMC *src) { PMC **data; if (key < 0 || key >= PMC_size(SELF)) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, _("FixedPMCArray: index out of bounds!")); data = PMC_array(SELF); data[key] = src; } /* =item C Sets the PMC at index C to C. =cut */ VTABLE void set_pmc_keyed(PMC *key, PMC *value) { const INTVAL k = VTABLE_get_integer(INTERP, key); PMC * const nextkey = Parrot_key_next(INTERP, key); if (!nextkey) { SELF.set_pmc_keyed_int(k, value); } else { PMC * const box = SELF.get_pmc_keyed_int(k); if (PMC_IS_NULL(box)) cannot_autovivify_nested(INTERP); VTABLE_set_pmc_keyed(INTERP, box, nextkey, value); } } /* =item C The C<==> operation. Compares two array to hold equal elements. =cut */ VTABLE INTVAL is_equal(PMC *value) { INTVAL j, n; if (value->vtable->base_type != SELF->vtable->base_type) return 0; n = SELF.elements(); if (VTABLE_elements(INTERP, value) != n) return 0; for (j = 0; j < n; ++j) { PMC * const item1 = SELF.get_pmc_keyed_int(j); PMC * const item2 = VTABLE_get_pmc_keyed_int(INTERP, value, j); if (item1 == item2) continue; if (item1->vtable->base_type == enum_class_Null || item2->vtable->base_type == enum_class_Null) return 0; if (!VTABLE_is_equal(INTERP, item1, item2)) return 0; } return 1; } /* =item C Return a new iterator for SELF. =cut */ VTABLE PMC *get_iter() { return Parrot_pmc_new_init(INTERP, enum_class_ArrayIterator, SELF); } /* =item C =item C Returns TRUE is the element at C exists; otherwise returns false. =cut */ VTABLE INTVAL exists_keyed_int(INTVAL key) { PMC **data; if (key < 0 || key >= PMC_size(SELF)) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, _("FixedPMCArray: index out of bounds!")); data = PMC_array(SELF); return !PMC_IS_NULL(data[key]); } VTABLE INTVAL exists_keyed(PMC *key) { const INTVAL ix = VTABLE_get_integer(INTERP, key); return SELF.exists_keyed_int(ix); } /* =item C Replaces C elements starting at C with the elements in C. If C is 0 then the elements in C will be inserted after C. This throws an exception if any of the spliced in values are out of the range of this array. =cut */ VTABLE void splice(PMC *value, INTVAL offset, INTVAL count) { if (count + offset > PMC_size(SELF)) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, _("FixedPMCArray: index out of bounds!")); for (count--; count >= 0; --count) { VTABLE_set_pmc_keyed_int(INTERP, SELF, offset + count, value); } } /* =item C This is used by freeze/thaw to visit the contents of the array. C<*info> is the visit info, (see F). =item C Used to archive the array. =item C Used to unarchive the array. =cut */ VTABLE void visit(PMC *info) { INTVAL i; const INTVAL n = VTABLE_elements(INTERP, SELF); PMC **pos = PMC_array(SELF); for (i = 0; i < n; ++i, ++pos) { VISIT_PMC(INTERP, info, *pos); } SUPER(info); } VTABLE void freeze(PMC *info) { VTABLE_push_integer(INTERP, info, VTABLE_elements(INTERP, SELF)); } VTABLE void thaw(PMC *info) { SELF.init_int(VTABLE_shift_integer(INTERP, info)); } /* =item C Returns TRUE is the element at C is defined; otherwise returns false. =cut */ VTABLE INTVAL defined_keyed_int(INTVAL key) { PMC * const val = SELF.get_pmc_keyed_int(key); if (PMC_IS_NULL(val)) return 0; return VTABLE_defined(INTERP, val); } /* =item C Mark the array. =cut */ VTABLE void mark() { PMC ** const data = PMC_array(SELF); if (data) { INTVAL i; for (i = PMC_size(SELF) - 1; i >= 0; --i) Parrot_gc_mark_PMC_alive(INTERP, data[i]); } } } /* =back =head1 Auxiliary functions =over 4 =item C Throw exception when trying to autovivify nested arrays =cut */ PARROT_DOES_NOT_RETURN static void cannot_autovivify_nested(PARROT_INTERP) { ASSERT_ARGS(cannot_autovivify_nested) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Cannot autovivify nested arrays"); } /* =back =head1 SEE ALSO F. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ gc-active-buffers.t000644000765000765 216511533177645 17073 0ustar00brucebruce000000000000parrot-5.9.0/t/op#!./parrot # Copyright (C) 2010, Parrot Foundation. =head1 NAME t/op/gc-active-buffers.t - Test that buffers are freed as soon as possible =head1 SYNOPSIS % prove t/op/gc-active-buffers.t =head1 DESCRIPTION Tests that unused buffers (strings) are freed in the first GC run. See TT1603 - http://trac.parrot.org/parrot/ticket/1603 =cut .include 'interpinfo.pasm' .sub _main :main .include 'test_more.pir' plan(1) sweep 1 $I0 = interpinfo .INTERPINFO_ACTIVE_BUFFERS .local int count count= 1000 loop: unless count goto done # original test form TT1603 $P0 = new 'StringBuilder' $P0.'append_format'("a\n") $S0 = $P0 # another way to trigger the problem $S1 = "abc" $S2 = substr $S1, 0, 1 dec count goto loop done: sweep 1 $I1 = interpinfo .INTERPINFO_ACTIVE_BUFFERS $I2 = $I1 - $I0 $S0 = $I2 $S0 .= " additional active buffers (which should be <= 100)" $I3 = isle $I2, 100 ok($I3, $S0) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: resizablestringarray.t000644000765000765 12024111656271051 20232 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc#!./parrot # Copyright (C) 2001-2009, Parrot Foundation. =head1 NAME t/pmc/resizablestringarray.t - testing the ResizableStringArray PMC =head1 SYNOPSIS % prove t/pmc/resizablestringarray.t =head1 DESCRIPTION Tests C PMC. Checks size, sets various elements, including out-of-bounds test. Checks INT and PMC keys. =cut .sub main :main .include 'test_more.pir' # set a test plan plan(271) 'size/resize'() 'clone'() 'set_pmc_keyed'() 'set_string_keyed'() 'set_integer_keyed'() 'set_number_keyed'() 'get_pmc_keyed'() 'get_string_keyed'() 'get_integer_keyed'() 'get_number_keyed'() 'delete_keyed'() 'push_pmc'() 'push_string'() 'push_integer'() 'push_float'() 'pop_pmc'() 'pop_string'() 'pop_integer'() 'pop_float'() 'shift_pmc'() 'shift_string'() 'shift_integer'() 'shift_float'() 'unshift_pmc'() 'unshift_string'() 'unshift_integer'() 'unshift_float'() 'unshift_string_resize_threshold'() 'does'() # 'get_string'() 'sparse'() 'splice'() method_push_pmc() method_push_string() method_push_integer() method_push_float() method_pop_pmc() method_pop_string() method_pop_integer() method_pop_float() method_shift_pmc() method_shift_string() method_shift_integer() method_shift_float() method_unshift_pmc() method_unshift_string() method_unshift_integer() method_unshift_float() method_reverse() .end # # test the sizing and resizing of the array (including init to 0) # this tests the following vtable functions: # - elements # - init # - get_integer_native # - set_integer_native # .sub 'size/resize' .local pmc array array = new ['ResizableStringArray'] $I0 = array $I1 = elements array is($I0, 0, "initial array size (get_int)") is($I1, 0, "initial array size (elements)") array = 1 $I0 = array $I1 = elements array is($I0, 1, "array resize to 1 (get_int)") is($I1, 1, "array resize to 1 (elements)") array = 5 $I0 = array $I1 = elements array is($I0, 5, "array resize to 5 (get_int)") is($I1, 5, "array resize to 5 (elements)") array = 9 $I0 = array $I1 = elements array is($I0, 9, "array resize to 9 (get_int)") is($I1, 9, "array resize to 9 (elements)") array = 7 $I0 = array $I1 = elements array is($I0, 7, "array resize to 7 (get_int)") is($I1, 7, "array resize to 7 (elements)") push_eh neg_exception array = -3 pop_eh ok(0, "array resize to -3") goto still_ok neg_exception: ok(1, "array resize to -3") still_ok: $I0 = array $I1 = elements array is($I0, 7, "array resize to -3 (get_int)") is($I1, 7, "array resize to -3 (elements)") .end # # test setting different elements of the array with PMCs # .sub 'set_pmc_keyed' .local pmc array, elem array = new ['ResizableStringArray'] elem = new ['Integer'] array = 1 elem = 5 array[0] = elem $S0 = array[0] is($S0, "5", "set_pmc_keyed_int") elem = 7 array["0"] = elem $S0 = array[0] is($S0, "7", "set_pmc_keyed") array = 3 elem = 4 array[-2] = elem $S0 = array[1] is($S0, "4", "set_pmc_keyed_int (negative)") elem = 9 array["-3"] = elem $S0 = array[0] is($S0, "9", "set_pmc_keyed (negative)") array = 3 elem = 8 array[4] = elem $I0 = elements array $S0 = array[4] is($I0, 5, "set_pmc_keyed_int (out of bounds - length)") is($S0, "8", "set_pmc_keyed_int (out of bounds)") array = 3 elem = 11 array["4"] = elem $I0 = elements array $S0 = array[4] is($I0, 5, "set_pmc_keyed (out of bounds - length)") is($S0, "11", "set_pmc_keyed (out of bounds)") push_eh set_pmc_keyed_int_exception array[-10] = elem pop_eh ok(0, "set_pmc_keyed_int (negative, out of bounds)") goto set_pmc_keyed set_pmc_keyed_int_exception: ok(1, "set_pmc_keyed_int (negative, out of bounds)") set_pmc_keyed: push_eh set_pmc_keyed_exception array["-10"] = elem pop_eh ok(0, "set_pmc_keyed (negative, out of bounds)") goto done set_pmc_keyed_exception: ok(1, "set_pmc_keyed (negative, out of bounds)") done: .return() .end # # test getting different elements as PMCs # .sub 'get_pmc_keyed' .local pmc array array = new ['ResizableStringArray'] array = 1 array[0] = "first" array[1] = "second" array[2] = "third" array[3] = "fourth" $P0 = array[0] $S0 = typeof $P0 is($S0, 'String', "get_pmc_keyed_int - type") is($P0, 'first', "get_pmc_keyed_int - value") # get_pmc_keyed $P0 = array['1'] $S0 = typeof $P0 is($S0, 'String', "get_pmc_keyed - type") is($P0, 'second', "get_pmc_keyed - value") # get_pmc_keyed_int (negative) $P0 = array[-1] $S0 = typeof $P0 is($S0, 'String', "get_pmc_keyed_int (negative) - type") is($P0, 'fourth', "get_pmc_keyed_int (negative) - value") # get_pmc_keyed (negative) $P0 = array['-2'] $S0 = typeof $P0 is($S0, 'String', "get_pmc_keyed (negative) - type") is($P0, 'third', "get_pmc_keyed (negative) - value") array = 1 $P0 = array[2] $S0 = typeof $P0 is($S0, 'String', "get_pmc_keyed_int (out of bounds) - type") is($P0, '', "get_pmc_keyed_int (out of bounds) - value") array = 1 $P0 = array["2"] $S0 = typeof $P0 is($S0, 'String', "get_pmc_keyed (out of bounds) - type") is($P0, '', "get_pmc_keyed (out of bounds) - value") push_eh get_pmc_keyed_int_exception $P0 = array[-10] pop_eh ok(0, "get_pmc_keyed_int (negative, out of bounds)") goto get_pmc_keyed get_pmc_keyed_int_exception: ok(1, "get_pmc_keyed_int (negative, out of bounds)") get_pmc_keyed: push_eh get_pmc_keyed_exception $P0 = array["-10"] pop_eh ok(0, "get_pmc_keyed (negative, out of bounds)") goto done get_pmc_keyed_exception: ok(1, "get_pmc_keyed (negative, out of bounds)") done: .return() .end # # test setting different elements of the array with STRINGs # .sub 'set_string_keyed' .local pmc array .local string elem array = new ['ResizableStringArray'] array = 1 elem = "5" array[0] = elem $S0 = array[0] is($S0, "5", "set_string_keyed_int") elem = "7" array["0"] = elem $S0 = array[0] is($S0, "7", "set_string_keyed") array = 3 elem = "4" array[-2] = elem $S0 = array[1] is($S0, "4", "set_string_keyed_int (negative)") elem = "9" array["-3"] = elem $S0 = array[0] is($S0, "9", "set_string_keyed (negative)") array = 3 elem = "8" array[4] = elem $I0 = elements array $S0 = array[4] is($I0, 5, "set_string_keyed_int (out of bounds - length)") is($S0, "8", "set_string_keyed_int (out of bounds)") array = 3 elem = "11" array["4"] = elem $I0 = elements array $S0 = array[4] is($I0, 5, "set_string_keyed (out of bounds - length)") is($S0, "11", "set_string_keyed (out of bounds)") push_eh set_pmc_keyed_int_exception array[-10] = elem pop_eh ok(0, "set_string_keyed_int (negative, out of bounds)") goto set_pmc_keyed set_pmc_keyed_int_exception: ok(1, "set_string_keyed_int (negative, out of bounds)") set_pmc_keyed: push_eh set_pmc_keyed_exception array["-10"] = elem pop_eh ok(0, "set_string_keyed (negative, out of bounds)") goto done set_pmc_keyed_exception: ok(1, "set_string_keyed (negative, out of bounds)") done: .return() .end # # test getting different elements as STRINGs # .sub 'get_string_keyed' .local pmc array array = new ['ResizableStringArray'] array = 1 array[0] = "first" array[1] = "second" array[2] = "third" array[3] = "fourth" $S0 = array[0] is($S0, 'first', "get_string_keyed_int") $S0 = array['1'] is($S0, 'second', "get_string_keyed") $S0 = array[-1] is($S0, 'fourth', "get_string_keyed_int (negative)") $S0 = array['-2'] is($S0, 'third', "get_string_keyed (negative)") array = 1 $S0 = array[2] is($S0, '', "get_string_keyed_int (out of bounds)") array = 1 $S0 = array["2"] is($S0, '', "get_string_keyed (out of bounds)") push_eh get_string_keyed_int_exception $S0 = array[-10] pop_eh ok(0, "get_string_keyed_int (negative, out of bounds)") goto get_string_keyed get_string_keyed_int_exception: ok(1, "get_string_keyed_int (negative, out of bounds)") get_string_keyed: push_eh get_string_keyed_exception $S0 = array["-10"] pop_eh ok(0, "get_string_keyed (negative, out of bounds)") goto done get_string_keyed_exception: ok(1, "get_string_keyed (negative, out of bounds)") done: .return() .end # # test setting different elements of the array with INTVALs # .sub 'set_integer_keyed' .local pmc array .local int elem array = new ['ResizableStringArray'] array = 1 elem = 5 array[0] = elem $S0 = array[0] is($S0, "5", "set_integer_keyed_int") elem = 7 array["0"] = elem $S0 = array[0] is($S0, "7", "set_integer_keyed") array = 3 elem = 4 array[-2] = elem $S0 = array[1] is($S0, "4", "set_integer_keyed_int (negative)") elem = 9 array["-3"] = elem $S0 = array[0] is($S0, "9", "set_integer_keyed (negative)") array = 3 elem = 8 array[4] = elem $I0 = elements array $S0 = array[4] is($I0, 5, "set_integer_keyed_int (out of bounds - length)") is($S0, "8", "set_integer_keyed_int (out of bounds)") array = 3 elem = 11 array["4"] = elem $I0 = elements array $S0 = array[4] is($I0, 5, "set_integer_keyed (out of bounds - length)") is($S0, "11", "set_integer_keyed (out of bounds)") push_eh set_pmc_keyed_int_exception array[-10] = elem pop_eh ok(0, "set_integer_keyed_int (negative, out of bounds)") goto set_pmc_keyed set_pmc_keyed_int_exception: ok(1, "set_integer_keyed_int (negative, out of bounds)") set_pmc_keyed: push_eh set_pmc_keyed_exception array["-10"] = elem pop_eh ok(0, "set_integer_keyed (negative, out of bounds)") goto done set_pmc_keyed_exception: ok(1, "set_integer_keyed (negative, out of bounds)") done: .return() .end # # test getting different elements as INTVALs # .sub 'get_integer_keyed' .local pmc array array = new ['ResizableStringArray'] array = 1 array[0] = "1" array[1] = "2" array[2] = "3" array[3] = "4" $I0 = array[0] is($I0, 1, "get_integer_keyed_int") $I0 = array['1'] is($I0, 2, "get_integer_keyed") $I0 = array[-1] is($I0, 4, "get_integer_keyed_int (negative)") $I0 = array['-2'] is($I0, 3, "get_integer_keyed (negative)") array = 1 $I0 = array[2] is($I0, 0, "get_integer_keyed_int (out of bounds)") array = 1 $I0 = array["2"] is($I0, 0, "get_integer_keyed (out of bounds)") push_eh get_integer_keyed_int_exception $I0 = array[-10] pop_eh ok(0, "get_integer_keyed_int (negative, out of bounds)") goto get_integer_keyed get_integer_keyed_int_exception: ok(1, "get_integer_keyed_int (negative, out of bounds)") get_integer_keyed: push_eh get_integer_keyed_exception $I0 = array["-10"] pop_eh ok(0, "get_integer_keyed (negative, out of bounds)") goto done get_integer_keyed_exception: ok(1, "get_integer_keyed (negative, out of bounds)") done: .return() .end # # test setting different elements of the array with FLOATs # .sub 'set_number_keyed' .local pmc array .local num elem array = new ['ResizableStringArray'] array = 1 elem = 5.1 array[0] = elem $S0 = array[0] is($S0, "5.1", "set_number_keyed_int") elem = 7.2 array["0"] = elem $S0 = array[0] is($S0, "7.2", "set_number_keyed") array = 3 elem = 4.3 array[-2] = elem $S0 = array[1] is($S0, "4.3", "set_number_keyed_int (negative)") elem = 9.4 array["-3"] = elem $S0 = array[0] is($S0, "9.4", "set_number_keyed (negative)") array = 3 elem = 8.5 array[4] = elem $I0 = elements array $S0 = array[4] is($I0, 5, "set_number_keyed_int (out of bounds - length)") is($S0, "8.5", "set_number_keyed_int (out of bounds)") array = 3 elem = 11.6 array["4"] = elem $I0 = elements array $S0 = array[4] is($I0, 5, "set_number_keyed (out of bounds - length)") is($S0, "11.6", "set_number_keyed (out of bounds)") push_eh set_pmc_keyed_int_exception array[-10] = elem pop_eh ok(0, "set_number_keyed_int (negative, out of bounds)") goto set_pmc_keyed set_pmc_keyed_int_exception: ok(1, "set_number_keyed_int (negative, out of bounds)") set_pmc_keyed: push_eh set_pmc_keyed_exception array["-10"] = elem pop_eh ok(0, "set_number_keyed (negative, out of bounds)") goto done set_pmc_keyed_exception: ok(1, "set_number_keyed (negative, out of bounds)") done: .return() .end # # test getting different elements as FLOATs # .sub 'get_number_keyed' .local pmc array array = new ['ResizableStringArray'] array = 1 array[0] = "1.1" array[1] = "2.2" array[2] = "3.3" array[3] = "4.4" $N0 = array[0] is($N0, 1.1, "get_number_keyed_int") $N0 = array['1'] is($N0, 2.2, "get_number_keyed") $N0 = array[-1] is($N0, 4.4, "get_number_keyed_int (negative)") $N0 = array['-2'] is($N0, 3.3, "get_number_keyed (negative)") array = 1 $N0 = array[2] is($N0, 0.0, "get_number_keyed_int (out of bounds)") array = 1 $N0 = array["2"] is($N0, 0.0, "get_number_keyed (out of bounds)") push_eh get_number_keyed_int_exception $N0 = array[-10] pop_eh ok(0, "get_number_keyed_int (negative, out of bounds)") goto get_number_keyed get_number_keyed_int_exception: ok(1, "get_number_keyed_int (negative, out of bounds)") get_number_keyed: push_eh get_number_keyed_exception $S0 = array["-10"] pop_eh ok(0, "get_number_keyed (negative, out of bounds)") goto done get_number_keyed_exception: ok(1, "get_number_keyed (negative, out of bounds)") done: .return() .end # # test delete_keyed # .sub 'delete_keyed' .local pmc array array = new ['ResizableStringArray'] array[0] = "one" array[1] = "two" array[2] = "three" $P0 = new ['Integer'] $P0 = 1 delete array[$P0] $I0 = elements array $S0 = array[1] is($I0, 2, "delete_keyed - elements") is($S0, "three", "delete_keyed - value") .end # # test pushing PMCs onto the array # .sub 'push_pmc' .local pmc array array = new ['ResizableStringArray'] .local pmc array array = new ['ResizableStringArray'] array = 0 $P0 = new ['String'] $P0 = "one" push array, $P0 $I0 = elements array $S0 = array[0] is($I0, 1, "push_pmc - elements") is($S0, "one", "push_pmc - value") $P0 = new ['String'] $P0 = "two" push array, $P0 $I0 = elements array $S0 = array[1] is($I0, 2, "push_pmc (grow) - elements") is($S0, "two", "push_pmc (grow) - value") array = 1 push array, "three" $I0 = elements array $S0 = array[1] is($I0, 2, "push_pmc (shrink, grow) - elements") is($S0, "three", "push_pmc (shrink, grow) - value") .end # # test pushing STRINGs onto the array # .sub 'push_string' .local pmc array array = new ['ResizableStringArray'] array = 0 push array, "one" $I0 = elements array $S0 = array[0] is($I0, 1, "push_string - elements") is($S0, "one", "push_string - value") push array, "two" $I0 = elements array $S0 = array[1] is($I0, 2, "push_string (grow) - elements") is($S0, "two", "push_string (grow) - value") array = 1 push array, "three" $I0 = elements array $S0 = array[1] is($I0, 2, "push_string (shrink, grow) - elements") is($S0, "three", "push_string (shrink, grow) - value") .end # # test pushing INTVALs onto the array # .sub 'push_integer' .local pmc array array = new ['ResizableStringArray'] array = 0 push array, 1 $I0 = elements array $S0 = array[0] is($I0, 1, "push_integer - elements") is($S0, "1", "push_integer - value") push array, 2 $I0 = elements array $S0 = array[1] is($I0, 2, "push_integer (grow) - elements") is($S0, "2", "push_integer (grow) - value") array = 1 push array, 3 $I0 = elements array $S0 = array[1] is($I0, 2, "push_integer (shrink, grow) - elements") is($S0, "3", "push_integer (shrink, grow) - value") .end # # test pushing FLOATs onto the array # .sub 'push_float' .local pmc array array = new ['ResizableStringArray'] array = 0 push array, 1.1 $I0 = elements array $S0 = array[0] is($I0, 1, "push_float - elements") is($S0, "1.1", "push_float - value") push array, 2.2 $I0 = elements array $S0 = array[1] is($I0, 2, "push_float (grow) - elements") is($S0, "2.2", "push_float (grow) - value") array = 1 push array, 3.3 $I0 = elements array $S0 = array[1] is($I0, 2, "push_float (shrink, grow) - elements") is($S0, "3.3", "push_float (shrink, grow) - value") .end .sub 'pop_pmc' .local pmc array array = new ['ResizableStringArray'] array[1] = "foo" $P0 = pop array $I0 = elements array $S0 = typeof $P0 $S1 = $P0 is($I0, 1, "pop_pmc - elements") is($S0, 'String', "pop_pmc - type") is($S1, 'foo', "pop_pmc - value") array = 0 push_eh exception $P0 = pop array pop_eh ok(0, "pop_pmc - exception") .return() exception: ok(1, "pop_pmc - exception") .return() .end .sub 'pop_string' .local pmc array array = new ['ResizableStringArray'] array[1] = "foo" $S0 = pop array $I0 = elements array is($I0, 1, "pop_string - elements") is($S0, 'foo', "pop_string - value") array = 0 push_eh exception $S0 = pop array pop_eh ok(0, "pop_string - exception") .return() exception: ok(1, "pop_string - exception") .return() .end .sub 'pop_integer' .local pmc array array = new ['ResizableStringArray'] array[1] = "2" $I1 = pop array $I0 = elements array is($I0, 1, "pop_integer - elements") is($I1, 2, "pop_integer - value") array = 0 push_eh exception $I0 = pop array pop_eh ok(0, "pop_integer - exception") .return() exception: ok(1, "pop_integer - exception") .return() .end .sub 'pop_float' .local pmc array array = new ['ResizableStringArray'] array[1] = "2.2" $N0 = pop array $I0 = elements array is($I0, 1, "pop_float - elements") is($N0, 2.2, "pop_float - value") array = 0 push_eh exception $N0 = pop array pop_eh ok(0, "pop_float - exception") .return() exception: ok(1, "pop_float - exception") .return() .end .sub 'shift_pmc' .local pmc array array = new ['ResizableStringArray'] array[0] = "foo" array[1] = "bar" $P0 = shift array $I0 = elements array $S0 = typeof $P0 $S1 = $P0 is($I0, 1, "shift_pmc - elements") is($S0, 'String', "shift_pmc - type") is($S1, 'foo', "shift_pmc - value") array = 0 push_eh exception $P0 = shift array pop_eh ok(0, "shift_pmc - exception") .return() exception: ok(1, "shift_pmc - exception") .return() .end .sub 'shift_string' .local pmc array array = new ['ResizableStringArray'] array[0] = "foo" array[1] = "bar" $S0 = shift array $I0 = elements array is($I0, 1, "shift_string - elements") is($S0, 'foo', "shift_string - value") array = 0 push_eh exception $S0 = shift array pop_eh ok(0, "shift_string - exception") .return() exception: ok(1, "shift_string - exception") .return() .end .sub 'shift_integer' .local pmc array array = new ['ResizableStringArray'] array[0] = "2" array[1] = "3" $I1 = shift array $I0 = elements array is($I0, 1, "shift_integer - elements") is($I1, 2, "shift_integer - value") array = 0 push_eh exception $I0 = shift array pop_eh ok(0, "shift_integer - exception") .return() exception: ok(1, "shift_integer - exception") .return() .end .sub 'shift_float' .local pmc array array = new ['ResizableStringArray'] array[0] = "2.2" array[1] = "3.3" $N0 = shift array $I0 = elements array is($I0, 1, "shift_float - elements") is($N0, 2.2, "shift_float - value") array = 0 push_eh exception $N0 = shift array pop_eh ok(0, "shift_float - exception") .return() exception: ok(1, "shift_float - exception") .return() .end # # test unshifting PMCs onto the array # .sub 'unshift_pmc' .local pmc array array = new ['ResizableStringArray'] array = 0 $P0 = new ['String'] $P0 = "one" unshift array, $P0 $I0 = elements array $S0 = array[0] is($I0, 1, "unshift_pmc - elements") is($S0, "one", "unshift_pmc - value") $P0 = new ['String'] $P0 = "two" unshift array, $P0 $I0 = elements array $S0 = array[0] is($I0, 2, "unshift_pmc (grow) - elements") is($S0, "two", "unshift_pmc (grow) - value") array = 1 unshift array, "three" $I0 = elements array $S0 = array[0] is($I0, 2, "unshift_pmc (shrink, grow) - elements") is($S0, "three", "unshift_pmc (shrink, grow) - value") .end # # test unshifting STRINGs onto the array # .sub 'unshift_string' .local pmc array array = new ['ResizableStringArray'] array = 0 unshift array, "one" $I0 = elements array $S0 = array[0] is($I0, 1, "unshift_string - elements") is($S0, "one", "unshift_string - value") unshift array, "two" $I0 = elements array $S0 = array[0] is($I0, 2, "unshift_string (grow) - elements") is($S0, "two", "unshift_string (grow) - value") array = 1 unshift array, "three" $I0 = elements array $S0 = array[0] is($I0, 2, "unshift_string (shrink, grow) - elements") is($S0, "three", "unshift_string (shrink, grow) - value") .end # # Test unshifting STRINGs onto an array # that is at the default resize_threshold(8). # Trac ticket# 256 # .sub 'unshift_string_resize_threshold' .local pmc rsarray rsarray = new ['ResizableStringArray'] push rsarray, "1" push rsarray, "2" push rsarray, "3" push rsarray, "4" push rsarray, "5" push rsarray, "6" push rsarray, "7" push rsarray, "8" # rsarray is now: 1 2 3 4 5 6 7 8 # This unshift will cause a resize larger than the # initial resize_threshold (8), triggering the bug. unshift rsarray, "0" # rsarray should now be : 0 1 2 3 4 5 6 7 8 # The bug causes it to be : 0 2 3 4 5 6 7 8 "" $S0 = rsarray[0] $S1 = rsarray[1] $S2 = rsarray[2] $S3 = rsarray[3] $S4 = rsarray[4] $S5 = rsarray[5] $S6 = rsarray[6] $S7 = rsarray[7] $S8 = rsarray[8] $S9 = $S0 $S9 .= $S1 $S9 .= $S2 $S9 .= $S3 $S9 .= $S4 $S9 .= $S5 $S9 .= $S6 $S9 .= $S7 $S9 .= $S8 is( $S9, "012345678", 'Unshift prepends at array instead of overlaying' ) .end # # test unshifting INTVALs onto the array # .sub 'unshift_integer' .local pmc array array = new ['ResizableStringArray'] # unshift_string array = 0 unshift array, 1 $I0 = elements array $S0 = array[0] is($I0, 1, "unshift_integer - elements") is($S0, "1", "unshift_integer - value") unshift array, 2 $I0 = elements array $S0 = array[0] is($I0, 2, "unshift_integer (grow) - elements") is($S0, "2", "unshift_integer (grow) - value") array = 1 unshift array, 3 $I0 = elements array $S0 = array[0] is($I0, 2, "unshift_integer (shrink, grow) - elements") is($S0, "3", "unshift_integer (shrink, grow) - value") .end # # test unshifting FLOATs onto the array # .sub 'unshift_float' .local pmc array array = new ['ResizableStringArray'] array = 0 unshift array, 1.1 $I0 = elements array $S0 = array[0] is($I0, 1, "unshift_float - elements") is($S0, "1.1", "unshift_float - value") unshift array, 2.2 $I0 = elements array $S0 = array[0] is($I0, 2, "unshift_float (grow) - elements") is($S0, "2.2", "unshift_float (grow) - value") array = 1 unshift array, 3.3 $I0 = elements array $S0 = array[0] is($I0, 2, "unshift_float (shrink, grow) - elements") is($S0, "3.3", "unshift_float (shrink, grow) - value") .end # # test clone # .sub 'clone' .local pmc array array = new ['ResizableStringArray'] array = 3 array[0] = 1 array[1] = 3.2 array[2] = "boo" .local pmc cloned cloned = clone array $I0 = elements cloned is($I0, 3, 'cloned array - size') $S0 = typeof cloned is($S0, 'ResizableStringArray', 'cloned array - type') is_deeply(cloned, array, 'cloned array - deep comparison') .end .sub 'get_string' .local pmc array array = new ['ResizablePMCArray'] array[0] = "foo" array[1] = "bar" array[2] = "baz" $S0 = array is($S0, 3, "get_string") .end .sub 'does' .local pmc array array = new ['ResizableStringArray'] $I0 = does array, 'array' is($I0, 1, "does array") $I0 = does array, 'scalar' is($I0, 0, "doesn't do scalar") .end # # a test with a sparse array. this converted from PASM from the original # ResizableStringArray tests. # .sub sparse .local pmc array array = new ['ResizableStringArray'] $I10 = 110000 $I0 = 1 lp1: $I1 = $I0 + 5 $I9 = $I1 % 2 $S9 = $I9 array[$I0] = $S9 $I3 = $I1 + $I0 $I9 = $I3 % 2 $S9 = $I9 push array, $S9 $I0 = shl $I0, 1 inc $I0 if $I0 <= $I10 goto lp1 $I0 = 1 lp2: $I1 = $I0 + 5 $I9 = $I1 % 2 $S2 = array[$I0] $I2 = $S2 if $I2 != $I9 goto err_1 $I3 = $I1 + $I0 $I9 = $I3 % 2 $I4 = $I0 + 1 $S4 = array[$I4] $I4 = $S4 if $I9 != $I4 goto err_1 $I0 = shl $I0, 1 inc $I0 if $I0 <= $I10 goto lp2 ok(1, "sparse 1") # now repeat and fill some holes two: $I0 = 777 lp3: $I1 = $I0 + 5 $I9 = $I1 % 2 $S9 = $I9 array[$I0] = $S9 $I0 += 666 if $I0 <= $I10 goto lp3 $I0 = 777 lp4: $I1 = $I0 + 5 $I9 = $I1 % 2 $S2 = array[$I0] $I2 = $S2 if $I2 != $I9 goto err_2 $I0 += 666 if $I0 <= $I10 goto lp4 ok(1, "sparse 2") .return() err_1: ok(0, "sparse 1") goto two err_2: ok(0, "sparse 2") .return() .end .sub 'splice' $P1 = new ['ResizableStringArray'] $P1 = 3 $P1[0] = '1' $P1[1] = '2' $P1[2] = '3' $P2 = new ['ResizableStringArray'] $P2 = 1 $P2[0] = 'A' splice $P1, $P2, 0, 2 $S0 = join "", $P1 is($S0, "A3", "splice replace") $P1 = new ['ResizableStringArray'] $P1 = 3 $P1[0] = '1' $P1[1] = '2' $P1[2] = '3' $P2 = new ['ResizableStringArray'] $P2 = 1 $P2[0] = 'A' splice $P1, $P2, 1, 2 $S0 = join "", $P1 is($S0, "1A", "splice replace") .macro SpliceMadeEasy(code, out, testing) $P1 = new ['ResizableStringArray'] $P1[0] = "1" $P1[1] = "2" $P1[2] = "3" $P1[3] = "4" $P1[4] = "5" $P2 = new ['ResizableStringArray'] $P2[0] = 'A' $P2[1] = 'B' $P2[2] = 'C' $P2[3] = 'D' $P2[4] = 'E' .code $S0 = join "", $P1 is($S0, .out, .testing) .endm .SpliceMadeEasy({ splice $P1, $P2, 0, 5 }, "ABCDE", "splice, complete replace") .SpliceMadeEasy({ splice $P1, $P2, 5, 0 }, "12345ABCDE", "splice, append") .SpliceMadeEasy({ splice $P1, $P2, 4, 0 }, "1234ABCDE5", "splice, insert before last element") .SpliceMadeEasy({ splice $P1, $P2, 3, 0 }, "123ABCDE45", "splice, append-in-middle") .SpliceMadeEasy({ splice $P1, $P2, 0, 2 }, "ABCDE345", "splice, replace at beginning") .SpliceMadeEasy({ splice $P1, $P2, 2, 2 }, "12ABCDE5", "splice, replace in middle") .SpliceMadeEasy({ splice $P1, $P2, 3, 2 }, "123ABCDE", "splice, replace at end") .SpliceMadeEasy({ splice $P1, $P2, -3, 2 }, "12ABCDE5", "splice, replace in middle start from end") .SpliceMadeEasy({ $P2 = new ['ResizableStringArray'] splice $P1, $P2, 2, 2 }, "125", "splice, empty replacement") .SpliceMadeEasy({ $P2 = new ['ResizableStringArray'] $P2[0] = "A" splice $P1, $P2, 2, 1 }, "12A45", "splice, equal size replacement") $P1 = new ['ResizableStringArray'] $P1[0] = "1" $P2 = new ['ResizableStringArray'] $P2[0] = 'A' $I0 = 0 push_eh handle_negtoobig splice $P1, $P2, -10, 1 goto after_negtoobig handle_negtoobig: inc $I0 after_negtoobig: pop_eh is($I0, 1, 'splice, negative offset too long throws') $P1 = new ['ResizableStringArray'] $P1[0] = "1" $P1[1] = "2" $P1[2] = "3" $P1[3] = "4" $P1[4] = "5" $P2 = new ['ResizablePMCArray'] $P2[0] = 'A' $P2[1] = 'B' $P2[2] = 'C' $P2[3] = 'D' $P2[4] = 'E' push_eh bad_type splice $P1, $P2, 1, 0 pop_eh goto still_ok .local pmc exception .local string message bad_type: pop_eh .get_results (exception) message = exception still_ok: message = substr message, 22, 23 is(message, 'illegal type for splice', "splice with a different type") .end # # test pushing PMCs onto the array # .sub method_push_pmc .local pmc array array = new ['ResizableStringArray'] array = 0 $P0 = new ['String'] $P0 = "one" array.'push'($P0) $I0 = elements array $S0 = array[0] is($I0, 1, "method_push_pmc - elements") is($S0, "one", "method_push_pmc - value") $P0 = new ['String'] $P0 = "two" array.'push'($P0) $I0 = elements array $S0 = array[1] is($I0, 2, "method_push_pmc (grow) - elements") is($S0, "two", "method_push_pmc (grow) - value") array = 1 array.'push'('three') $I0 = elements array $S0 = array[1] is($I0, 2, "method_push_pmc (shrink, grow) - elements") is($S0, "three", "method_push_pmc (shrink, grow) - value") .end # # test pushing STRINGs onto the array # .sub method_push_string .local pmc array array = new ['ResizableStringArray'] array = 0 array.'push'("one") $I0 = elements array $S0 = array[0] is($I0, 1, "method_push_string - elements") is($S0, "one", "method_push_string - value") array.'push'("two") $I0 = elements array $S0 = array[1] is($I0, 2, "method_push_string (grow) - elements") is($S0, "two", "method_push_string (grow) - value") array = 1 array.'push'("three") $I0 = elements array $S0 = array[1] is($I0, 2, "method_push_string (shrink, grow) - elements") is($S0, "three", "method_push_string (shrink, grow) - value") .end # # test pushing INTVALs onto the array # .sub method_push_integer .local pmc array array = new ['ResizableStringArray'] array = 0 array.'push'(1) $I0 = elements array $S0 = array[0] is($I0, 1, "method_push_integer - elements") is($S0, "1", "method_push_integer - value") array.'push'(2) $I0 = elements array $S0 = array[1] is($I0, 2, "method_push_integer (grow) - elements") is($S0, "2", "method_push_integer (grow) - value") array = 1 array.'push'(3) $I0 = elements array $S0 = array[1] is($I0, 2, "method_push_integer (shrink, grow) - elements") is($S0, "3", "method_push_integer (shrink, grow) - value") .end # # test pushing FLOATs onto the array # .sub method_push_float .local pmc array array = new ['ResizableStringArray'] array = 0 array.'push'(1.1) $I0 = elements array $S0 = array[0] is($I0, 1, "method_push_float - elements") is($S0, "1.1", "method_push_float - value") array.'push'(2.2) $I0 = elements array $S0 = array[1] is($I0, 2, "method_push_float (grow) - elements") is($S0, "2.2", "method_push_float (grow) - value") array = 1 array.'push'(3.3) $I0 = elements array $S0 = array[1] is($I0, 2, "method_push_float (shrink, grow) - elements") is($S0, "3.3", "method_push_float (shrink, grow) - value") .end .sub method_pop_pmc .local pmc array array = new ['ResizableStringArray'] array[1] = "foo" $P0 = array.'pop'() $I0 = elements array $S0 = typeof $P0 $S1 = $P0 is($I0, 1, "method_pop_pmc - elements") is($S0, 'String', "method_pop_pmc - type") is($S1, 'foo', "method_pop_pmc - value") array = 0 push_eh exception $P0 = array.'pop'() pop_eh ok(0, "method_pop_pmc - exception") .return() exception: ok(1, "method_pop_pmc - exception") .return() .end .sub method_pop_string .local pmc array array = new ['ResizableStringArray'] array[1] = "foo" $S0 = array.'pop'() $I0 = elements array is($I0, 1, "method_pop_string - elements") is($S0, 'foo', "method_pop_string - value") array = 0 push_eh exception $S0 = array.'pop'() pop_eh ok(0, "method_pop_string - exception") .return() exception: ok(1, "method_pop_string - exception") .return() .end .sub method_pop_integer .local pmc array array = new ['ResizableStringArray'] array[1] = "2" $I1 = array.'pop'() $I0 = elements array is($I0, 1, "method_pop_integer - elements") is($I1, 2, "method_pop_integer - value") array = 0 push_eh exception $I0 = array.'pop'() pop_eh ok(0, "method_pop_integer - exception") .return() exception: ok(1, "method_pop_integer - exception") .return() .end .sub method_pop_float .local pmc array array = new ['ResizableStringArray'] array[1] = "2.2" $N0 = array.'pop'() $I0 = elements array is($I0, 1, "method_pop_float - elements") is($N0, 2.2, "method_pop_float - value") array = 0 push_eh exception $N0 = array.'pop'() pop_eh ok(0, "method_pop_float - exception") .return() exception: ok(1, "method_pop_float - exception") .return() .end .sub method_shift_pmc .local pmc array array = new ['ResizableStringArray'] array[0] = "foo" array[1] = "bar" $P0 = array.'shift'() $I0 = elements array $S0 = typeof $P0 $S1 = $P0 is($I0, 1, "method_shift_pmc - elements") is($S0, 'String', "method_shift_pmc - type") is($S1, 'foo', "method_shift_pmc - value") array = 0 push_eh exception $P0 = array.'shift'() pop_eh ok(0, "method_shift_pmc - exception") .return() exception: ok(1, "method_shift_pmc - exception") .return() .end .sub method_shift_string .local pmc array array = new ['ResizableStringArray'] array[0] = "foo" array[1] = "bar" $S0 = array.'shift'() $I0 = elements array is($I0, 1, "method_shift_string - elements") is($S0, 'foo', "method_shift_string - value") array = 0 push_eh exception $S0 = array.'shift'() pop_eh ok(0, "method_shift_string - exception") .return() exception: ok(1, "method_shift_string - exception") .return() .end .sub method_shift_integer .local pmc array array = new ['ResizableStringArray'] array[0] = "2" array[1] = "3" $I1 = array.'shift'() $I0 = elements array is($I0, 1, "method_shift_integer - elements") is($I1, 2, "method_shift_integer - value") array = 0 push_eh exception $I0 = array.'shift'() pop_eh ok(0, "method_shift_integer - exception") .return() exception: ok(1, "method_shift_integer - exception") .return() .end .sub method_shift_float .local pmc array array = new ['ResizableStringArray'] array[0] = "2.2" array[1] = "3.3" $N0 = array.'shift'() $I0 = elements array is($I0, 1, "method_shift_float - elements") is($N0, 2.2, "method_shift_float - value") array = 0 push_eh exception $N0 = array.'shift'() pop_eh ok(0, "method_shift_float - exception") .return() exception: ok(1, "method_shift_float - exception") .return() .end .sub method_unshift_pmc .local pmc array array = new ['ResizableStringArray'] array = 0 $P0 = new ['String'] $P0 = "one" array.'unshift'($P0) $I0 = elements array $S0 = array[0] is($I0, 1, "method_unshift_pmc - elements") is($S0, "one", "method_unshift_pmc - value") $P0 = new ['String'] $P0 = "two" array.'unshift'($P0) $I0 = elements array $S0 = array[0] is($I0, 2, "method_unshift_pmc (grow) - elements") is($S0, "two", "method_unshift_pmc (grow) - value") array = 1 array.'unshift'("three") $I0 = elements array $S0 = array[0] is($I0, 2, "method_unshift_pmc (shrink, grow) - elements") is($S0, "three", "method_unshift_pmc (shrink, grow) - value") .end # # test unshifting STRINGs onto the array # .sub method_unshift_string .local pmc array array = new ['ResizableStringArray'] array = 0 array.'unshift'("one") $I0 = elements array $S0 = array[0] is($I0, 1, "method_unshift_string - elements") is($S0, "one", "method_unshift_string - value") array.'unshift'("two") $I0 = elements array $S0 = array[0] is($I0, 2, "method_unshift_string (grow) - elements") is($S0, "two", "method_unshift_string (grow) - value") array = 1 array.'unshift'("three") $I0 = elements array $S0 = array[0] is($I0, 2, "method_unshift_string (shrink, grow) - elements") is($S0, "three", "method_unshift_string (shrink, grow) - value") .end # # test unshifting INTVALs onto the array # .sub method_unshift_integer .local pmc array array = new ['ResizableStringArray'] array = 0 array.'unshift'(1) $I0 = elements array $S0 = array[0] is($I0, 1, "method_unshift_integer - elements") is($S0, "1", "method_unshift_integer - value") array.'unshift'(2) $I0 = elements array $S0 = array[0] is($I0, 2, "method_unshift_integer (grow) - elements") is($S0, "2", "method_unshift_integer (grow) - value") array = 1 array.'unshift'(3) $I0 = elements array $S0 = array[0] is($I0, 2, "method_unshift_integer (shrink, grow) - elements") is($S0, "3", "method_unshift_integer (shrink, grow) - value") .end # # test unshifting FLOATs onto the array # .sub method_unshift_float .local pmc array array = new ['ResizableStringArray'] array = 0 array.'unshift'(1.1) $I0 = elements array $S0 = array[0] is($I0, 1, "method_unshift_float - elements") is($S0, "1.1", "method_unshift_float - value") array.'unshift'(2.2) $I0 = elements array $S0 = array[0] is($I0, 2, "method_unshift_float (grow) - elements") is($S0, "2.2", "method_unshift_float (grow) - value") array = 1 array.'unshift'(3.3) $I0 = elements array $S0 = array[0] is($I0, 2, "method_unshift_float (shrink, grow) - elements") is($S0, "3.3", "method_unshift_float (shrink, grow) - value") .end .sub method_reverse .local pmc array array = new ['ResizableStringArray'] array."reverse"() $I0 = elements array is($I0, 0, "method_reverse - reverse of empty array") push array, "3" array."reverse"() $S0 = array[0] is($S0, "3", "method_reverse - reverse of array with one element") push array, "1" array."reverse"() array."reverse"() array."reverse"() $S0 = array[0] is($S0, "1", "method_reverse - reverse of array with two elements") $S0 = array[1] is($S0, "3", "method_reverse - reverse of array with two elements second element") push array, "4" array."reverse"() push array, "5" array."reverse"() $S0 = join "", array is($S0, "5134", "method_reverse - four elements") array."reverse"() $S0 = join "", array is($S0, "4315", "method_reverse - four elements second reverse") push array, "6" array."reverse"() $S0 = join "", array is($S0, "65134", "method_reverse - five elements") array."reverse"() $S0 = join "", array is($S0, "43156", "method_reverse - five elements second reverse") .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: signatures.c000644000765000765 1557312101554067 16435 0ustar00brucebruce000000000000parrot-5.9.0/src/nci/* Copyright (C) 2010-2011, Parrot Foundation. =head1 NAME src/nci/signatures.c - Native Call Interface signature processing routines =head1 DESCRIPTION This file implements functionality for parsing NCI signatures and generating PCC signatures. =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" #include "parrot/nci.h" #include "signatures.str" /* HEADERIZER HFILE: include/parrot/nci.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static char ncidt_to_pcc(PARROT_INTERP, PARROT_DATA_TYPE t) __attribute__nonnull__(1); #define ASSERT_ARGS_ncidt_to_pcc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Parse a signature string to a NCI signature PMC. =cut */ PARROT_CANNOT_RETURN_NULL PARROT_EXPORT PMC * Parrot_nci_parse_signature(PARROT_INTERP, ARGIN(STRING *sig_str)) { ASSERT_ARGS(Parrot_nci_parse_signature) const size_t sig_length = Parrot_str_byte_length(interp, sig_str); PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, sig_length); size_t i; if (!sig_length) { sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, 1); VTABLE_set_integer_keyed_int(interp, sig_pmc, 0, enum_type_void); return sig_pmc; } for (i = 0; i < sig_length; ++i) { const INTVAL c = Parrot_str_indexed(interp, sig_str, i); PARROT_DATA_TYPE e; PARROT_ASSERT(c == (char)c); switch ((char)c) { case 'f': e = enum_type_float; break; case 'd': e = enum_type_double; break; case 'N': e = enum_type_FLOATVAL; break; case 'c': /* char */ e = enum_type_char; break; case 's': /* short */ e = enum_type_short; break; case 'i': /* int */ e = enum_type_int; break; case 'l': /* long */ e = enum_type_long; break; case 'I': /* INTVAL */ e = enum_type_INTVAL; break; case 'S': e = enum_type_STRING; break; case 'p': /* push pmc->data */ e = enum_type_ptr; break; case 'O': /* PMC invocant */ case 'P': /* push PMC * */ e = enum_type_PMC; break; case 'v': e = enum_type_void; break; default: Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_JIT_ERROR, "Unknown param Signature %c\n", (char)c); break; } VTABLE_set_integer_keyed_int(interp, sig_pmc, i, e); } return sig_pmc; } /* =item C Lookup the appropriate PCC signature item to use for a given NCI type. =cut */ static char ncidt_to_pcc(PARROT_INTERP, PARROT_DATA_TYPE t) { ASSERT_ARGS(ncidt_to_pcc) switch (t) { case enum_type_float: case enum_type_double: case enum_type_FLOATVAL: return 'N'; case enum_type_char: case enum_type_short: case enum_type_int: case enum_type_long: case enum_type_INTVAL: return 'I'; case enum_type_STRING: return 'S'; case enum_type_ptr: case enum_type_PMC: return 'P'; case enum_type_void: return 'v'; default: Parrot_ex_throw_from_c_args(interp, NULL, 0, "Unhandled NCI type: `%Ss'", Parrot_dt_get_datatype_name(interp, t)); } } /* =item C Determine the PCC signatures for a given NCI signature PMC. =cut */ void Parrot_nci_sig_to_pcc(PARROT_INTERP, ARGIN(PMC *sig_pmc), ARGOUT(STRING **params_sig), ARGOUT(STRING **ret_sig)) { ASSERT_ARGS(Parrot_nci_sig_to_pcc) const size_t sig_len = VTABLE_elements(interp, sig_pmc); const size_t argc = sig_len - 1; size_t retc = 0; /* avoid malloc churn on common signatures */ char static_buf[16]; char *sig_buf; size_t i, j; PARROT_DATA_TYPE t; /* process NCI arguments */ sig_buf = argc < sizeof static_buf ? static_buf : (char *)mem_sys_allocate(argc); for (i = 0; i < argc; i++) { t = (PARROT_DATA_TYPE)VTABLE_get_integer_keyed_int(interp, sig_pmc, i + 1); sig_buf[i] = ncidt_to_pcc(interp, (PARROT_DATA_TYPE)(t & ~enum_type_ref_flag)); if (t & enum_type_ref_flag) retc++; } *params_sig = argc ? Parrot_str_new(interp, sig_buf, argc) : CONST_STRING(interp, ""); if (sig_buf != static_buf) mem_sys_free(sig_buf); if (enum_type_void != (t = (PARROT_DATA_TYPE)VTABLE_get_integer_keyed_int(interp, sig_pmc, 0))) retc++; /* process NCI returns */ sig_buf = retc < sizeof static_buf ? static_buf : (char *)mem_sys_allocate(retc); if (enum_type_void == t) { j = 0; } else { sig_buf[0] = ncidt_to_pcc(interp, t); j = 1; } for (i = 0; j < retc; i++) { t = (PARROT_DATA_TYPE)VTABLE_get_integer_keyed_int(interp, sig_pmc, i + 1); if (t & enum_type_ref_flag) sig_buf[j++] = ncidt_to_pcc(interp, (PARROT_DATA_TYPE)(t & ~enum_type_ref_flag)); } *ret_sig = retc ? Parrot_str_new(interp, sig_buf, retc) : CONST_STRING(interp, ""); if (sig_buf != static_buf) mem_sys_free(sig_buf); } /* =item C Provide a descriptive string for a signature. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * Parrot_nci_describe_sig(PARROT_INTERP, ARGIN(PMC *sig)) { ASSERT_ARGS(Parrot_nci_describe_sig) STRING *s; size_t n = VTABLE_elements(interp, sig); size_t i; /* return value */ s = Parrot_dt_get_datatype_name(interp, VTABLE_get_integer_keyed_int(interp, sig, 0)); /* arguments */ s = Parrot_str_concat(interp, s, CONST_STRING(interp, " (")); for (i = 1; i < n; i++) { s = Parrot_str_concat(interp, s, Parrot_dt_get_datatype_name(interp, VTABLE_get_integer_keyed_int(interp, sig, i))); if (i < n - 1) s = Parrot_str_concat(interp, s, CONST_STRING(interp, ", ")); } s = Parrot_str_concat(interp, s, CONST_STRING(interp, ")")); return s; } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ 12-logical.t000644000765000765 163212101554066 17620 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx/t/nqp#!./parrot-nqp # check '||', '&&', and '//' plan(7); my $or_no_branch := 1; $or_no_branch || ( $or_no_branch := 0 ); ok($or_no_branch, "logical || shortcuts, branch not taken"); my $or_branch := 0; 0 || ( $or_branch := 1 ); ok($or_branch, "logical || shortcuts, branch taken"); my $and_no_branch := 0; $and_no_branch && ( $and_no_branch := 1 ); ok(!$and_no_branch, "logical && shortcuts, branch not taken"); my $and_branch := 0; 1 && ( $and_branch := 1 ); ok($and_branch, "logicl && shortcuts, branch taken"); my $err_no_branch := 1; $err_no_branch // ( $err_no_branch := -1 ); ok($err_no_branch == 1, "logical // shortcuts on true, branch not taken"); $err_no_branch := 0; $err_no_branch // ( $err_no_branch := -1 ); ok($err_no_branch == 0, "logical // shortcuts on defined false, branch not taken"); my $err_branch; $err_branch // ( $err_branch := 1 ); ok($err_branch == 1, "logical // takes branch on undef"); mysqltest.bas000644000765000765 236411533177634 17674 0ustar00brucebruce000000000000parrot-5.9.0/examples/pir1 rem Copyright (C) 2008, Parrot Foundation. 3 rem 10 rem +----------------------------------------------------------------------+ 20 rem + mysqltest.bas + 30 rem + A test of the pirric basic interpreter + 40 rem + First build the Mysql module in examples/nci + 50 rem + Then do: + 60 rem + ../../parrot -L /yourparrotdir/examples/nci pirric.pir mysqltest.bas + 70 rem +----------------------------------------------------------------------+ 80 rem 90 on error goto 10100 100 load "Mysql.pbc",b 110 on error goto 10200 120 my = new("Mysql") 130 a = my.connect("localhost","parrot","baDworD","parrot") 140 q = my.query("select * from hello") 150 result = my.use_result() 160 e = result.field_count() 170 print "Fields: "; e 1000 rows = 0 1010 row = result.fetch_row() 1020 if row then goto 1100 1030 print "Rows: "; rows 1040 exit 1100 rows = rows + 1 1140 for i= 1 to e 1160 print "'"; row.get(i - 1); "'"; 1180 if i < e then print ", "; 1190 next 2000 print 2010 goto 1010 10000 rem Errors 10100 print "Cannot load mysql client library" 10110 exit 1 10200 print "Error in mysql usage" 10210 exit 1 malloc.c000644000765000765 57035211631440402 15353 0ustar00brucebruce000000000000parrot-5.9.0/src/gc/* This is a version (aka dlmalloc) of malloc/free/realloc written by Doug Lea and released to the public domain. Use, modify, and redistribute this code without permission or acknowledgment in any way you wish. Send questions, comments, complaints, performance data, etc to dl@cs.oswego.edu * VERSION 2.7.2 Sat Aug 17 09:07:30 2002 Doug Lea (dl at gee) Note: There may be an updated version of this malloc obtainable at ftp://gee.cs.oswego.edu/pub/misc/malloc.c Check before installing! * Quickstart This library is all in one file to simplify the most common usage: ftp it, compile it (-O), and link it into another program. All of the compile-time options default to reasonable values for use on most unix platforms. Compile -DWIN32 for reasonable defaults on windows. You might later want to step through various compile-time and dynamic tuning options. For convenience, an include file for code using this malloc is at: ftp://gee.cs.oswego.edu/pub/misc/malloc-2.7.1.h You don't really need this .h file unless you call functions not defined in your system include files. The .h file contains only the excerpts from this file needed for using this malloc on ANSI C/C++ systems, so long as you haven't changed compile-time options about naming and tuning parameters. If you do, then you can create your own malloc.h that does include all settings by cutting at the point indicated below. * Why use this malloc? This is not the fastest, most space-conserving, most portable, or most tunable malloc ever written. However it is among the fastest while also being among the most space-conserving, portable and tunable. Consistent balance across these factors results in a good general-purpose allocator for malloc-intensive programs. The main properties of the algorithms are: * For large (>= 512 bytes) requests, it is a pure best-fit allocator, with ties normally decided via FIFO (i.e. least recently used). * For small (<= 64 bytes by default) requests, it is a caching allocator, that maintains pools of quickly recycled chunks. * In between, and for combinations of large and small requests, it does the best it can trying to meet both goals at once. * For very large requests (>= 128KB by default), it relies on system memory mapping facilities, if supported. For a longer but slightly out of date high-level description, see http://gee.cs.oswego.edu/dl/html/malloc.html You may already by default be using a C library containing a malloc that is based on some version of this malloc (for example in linux). You might still want to use the one in this file in order to customize settings or to avoid overheads associated with library versions. * Contents, described in more detail in "description of public routines" below. Standard (ANSI/SVID/...) functions: malloc(size_t n); calloc(size_t n_elements, size_t element_size); free(Void_t* p); realloc(Void_t* p, size_t n); memalign(size_t alignment, size_t n); valloc(size_t n); mallinfo() mallopt(int parameter_number, int parameter_value) Additional functions: independent_calloc(size_t n_elements, size_t size, Void_t* chunks[]); independent_comalloc(size_t n_elements, size_t sizes[], Void_t* chunks[]); pvalloc(size_t n); cfree(Void_t* p); malloc_trim(size_t pad); malloc_usable_size(Void_t* p); malloc_stats(); * Vital statistics: Supported pointer representation: 4 or 8 bytes Supported size_t representation: 4 or 8 bytes Note that size_t is allowed to be 4 bytes even if pointers are 8. You can adjust this by defining INTERNAL_SIZE_T Alignment: 2 * sizeof (size_t) (default) (i.e., 8 byte alignment with 4byte size_t). This suffices for nearly all current machines and C compilers. However, you can define MALLOC_ALIGNMENT to be wider than this if necessary. Minimum overhead per allocated chunk: 4 or 8 bytes Each malloced chunk has a hidden word of overhead holding size and status information. Minimum allocated size: 4-byte ptrs: 16 bytes (including 4 overhead) 8-byte ptrs: 24/32 bytes (including, 4/8 overhead) When a chunk is freed, 12 (for 4byte ptrs) or 20 (for 8 byte ptrs but 4 byte size) or 24 (for 8/8) additional bytes are needed; 4 (8) for a trailing size field and 8 (16) bytes for free list pointers. Thus, the minimum allocatable size is 16/24/32 bytes. Even a request for zero bytes (i.e., malloc(0)) returns a pointer to something of the minimum allocatable size. The maximum overhead wastage (i.e., number of extra bytes allocated than were requested in malloc) is less than or equal to the minimum size, except for requests >= mmap_threshold that are serviced via mmap(), where the worst case wastage is 2 * sizeof (size_t) bytes plus the remainder from a system page (the minimal mmap unit); typically 4096 or 8192 bytes. Maximum allocated size: 4-byte size_t: 2^32 minus about two pages 8-byte size_t: 2^64 minus about two pages It is assumed that (possibly signed) size_t values suffice to represent chunk sizes. `Possibly signed' is due to the fact that `size_t' may be defined on a system as either a signed or an unsigned type. The ISO C standard says that it must be unsigned, but a few systems are known not to adhere to this. Additionally, even when size_t is unsigned, sbrk (which is by default used to obtain memory from system) accepts signed arguments, and may not be able to handle size_t-wide arguments with negative sign bit. Generally, values that would appear as negative after accounting for overhead and alignment are supported only via mmap(), which does not have this limitation. Requests for sizes outside the allowed range will perform an optional failure action and then return null. (Requests may also also fail because a system is out of memory.) Thread-safety: NOT thread-safe unless USE_MALLOC_LOCK defined When USE_MALLOC_LOCK is defined, wrappers are created to surround every public call with either a pthread mutex or a win32 spinlock (depending on WIN32). This is not especially fast, and can be a major bottleneck. It is designed only to provide minimal protection in concurrent environments, and to provide a basis for extensions. If you are using malloc in a concurrent program, you would be far better off obtaining ptmalloc, which is derived from a version of this malloc, and is well-tuned for concurrent programs. (See http://www.malloc.de) Note that even when USE_MALLOC_LOCK is defined, you can guarantee full thread-safety only if no threads acquire memory through direct calls to MORECORE or other system-level allocators. Compliance: I believe it is compliant with the 1997 Single Unix Specification (See http://www.opennc.org). Also SVID/XPG, ANSI C, and probably others as well. * Synopsis of compile-time options: People have reported using previous versions of this malloc on all versions of Unix, sometimes by tweaking some of the defines below. It has been tested most extensively on Solaris and Linux. It is also reported to work on WIN32 platforms. People also report using it in stand-alone embedded systems. The implementation is in straight, hand-tuned ANSI C. It is not at all modular. (Sorry!) It uses a lot of macros. To be at all usable, this code should be compiled using an optimizing compiler (for example gcc -O3) that can simplify expressions and control paths. (FAQ: some macros import variables as arguments rather than declare locals because people reported that some debuggers otherwise get confused.) OPTION DEFAULT VALUE Compilation Environment options: __STD_C derived from C compiler defines WIN32 NOT defined HAVE_MEMCPY defined USE_MEMCPY 1 if HAVE_MEMCPY is defined HAVE_MMAP defined as 1 MMAP_CLEARS 1 HAVE_MREMAP 0 unless linux defined malloc_getpagesize derived from system #includes, or 4096 if not HAVE_USR_INCLUDE_MALLOC_H NOT defined LACKS_UNISTD_H NOT defined unless WIN32 LACKS_SYS_PARAM_H NOT defined unless WIN32 LACKS_SYS_MMAN_H NOT defined unless WIN32 LACKS_FCNTL_H NOT defined Changing default word sizes: INTERNAL_SIZE_T size_t MALLOC_ALIGNMENT 2 * sizeof (INTERNAL_SIZE_T) PTR_UINT unsigned long CHUNK_SIZE_T unsigned long Configuration and functionality options: USE_DL_PREFIX NOT defined USE_PUBLIC_MALLOC_WRAPPERS NOT defined USE_MALLOC_LOCK NOT defined DEBUG NOT defined REALLOC_ZERO_BYTES_FREES NOT defined MALLOC_FAILURE_ACTION errno = ENOMEM, if __STD_C defined, else no-op TRIM_FASTBINS 0 FIRST_SORTED_BIN_SIZE 512 Options for customizing MORECORE: MORECORE sbrk MORECORE_CONTIGUOUS 1 MORECORE_CANNOT_TRIM NOT defined MMAP_AS_MORECORE_SIZE (1024 * 1024) Tuning options that are also dynamically changeable via mallopt: DEFAULT_MXFAST 64 DEFAULT_TRIM_THRESHOLD 256 * 1024 DEFAULT_TOP_PAD 0 DEFAULT_MMAP_THRESHOLD 256 * 1024 DEFAULT_MMAP_MAX 65536 There are several other #defined constants and macros that you probably don't want to touch unless you are extending or adapting malloc. */ /* WIN32 sets up defaults for MS environment and compilers. Otherwise defaults are for unix. */ /* #define WIN32 */ #ifdef WIN32 # define WIN32_LEAN_AND_MEAN # include /* Win32 doesn't supply or need the following headers */ # define LACKS_UNISTD_H # define LACKS_SYS_PARAM_H # define LACKS_SYS_MMAN_H /* Use the supplied emulation of sbrk */ # define MORECORE sbrk # define MORECORE_CONTIGUOUS 1 # define MORECORE_FAILURE ((void*)(-1)) /* Use the supplied emulation of mmap and munmap */ # define HAVE_MMAP 1 # define MUNMAP_FAILURE (-1) # define MMAP_CLEARS 1 /* These values don't really matter in windows mmap emulation */ # define MAP_PRIVATE 1 # define MAP_ANONYMOUS 2 # define PROT_READ 1 # define PROT_WRITE 2 /* Emulation functions defined at the end of this file */ /* If USE_MALLOC_LOCK, use supplied critical-section-based lock functions */ # ifdef USE_MALLOC_LOCK static int slwait(int *sl); static int slrelease(int *sl); # endif static long getpagesize(void); static long getregionsize(void); static void *sbrk(long size); static void *mmap(void *ptr, long size, long prot, long type, long handle, long arg); static long munmap(void *ptr, long size); static void vminfo (unsigned long*free, unsigned long*reserved, unsigned long*committed); static int cpuinfo (int whole, unsigned long*kernel, unsigned long*user); #endif /* __STD_C should be nonzero if using ANSI-standard C compiler, a C++ compiler, or a C compiler sufficiently close to ANSI to get away with it. */ #ifndef __STD_C # if defined(__STDC__) || defined(_cplusplus) # define __STD_C 1 # else # define __STD_C 0 # endif #endif /*__STD_C*/ /* Void_t* is the pointer type that malloc should say it returns */ #ifndef Void_t # if (__STD_C || defined(WIN32)) # define Void_t void # else # define Void_t char # endif #endif /*Void_t*/ #if __STD_C # include /* for size_t */ #else # include #endif #ifdef __cplusplus extern "C" { #endif /* define LACKS_UNISTD_H if your system does not have a . */ /* #define LACKS_UNISTD_H */ #ifndef LACKS_UNISTD_H # include #endif /* define LACKS_SYS_PARAM_H if your system does not have a . */ /* #define LACKS_SYS_PARAM_H */ #include /* needed for malloc_stats */ #include /* needed for optional MALLOC_FAILURE_ACTION */ /* Debugging: Because freed chunks may be overwritten with bookkeeping fields, this malloc will often die when freed memory is overwritten by user programs. This can be very effective (albeit in an annoying way) in helping track down dangling pointers. If you compile with -DDEBUG, a number of assertion checks are enabled that will catch more memory errors. You probably won't be able to make much sense of the actual assertion errors, but they should help you locate incorrectly overwritten memory. The checking is fairly extensive, and will slow down execution noticeably. Calling malloc_stats or mallinfo with DEBUG set will attempt to check every non-mmapped allocated and free chunk in the course of computing the summaries. (By nature, mmapped regions cannot be checked very much automatically.) Setting DEBUG may also be helpful if you are trying to modify this code. The assertions in the check routines spell out in more detail the assumptions and invariants underlying the algorithms. Setting DEBUG does NOT provide an automated mechanism for checking that all accesses to malloced memory stay within their bounds. However, there are several add-ons and adaptations of this or other mallocs available that do this. */ #if DEBUG # include #else # define assert(x) ((void)0) #endif /* The unsigned integer type used for comparing any two chunk sizes. This should be at least as wide as size_t, but should not be signed. */ #ifndef CHUNK_SIZE_T # define CHUNK_SIZE_T unsigned long #endif /* The unsigned integer type used to hold addresses when they are manipulated as integers. Except that it is not defined on all systems, intptr_t would suffice. */ #ifndef PTR_UINT # define PTR_UINT unsigned long #endif /* INTERNAL_SIZE_T is the word-size used for internal bookkeeping of chunk sizes. The default version is the same as size_t. While not strictly necessary, it is best to define this as an unsigned type, even if size_t is a signed type. This may avoid some artificial size limitations on some systems. On a 64-bit machine, you may be able to reduce malloc overhead by defining INTERNAL_SIZE_T to be a 32 bit `unsigned int' at the expense of not being able to handle more than 2^32 of malloced space. If this limitation is acceptable, you are encouraged to set this unless you are on a platform requiring 16byte alignments. In this case the alignment requirements turn out to negate any potential advantages of decreasing size_t word size. Implementors: Beware of the possible combinations of: - INTERNAL_SIZE_T might be signed or unsigned, might be 32 or 64 bits, and might be the same width as int or as long - size_t might have different width and signedness as INTERNAL_SIZE_T - int and long might be 32 or 64 bits, and might be the same width To deal with this, most comparisons and difference computations among INTERNAL_SIZE_Ts should cast them to CHUNK_SIZE_T, being aware of the fact that casting an unsigned int to a wider long does not sign-extend. (This also makes checking for negative numbers awkward.) Some of these casts result in harmless compiler warnings on some systems. */ #ifndef INTERNAL_SIZE_T # define INTERNAL_SIZE_T size_t #endif /* The corresponding word size */ #define SIZE_SZ (sizeof (INTERNAL_SIZE_T)) /* MALLOC_ALIGNMENT is the minimum alignment for malloc'ed chunks. It must be a power of two at least 2 * SIZE_SZ, even on machines for which smaller alignments would suffice. It may be defined as larger than this though. Note however that code and data structures are optimized for the case of 8-byte alignment. */ #ifndef MALLOC_ALIGNMENT # define MALLOC_ALIGNMENT (2 * SIZE_SZ) #endif /* The corresponding bit mask value */ #define MALLOC_ALIGN_MASK (MALLOC_ALIGNMENT - 1) /* REALLOC_ZERO_BYTES_FREES should be set if a call to realloc with zero bytes should be the same as a call to free. Some people think it should. Otherwise, since this malloc returns a unique pointer for malloc(0), so does realloc(p, 0). */ /* #define REALLOC_ZERO_BYTES_FREES */ /* TRIM_FASTBINS controls whether free() of a very small chunk can immediately lead to trimming. Setting to true (1) can reduce memory footprint, but will almost always slow down programs that use a lot of small chunks. Define this only if you are willing to give up some speed to more aggressively reduce system-level memory footprint when releasing memory in programs that use many small chunks. You can get essentially the same effect by setting MXFAST to 0, but this can lead to even greater slowdowns in programs using many small chunks. TRIM_FASTBINS is an in-between compile-time option, that disables only those chunks bordering topmost memory from being placed in fastbins. */ #ifndef TRIM_FASTBINS # define TRIM_FASTBINS 0 #endif /* USE_DL_PREFIX will prefix all public routines with the string 'dl'. This is necessary when you only want to use this malloc in one part of a program, using your regular system malloc elsewhere. */ /* #define USE_DL_PREFIX */ /* USE_MALLOC_LOCK causes wrapper functions to surround each callable routine with pthread mutex lock/unlock. USE_MALLOC_LOCK forces USE_PUBLIC_MALLOC_WRAPPERS to be defined */ /* #define USE_MALLOC_LOCK */ /* If USE_PUBLIC_MALLOC_WRAPPERS is defined, every public routine is actually a wrapper function that first calls MALLOC_PREACTION, then calls the internal routine, and follows it with MALLOC_POSTACTION. This is needed for locking, but you can also use this, without USE_MALLOC_LOCK, for purposes of interception, instrumentation, etc. It is a sad fact that using wrappers often noticeably degrades performance of malloc-intensive programs. */ #ifdef USE_MALLOC_LOCK # define USE_PUBLIC_MALLOC_WRAPPERS #else /* #define USE_PUBLIC_MALLOC_WRAPPERS */ #endif /* Two-phase name translation. All of the actual routines are given mangled names. When wrappers are used, they become the public callable versions. When DL_PREFIX is used, the callable names are prefixed. */ #ifndef USE_PUBLIC_MALLOC_WRAPPERS # define cALLOc public_cALLOc # define fREe public_fREe # define cFREe public_cFREe # define mALLOc public_mALLOc # define mEMALIGn public_mEMALIGn # define rEALLOc public_rEALLOc # define vALLOc public_vALLOc # define pVALLOc public_pVALLOc # define mALLINFo public_mALLINFo # define mALLOPt public_mALLOPt # define mTRIm public_mTRIm # define mSTATs public_mSTATs # define mUSABLe public_mUSABLe # define iCALLOc public_iCALLOc # define iCOMALLOc public_iCOMALLOc #endif #ifdef USE_DL_PREFIX # define public_cALLOc dlcalloc # define public_fREe dlfree # define public_cFREe dlcfree # define public_mALLOc dlmalloc # define public_mEMALIGn dlmemalign # define public_rEALLOc dlrealloc # define public_vALLOc dlvalloc # define public_pVALLOc dlpvalloc # define public_mALLINFo dlmallinfo # define public_mALLOPt dlmallopt # define public_mTRIm dlmalloc_trim # define public_mSTATs dlmalloc_stats # define public_mUSABLe dlmalloc_usable_size # define public_iCALLOc dlindependent_calloc # define public_iCOMALLOc dlindependent_comalloc #else /* USE_DL_PREFIX */ # define public_cALLOc calloc # define public_fREe free # define public_cFREe cfree # define public_mALLOc malloc # define public_mEMALIGn memalign # define public_rEALLOc realloc # define public_vALLOc valloc # define public_pVALLOc pvalloc # define public_mALLINFo mallinfo # define public_mALLOPt mallopt # define public_mTRIm malloc_trim # define public_mSTATs malloc_stats # define public_mUSABLe malloc_usable_size # define public_iCALLOc independent_calloc # define public_iCOMALLOc independent_comalloc #endif /* USE_DL_PREFIX */ /* HAVE_MEMCPY should be defined if you are not otherwise using ANSI STD C, but still have memcpy and memset in your C library and want to use them in calloc and realloc. Otherwise simple macro versions are defined below. USE_MEMCPY should be defined as 1 if you actually want to have memset and memcpy called. People report that the macro versions are faster than libc versions on some systems. Even if USE_MEMCPY is set to 1, loops to copy/clear small chunks (of <= 36 bytes) are manually unrolled in realloc and calloc. */ #define HAVE_MEMCPY #ifndef USE_MEMCPY # ifdef HAVE_MEMCPY # define USE_MEMCPY 1 # else # define USE_MEMCPY 0 # endif #endif #if (__STD_C || defined(HAVE_MEMCPY)) # ifdef WIN32 /* On Win32 memset and memcpy are already declared in windows.h */ # else # if __STD_C void* memset(void*, int, size_t); void* memcpy(void*, const void*, size_t); # else Void_t* memset(); Void_t* memcpy(); # endif # endif #endif /* MALLOC_FAILURE_ACTION is the action to take before "return 0" when malloc fails to be able to return memory, either because memory is exhausted or because of illegal arguments. By default, sets errno if running on STD_C platform, else does nothing. */ #ifndef MALLOC_FAILURE_ACTION # if __STD_C # define MALLOC_FAILURE_ACTION \ errno = ENOMEM; # else # define MALLOC_FAILURE_ACTION # endif #endif /* MORECORE-related declarations. By default, rely on sbrk */ #ifdef LACKS_UNISTD_H # if !defined(__FreeBSD__) && !defined(__OpenBSD__) && \ !defined(__NetBSD__) && !defined(__GNUC__) # if __STD_C extern Void_t* sbrk(ptrdiff_t); # else extern Void_t* sbrk(); # endif # endif #endif /* MORECORE is the name of the routine to call to obtain more memory from the system. See below for general guidance on writing alternative MORECORE functions, as well as a version for WIN32 and a sample version for pre-OSX macos. */ #ifndef MORECORE # define MORECORE sbrk #endif /* MORECORE_FAILURE is the value returned upon failure of MORECORE as well as mmap. Since it cannot be an otherwise valid memory address, and must reflect values of standard sys calls, you probably ought not try to redefine it. */ #ifndef MORECORE_FAILURE # define MORECORE_FAILURE (-1) #endif /* If MORECORE_CONTIGUOUS is true, take advantage of fact that consecutive calls to MORECORE with positive arguments always return contiguous increasing addresses. This is true of unix sbrk. Even if not defined, when regions happen to be contiguous, malloc will permit allocations spanning regions obtained from different calls. But defining this when applicable enables some stronger consistency checks and space efficiencies. */ #ifndef MORECORE_CONTIGUOUS # define MORECORE_CONTIGUOUS 1 #endif /* Define MORECORE_CANNOT_TRIM if your version of MORECORE cannot release space back to the system when given negative arguments. This is generally necessary only if you are using a hand-crafted MORECORE function that cannot handle negative arguments. */ /* #define MORECORE_CANNOT_TRIM */ /* Define HAVE_MMAP as true to optionally make malloc() use mmap() to allocate very large blocks. These will be returned to the operating system immediately after a free(). Also, if mmap is available, it is used as a backup strategy in cases where MORECORE fails to provide space from system. This malloc is best tuned to work with mmap for large requests. If you do not have mmap, operations involving very large chunks (1MB or so) may be slower than you'd like. */ #ifndef HAVE_MMAP # define HAVE_MMAP 1 #endif #if HAVE_MMAP /* Standard unix mmap using /dev/zero clears memory so calloc doesn't need to. */ # ifndef MMAP_CLEARS # define MMAP_CLEARS 1 # endif #else /* no mmap */ # ifndef MMAP_CLEARS # define MMAP_CLEARS 0 # endif #endif /* MMAP_AS_MORECORE_SIZE is the minimum mmap size argument to use if sbrk fails, and mmap is used as a backup (which is done only if HAVE_MMAP). The value must be a multiple of page size. This backup strategy generally applies only when systems have "holes" in address space, so sbrk cannot perform contiguous expansion, but there is still space available on system. On systems for which this is known to be useful (i.e. most linux kernels), this occurs only when programs allocate huge amounts of memory. Between this, and the fact that mmap regions tend to be limited, the size should be large, to avoid too many mmap calls and thus avoid running out of kernel resources. */ #ifndef MMAP_AS_MORECORE_SIZE # define MMAP_AS_MORECORE_SIZE (1024 * 1024) #endif /* Define HAVE_MREMAP to make realloc() use mremap() to re-allocate large blocks. This is currently only possible on Linux with kernel versions newer than 1.3.77. */ #ifndef HAVE_MREMAP # ifdef linux # define HAVE_MREMAP 1 # else # define HAVE_MREMAP 0 # endif #endif /* HAVE_MMAP */ /* The system page size. To the extent possible, this malloc manages memory from the system in page-size units. Note that this value is cached during initialization into a field of malloc_state. So even if malloc_getpagesize is a function, it is only called once. The following mechanics for getpagesize were adapted from bsd/gnu getpagesize.h. If none of the system-probes here apply, a value of 4096 is used, which should be OK: If they don't apply, then using the actual value probably doesn't impact performance. */ #ifndef malloc_getpagesize # ifndef LACKS_UNISTD_H # include # endif # ifdef _SC_PAGESIZE /* some SVR4 systems omit an underscore */ # ifndef _SC_PAGE_SIZE # define _SC_PAGE_SIZE _SC_PAGESIZE # endif # endif # ifdef _SC_PAGE_SIZE # define malloc_getpagesize sysconf(_SC_PAGE_SIZE) # else # if defined(BSD) || defined(DGUX) || defined(HAVE_GETPAGESIZE) extern size_t getpagesize(); # define malloc_getpagesize getpagesize() # else # ifdef WIN32 /* use supplied emulation of getpagesize */ # define malloc_getpagesize getpagesize() # else # ifndef LACKS_SYS_PARAM_H # include # endif # ifdef EXEC_PAGESIZE # define malloc_getpagesize EXEC_PAGESIZE # else # ifdef NBPG # ifndef CLSIZE # define malloc_getpagesize NBPG # else # define malloc_getpagesize (NBPG * CLSIZE) # endif # else # ifdef NBPC # define malloc_getpagesize NBPC # else # ifdef PAGESIZE # define malloc_getpagesize PAGESIZE # else /* just guess */ # define malloc_getpagesize (4096) # endif # endif # endif # endif # endif # endif # endif #endif /* This version of malloc supports the standard SVID/XPG mallinfo routine that returns a struct containing usage properties and statistics. It should work on any SVID/XPG compliant system that has a /usr/include/malloc.h defining struct mallinfo. (If you'd like to install such a thing yourself, cut out the preliminary declarations as described above and below and save them in a malloc.h file. But there's no compelling reason to bother to do this.) The main declaration needed is the mallinfo struct that is returned (by-copy) by mallinfo(). The SVID/XPG malloinfo struct contains a bunch of fields that are not even meaningful in this version of malloc. These fields are instead filled by mallinfo() with other numbers that might be of interest. HAVE_USR_INCLUDE_MALLOC_H should be set if you have a /usr/include/malloc.h file that includes a declaration of struct mallinfo. If so, it is included; else an SVID2/XPG2 compliant version is declared below. These must be precisely the same for mallinfo() to work. The original SVID version of this struct, defined on most systems with mallinfo, declares all fields as ints. But some others define as unsigned long. If your system defines the fields using a type of different width than listed here, you must #include your system version and #define HAVE_USR_INCLUDE_MALLOC_H. */ /* #define HAVE_USR_INCLUDE_MALLOC_H */ #ifdef HAVE_USR_INCLUDE_MALLOC_H # include "/usr/include/malloc.h" #else /* SVID2/XPG mallinfo structure */ struct mallinfo { int arena; /* non-mmapped space allocated from system */ int ordblks; /* number of free chunks */ int smblks; /* number of fastbin blocks */ int hblks; /* number of mmapped regions */ int hblkhd; /* space in mmapped regions */ int usmblks; /* maximum total allocated space */ int fsmblks; /* space available in freed fastbin blocks */ int uordblks; /* total allocated space */ int fordblks; /* total free space */ int keepcost; /* top-most, releasable (via malloc_trim) space */ }; /* SVID/XPG defines four standard parameter numbers for mallopt, normally defined in malloc.h. Only one of these (M_MXFAST) is used in this malloc. The others (M_NLBLKS, M_GRAIN, M_KEEP) don't apply, so setting them has no effect. But this malloc also supports other options in mallopt described below. */ #endif /* ---------- description of public routines ------------ */ /* malloc(size_t n) Returns a pointer to a newly allocated chunk of at least n bytes, or null if no space is available. Additionally, on failure, errno is set to ENOMEM on ANSI C systems. If n is zero, malloc returns a minumum-sized chunk. (The minimum size is 16 bytes on most 32bit systems, and 24 or 32 bytes on 64bit systems.) On most systems, size_t is an unsigned type, so calls with negative arguments are interpreted as requests for huge amounts of space, which will often fail. The maximum supported value of n differs across systems, but is in all cases less than the maximum representable value of a size_t. */ #if __STD_C Void_t* public_mALLOc(size_t); #else Void_t* public_mALLOc(); #endif /* free(Void_t* p) Releases the chunk of memory pointed to by p, that had been previously allocated using malloc or a related routine such as realloc. It has no effect if p is null. It can have arbitrary (i.e., bad!) effects if p has already been freed. Unless disabled (using mallopt), freeing very large spaces will when possible, automatically trigger operations that give back unused memory to the system, thus reducing program footprint. */ #if __STD_C void public_fREe(Void_t*); #else void public_fREe(); #endif /* calloc(size_t n_elements, size_t element_size); Returns a pointer to n_elements * element_size bytes, with all locations set to zero. */ #if __STD_C Void_t* public_cALLOc(size_t, size_t); #else Void_t* public_cALLOc(); #endif /* realloc(Void_t* p, size_t n) Returns a pointer to a chunk of size n that contains the same data as does chunk p up to the minimum of (n, p's size) bytes, or null if no space is available. The returned pointer may or may not be the same as p. The algorithm prefers extending p when possible, otherwise it employs the equivalent of a malloc-copy-free sequence. If p is null, realloc is equivalent to malloc. If space is not available, realloc returns null, errno is set (if on ANSI) and p is NOT freed. if n is for fewer bytes than already held by p, the newly unused space is lopped off and freed if possible. Unless the #define REALLOC_ZERO_BYTES_FREES is set, realloc with a size argument of zero (re)allocates a minimum-sized chunk. Large chunks that were internally obtained via mmap will always be reallocated using malloc-copy-free sequences unless the system supports MREMAP (currently only linux). The old unix realloc convention of allowing the last-free'd chunk to be used as an argument to realloc is not supported. */ #if __STD_C Void_t* public_rEALLOc(Void_t*, size_t); #else Void_t* public_rEALLOc(); #endif /* memalign(size_t alignment, size_t n); Returns a pointer to a newly allocated chunk of n bytes, aligned in accord with the alignment argument. The alignment argument should be a power of two. If the argument is not a power of two, the nearest greater power is used. 8-byte alignment is guaranteed by normal malloc calls, so don't bother calling memalign with an argument of 8 or less. Overreliance on memalign is a sure way to fragment space. */ #if __STD_C Void_t* public_mEMALIGn(size_t, size_t); #else Void_t* public_mEMALIGn(); #endif /* valloc(size_t n); Equivalent to memalign(pagesize, n), where pagesize is the page size of the system. If the pagesize is unknown, 4096 is used. */ #if __STD_C Void_t* public_vALLOc(size_t); #else Void_t* public_vALLOc(); #endif /* mallopt(int parameter_number, int parameter_value) Sets tunable parameters The format is to provide a (parameter-number, parameter-value) pair. mallopt then sets the corresponding parameter to the argument value if it can (i.e., so long as the value is meaningful), and returns 1 if successful else 0. SVID/XPG/ANSI defines four standard param numbers for mallopt, normally defined in malloc.h. Only one of these (M_MXFAST) is used in this malloc. The others (M_NLBLKS, M_GRAIN, M_KEEP) don't apply, so setting them has no effect. But this malloc also supports four other options in mallopt. See below for details. Briefly, supported parameters are as follows (listed defaults are for "typical" configurations). Symbol param # default allowed param values M_MXFAST 1 64 0-80 (0 disables fastbins) M_TRIM_THRESHOLD -1 256*1024 any (-1U disables trimming) M_TOP_PAD -2 0 any M_MMAP_THRESHOLD -3 256*1024 any (or 0 if no MMAP support) M_MMAP_MAX -4 65536 any (0 disables use of mmap) */ #if __STD_C int public_mALLOPt(int, int); #else int public_mALLOPt(); #endif /* mallinfo() Returns (by copy) a struct containing various summary statistics: arena: current total non-mmapped bytes allocated from system ordblks: the number of free chunks smblks: the number of fastbin blocks (i.e., small chunks that have been freed but not use, reused, or consolidated) hblks: current number of mmapped regions hblkhd: total bytes held in mmapped regions usmblks: the maximum total allocated space. This will be greater than current total if trimming has occurred. fsmblks: total bytes held in fastbin blocks uordblks: current total allocated space (normal or mmapped) fordblks: total free space keepcost: the maximum number of bytes that could ideally be released back to system via malloc_trim. ("ideally" means that it ignores page restrictions etc.) Because these fields are ints, but internal bookkeeping may be kept as longs, the reported values may wrap around zero and thus be inaccurate. */ #if __STD_C struct mallinfo public_mALLINFo(void); #else struct mallinfo public_mALLINFo(); #endif /* independent_calloc(size_t n_elements, size_t element_size, Void_t* chunks[]); independent_calloc is similar to calloc, but instead of returning a single cleared space, it returns an array of pointers to n_elements independent elements that can hold contents of size elem_size, each of which starts out cleared, and can be independently freed, realloc'ed etc. The elements are guaranteed to be adjacently allocated (this is not guaranteed to occur with multiple callocs or mallocs), which may also improve cache locality in some applications. The "chunks" argument is optional (i.e., may be null, which is probably the most typical usage). If it is null, the returned array is itself dynamically allocated and should also be freed when it is no longer needed. Otherwise, the chunks array must be of at least n_elements in length. It is filled in with the pointers to the chunks. In either case, independent_calloc returns this pointer array, or null if the allocation failed. If n_elements is zero and "chunks" is null, it returns a chunk representing an array with zero elements (which should be freed if not wanted). Each element must be individually freed when it is no longer needed. If you'd like to instead be able to free all at once, you should instead use regular calloc and assign pointers into this space to represent elements. (In this case though, you cannot independently free elements.) independent_calloc simplifies and speeds up implementations of many kinds of pools. It may also be useful when constructing large data structures that initially have a fixed number of fixed-sized nodes, but the number is not known at compile time, and some of the nodes may later need to be freed. For example: struct Node { int item; struct Node* next; }; struct Node* build_list() { struct Node** pool; int n = read_number_of_nodes_needed(); if (n <= 0) return 0; pool = (struct Node**)(independent_calloc(n, sizeof (struct Node), 0); if (pool == 0) die(); / / organize into a linked list... struct Node* first = pool[0]; for (i = 0; i < n-1; ++i) pool[i]->next = pool[i+1]; free(pool); / / Can now free the array (or not, if it is needed later) return first; } */ #if __STD_C Void_t** public_iCALLOc(size_t, size_t, Void_t**); #else Void_t** public_iCALLOc(); #endif /* independent_comalloc(size_t n_elements, size_t sizes[], Void_t* chunks[]); independent_comalloc allocates, all at once, a set of n_elements chunks with sizes indicated in the "sizes" array. It returns an array of pointers to these elements, each of which can be independently freed, realloc'ed etc. The elements are guaranteed to be adjacently allocated (this is not guaranteed to occur with multiple callocs or mallocs), which may also improve cache locality in some applications. The "chunks" argument is optional (i.e., may be null). If it is null the returned array is itself dynamically allocated and should also be freed when it is no longer needed. Otherwise, the chunks array must be of at least n_elements in length. It is filled in with the pointers to the chunks. In either case, independent_comalloc returns this pointer array, or null if the allocation failed. If n_elements is zero and chunks is null, it returns a chunk representing an array with zero elements (which should be freed if not wanted). Each element must be individually freed when it is no longer needed. If you'd like to instead be able to free all at once, you should instead use a single regular malloc, and assign pointers at particular offsets in the aggregate space. (In this case though, you cannot independently free elements.) independent_comallac differs from independent_calloc in that each element may have a different size, and also that it does not automatically clear elements. independent_comalloc can be used to speed up allocation in cases where several structs or objects must always be allocated at the same time. For example: struct Head { ... } struct Foot { ... } void send_message(char* msg) { int msglen = strlen(msg); size_t sizes[3] = { sizeof (struct Head), msglen, sizeof (struct Foot) }; void* chunks[3]; if (independent_comalloc(3, sizes, chunks) == 0) die(); struct Head* head = (struct Head*)(chunks[0]); char* body = (char*)(chunks[1]); struct Foot* foot = (struct Foot*)(chunks[2]); / / ... } In general though, independent_comalloc is worth using only for larger values of n_elements. For small values, you probably won't detect enough difference from series of malloc calls to bother. Overuse of independent_comalloc can increase overall memory usage, since it cannot reuse existing noncontiguous small chunks that might be available for some of the elements. */ #if __STD_C Void_t** public_iCOMALLOc(size_t, size_t*, Void_t**); #else Void_t** public_iCOMALLOc(); #endif /* pvalloc(size_t n); Equivalent to valloc(minimum-page-that-holds(n)), that is, round up n to nearest pagesize. */ #if __STD_C Void_t* public_pVALLOc(size_t); #else Void_t* public_pVALLOc(); #endif /* cfree(Void_t* p); Equivalent to free(p). cfree is needed/defined on some systems that pair it with calloc, for odd historical reasons (such as: cfree is used in example code in the first edition of K&R). */ #if __STD_C void public_cFREe(Void_t*); #else void public_cFREe(); #endif /* malloc_trim(size_t pad); If possible, gives memory back to the system (via negative arguments to sbrk) if there is unused memory at the `high' end of the malloc pool. You can call this after freeing large blocks of memory to potentially reduce the system-level memory requirements of a program. However, it cannot guarantee to reduce memory. Under some allocation patterns, some large free blocks of memory will be locked between two used chunks, so they cannot be given back to the system. The `pad' argument to malloc_trim represents the amount of free trailing space to leave untrimmed. If this argument is zero, only the minimum amount of memory to maintain internal data structures will be left (one page or less). Non-zero arguments can be supplied to maintain enough trailing space to service future expected allocations without having to re-obtain memory from the system. Malloc_trim returns 1 if it actually released any memory, else 0. On systems that do not support "negative sbrks", it will always rreturn 0. */ #if __STD_C int public_mTRIm(size_t); #else int public_mTRIm(); #endif /* malloc_usable_size(Void_t* p); Returns the number of bytes you can actually use in an allocated chunk, which may be more than you requested (although often not) due to alignment and minimum size constraints. You can use this many bytes without worrying about overwriting other allocated objects. This is not a particularly great programming practice. malloc_usable_size can be more useful in debugging and assertions, for example: p = malloc(n); assert(malloc_usable_size(p) >= 256); */ #if __STD_C size_t public_mUSABLe(Void_t*); #else size_t public_mUSABLe(); #endif /* malloc_stats(); Prints on stderr the amount of space obtained from the system (both via sbrk and mmap), the maximum amount (which may be more than current if malloc_trim and/or munmap got called), and the current number of bytes allocated via malloc (or realloc, etc) but not yet freed. Note that this is the number of bytes allocated, not the number requested. It will be larger than the number requested because of alignment and bookkeeping overhead. Because it includes alignment wastage as being in use, this figure may be greater than zero even when no user-level chunks are allocated. The reported current and maximum system memory can be inaccurate if a program makes other calls to system memory allocation functions (normally sbrk) outside of malloc. malloc_stats prints only the most commonly interesting statistics. More information can be obtained by calling mallinfo. */ #if __STD_C void public_mSTATs(); #else void public_mSTATs(); #endif /* mallopt tuning options */ /* M_MXFAST is the maximum request size used for "fastbins", special bins that hold returned chunks without consolidating their spaces. This enables future requests for chunks of the same size to be handled very quickly, but can increase fragmentation, and thus increase the overall memory footprint of a program. This malloc manages fastbins very conservatively yet still efficiently, so fragmentation is rarely a problem for values less than or equal to the default. The maximum supported value of MXFAST is 80. You wouldn't want it any higher than this anyway. Fastbins are designed especially for use with many small structs, objects or strings -- the default handles structs/objects/arrays with sizes up to 16 4byte fields, or small strings representing words, tokens, etc. Using fastbins for larger objects normally worsens fragmentation without improving speed. M_MXFAST is set in REQUEST size units. It is internally used in chunksize units, which adds padding and alignment. You can reduce M_MXFAST to 0 to disable all use of fastbins. This causes the malloc algorithm to be a closer approximation of fifo-best-fit in all cases, not just for larger requests, but will generally cause it to be slower. */ /* M_MXFAST is a standard SVID/XPG tuning option, usually listed in malloc.h */ #ifndef M_MXFAST # define M_MXFAST 1 #endif #ifndef DEFAULT_MXFAST # define DEFAULT_MXFAST 64 #endif /* M_TRIM_THRESHOLD is the maximum amount of unused top-most memory to keep before releasing via malloc_trim in free(). Automatic trimming is mainly useful in long-lived programs. Because trimming via sbrk can be slow on some systems, and can sometimes be wasteful (in cases where programs immediately afterward allocate more large chunks) the value should be high enough so that your overall system performance would improve by releasing this much memory. The trim threshold and the mmap control parameters (see below) can be traded off with one another. Trimming and mmapping are two different ways of releasing unused memory back to the system. Between these two, it is often possible to keep system-level demands of a long-lived program down to a bare minimum. For example, in one test suite of sessions measuring the XF86 X server on Linux, using a trim threshold of 128K and a mmap threshold of 192K led to near-minimal long term resource consumption. If you are using this malloc in a long-lived program, it should pay to experiment with these values. As a rough guide, you might set to a value close to the average size of a process (program) running on your system. Releasing this much memory would allow such a process to run in memory. Generally, it's worth it to tune for trimming rather tham memory mapping when a program undergoes phases where several large chunks are allocated and released in ways that can reuse each other's storage, perhaps mixed with phases where there are no such chunks at all. And in well-behaved long-lived programs, controlling release of large blocks via trimming versus mapping is usually faster. However, in most programs, these parameters serve mainly as protection against the system-level effects of carrying around massive amounts of unneeded memory. Since frequent calls to sbrk, mmap, and munmap otherwise degrade performance, the default parameters are set to relatively high values that serve only as safeguards. The trim value must be greater than page size to have any useful effect. To disable trimming completely, you can set to (unsigned long)(-1) Trim settings interact with fastbin (MXFAST) settings: Unless TRIM_FASTBINS is defined, automatic trimming never takes place upon freeing a chunk with size less than or equal to MXFAST. Trimming is instead delayed until subsequent freeing of larger chunks. However, you can still force an attempted trim by calling malloc_trim. Also, trimming is not generally possible in cases where the main arena is obtained via mmap. Note that the trick some people use of mallocing a huge space and then freeing it at program startup, in an attempt to reserve system memory, doesn't have the intended effect under automatic trimming, since that memory will immediately be returned to the system. */ #define M_TRIM_THRESHOLD -1 #ifndef DEFAULT_TRIM_THRESHOLD # define DEFAULT_TRIM_THRESHOLD (256 * 1024) #endif /* M_TOP_PAD is the amount of extra `padding' space to allocate or retain whenever sbrk is called. It is used in two ways internally: * When sbrk is called to extend the top of the arena to satisfy a new malloc request, this much padding is added to the sbrk request. * When malloc_trim is called automatically from free(), it is used as the `pad' argument. In both cases, the actual amount of padding is rounded so that the end of the arena is always a system page boundary. The main reason for using padding is to avoid calling sbrk so often. Having even a small pad greatly reduces the likelihood that nearly every malloc request during program start-up (or after trimming) will invoke sbrk, which needlessly wastes time. Automatic rounding-up to page-size units is normally sufficient to avoid measurable overhead, so the default is 0. However, in systems where sbrk is relatively slow, it can pay to increase this value, at the expense of carrying around more memory than the program needs. */ #define M_TOP_PAD -2 #ifndef DEFAULT_TOP_PAD # define DEFAULT_TOP_PAD (0) #endif /* M_MMAP_THRESHOLD is the request size threshold for using mmap() to service a request. Requests of at least this size that cannot be allocated using already-existing space will be serviced via mmap. (If enough normal freed space already exists it is used instead.) Using mmap segregates relatively large chunks of memory so that they can be individually obtained and released from the host system. A request serviced through mmap is never reused by any other request (at least not directly; the system may just so happen to remap successive requests to the same locations). Segregating space in this way has the benefits that: 1. Mmapped space can ALWAYS be individually released back to the system, which helps keep the system level memory demands of a long-lived program low. 2. Mapped memory can never become `locked' between other chunks, as can happen with normally allocated chunks, which means that even trimming via malloc_trim would not release them. 3. On some systems with "holes" in address spaces, mmap can obtain memory that sbrk cannot. However, it has the disadvantages that: 1. The space cannot be reclaimed, consolidated, and then used to service later requests, as happens with normal chunks. 2. It can lead to more wastage because of mmap page alignment requirements 3. It causes malloc performance to be more dependent on host system memory management support routines which may vary in implementation quality and may impose arbitrary limitations. Generally, servicing a request via normal malloc steps is faster than going through a system's mmap. The advantages of mmap nearly always outweigh disadvantages for "large" chunks, but the value of "large" varies across systems. The default is an empirically derived value that works well in most systems. */ #define M_MMAP_THRESHOLD -3 #ifndef DEFAULT_MMAP_THRESHOLD # define DEFAULT_MMAP_THRESHOLD (256 * 1024) #endif /* M_MMAP_MAX is the maximum number of requests to simultaneously service using mmap. This parameter exists because . Some systems have a limited number of internal tables for use by mmap, and using more than a few of them may degrade performance. The default is set to a value that serves only as a safeguard. Setting to 0 disables use of mmap for servicing large requests. If HAVE_MMAP is not set, the default value is 0, and attempts to set it to non-zero values in mallopt will fail. */ #define M_MMAP_MAX -4 #ifndef DEFAULT_MMAP_MAX # if HAVE_MMAP # define DEFAULT_MMAP_MAX (65536) # else # define DEFAULT_MMAP_MAX (0) # endif #endif #ifdef __cplusplus }; /* end of extern "C" */ #endif /* ======================================================================== To make a fully customizable malloc.h header file, cut everything above this line, put into file malloc.h, edit to suit, and #include it on the next line, as well as in programs that use this malloc. ======================================================================== */ /* #include "malloc.h" */ /* --------------------- public wrappers ---------------------- */ #ifdef USE_PUBLIC_MALLOC_WRAPPERS /* Declare all routines as internal */ # if __STD_C static Void_t* mALLOc(size_t); static void fREe(Void_t*); static Void_t* rEALLOc(Void_t*, size_t); static Void_t* mEMALIGn(size_t, size_t); static Void_t* vALLOc(size_t); static Void_t* pVALLOc(size_t); static Void_t* cALLOc(size_t, size_t); static Void_t** iCALLOc(size_t, size_t, Void_t**); static Void_t** iCOMALLOc(size_t, size_t*, Void_t**); static void cFREe(Void_t*); static int mTRIm(size_t); static size_t mUSABLe(Void_t*); static void mSTATs(); static int mALLOPt(int, int); static struct mallinfo mALLINFo(void); # else static Void_t* mALLOc(); static void fREe(); static Void_t* rEALLOc(); static Void_t* mEMALIGn(); static Void_t* vALLOc(); static Void_t* pVALLOc(); static Void_t* cALLOc(); static Void_t** iCALLOc(); static Void_t** iCOMALLOc(); static void cFREe(); static int mTRIm(); static size_t mUSABLe(); static void mSTATs(); static int mALLOPt(); static struct mallinfo mALLINFo(); # endif /* MALLOC_PREACTION and MALLOC_POSTACTION should be defined to return 0 on success, and nonzero on failure. The return value of MALLOC_POSTACTION is currently ignored in wrapper functions since there is no reasonable default action to take on failure. */ # ifdef USE_MALLOC_LOCK # ifdef WIN32 static int mALLOC_MUTEx; # define MALLOC_PREACTION slwait(&mALLOC_MUTEx) # define MALLOC_POSTACTION slrelease(&mALLOC_MUTEx) # else # include static pthread_mutex_t mALLOC_MUTEx = PTHREAD_MUTEX_INITIALIZER; # define MALLOC_PREACTION pthread_mutex_lock(&mALLOC_MUTEx) # define MALLOC_POSTACTION pthread_mutex_unlock(&mALLOC_MUTEx) # endif /* USE_MALLOC_LOCK */ # else /* Substitute anything you like for these */ # define MALLOC_PREACTION (0) # define MALLOC_POSTACTION (0) # endif Void_t* public_mALLOc(size_t bytes) { Void_t* m; if (MALLOC_PREACTION != 0) { return 0; } m = mALLOc(bytes); if (MALLOC_POSTACTION != 0) { } return m; } void public_fREe(Void_t* m) { if (MALLOC_PREACTION != 0) { return; } fREe(m); if (MALLOC_POSTACTION != 0) { } } Void_t* public_rEALLOc(Void_t* m, size_t bytes) { if (MALLOC_PREACTION != 0) { return 0; } m = rEALLOc(m, bytes); if (MALLOC_POSTACTION != 0) { } return m; } Void_t* public_mEMALIGn(size_t alignment, size_t bytes) { Void_t* m; if (MALLOC_PREACTION != 0) { return 0; } m = mEMALIGn(alignment, bytes); if (MALLOC_POSTACTION != 0) { } return m; } Void_t* public_vALLOc(size_t bytes) { Void_t* m; if (MALLOC_PREACTION != 0) { return 0; } m = vALLOc(bytes); if (MALLOC_POSTACTION != 0) { } return m; } Void_t* public_pVALLOc(size_t bytes) { Void_t* m; if (MALLOC_PREACTION != 0) { return 0; } m = pVALLOc(bytes); if (MALLOC_POSTACTION != 0) { } return m; } Void_t* public_cALLOc(size_t n, size_t elem_size) { Void_t* m; if (MALLOC_PREACTION != 0) { return 0; } m = cALLOc(n, elem_size); if (MALLOC_POSTACTION != 0) { } return m; } Void_t** public_iCALLOc(size_t n, size_t elem_size, Void_t** chunks) { Void_t** m; if (MALLOC_PREACTION != 0) { return 0; } m = iCALLOc(n, elem_size, chunks); if (MALLOC_POSTACTION != 0) { } return m; } Void_t** public_iCOMALLOc(size_t n, size_t sizes[], Void_t** chunks) { Void_t** m; if (MALLOC_PREACTION != 0) { return 0; } m = iCOMALLOc(n, sizes, chunks); if (MALLOC_POSTACTION != 0) { } return m; } void public_cFREe(Void_t* m) { if (MALLOC_PREACTION != 0) { return; } cFREe(m); if (MALLOC_POSTACTION != 0) { } } int public_mTRIm(size_t s) { int result; if (MALLOC_PREACTION != 0) { return 0; } result = mTRIm(s); if (MALLOC_POSTACTION != 0) { } return result; } size_t public_mUSABLe(Void_t* m) { size_t result; if (MALLOC_PREACTION != 0) { return 0; } result = mUSABLe(m); if (MALLOC_POSTACTION != 0) { } return result; } void public_mSTATs() { if (MALLOC_PREACTION != 0) { return; } mSTATs(); if (MALLOC_POSTACTION != 0) { } } struct mallinfo public_mALLINFo() { struct mallinfo m; if (MALLOC_PREACTION != 0) { struct mallinfo nm = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; return nm; } m = mALLINFo(); if (MALLOC_POSTACTION != 0) { } return m; } int public_mALLOPt(int p, int v) { int result; if (MALLOC_PREACTION != 0) { return 0; } result = mALLOPt(p, v); if (MALLOC_POSTACTION != 0) { } return result; } #endif /* ------------- Optional versions of memcopy ---------------- */ #if USE_MEMCPY /* Note: memcpy is ONLY invoked with non-overlapping regions, so the (usually slower) memmove is not needed. */ # define MALLOC_COPY(dest, src, nbytes) memcpy((dest), (src), (nbytes)) # define MALLOC_ZERO(dest, nbytes) memset((dest), 0, (nbytes)) #else /* !USE_MEMCPY */ /* Use Duff's device for good zeroing/copying performance. */ # define MALLOC_ZERO(charp, nbytes) \ do { \ INTERNAL_SIZE_T* mzp = (INTERNAL_SIZE_T*)(charp); \ CHUNK_SIZE_T mctmp = (nbytes)/sizeof (INTERNAL_SIZE_T); \ long mcn; \ if (mctmp < 8) mcn = 0; else { mcn = (mctmp-1)/8; mctmp %= 8; } \ switch (mctmp) { \ case 0: for (;;) { *mzp++ = 0; \ case 7: *mzp++ = 0; \ case 6: *mzp++ = 0; \ case 5: *mzp++ = 0; \ case 4: *mzp++ = 0; \ case 3: *mzp++ = 0; \ case 2: *mzp++ = 0; \ case 1: *mzp++ = 0; if (mcn <= 0) break; --mcn; } \ } \ } while (0) # define MALLOC_COPY(dest,src,nbytes) \ do { \ INTERNAL_SIZE_T* mcsrc = (INTERNAL_SIZE_T*) (src); \ INTERNAL_SIZE_T* mcdst = (INTERNAL_SIZE_T*) (dest); \ CHUNK_SIZE_T mctmp = (nbytes)/sizeof (INTERNAL_SIZE_T); \ long mcn; \ if (mctmp < 8) mcn = 0; else { mcn = (mctmp-1)/8; mctmp %= 8; } \ switch (mctmp) { \ case 0: for (;;) { *mcdst++ = *mcsrc++; \ case 7: *mcdst++ = *mcsrc++; \ case 6: *mcdst++ = *mcsrc++; \ case 5: *mcdst++ = *mcsrc++; \ case 4: *mcdst++ = *mcsrc++; \ case 3: *mcdst++ = *mcsrc++; \ case 2: *mcdst++ = *mcsrc++; \ case 1: *mcdst++ = *mcsrc++; if (mcn <= 0) break; --mcn; } \ } \ } while (0) #endif /* ------------------ MMAP support ------------------ */ #if HAVE_MMAP # ifndef LACKS_FCNTL_H # include # endif # ifndef LACKS_SYS_MMAN_H # include # endif # if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) # define MAP_ANONYMOUS MAP_ANON # endif /* Nearly all versions of mmap support MAP_ANONYMOUS, so the following is unlikely to be needed, but is supplied just in case. */ # ifndef MAP_ANONYMOUS static int dev_zero_fd = -1; /* Cached file descriptor for /dev/zero. */ # define MMAP(addr, size, prot, flags) ((dev_zero_fd < 0) ? \ (dev_zero_fd = open("/dev/zero", O_RDWR), \ mmap((addr), (size), (prot), (flags), dev_zero_fd, 0)) : \ mmap((addr), (size), (prot), (flags), dev_zero_fd, 0)) # else # define MMAP(addr, size, prot, flags) \ (mmap((addr), (size), (prot), (flags)|MAP_ANONYMOUS, -1, 0)) # endif #endif /* HAVE_MMAP */ /* ----------------------- Chunk representations ----------------------- */ /* This struct declaration is misleading (but accurate and necessary). It declares a "view" into memory allowing access to necessary fields at known offsets from a given base. See explanation below. */ struct malloc_chunk { INTERNAL_SIZE_T prev_size; /* Size of previous chunk (if free). */ INTERNAL_SIZE_T size; /* Size in bytes, including overhead. */ struct malloc_chunk* fd; /* double links -- used only if free. */ struct malloc_chunk* bk; }; typedef struct malloc_chunk* mchunkptr; /* malloc_chunk details: (The following includes lightly edited explanations by Colin Plumb.) Chunks of memory are maintained using a `boundary tag' method as described in e.g., Knuth or Standish. (See the paper by Paul Wilson ftp://ftp.cs.utexas.edu/pub/garbage/allocsrv.ps for a survey of such techniques.) Sizes of free chunks are stored both in the front of each chunk and at the end. This makes consolidating fragmented chunks into bigger chunks very fast. The size fields also hold bits representing whether chunks are free or in use. An allocated chunk looks like this: chunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Size of previous chunk, if allocated | | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Size of chunk, in bytes |P| mem-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | User data starts here... . . . . (malloc_usable_space() bytes) . . | nextchunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Size of chunk | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ Where "chunk" is the front of the chunk for the purpose of most of the malloc code, but "mem" is the pointer that is returned to the user. "Nextchunk" is the beginning of the next contiguous chunk. Chunks always begin on even word boundaries, so the mem portion (which is returned to the user) is also on an even word boundary, and thus at least double-word aligned. Free chunks are stored in circular doubly-linked lists, and look like this: chunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Size of previous chunk | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ `head:' | Size of chunk, in bytes |P| mem-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Forward pointer to next chunk in list | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Back pointer to previous chunk in list | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Unused space (may be 0 bytes long) . . . . | nextchunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ `foot:' | Size of chunk, in bytes | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ The P (PREV_INUSE) bit, stored in the unused low-order bit of the chunk size (which is always a multiple of two words), is an in-use bit for the *previous* chunk. If that bit is *clear*, then the word before the current chunk size contains the previous chunk size, and can be used to find the front of the previous chunk. The very first chunk allocated always has this bit set, preventing access to non-existent (or non-owned) memory. If prev_inuse is set for any given chunk, then you CANNOT determine the size of the previous chunk, and might even get a memory addressing fault when trying to do so. Note that the `foot' of the current chunk is actually represented as the prev_size of the NEXT chunk. This makes it easier to deal with alignments etc but can be very confusing when trying to extend or adapt this code. The two exceptions to all this are 1. The special chunk `top' doesn't bother using the trailing size field since there is no next contiguous chunk that would have to index off it. After initialization, `top' is forced to always exist. If it would become less than MINSIZE bytes long, it is replenished. 2. Chunks allocated via mmap, which have the second-lowest-order bit (IS_MMAPPED) set in their size fields. Because they are allocated one-by-one, each must contain its own trailing size field. */ /* ---------- Size and alignment checks and conversions ---------- */ /* conversion from malloc headers to user pointers, and back */ #define chunk2mem(p) ((Void_t*)((char*)(p) + 2*SIZE_SZ)) #define mem2chunk(mem) ((mchunkptr)((char*)(mem) - 2*SIZE_SZ)) /* The smallest possible chunk */ #define MIN_CHUNK_SIZE (sizeof (struct malloc_chunk)) /* The smallest size we can malloc is an aligned minimal chunk */ #define MINSIZE \ (CHUNK_SIZE_T)(((MIN_CHUNK_SIZE+MALLOC_ALIGN_MASK) & ~MALLOC_ALIGN_MASK)) /* Check if m has acceptable alignment */ #define aligned_OK(m) (((PTR_UINT)((m)) & (MALLOC_ALIGN_MASK)) == 0) /* Check if a request is so large that it would wrap around zero when padded and aligned. To simplify some other code, the bound is made low enough so that adding MINSIZE will also not wrap around sero. */ #define REQUEST_OUT_OF_RANGE(req) \ ((CHUNK_SIZE_T)(req) >= \ (CHUNK_SIZE_T)(INTERNAL_SIZE_T)(-2 * MINSIZE)) /* pad request bytes into a usable size -- internal version */ #define request2size(req) \ (((req) + SIZE_SZ + MALLOC_ALIGN_MASK < MINSIZE) ? \ MINSIZE : \ ((req) + SIZE_SZ + MALLOC_ALIGN_MASK) & ~MALLOC_ALIGN_MASK) /* Same, except also perform argument check */ #define checked_request2size(req, sz) \ if (REQUEST_OUT_OF_RANGE(req)) { \ MALLOC_FAILURE_ACTION; \ return 0; \ } \ (sz) = request2size(req); /* --------------- Physical chunk operations --------------- */ /* size field is or'ed with PREV_INUSE when previous adjacent chunk in use */ #define PREV_INUSE 0x1 /* extract inuse bit of previous chunk */ #define prev_inuse(p) ((p)->size & PREV_INUSE) /* size field is or'ed with IS_MMAPPED if the chunk was obtained with mmap() */ #define IS_MMAPPED 0x2 /* check for mmap()'ed chunk */ #define chunk_is_mmapped(p) ((p)->size & IS_MMAPPED) /* Bits to mask off when extracting size Note: IS_MMAPPED is intentionally not masked off from size field in macros for which mmapped chunks should never be seen. This should cause helpful core dumps to occur if it is tried by accident by people extending or adapting this malloc. */ #define SIZE_BITS (PREV_INUSE|IS_MMAPPED) /* Get size, ignoring use bits */ #define chunksize(p) ((p)->size & ~(SIZE_BITS)) /* Ptr to next physical malloc_chunk. */ #define next_chunk(p) ((mchunkptr)(((char*)(p)) + ((p)->size & ~PREV_INUSE))) /* Ptr to previous physical malloc_chunk */ #define prev_chunk(p) ((mchunkptr)(((char*)(p)) - ((p)->prev_size))) /* Treat space at ptr + offset as a chunk */ #define chunk_at_offset(p, s) ((mchunkptr)(((char*)(p)) + (s))) /* extract p's inuse bit */ #define inuse(p)\ ((((mchunkptr)(((char*)(p))+((p)->size & ~PREV_INUSE)))->size) & PREV_INUSE) /* set/clear chunk as being inuse without otherwise disturbing */ #define set_inuse(p)\ ((mchunkptr)(((char*)(p)) + ((p)->size & ~PREV_INUSE)))->size |= PREV_INUSE #define clear_inuse(p)\ ((mchunkptr)(((char*)(p)) + ((p)->size & ~PREV_INUSE)))->size &= ~(PREV_INUSE) /* check/set/clear inuse bits in known places */ #define inuse_bit_at_offset(p, s)\ (((mchunkptr)(((char*)(p)) + (s)))->size & PREV_INUSE) #define set_inuse_bit_at_offset(p, s)\ (((mchunkptr)(((char*)(p)) + (s)))->size |= PREV_INUSE) #define clear_inuse_bit_at_offset(p, s)\ (((mchunkptr)(((char*)(p)) + (s)))->size &= ~(PREV_INUSE)) /* Set size at head, without disturbing its use bit */ #define set_head_size(p, s) ((p)->size = (((p)->size & PREV_INUSE) | (s))) /* Set size/use field */ #define set_head(p, s) ((p)->size = (s)) /* Set size at footer (only when chunk is not in use) */ #define set_foot(p, s) (((mchunkptr)((char*)(p) + (s)))->prev_size = (s)) /* -------------------- Internal data structures -------------------- All internal state is held in an instance of malloc_state defined below. There are no other static variables, except in two optional cases: * If USE_MALLOC_LOCK is defined, the mALLOC_MUTEx declared above. * If HAVE_MMAP is true, but mmap doesn't support MAP_ANONYMOUS, a dummy file descriptor for mmap. Beware of lots of tricks that minimize the total bookkeeping space requirements. The result is a little over 1K bytes (for 4byte pointers and size_t.) */ /* Bins An array of bin headers for free chunks. Each bin is doubly linked. The bins are approximately proportionally (log) spaced. There are a lot of these bins (128). This may look excessive, but works very well in practice. Most bins hold sizes that are unusual as malloc request sizes, but are more usual for fragments and consolidated sets of chunks, which is what these bins hold, so they can be found quickly. All procedures maintain the invariant that no consolidated chunk physically borders another one, so each chunk in a list is known to be preceded and followed by either inuse chunks or the ends of memory. Chunks in bins are kept in size order, with ties going to the approximately least recently used chunk. Ordering isn't needed for the small bins, which all contain the same-sized chunks, but facilitates best-fit allocation for larger chunks. These lists are just sequential. Keeping them in order almost never requires enough traversal to warrant using fancier ordered data structures. Chunks of the same size are linked with the most recently freed at the front, and allocations are taken from the back. This results in LRU (FIFO) allocation order, which tends to give each chunk an equal opportunity to be consolidated with adjacent freed chunks, resulting in larger free chunks and less fragmentation. To simplify use in double-linked lists, each bin header acts as a malloc_chunk. This avoids special-casing for headers. But to conserve space and improve locality, we allocate only the fd/bk pointers of bins, and then use repositioning tricks to treat these as the fields of a malloc_chunk*. */ typedef struct malloc_chunk* mbinptr; /* addressing -- note that bin_at(0) does not exist */ #define bin_at(m, i) ((mbinptr)((char*)&((m)->bins[(i)<<1]) - (SIZE_SZ<<1))) /* analog of ++bin */ #define next_bin(b) ((mbinptr)((char*)(b) + (sizeof (mchunkptr)<<1))) /* Reminders about list directionality within bins */ #define first(b) ((b)->fd) #define last(b) ((b)->bk) /* Take a chunk off a bin list */ #define unlink(P, BK, FD) { \ (FD) = (P)->fd; \ (BK) = (P)->bk; \ (FD)->bk = (BK); \ (BK)->fd = (FD); \ } /* Indexing Bins for sizes < 512 bytes contain chunks of all the same size, spaced 8 bytes apart. Larger bins are approximately logarithmically spaced: 64 bins of size 8 32 bins of size 64 16 bins of size 512 8 bins of size 4096 4 bins of size 32768 2 bins of size 262144 1 bin of size what's left The bins top out around 1MB because we expect to service large requests via mmap. */ #define NBINS 96 #define NSMALLBINS 32 #define SMALLBIN_WIDTH 8 #define MIN_LARGE_SIZE 256 #define in_smallbin_range(sz) \ ((CHUNK_SIZE_T)(sz) < (CHUNK_SIZE_T)MIN_LARGE_SIZE) #define smallbin_index(sz) (((unsigned)(sz)) >> 3) /* Compute index for size. We expect this to be inlined when compiled with optimization, else not, which works out well. */ static int largebin_index(unsigned int sz) { unsigned int x = sz >> SMALLBIN_WIDTH; unsigned int m; /* bit position of highest set bit of m */ if (x >= 0x10000) return NBINS-1; /* On intel, use BSRL instruction to find highest bit */ #if defined(__GNUC__) && defined(i386) __asm__("bsrl %1,%0\n\t" : "=r" (m) : "g" (x)); #else { /* Based on branch-free nlz algorithm in chapter 5 of Henry S. Warren Jr's book "Hacker's Delight". */ unsigned int n = ((x - 0x100) >> 16) & 8; x <<= n; m = ((x - 0x1000) >> 16) & 4; n += m; x <<= m; m = ((x - 0x4000) >> 16) & 2; n += m; x = (x << m) >> 14; m = 13 - n + (x & ~(x>>1)); } #endif /* Use next 2 bits to create finer-granularity bins */ return NSMALLBINS + (m << 2) + ((sz >> (m + 6)) & 3); } #define bin_index(sz) \ ((in_smallbin_range(sz)) ? smallbin_index(sz) : largebin_index(sz)) /* FIRST_SORTED_BIN_SIZE is the chunk size corresponding to the first bin that is maintained in sorted order. This must be the smallest size corresponding to a given bin. Normally, this should be MIN_LARGE_SIZE. But you can weaken best fit guarantees to sometimes speed up malloc by increasing value. Doing this means that malloc may choose a chunk that is non-best-fitting by up to the width of the bin. Some useful cutoff values: 512 - all bins sorted 2560 - leaves bins <= 64 bytes wide unsorted 12288 - leaves bins <= 512 bytes wide unsorted 65536 - leaves bins <= 4096 bytes wide unsorted 262144 - leaves bins <= 32768 bytes wide unsorted -1 - no bins sorted (not recommended!) */ #define FIRST_SORTED_BIN_SIZE MIN_LARGE_SIZE /* #define FIRST_SORTED_BIN_SIZE 65536 */ /* Unsorted chunks All remainders from chunk splits, as well as all returned chunks, are first placed in the "unsorted" bin. They are then placed in regular bins after malloc gives them ONE chance to be used before binning. So, basically, the unsorted_chunks list acts as a queue, with chunks being placed on it in free (and malloc_consolidate), and taken off (to be either used or placed in bins) in malloc. */ /* The otherwise unindexable 1-bin is used to hold unsorted chunks. */ #define unsorted_chunks(M) (bin_at((M), 1)) /* Top The top-most available chunk (i.e., the one bordering the end of available memory) is treated specially. It is never included in any bin, is used only if no other chunk is available, and is released back to the system if it is very large (see M_TRIM_THRESHOLD). Because top initially points to its own bin with initial zero size, thus forcing extension on the first malloc request, we avoid having any special code in malloc to check whether it even exists yet. But we still need to do so when getting memory from system, so we make initial_top treat the bin as a legal but unusable chunk during the interval between initialization and the first call to sYSMALLOc. (This is somewhat delicate, since it relies on the 2 preceding words to be zero during this interval as well.) */ /* Conveniently, the unsorted bin can be used as dummy top on first call */ #define initial_top(M) (unsorted_chunks(M)) /* Binmap To help compensate for the large number of bins, a one-level index structure is used for bin-by-bin searching. `binmap' is a bitvector recording whether bins are definitely empty so they can be skipped over during traversals. The bits are NOT always cleared as soon as bins are empty, but instead only when they are noticed to be empty during traversal in malloc. */ /* Conservatively use 32 bits per map word, even if on 64bit system */ #define BINMAPSHIFT 5 #define BITSPERMAP (1U << BINMAPSHIFT) #define BINMAPSIZE (NBINS / BITSPERMAP) #define idx2block(i) ((i) >> BINMAPSHIFT) #define idx2bit(i) ((1U << ((i) & ((1U << BINMAPSHIFT)-1)))) #define mark_bin(m,i) ((m)->binmap[idx2block(i)] |= idx2bit(i)) #define unmark_bin(m,i) ((m)->binmap[idx2block(i)] &= ~(idx2bit(i))) #define get_binmap(m,i) ((m)->binmap[idx2block(i)] & idx2bit(i)) /* Fastbins An array of lists holding recently freed small chunks. Fastbins are not doubly linked. It is faster to single-link them, and since chunks are never removed from the middles of these lists, double linking is not necessary. Also, unlike regular bins, they are not even processed in FIFO order (they use faster LIFO) since ordering doesn't much matter in the transient contexts in which fastbins are normally used. Chunks in fastbins keep their inuse bit set, so they cannot be consolidated with other free chunks. malloc_consolidate releases all chunks in fastbins and consolidates them with other free chunks. */ typedef struct malloc_chunk* mfastbinptr; /* offset 2 to use otherwise unindexable first 2 bins */ #define fastbin_index(sz) ((((unsigned int)(sz)) >> 3) - 2) /* The maximum fastbin request size we support */ #define MAX_FAST_SIZE 80 #define NFASTBINS (fastbin_index(request2size(MAX_FAST_SIZE))+1) /* FASTBIN_CONSOLIDATION_THRESHOLD is the size of a chunk in free() that triggers automatic consolidation of possibly-surrounding fastbin chunks. This is a heuristic, so the exact value should not matter too much. It is defined at half the default trim threshold as a compromise heuristic to only attempt consolidation if it is likely to lead to trimming. However, it is not dynamically tunable, since consolidation reduces fragmentation surrounding loarge chunks even if trimming is not used. */ #define FASTBIN_CONSOLIDATION_THRESHOLD \ ((unsigned long)(DEFAULT_TRIM_THRESHOLD) >> 1) /* Since the lowest 2 bits in max_fast don't matter in size comparisons, they are used as flags. */ /* ANYCHUNKS_BIT held in max_fast indicates that there may be any freed chunks at all. It is set true when entering a chunk into any bin. */ #define ANYCHUNKS_BIT (1U) #define have_anychunks(M) (((M)->max_fast & ANYCHUNKS_BIT)) #define set_anychunks(M) ((M)->max_fast |= ANYCHUNKS_BIT) #define clear_anychunks(M) ((M)->max_fast &= ~ANYCHUNKS_BIT) /* FASTCHUNKS_BIT held in max_fast indicates that there are probably some fastbin chunks. It is set true on entering a chunk into any fastbin, and cleared only in malloc_consolidate. */ #define FASTCHUNKS_BIT (2U) #define have_fastchunks(M) (((M)->max_fast & FASTCHUNKS_BIT)) #define set_fastchunks(M) ((M)->max_fast |= (FASTCHUNKS_BIT|ANYCHUNKS_BIT)) #define clear_fastchunks(M) ((M)->max_fast &= ~(FASTCHUNKS_BIT)) /* Set value of max_fast. Use impossibly small value if 0. */ #define set_max_fast(M, s) \ (M)->max_fast = (((s) == 0)? SMALLBIN_WIDTH: request2size(s)) | \ ((M)->max_fast & (FASTCHUNKS_BIT|ANYCHUNKS_BIT)) #define get_max_fast(M) \ ((M)->max_fast & ~(FASTCHUNKS_BIT | ANYCHUNKS_BIT)) /* morecore_properties is a status word holding dynamically discovered or controlled properties of the morecore function */ #define MORECORE_CONTIGUOUS_BIT (1U) #define contiguous(M) \ (((M)->morecore_properties & MORECORE_CONTIGUOUS_BIT)) #define noncontiguous(M) \ (((M)->morecore_properties & MORECORE_CONTIGUOUS_BIT) == 0) #define set_contiguous(M) \ ((M)->morecore_properties |= MORECORE_CONTIGUOUS_BIT) #define set_noncontiguous(M) \ ((M)->morecore_properties &= ~MORECORE_CONTIGUOUS_BIT) /* ----------- Internal state representation and initialization ----------- */ struct malloc_state { /* The maximum chunk size to be eligible for fastbin */ INTERNAL_SIZE_T max_fast; /* low 2 bits used as flags */ /* Fastbins */ mfastbinptr fastbins[NFASTBINS]; /* Base of the topmost chunk -- not otherwise kept in a bin */ mchunkptr top; /* The remainder from the most recent split of a small request */ mchunkptr last_remainder; /* Normal bins packed as described above */ mchunkptr bins[NBINS * 2]; /* Bitmap of bins. Trailing zero map handles cases of largest binned size */ unsigned int binmap[BINMAPSIZE+1]; /* Tunable parameters */ CHUNK_SIZE_T trim_threshold; INTERNAL_SIZE_T top_pad; INTERNAL_SIZE_T mmap_threshold; /* Memory map support */ int n_mmaps; int n_mmaps_max; int max_n_mmaps; /* Cache malloc_getpagesize */ unsigned int pagesize; /* Track properties of MORECORE */ unsigned int morecore_properties; /* Statistics */ INTERNAL_SIZE_T mmapped_mem; INTERNAL_SIZE_T sbrked_mem; INTERNAL_SIZE_T max_sbrked_mem; INTERNAL_SIZE_T max_mmapped_mem; INTERNAL_SIZE_T max_total_mem; }; typedef struct malloc_state *mstate; /* There is exactly one instance of this struct in this malloc. If you are adapting this malloc in a way that does NOT use a static malloc_state, you MUST explicitly zero-fill it before using. This malloc relies on the property that malloc_state is initialized to all zeroes (as is true of C statics). */ static struct malloc_state av_; /* never directly referenced */ /* All uses of av_ are via get_malloc_state(). At most one "call" to get_malloc_state is made per invocation of the public versions of malloc and free, but other routines that in turn invoke malloc and/or free may call more then once. Also, it is called in check* routines if DEBUG is set. */ #define get_malloc_state() (&(av_)) /* Initialize a malloc_state struct. This is called only from within malloc_consolidate, which needs be called in the same contexts anyway. It is never called directly outside of malloc_consolidate because some optimizing compilers try to inline it at all call points, which turns out not to be an optimization at all. (Inlining it in malloc_consolidate is fine though.) */ #if __STD_C static void malloc_init_state(mstate av) #else static void malloc_init_state(av) mstate av; #endif { int i; mbinptr bin; /* Establish circular links for normal bins */ for (i = 1; i < NBINS; ++i) { bin = bin_at(av,i); bin->fd = bin->bk = bin; } av->top_pad = DEFAULT_TOP_PAD; av->n_mmaps_max = DEFAULT_MMAP_MAX; av->mmap_threshold = DEFAULT_MMAP_THRESHOLD; av->trim_threshold = DEFAULT_TRIM_THRESHOLD; #if MORECORE_CONTIGUOUS set_contiguous(av); #else set_noncontiguous(av); #endif set_max_fast(av, DEFAULT_MXFAST); av->top = initial_top(av); av->pagesize = malloc_getpagesize; } /* Other internal utilities operating on mstates */ #if __STD_C static Void_t* sYSMALLOc(INTERNAL_SIZE_T, mstate); static int sYSTRIm(size_t, mstate); static void malloc_consolidate(mstate); static Void_t** iALLOc(size_t, size_t*, int, Void_t**); #else static Void_t* sYSMALLOc(); static int sYSTRIm(); static void malloc_consolidate(); static Void_t** iALLOc(); #endif /* Debugging support These routines make a number of assertions about the states of data structures that should be true at all times. If any are not true, it's very likely that a user program has somehow trashed memory. (It's also possible that there is a coding error in malloc. In which case, please report it!) */ #if ! DEBUG # define check_chunk(P) # define check_free_chunk(P) # define check_inuse_chunk(P) # define check_remalloced_chunk(P,N) # define check_malloced_chunk(P,N) # define check_malloc_state() #else # define check_chunk(P) do_check_chunk((P)) # define check_free_chunk(P) do_check_free_chunk((P)) # define check_inuse_chunk(P) do_check_inuse_chunk((P)) # define check_remalloced_chunk(P,N) do_check_remalloced_chunk((P),(N)) # define check_malloced_chunk(P,N) do_check_malloced_chunk((P),(N)) # define check_malloc_state() do_check_malloc_state() /* Properties of all chunks */ # if __STD_C static void do_check_chunk(mchunkptr p) # else static void do_check_chunk(p) mchunkptr p; # endif { mstate av = get_malloc_state(); CHUNK_SIZE_T sz = chunksize(p); /* min and max possible addresses assuming contiguous allocation */ char* max_address = (char*)(av->top) + chunksize(av->top); char* min_address = max_address - av->sbrked_mem; if (!chunk_is_mmapped(p)) { /* Has legal address ... */ if (p != av->top) { if (contiguous(av)) { assert(((char*)p) >= min_address); assert(((char*)p + sz) <= ((char*)(av->top))); } } else { /* top size is always at least MINSIZE */ assert((CHUNK_SIZE_T)(sz) >= MINSIZE); /* top predecessor always marked inuse */ assert(prev_inuse(p)); } } else { # if HAVE_MMAP /* address is outside main heap */ if (contiguous(av) && av->top != initial_top(av)) { assert(((char*)p) < min_address || ((char*)p) > max_address); } /* chunk is page-aligned */ assert(((p->prev_size + sz) & (av->pagesize-1)) == 0); /* mem is aligned */ assert(aligned_OK(chunk2mem(p))); # else /* force an appropriate assert violation if debug set */ assert(!chunk_is_mmapped(p)); # endif } } /* Properties of free chunks */ # if __STD_C static void do_check_free_chunk(mchunkptr p) # else static void do_check_free_chunk(p) mchunkptr p; # endif { mstate av = get_malloc_state(); INTERNAL_SIZE_T sz = p->size & ~PREV_INUSE; mchunkptr next = chunk_at_offset(p, sz); do_check_chunk(p); /* Chunk must claim to be free ... */ assert(!inuse(p)); assert (!chunk_is_mmapped(p)); /* Unless a special marker, must have OK fields */ if ((CHUNK_SIZE_T)(sz) >= MINSIZE) { assert((sz & MALLOC_ALIGN_MASK) == 0); assert(aligned_OK(chunk2mem(p))); /* ... matching footer field */ assert(next->prev_size == sz); /* ... and is fully consolidated */ assert(prev_inuse(p)); assert (next == av->top || inuse(next)); /* ... and has minimally sane links */ assert(p->fd->bk == p); assert(p->bk->fd == p); } else /* markers are always of size SIZE_SZ */ assert(sz == SIZE_SZ); } /* Properties of inuse chunks */ # if __STD_C static void do_check_inuse_chunk(mchunkptr p) # else static void do_check_inuse_chunk(p) mchunkptr p; # endif { mstate av = get_malloc_state(); mchunkptr next; do_check_chunk(p); if (chunk_is_mmapped(p)) return; /* mmapped chunks have no next/prev */ /* Check whether it claims to be in use ... */ assert(inuse(p)); next = next_chunk(p); /* ... and is surrounded by OK chunks. Since more things can be checked with free chunks than inuse ones, if an inuse chunk borders them and debug is on, it's worth doing them. */ if (!prev_inuse(p)) { /* Note that we cannot even look at prev unless it is not inuse */ mchunkptr prv = prev_chunk(p); assert(next_chunk(prv) == p); do_check_free_chunk(prv); } if (next == av->top) { assert(prev_inuse(next)); assert(chunksize(next) >= MINSIZE); } else if (!inuse(next)) do_check_free_chunk(next); } /* Properties of chunks recycled from fastbins */ # if __STD_C static void do_check_remalloced_chunk(mchunkptr p, INTERNAL_SIZE_T s) # else static void do_check_remalloced_chunk(p, s) mchunkptr p; INTERNAL_SIZE_T s; # endif { INTERNAL_SIZE_T sz = p->size & ~PREV_INUSE; do_check_inuse_chunk(p); /* Legal size ... */ assert((sz & MALLOC_ALIGN_MASK) == 0); assert((CHUNK_SIZE_T)(sz) >= MINSIZE); /* ... and alignment */ assert(aligned_OK(chunk2mem(p))); /* chunk is less than MINSIZE more than request */ assert((long)(sz) - (long)(s) >= 0); assert((long)(sz) - (long)(s + MINSIZE) < 0); } /* Properties of nonrecycled chunks at the point they are malloced */ # if __STD_C static void do_check_malloced_chunk(mchunkptr p, INTERNAL_SIZE_T s) # else static void do_check_malloced_chunk(p, s) mchunkptr p; INTERNAL_SIZE_T s; # endif { /* same as recycled case ... */ do_check_remalloced_chunk(p, s); /* ... plus, must obey implementation invariant that prev_inuse is always true of any allocated chunk; i.e., that each allocated chunk borders either a previously allocated and still in-use chunk, or the base of its memory arena. This is ensured by making all allocations from the `lowest' part of any found chunk. This does not necessarily hold however for chunks recycled via fastbins. */ assert(prev_inuse(p)); } /* Properties of malloc_state. This may be useful for debugging malloc, as well as detecting user programmer errors that somehow write into malloc_state. If you are extending or experimenting with this malloc, you can probably figure out how to hack this routine to print out or display chunk addresses, sizes, bins, and other instrumentation. */ static void do_check_malloc_state() { mstate av = get_malloc_state(); int i; mchunkptr p; mchunkptr q; mbinptr b; unsigned int binbit; int empty; unsigned int idx; INTERNAL_SIZE_T size; CHUNK_SIZE_T total = 0; int max_fast_bin; /* internal size_t must be no wider than pointer type */ assert(sizeof (INTERNAL_SIZE_T) <= sizeof (char*)); /* alignment is a power of 2 */ assert((MALLOC_ALIGNMENT & (MALLOC_ALIGNMENT-1)) == 0); /* cannot run remaining checks until fully initialized */ if (av->top == 0 || av->top == initial_top(av)) return; /* pagesize is a power of 2 */ assert((av->pagesize & (av->pagesize-1)) == 0); /* properties of fastbins */ /* max_fast is in allowed range */ assert(get_max_fast(av) <= request2size(MAX_FAST_SIZE)); max_fast_bin = fastbin_index(av->max_fast); for (i = 0; i < NFASTBINS; ++i) { p = av->fastbins[i]; /* all bins past max_fast are empty */ if (i > max_fast_bin) assert(p == 0); while (p != 0) { /* each chunk claims to be inuse */ do_check_inuse_chunk(p); total += chunksize(p); /* chunk belongs in this bin */ assert(fastbin_index(chunksize(p)) == i); p = p->fd; } } if (total != 0) assert(have_fastchunks(av)); else if (!have_fastchunks(av)) assert(total == 0); /* check normal bins */ for (i = 1; i < NBINS; ++i) { b = bin_at(av,i); /* binmap is accurate (except for bin 1 == unsorted_chunks) */ if (i >= 2) { binbit = get_binmap(av,i); empty = last(b) == b; if (!binbit) assert(empty); else if (!empty) assert(binbit); } for (p = last(b); p != b; p = p->bk) { /* each chunk claims to be free */ do_check_free_chunk(p); size = chunksize(p); total += size; if (i >= 2) { /* chunk belongs in bin */ idx = bin_index(size); assert(idx == i); /* lists are sorted */ if ((CHUNK_SIZE_T) size >= (CHUNK_SIZE_T)(FIRST_SORTED_BIN_SIZE)) { assert(p->bk == b || (CHUNK_SIZE_T)chunksize(p->bk) >= (CHUNK_SIZE_T)chunksize(p)); } } /* chunk is followed by a legal chain of inuse chunks */ for (q = next_chunk(p); (q != av->top && inuse(q) && (CHUNK_SIZE_T)(chunksize(q)) >= MINSIZE); q = next_chunk(q)) do_check_inuse_chunk(q); } } /* top chunk is OK */ check_chunk(av->top); /* sanity checks for statistics */ assert(total <= (CHUNK_SIZE_T)(av->max_total_mem)); assert(av->n_mmaps >= 0); assert(av->n_mmaps <= av->max_n_mmaps); assert((CHUNK_SIZE_T)(av->sbrked_mem) <= (CHUNK_SIZE_T)(av->max_sbrked_mem)); assert((CHUNK_SIZE_T)(av->mmapped_mem) <= (CHUNK_SIZE_T)(av->max_mmapped_mem)); assert((CHUNK_SIZE_T)(av->max_total_mem) >= (CHUNK_SIZE_T)(av->mmapped_mem) + (CHUNK_SIZE_T)(av->sbrked_mem)); } #endif /* ----------- Routines dealing with system allocation -------------- */ /* sysmalloc handles malloc cases requiring more memory from the system. On entry, it is assumed that av->top does not have enough space to service request for nb bytes, thus requiring that av->top be extended or replaced. */ #if __STD_C static Void_t* sYSMALLOc(INTERNAL_SIZE_T nb, mstate av) #else static Void_t* sYSMALLOc(nb, av) INTERNAL_SIZE_T nb; mstate av; #endif { mchunkptr old_top; /* incoming value of av->top */ INTERNAL_SIZE_T old_size; /* its size */ char* old_end; /* its end address */ long size; /* arg to first MORECORE or mmap call */ char* brk; /* return value from MORECORE */ long correction; /* arg to 2nd MORECORE call */ char* snd_brk; /* 2nd return val */ INTERNAL_SIZE_T front_misalign; /* unusable bytes at front of new space */ INTERNAL_SIZE_T end_misalign; /* partial page left at end of new space */ char* aligned_brk; /* aligned offset into brk */ mchunkptr p; /* the allocated/returned chunk */ mchunkptr remainder; /* remainder from allocation */ CHUNK_SIZE_T remainder_size; /* its size */ CHUNK_SIZE_T sum; /* for updating stats */ size_t pagemask = av->pagesize - 1; /* If there is space available in fastbins, consolidate and retry malloc from scratch rather than getting memory from system. This can occur only if nb is in smallbin range so we didn't consolidate upon entry to malloc. It is much easier to handle this case here than in malloc proper. */ if (have_fastchunks(av)) { assert(in_smallbin_range(nb)); malloc_consolidate(av); return mALLOc(nb - MALLOC_ALIGN_MASK); } #if HAVE_MMAP /* If have mmap, and the request size meets the mmap threshold, and the system supports mmap, and there are few enough currently allocated mmapped regions, try to directly map this request rather than expanding top. */ if ((CHUNK_SIZE_T)(nb) >= (CHUNK_SIZE_T)(av->mmap_threshold) && (av->n_mmaps < av->n_mmaps_max)) { char* mm; /* return value from mmap call*/ /* Round up size to nearest page. For mmapped chunks, the overhead is one SIZE_SZ unit larger than for normal chunks, because there is no following chunk whose prev_size field could be used. */ size = (nb + SIZE_SZ + MALLOC_ALIGN_MASK + pagemask) & ~pagemask; /* Don't try if size wraps around 0 */ if ((CHUNK_SIZE_T)(size) > (CHUNK_SIZE_T)(nb)) { mm = (char*)(MMAP(0, size, PROT_READ|PROT_WRITE, MAP_PRIVATE)); if (mm != (char*)(MORECORE_FAILURE)) { /* The offset to the start of the mmapped region is stored in the prev_size field of the chunk. This allows us to adjust returned start address to meet alignment requirements here and in memalign(), and still be able to compute proper address argument for later munmap in free() and realloc(). */ front_misalign = (INTERNAL_SIZE_T)chunk2mem(mm) & MALLOC_ALIGN_MASK; if (front_misalign > 0) { correction = MALLOC_ALIGNMENT - front_misalign; p = (mchunkptr)(mm + correction); p->prev_size = correction; set_head(p, (size - correction) |IS_MMAPPED); } else { p = (mchunkptr)mm; p->prev_size = 0; set_head(p, size|IS_MMAPPED); } /* update statistics */ if (++av->n_mmaps > av->max_n_mmaps) av->max_n_mmaps = av->n_mmaps; sum = av->mmapped_mem += size; if (sum > (CHUNK_SIZE_T)(av->max_mmapped_mem)) av->max_mmapped_mem = sum; sum += av->sbrked_mem; if (sum > (CHUNK_SIZE_T)(av->max_total_mem)) av->max_total_mem = sum; check_chunk(p); return chunk2mem(p); } } } #endif /* Record incoming configuration of top */ old_top = av->top; old_size = chunksize(old_top); old_end = (char*)(chunk_at_offset(old_top, old_size)); brk = snd_brk = (char*)(MORECORE_FAILURE); /* If not the first time through, we require old_size to be at least MINSIZE and to have prev_inuse set. */ assert((old_top == initial_top(av) && old_size == 0) || ((CHUNK_SIZE_T) (old_size) >= MINSIZE && prev_inuse(old_top))); /* Precondition: not enough current space to satisfy nb request */ assert((CHUNK_SIZE_T)(old_size) < (CHUNK_SIZE_T)(nb + MINSIZE)); /* Precondition: all fastbins are consolidated */ assert(!have_fastchunks(av)); /* Request enough space for nb + pad + overhead */ size = nb + av->top_pad + MINSIZE; /* If contiguous, we can subtract out existing space that we hope to combine with new space. We add it back later only if we don't actually get contiguous space. */ if (contiguous(av)) size -= old_size; /* Round to a multiple of page size. If MORECORE is not contiguous, this ensures that we only call it with whole-page arguments. And if MORECORE is contiguous and this is not first time through, this preserves page-alignment of previous calls. Otherwise, we correct to page-align below. */ size = (size + pagemask) & ~pagemask; /* Don't try to call MORECORE if argument is so big as to appear negative. Note that since mmap takes size_t arg, it may succeed below even if we cannot call MORECORE. */ if (size > 0) brk = (char*)(MORECORE(size)); /* If have mmap, try using it as a backup when MORECORE fails or cannot be used. This is worth doing on systems that have "holes" in address space, so sbrk cannot extend to give contiguous space, but space is available elsewhere. Note that we ignore mmap max count and threshold limits, since the space will not be used as a segregated mmap region. */ #if HAVE_MMAP if (brk == (char*)(MORECORE_FAILURE)) { /* Cannot merge with old top, so add its size back in */ if (contiguous(av)) size = (size + old_size + pagemask) & ~pagemask; /* If we are relying on mmap as backup, then use larger units */ if ((CHUNK_SIZE_T)(size) < (CHUNK_SIZE_T)(MMAP_AS_MORECORE_SIZE)) size = MMAP_AS_MORECORE_SIZE; /* Don't try if size wraps around 0 */ if ((CHUNK_SIZE_T)(size) > (CHUNK_SIZE_T)(nb)) { brk = (char*)(MMAP(0, size, PROT_READ|PROT_WRITE, MAP_PRIVATE)); if (brk != (char*)(MORECORE_FAILURE)) { /* We do not need, and cannot use, another sbrk call to find end */ snd_brk = brk + size; /* Record that we no longer have a contiguous sbrk region. After the first time mmap is used as backup, we do not ever rely on contiguous space since this could incorrectly bridge regions. */ set_noncontiguous(av); } } } #endif if (brk != (char*)(MORECORE_FAILURE)) { av->sbrked_mem += size; /* If MORECORE extends previous space, we can likewise extend top size. */ if (brk == old_end && snd_brk == (char*)(MORECORE_FAILURE)) { set_head(old_top, (size + old_size) | PREV_INUSE); } /* Otherwise, make adjustments: * If the first time through or noncontiguous, we need to call sbrk just to find out where the end of memory lies. * We need to ensure that all returned chunks from malloc will meet MALLOC_ALIGNMENT * If there was an intervening foreign sbrk, we need to adjust sbrk request size to account for fact that we will not be able to combine new space with existing space in old_top. * Almost all systems internally allocate whole pages at a time, in which case we might as well use the whole last page of request. So we allocate enough more memory to hit a page boundary now, which in turn causes future contiguous calls to page-align. */ else { front_misalign = 0; end_misalign = 0; correction = 0; aligned_brk = brk; /* If MORECORE returns an address lower than we have seen before, we know it isn't really contiguous. This and some subsequent checks help cope with non-conforming MORECORE functions and the presence of "foreign" calls to MORECORE from outside of malloc or by other threads. We cannot guarantee to detect these in all cases, but cope with the ones we do detect. */ if (contiguous(av) && old_size != 0 && brk < old_end) { set_noncontiguous(av); } /* handle contiguous cases */ if (contiguous(av)) { /* We can tolerate forward non-contiguities here (usually due to foreign calls) but treat them as part of our space for stats reporting. */ if (old_size != 0) av->sbrked_mem += brk - old_end; /* Guarantee alignment of first new chunk made from this space */ front_misalign = (INTERNAL_SIZE_T)chunk2mem(brk) & MALLOC_ALIGN_MASK; if (front_misalign > 0) { /* Skip over some bytes to arrive at an aligned position. We don't need to specially mark these wasted front bytes. They will never be accessed anyway because prev_inuse of av->top (and any chunk created from its start) is always true after initialization. */ correction = MALLOC_ALIGNMENT - front_misalign; aligned_brk += correction; } /* If this isn't adjacent to existing space, then we will not be able to merge with old_top space, so must add to 2nd request. */ correction += old_size; /* Extend the end address to hit a page boundary */ end_misalign = (INTERNAL_SIZE_T)(brk + size + correction); correction += ((end_misalign + pagemask) & ~pagemask) - end_misalign; assert(correction >= 0); snd_brk = (char*)(MORECORE(correction)); if (snd_brk == (char*)(MORECORE_FAILURE)) { /* If can't allocate correction, try to at least find out current brk. It might be enough to proceed without failing. */ correction = 0; snd_brk = (char*)(MORECORE(0)); } else if (snd_brk < brk) { /* If the second call gives noncontiguous space even though it says it won't, the only course of action is to ignore results of second call, and conservatively estimate where the first call left us. Also set noncontiguous, so this won't happen again, leaving at most one hole. Note that this check is intrinsically incomplete. Because MORECORE is allowed to give more space than we ask for, there is no reliable way to detect a noncontiguity producing a forward gap for the second call. */ snd_brk = brk + size; correction = 0; set_noncontiguous(av); } } /* handle non-contiguous cases */ else { /* MORECORE/mmap must correctly align */ assert(aligned_OK(chunk2mem(brk))); /* Find out current end of memory */ if (snd_brk == (char*)(MORECORE_FAILURE)) { snd_brk = (char*)(MORECORE(0)); av->sbrked_mem += snd_brk - brk - size; } } /* Adjust top based on results of second sbrk */ if (snd_brk != (char*)(MORECORE_FAILURE)) { av->top = (mchunkptr)aligned_brk; set_head(av->top, (snd_brk - aligned_brk + correction) | PREV_INUSE); av->sbrked_mem += correction; /* If not the first time through, we either have a gap due to foreign sbrk or a non-contiguous region. Insert a double fencepost at old_top to prevent consolidation with space we don't own. These fenceposts are artificial chunks that are marked as inuse and are in any case too small to use. We need two to make sizes and alignments work out. */ if (old_size != 0) { /* Shrink old_top to insert fenceposts, keeping size a multiple of MALLOC_ALIGNMENT. We know there is at least enough space in old_top to do this. */ old_size = (old_size - 3*SIZE_SZ) & ~MALLOC_ALIGN_MASK; set_head(old_top, old_size | PREV_INUSE); /* Note that the following assignments completely overwrite old_top when old_size was previously MINSIZE. This is intentional. We need the fencepost, even if old_top otherwise gets lost. */ chunk_at_offset(old_top, old_size)->size = SIZE_SZ|PREV_INUSE; chunk_at_offset(old_top, old_size + SIZE_SZ)->size = SIZE_SZ|PREV_INUSE; /* If possible, release the rest, suppressing trimming. */ if (old_size >= MINSIZE) { INTERNAL_SIZE_T tt = av->trim_threshold; av->trim_threshold = (INTERNAL_SIZE_T)(-1); fREe(chunk2mem(old_top)); av->trim_threshold = tt; } } } } /* Update statistics */ sum = av->sbrked_mem; if (sum > (CHUNK_SIZE_T)(av->max_sbrked_mem)) av->max_sbrked_mem = sum; sum += av->mmapped_mem; if (sum > (CHUNK_SIZE_T)(av->max_total_mem)) av->max_total_mem = sum; check_malloc_state(); /* finally, do the allocation */ p = av->top; size = chunksize(p); /* check that one of the above allocation paths succeeded */ if ((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(nb + MINSIZE)) { remainder_size = size - nb; remainder = chunk_at_offset(p, nb); av->top = remainder; set_head(p, nb | PREV_INUSE); set_head(remainder, remainder_size | PREV_INUSE); check_malloced_chunk(p, nb); return chunk2mem(p); } } /* catch all failure paths */ MALLOC_FAILURE_ACTION; return 0; } /* sYSTRIm is an inverse of sorts to sYSMALLOc. It gives memory back to the system (via negative arguments to sbrk) if there is unused memory at the `high' end of the malloc pool. It is called automatically by free() when top space exceeds the trim threshold. It is also called by the public malloc_trim routine. It returns 1 if it actually released any memory, else 0. */ #if __STD_C static int sYSTRIm(size_t pad, mstate av) #else static int sYSTRIm(pad, av) size_t pad; mstate av; #endif { long top_size; /* Amount of top-most memory */ long extra; /* Amount to release */ long released; /* Amount actually released */ char* current_brk; /* address returned by pre-check sbrk call */ char* new_brk; /* address returned by post-check sbrk call */ size_t pagesz; pagesz = av->pagesize; top_size = chunksize(av->top); /* Release in pagesize units, keeping at least one page */ extra = ((top_size - pad - MINSIZE + (pagesz-1)) / pagesz - 1) * pagesz; if (extra > 0) { /* Only proceed if end of memory is where we last set it. This avoids problems if there were foreign sbrk calls. */ current_brk = (char*)(MORECORE(0)); if (current_brk == (char*)(av->top) + top_size) { /* Attempt to release memory. We ignore MORECORE return value, and instead call again to find out where new end of memory is. This avoids problems if first call releases less than we asked, of if failure somehow altered brk value. (We could still encounter problems if it altered brk in some very bad way, but the only thing we can do is adjust anyway, which will cause some downstream failure.) */ MORECORE(-extra); new_brk = (char*)(MORECORE(0)); if (new_brk != (char*)MORECORE_FAILURE) { released = (long)(current_brk - new_brk); if (released != 0) { /* Success. Adjust top. */ av->sbrked_mem -= released; set_head(av->top, (top_size - released) | PREV_INUSE); check_malloc_state(); return 1; } } } } return 0; } /* ------------------------------ malloc ------------------------------ */ #if __STD_C Void_t* mALLOc(size_t bytes) #else Void_t* mALLOc(bytes) size_t bytes; #endif { mstate av = get_malloc_state(); INTERNAL_SIZE_T nb; /* normalized request size */ unsigned int idx; /* associated bin index */ mbinptr bin; /* associated bin */ mfastbinptr* fb; /* associated fastbin */ mchunkptr victim; /* inspected/selected chunk */ INTERNAL_SIZE_T size; /* its size */ int victim_index; /* its bin index */ mchunkptr remainder; /* remainder from a split */ CHUNK_SIZE_T remainder_size; /* its size */ unsigned int block; /* bit map traverser */ unsigned int bit; /* bit map traverser */ unsigned int map; /* current word of binmap */ mchunkptr fwd; /* misc temp for linking */ mchunkptr bck; /* misc temp for linking */ /* Convert request size to internal form by adding SIZE_SZ bytes overhead plus possibly more to obtain necessary alignment and/or to obtain a size of at least MINSIZE, the smallest allocatable size. Also, checked_request2size traps (returning 0) request sizes that are so large that they wrap around zero when padded and aligned. */ checked_request2size(bytes, nb); /* Bypass search if no frees yet */ if (!have_anychunks(av)) { if (av->max_fast == 0) /* initialization check */ malloc_consolidate(av); goto use_top; } /* If the size qualifies as a fastbin, first check corresponding bin. */ if ((CHUNK_SIZE_T)(nb) <= (CHUNK_SIZE_T)(av->max_fast)) { fb = &(av->fastbins[(fastbin_index(nb))]); if ((victim = *fb) != 0) { *fb = victim->fd; check_remalloced_chunk(victim, nb); return chunk2mem(victim); } } /* If a small request, check regular bin. Since these "smallbins" hold one size each, no searching within bins is necessary. (For a large request, we need to wait until unsorted chunks are processed to find best fit. But for small ones, fits are exact anyway, so we can check now, which is faster.) */ if (in_smallbin_range(nb)) { idx = smallbin_index(nb); bin = bin_at(av,idx); if ((victim = last(bin)) != bin) { bck = victim->bk; set_inuse_bit_at_offset(victim, nb); bin->bk = bck; bck->fd = bin; check_malloced_chunk(victim, nb); return chunk2mem(victim); } } /* If this is a large request, consolidate fastbins before continuing. While it might look excessive to kill all fastbins before even seeing if there is space available, this avoids fragmentation problems normally associated with fastbins. Also, in practice, programs tend to have runs of either small or large requests, but less often mixtures, so consolidation is not invoked all that often in most programs. And the programs that it is called frequently in otherwise tend to fragment. */ else { idx = largebin_index(nb); if (have_fastchunks(av)) malloc_consolidate(av); } /* Process recently freed or remaindered chunks, taking one only if it is exact fit, or, if this a small request, the chunk is remainder from the most recent non-exact fit. Place other traversed chunks in bins. Note that this step is the only place in any routine where chunks are placed in bins. */ while ((victim = unsorted_chunks(av)->bk) != unsorted_chunks(av)) { bck = victim->bk; size = chunksize(victim); /* If a small request, try to use last remainder if it is the only chunk in unsorted bin. This helps promote locality for runs of consecutive small requests. This is the only exception to best-fit, and applies only when there is no exact fit for a small chunk. */ if (in_smallbin_range(nb) && bck == unsorted_chunks(av) && victim == av->last_remainder && (CHUNK_SIZE_T)(size) > (CHUNK_SIZE_T)(nb + MINSIZE)) { /* split and reattach remainder */ remainder_size = size - nb; remainder = chunk_at_offset(victim, nb); unsorted_chunks(av)->bk = unsorted_chunks(av)->fd = remainder; av->last_remainder = remainder; remainder->bk = remainder->fd = unsorted_chunks(av); set_head(victim, nb | PREV_INUSE); set_head(remainder, remainder_size | PREV_INUSE); set_foot(remainder, remainder_size); check_malloced_chunk(victim, nb); return chunk2mem(victim); } /* remove from unsorted list */ unsorted_chunks(av)->bk = bck; bck->fd = unsorted_chunks(av); /* Take now instead of binning if exact fit */ if (size == nb) { set_inuse_bit_at_offset(victim, size); check_malloced_chunk(victim, nb); return chunk2mem(victim); } /* place chunk in bin */ if (in_smallbin_range(size)) { victim_index = smallbin_index(size); bck = bin_at(av, victim_index); fwd = bck->fd; } else { victim_index = largebin_index(size); bck = bin_at(av, victim_index); fwd = bck->fd; if (fwd != bck) { /* if smaller than smallest, place first */ if ((CHUNK_SIZE_T)(size) < (CHUNK_SIZE_T)(bck->bk->size)) { fwd = bck; bck = bck->bk; } else if ((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(FIRST_SORTED_BIN_SIZE)) { /* maintain large bins in sorted order */ size |= PREV_INUSE; /* Or with inuse bit to speed comparisons */ while ((CHUNK_SIZE_T)(size) < (CHUNK_SIZE_T)(fwd->size)) fwd = fwd->fd; bck = fwd->bk; } } } mark_bin(av, victim_index); victim->bk = bck; victim->fd = fwd; fwd->bk = victim; bck->fd = victim; } /* If a large request, scan through the chunks of current bin to find one that fits. (This will be the smallest that fits unless FIRST_SORTED_BIN_SIZE has been changed from default.) This is the only step where an unbounded number of chunks might be scanned without doing anything useful with them. However the lists tend to be short. */ if (!in_smallbin_range(nb)) { bin = bin_at(av, idx); for (victim = last(bin); victim != bin; victim = victim->bk) { size = chunksize(victim); if ((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(nb)) { remainder_size = size - nb; unlink(victim, bck, fwd); /* Exhaust */ if (remainder_size < MINSIZE) { set_inuse_bit_at_offset(victim, size); check_malloced_chunk(victim, nb); return chunk2mem(victim); } /* Split */ else { remainder = chunk_at_offset(victim, nb); unsorted_chunks(av)->bk = unsorted_chunks(av)->fd = remainder; remainder->bk = remainder->fd = unsorted_chunks(av); set_head(victim, nb | PREV_INUSE); set_head(remainder, remainder_size | PREV_INUSE); set_foot(remainder, remainder_size); check_malloced_chunk(victim, nb); return chunk2mem(victim); } } } } /* Search for a chunk by scanning bins, starting with next largest bin. This search is strictly by best-fit; i.e., the smallest (with ties going to approximately the least recently used) chunk that fits is selected. The bitmap avoids needing to check that most blocks are nonempty. */ ++idx; bin = bin_at(av,idx); block = idx2block(idx); map = av->binmap[block]; bit = idx2bit(idx); for (;;) { /* Skip rest of block if there are no more set bits in this block. */ if (bit > map || bit == 0) { do { if (++block >= BINMAPSIZE) /* out of bins */ goto use_top; } while ((map = av->binmap[block]) == 0); bin = bin_at(av, (block << BINMAPSHIFT)); bit = 1; } /* Advance to bin with set bit. There must be one. */ while ((bit & map) == 0) { bin = next_bin(bin); bit <<= 1; assert(bit != 0); } /* Inspect the bin. It is likely to be non-empty */ victim = last(bin); /* If a false alarm (empty bin), clear the bit. */ if (victim == bin) { av->binmap[block] = map &= ~bit; /* Write through */ bin = next_bin(bin); bit <<= 1; } else { size = chunksize(victim); /* We know the first chunk in this bin is big enough to use. */ assert((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(nb)); remainder_size = size - nb; /* unlink */ bck = victim->bk; bin->bk = bck; bck->fd = bin; /* Exhaust */ if (remainder_size < MINSIZE) { set_inuse_bit_at_offset(victim, size); check_malloced_chunk(victim, nb); return chunk2mem(victim); } /* Split */ else { remainder = chunk_at_offset(victim, nb); unsorted_chunks(av)->bk = unsorted_chunks(av)->fd = remainder; remainder->bk = remainder->fd = unsorted_chunks(av); /* advertise as last remainder */ if (in_smallbin_range(nb)) av->last_remainder = remainder; set_head(victim, nb | PREV_INUSE); set_head(remainder, remainder_size | PREV_INUSE); set_foot(remainder, remainder_size); check_malloced_chunk(victim, nb); return chunk2mem(victim); } } } use_top: /* If large enough, split off the chunk bordering the end of memory (held in av->top). Note that this is in accord with the best-fit search rule. In effect, av->top is treated as larger (and thus less well fitting) than any other available chunk since it can be extended to be as large as necessary (up to system limitations). We require that av->top always exists (i.e., has size >= MINSIZE) after initialization, so if it would otherwise be exhausted by the current request, it is replenished. (The main reason for ensuring it exists is that we may need MINSIZE space to put in fenceposts in sysmalloc.) */ victim = av->top; size = chunksize(victim); if ((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(nb + MINSIZE)) { remainder_size = size - nb; remainder = chunk_at_offset(victim, nb); av->top = remainder; set_head(victim, nb | PREV_INUSE); set_head(remainder, remainder_size | PREV_INUSE); check_malloced_chunk(victim, nb); return chunk2mem(victim); } /* If no space in top, relay to handle system-dependent cases */ return sYSMALLOc(nb, av); } /* ------------------------------ free ------------------------------ */ #if __STD_C void fREe(Void_t* mem) #else void fREe(mem) Void_t* mem; #endif { mstate av = get_malloc_state(); mchunkptr p; /* chunk corresponding to mem */ INTERNAL_SIZE_T size; /* its size */ mfastbinptr* fb; /* associated fastbin */ mchunkptr nextchunk; /* next contiguous chunk */ INTERNAL_SIZE_T nextsize; /* its size */ int nextinuse; /* true if nextchunk is used */ INTERNAL_SIZE_T prevsize; /* size of previous contiguous chunk */ mchunkptr bck; /* misc temp for linking */ mchunkptr fwd; /* misc temp for linking */ /* free(0) has no effect */ if (mem != 0) { p = mem2chunk(mem); size = chunksize(p); check_inuse_chunk(p); /* If eligible, place chunk on a fastbin so it can be found and used quickly in malloc. */ if ((CHUNK_SIZE_T)(size) <= (CHUNK_SIZE_T)(av->max_fast) #if TRIM_FASTBINS /* If TRIM_FASTBINS set, don't place chunks bordering top into fastbins */ && (chunk_at_offset(p, size) != av->top) #endif ) { set_fastchunks(av); fb = &(av->fastbins[fastbin_index(size)]); p->fd = *fb; *fb = p; } /* Consolidate other non-mmapped chunks as they arrive. */ else if (!chunk_is_mmapped(p)) { set_anychunks(av); nextchunk = chunk_at_offset(p, size); nextsize = chunksize(nextchunk); /* consolidate backward */ if (!prev_inuse(p)) { prevsize = p->prev_size; size += prevsize; p = chunk_at_offset(p, -((long) prevsize)); unlink(p, bck, fwd); } if (nextchunk != av->top) { /* get and clear inuse bit */ nextinuse = inuse_bit_at_offset(nextchunk, nextsize); set_head(nextchunk, nextsize); /* consolidate forward */ if (!nextinuse) { unlink(nextchunk, bck, fwd); size += nextsize; } /* Place the chunk in unsorted chunk list. Chunks are not placed into regular bins until after they have been given one chance to be used in malloc. */ bck = unsorted_chunks(av); fwd = bck->fd; p->bk = bck; p->fd = fwd; bck->fd = p; fwd->bk = p; set_head(p, size | PREV_INUSE); set_foot(p, size); check_free_chunk(p); } /* If the chunk borders the current high end of memory, consolidate into top */ else { size += nextsize; set_head(p, size | PREV_INUSE); av->top = p; check_chunk(p); } /* If freeing a large space, consolidate possibly-surrounding chunks. Then, if the total unused topmost memory exceeds trim threshold, ask malloc_trim to reduce top. Unless max_fast is 0, we don't know if there are fastbins bordering top, so we cannot tell for sure whether threshold has been reached unless fastbins are consolidated. But we don't want to consolidate on each free. As a compromise, consolidation is performed if FASTBIN_CONSOLIDATION_THRESHOLD is reached. */ if ((CHUNK_SIZE_T)(size) >= FASTBIN_CONSOLIDATION_THRESHOLD) { if (have_fastchunks(av)) malloc_consolidate(av); #ifndef MORECORE_CANNOT_TRIM if ((CHUNK_SIZE_T)(chunksize(av->top)) >= (CHUNK_SIZE_T)(av->trim_threshold)) sYSTRIm(av->top_pad, av); #endif } } /* If the chunk was allocated via mmap, release via munmap() Note that if HAVE_MMAP is false but chunk_is_mmapped is true, then user must have overwritten memory. There's nothing we can do to catch this error unless DEBUG is set, in which case check_inuse_chunk (above) will have triggered error. */ else { #if HAVE_MMAP int ret; INTERNAL_SIZE_T offset = p->prev_size; --av->n_mmaps; av->mmapped_mem -= (size + offset); ret = munmap((char*)p - offset, size + offset); /* munmap returns non-zero on failure */ assert(ret == 0); #endif } } } /* ------------------------- malloc_consolidate ------------------------- malloc_consolidate is a specialized version of free() that tears down chunks held in fastbins. Free itself cannot be used for this purpose since, among other things, it might place chunks back onto fastbins. So, instead, we need to use a minor variant of the same code. Also, because this routine needs to be called the first time through malloc anyway, it turns out to be the perfect place to trigger initialization code. */ #if __STD_C static void malloc_consolidate(mstate av) #else static void malloc_consolidate(av) mstate av; #endif { mfastbinptr* fb; /* current fastbin being consolidated */ mfastbinptr* maxfb; /* last fastbin (for loop control) */ mchunkptr p; /* current chunk being consolidated */ mchunkptr nextp; /* next chunk to consolidate */ mchunkptr unsorted_bin; /* bin header */ mchunkptr first_unsorted; /* chunk to link to */ /* These have same use as in free() */ mchunkptr nextchunk; INTERNAL_SIZE_T size; INTERNAL_SIZE_T nextsize; INTERNAL_SIZE_T prevsize; int nextinuse; mchunkptr bck; mchunkptr fwd; /* If max_fast is 0, we know that av hasn't yet been initialized, in which case do so below */ if (av->max_fast != 0) { clear_fastchunks(av); unsorted_bin = unsorted_chunks(av); /* Remove each chunk from fast bin and consolidate it, placing it then in unsorted bin. Among other reasons for doing this, placing in unsorted bin avoids needing to calculate actual bins until malloc is sure that chunks aren't immediately going to be reused anyway. */ maxfb = &(av->fastbins[fastbin_index(av->max_fast)]); fb = &(av->fastbins[0]); do { if ((p = *fb) != 0) { *fb = 0; do { check_inuse_chunk(p); nextp = p->fd; /* Slightly streamlined version of consolidation code in free() */ size = p->size & ~PREV_INUSE; nextchunk = chunk_at_offset(p, size); nextsize = chunksize(nextchunk); if (!prev_inuse(p)) { prevsize = p->prev_size; size += prevsize; p = chunk_at_offset(p, -((long) prevsize)); unlink(p, bck, fwd); } if (nextchunk != av->top) { nextinuse = inuse_bit_at_offset(nextchunk, nextsize); set_head(nextchunk, nextsize); if (!nextinuse) { size += nextsize; unlink(nextchunk, bck, fwd); } first_unsorted = unsorted_bin->fd; unsorted_bin->fd = p; first_unsorted->bk = p; set_head(p, size | PREV_INUSE); p->bk = unsorted_bin; p->fd = first_unsorted; set_foot(p, size); } else { size += nextsize; set_head(p, size | PREV_INUSE); av->top = p; } } while ((p = nextp) != 0); } } while (fb++ != maxfb); } else { malloc_init_state(av); check_malloc_state(); } } /* ------------------------------ realloc ------------------------------ */ #if __STD_C Void_t* rEALLOc(Void_t* oldmem, size_t bytes) #else Void_t* rEALLOc(oldmem, bytes) Void_t* oldmem; size_t bytes; #endif { mstate av = get_malloc_state(); INTERNAL_SIZE_T nb; /* padded request size */ mchunkptr oldp; /* chunk corresponding to oldmem */ INTERNAL_SIZE_T oldsize; /* its size */ mchunkptr newp; /* chunk to return */ INTERNAL_SIZE_T newsize; /* its size */ Void_t* newmem; /* corresponding user mem */ mchunkptr next; /* next contiguous chunk after oldp */ mchunkptr remainder; /* extra space at end of newp */ CHUNK_SIZE_T remainder_size; /* its size */ mchunkptr bck; /* misc temp for linking */ mchunkptr fwd; /* misc temp for linking */ CHUNK_SIZE_T copysize; /* bytes to copy */ unsigned int ncopies; /* INTERNAL_SIZE_T words to copy */ INTERNAL_SIZE_T* s; /* copy source */ INTERNAL_SIZE_T* d; /* copy destination */ #ifdef REALLOC_ZERO_BYTES_FREES if (bytes == 0) { fREe(oldmem); return 0; } #endif /* realloc of null is supposed to be same as malloc */ if (oldmem == 0) return mALLOc(bytes); checked_request2size(bytes, nb); oldp = mem2chunk(oldmem); oldsize = chunksize(oldp); check_inuse_chunk(oldp); if (!chunk_is_mmapped(oldp)) { if ((CHUNK_SIZE_T)(oldsize) >= (CHUNK_SIZE_T)(nb)) { /* already big enough; split below */ newp = oldp; newsize = oldsize; } else { next = chunk_at_offset(oldp, oldsize); /* Try to expand forward into top */ if (next == av->top && (CHUNK_SIZE_T)(newsize = oldsize + chunksize(next)) >= (CHUNK_SIZE_T)(nb + MINSIZE)) { set_head_size(oldp, nb); av->top = chunk_at_offset(oldp, nb); set_head(av->top, (newsize - nb) | PREV_INUSE); return chunk2mem(oldp); } /* Try to expand forward into next chunk; split off remainder below */ else if (next != av->top && !inuse(next) && (CHUNK_SIZE_T)(newsize = oldsize + chunksize(next)) >= (CHUNK_SIZE_T)(nb)) { newp = oldp; unlink(next, bck, fwd); } /* allocate, copy, free */ else { newmem = mALLOc(nb - MALLOC_ALIGN_MASK); if (newmem == 0) return 0; /* propagate failure */ newp = mem2chunk(newmem); newsize = chunksize(newp); /* Avoid copy if newp is next chunk after oldp. */ if (newp == next) { newsize += oldsize; newp = oldp; } else { /* Unroll copy of <= 36 bytes (72 if 8byte sizes) We know that contents have an odd number of INTERNAL_SIZE_T-sized words; minimally 3. */ copysize = oldsize - SIZE_SZ; s = (INTERNAL_SIZE_T*)(oldmem); d = (INTERNAL_SIZE_T*)(newmem); ncopies = copysize / sizeof (INTERNAL_SIZE_T); assert(ncopies >= 3); if (ncopies > 9) MALLOC_COPY(d, s, copysize); else { *(d+0) = *(s+0); *(d+1) = *(s+1); *(d+2) = *(s+2); if (ncopies > 4) { *(d+3) = *(s+3); *(d+4) = *(s+4); if (ncopies > 6) { *(d+5) = *(s+5); *(d+6) = *(s+6); if (ncopies > 8) { *(d+7) = *(s+7); *(d+8) = *(s+8); } } } } fREe(oldmem); check_inuse_chunk(newp); return chunk2mem(newp); } } } /* If possible, free extra space in old or extended chunk */ assert((CHUNK_SIZE_T)(newsize) >= (CHUNK_SIZE_T)(nb)); remainder_size = newsize - nb; if (remainder_size < MINSIZE) { /* not enough extra to split off */ set_head_size(newp, newsize); set_inuse_bit_at_offset(newp, newsize); } else { /* split remainder */ remainder = chunk_at_offset(newp, nb); set_head_size(newp, nb); set_head(remainder, remainder_size | PREV_INUSE); /* Mark remainder as inuse so free() won't complain */ set_inuse_bit_at_offset(remainder, remainder_size); fREe(chunk2mem(remainder)); } check_inuse_chunk(newp); return chunk2mem(newp); } /* Handle mmap cases */ else { #if HAVE_MMAP # if HAVE_MREMAP INTERNAL_SIZE_T offset = oldp->prev_size; size_t pagemask = av->pagesize - 1; char *cp; CHUNK_SIZE_T sum; /* Note the extra SIZE_SZ overhead */ newsize = (nb + offset + SIZE_SZ + pagemask) & ~pagemask; /* don't need to remap if still within same page */ if (oldsize == newsize - offset) return oldmem; cp = (char*)mremap((char*)oldp - offset, oldsize + offset, newsize, 1); if (cp != (char*)MORECORE_FAILURE) { newp = (mchunkptr)(cp + offset); set_head(newp, (newsize - offset)|IS_MMAPPED); assert(aligned_OK(chunk2mem(newp))); assert((newp->prev_size == offset)); /* update statistics */ sum = av->mmapped_mem += newsize - oldsize; if (sum > (CHUNK_SIZE_T)(av->max_mmapped_mem)) av->max_mmapped_mem = sum; sum += av->sbrked_mem; if (sum > (CHUNK_SIZE_T)(av->max_total_mem)) av->max_total_mem = sum; return chunk2mem(newp); } # endif /* Note the extra SIZE_SZ overhead. */ if ((CHUNK_SIZE_T)(oldsize) >= (CHUNK_SIZE_T)(nb + SIZE_SZ)) newmem = oldmem; /* do nothing */ else { /* Must alloc, copy, free. */ newmem = mALLOc(nb - MALLOC_ALIGN_MASK); if (newmem != 0) { MALLOC_COPY(newmem, oldmem, oldsize - 2*SIZE_SZ); fREe(oldmem); } } return newmem; #else /* If !HAVE_MMAP, but chunk_is_mmapped, user must have overwritten mem */ check_malloc_state(); MALLOC_FAILURE_ACTION; return 0; #endif } } /* ------------------------------ memalign ------------------------------ */ #if __STD_C Void_t* mEMALIGn(size_t alignment, size_t bytes) #else Void_t* mEMALIGn(alignment, bytes) size_t alignment; size_t bytes; #endif { INTERNAL_SIZE_T nb; /* padded request size */ char* m; /* memory returned by malloc call */ mchunkptr p; /* corresponding chunk */ char* brk; /* alignment point within p */ mchunkptr newp; /* chunk to return */ INTERNAL_SIZE_T newsize; /* its size */ INTERNAL_SIZE_T leadsize; /* leading space before alignment point */ mchunkptr remainder; /* spare room at end to split off */ CHUNK_SIZE_T remainder_size; /* its size */ INTERNAL_SIZE_T size; /* If need less alignment than we give anyway, just relay to malloc */ if (alignment <= MALLOC_ALIGNMENT) return mALLOc(bytes); /* Otherwise, ensure that it is at least a minimum chunk size */ if (alignment < MINSIZE) alignment = MINSIZE; /* Make sure alignment is power of 2 (in case MINSIZE is not). */ if ((alignment & (alignment - 1)) != 0) { size_t a = MALLOC_ALIGNMENT * 2; while ((CHUNK_SIZE_T)a < (CHUNK_SIZE_T)alignment) a <<= 1; alignment = a; } checked_request2size(bytes, nb); /* Strategy: find a spot within that chunk that meets the alignment request, and then possibly free the leading and trailing space. */ /* Call malloc with worst case padding to hit alignment. */ m = (char*)(mALLOc(nb + alignment + MINSIZE)); if (m == 0) return 0; /* propagate failure */ p = mem2chunk(m); if ((((PTR_UINT)(m)) % alignment) != 0) { /* misaligned */ /* Find an aligned spot inside chunk. Since we need to give back leading space in a chunk of at least MINSIZE, if the first calculation places us at a spot with less than MINSIZE leader, we can move to the next aligned spot -- we've allocated enough total room so that this is always possible. */ brk = (char*)mem2chunk((PTR_UINT)(((PTR_UINT)(m + alignment - 1)) & -((signed long) alignment))); if ((CHUNK_SIZE_T)(brk - (char*)(p)) < MINSIZE) brk += alignment; newp = (mchunkptr)brk; leadsize = brk - (char*)(p); newsize = chunksize(p) - leadsize; /* For mmapped chunks, just adjust offset */ if (chunk_is_mmapped(p)) { newp->prev_size = p->prev_size + leadsize; set_head(newp, newsize|IS_MMAPPED); return chunk2mem(newp); } /* Otherwise, give back leader, use the rest */ set_head(newp, newsize | PREV_INUSE); set_inuse_bit_at_offset(newp, newsize); set_head_size(p, leadsize); fREe(chunk2mem(p)); p = newp; assert (newsize >= nb && (((PTR_UINT)(chunk2mem(p))) % alignment) == 0); } /* Also give back spare room at the end */ if (!chunk_is_mmapped(p)) { size = chunksize(p); if ((CHUNK_SIZE_T)(size) > (CHUNK_SIZE_T)(nb + MINSIZE)) { remainder_size = size - nb; remainder = chunk_at_offset(p, nb); set_head(remainder, remainder_size | PREV_INUSE); set_head_size(p, nb); fREe(chunk2mem(remainder)); } } check_inuse_chunk(p); return chunk2mem(p); } /* ------------------------------ calloc ------------------------------ */ #if __STD_C Void_t* cALLOc(size_t n_elements, size_t elem_size) #else Void_t* cALLOc(n_elements, elem_size) size_t n_elements; size_t elem_size; #endif { mchunkptr p; CHUNK_SIZE_T clearsize; CHUNK_SIZE_T nclears; INTERNAL_SIZE_T* d; Void_t* mem = mALLOc(n_elements * elem_size); if (mem != 0) { p = mem2chunk(mem); if (!chunk_is_mmapped(p)) { /* Unroll clear of <= 36 bytes (72 if 8byte sizes) We know that contents have an odd number of INTERNAL_SIZE_T-sized words; minimally 3. */ d = (INTERNAL_SIZE_T*)mem; clearsize = chunksize(p) - SIZE_SZ; nclears = clearsize / sizeof (INTERNAL_SIZE_T); assert(nclears >= 3); if (nclears > 9) MALLOC_ZERO(d, clearsize); else { *(d+0) = 0; *(d+1) = 0; *(d+2) = 0; if (nclears > 4) { *(d+3) = 0; *(d+4) = 0; if (nclears > 6) { *(d+5) = 0; *(d+6) = 0; if (nclears > 8) { *(d+7) = 0; *(d+8) = 0; } } } } } #if ! MMAP_CLEARS else { d = (INTERNAL_SIZE_T*)mem; /* Note the additional SIZE_SZ */ clearsize = chunksize(p) - 2*SIZE_SZ; MALLOC_ZERO(d, clearsize); } #endif } return mem; } /* ------------------------------ cfree ------------------------------ */ #if __STD_C void cFREe(Void_t *mem) #else void cFREe(mem) Void_t *mem; #endif { fREe(mem); } /* ------------------------- independent_calloc ------------------------- */ #if __STD_C Void_t** iCALLOc(size_t n_elements, size_t elem_size, Void_t* chunks[]) #else Void_t** iCALLOc(n_elements, elem_size, chunks) size_t n_elements; size_t elem_size; Void_t* chunks[]; #endif { size_t sz = elem_size; /* serves as 1-element array */ /* opts arg of 3 means all elements are same size, and should be cleared */ return iALLOc(n_elements, &sz, 3, chunks); } /* ------------------------- independent_comalloc ------------------------- */ #if __STD_C Void_t** iCOMALLOc(size_t n_elements, size_t sizes[], Void_t* chunks[]) #else Void_t** iCOMALLOc(n_elements, sizes, chunks) size_t n_elements; size_t sizes[]; Void_t* chunks[]; #endif { return iALLOc(n_elements, sizes, 0, chunks); } /* ------------------------------ ialloc ------------------------------ ialloc provides common support for independent_X routines, handling all of the combinations that can result. The opts arg has: bit 0 set if all elements are same size (using sizes[0]) bit 1 set if elements should be zeroed */ #if __STD_C static Void_t** iALLOc(size_t n_elements, size_t* sizes, int opts, Void_t* chunks[]) #else static Void_t** iALLOc(n_elements, sizes, opts, chunks) size_t n_elements; size_t* sizes; int opts; Void_t* chunks[]; #endif { mstate av = get_malloc_state(); INTERNAL_SIZE_T element_size; /* chunksize of each element, if all same */ INTERNAL_SIZE_T contents_size; /* total size of elements */ INTERNAL_SIZE_T array_size; /* request size of pointer array */ Void_t* mem; /* malloced aggregate space */ mchunkptr p; /* corresponding chunk */ INTERNAL_SIZE_T remainder_size; /* remaining bytes while splitting */ Void_t** marray; /* either "chunks" or malloced ptr array */ mchunkptr array_chunk; /* chunk for malloced ptr array */ int mmx; /* to disable mmap */ INTERNAL_SIZE_T size; size_t i; /* Ensure initialization */ if (av->max_fast == 0) malloc_consolidate(av); /* compute array length, if needed */ if (chunks != 0) { if (n_elements == 0) return chunks; /* nothing to do */ marray = chunks; array_size = 0; } else { /* if empty req, must still return chunk representing empty array */ if (n_elements == 0) return (Void_t**) mALLOc(0); marray = 0; array_size = request2size(n_elements * (sizeof (Void_t*))); } /* compute total element size */ if (opts & 0x1) { /* all-same-size */ element_size = request2size(*sizes); contents_size = n_elements * element_size; } else { /* add up all the sizes */ element_size = 0; contents_size = 0; for (i = 0; i != n_elements; ++i) contents_size += request2size(sizes[i]); } /* subtract out alignment bytes from total to minimize overallocation */ size = contents_size + array_size - MALLOC_ALIGN_MASK; /* Allocate the aggregate chunk. But first disable mmap so malloc won't use it, since we would not be able to later free/realloc space internal to a segregated mmap region. */ mmx = av->n_mmaps_max; /* disable mmap */ av->n_mmaps_max = 0; mem = mALLOc(size); av->n_mmaps_max = mmx; /* reset mmap */ if (mem == 0) return 0; p = mem2chunk(mem); assert(!chunk_is_mmapped(p)); remainder_size = chunksize(p); if (opts & 0x2) { /* optionally clear the elements */ MALLOC_ZERO(mem, remainder_size - SIZE_SZ - array_size); } /* If not provided, allocate the pointer array as final part of chunk */ if (marray == 0) { array_chunk = chunk_at_offset(p, contents_size); marray = (Void_t**) (chunk2mem(array_chunk)); set_head(array_chunk, (remainder_size - contents_size) | PREV_INUSE); remainder_size = contents_size; } /* split out elements */ for (i = 0; ; ++i) { marray[i] = chunk2mem(p); if (i != n_elements-1) { if (element_size != 0) size = element_size; else size = request2size(sizes[i]); remainder_size -= size; set_head(p, size | PREV_INUSE); p = chunk_at_offset(p, size); } else { /* the final element absorbs any overallocation slop */ set_head(p, remainder_size | PREV_INUSE); break; } } #if DEBUG if (marray != chunks) { /* final element must have exactly exhausted chunk */ if (element_size != 0) assert(remainder_size == element_size); else assert(remainder_size == request2size(sizes[i])); check_inuse_chunk(mem2chunk(marray)); } for (i = 0; i != n_elements; ++i) check_inuse_chunk(mem2chunk(marray[i])); #endif return marray; } /* ------------------------------ valloc ------------------------------ */ #if __STD_C Void_t* vALLOc(size_t bytes) #else Void_t* vALLOc(bytes) size_t bytes; #endif { /* Ensure initialization */ mstate av = get_malloc_state(); if (av->max_fast == 0) malloc_consolidate(av); return mEMALIGn(av->pagesize, bytes); } /* ------------------------------ pvalloc ------------------------------ */ #if __STD_C Void_t* pVALLOc(size_t bytes) #else Void_t* pVALLOc(bytes) size_t bytes; #endif { mstate av = get_malloc_state(); size_t pagesz; /* Ensure initialization */ if (av->max_fast == 0) malloc_consolidate(av); pagesz = av->pagesize; return mEMALIGn(pagesz, (bytes + pagesz - 1) & ~(pagesz - 1)); } /* ------------------------------ malloc_trim ------------------------------ */ #if __STD_C int mTRIm(size_t pad) #else int mTRIm(pad) size_t pad; #endif { mstate av = get_malloc_state(); /* Ensure initialization/consolidation */ malloc_consolidate(av); #ifndef MORECORE_CANNOT_TRIM return sYSTRIm(pad, av); #else return 0; #endif } /* ------------------------- malloc_usable_size ------------------------- */ #if __STD_C size_t mUSABLe(Void_t* mem) #else size_t mUSABLe(mem) Void_t* mem; #endif { mchunkptr p; if (mem != 0) { p = mem2chunk(mem); if (chunk_is_mmapped(p)) return chunksize(p) - 2*SIZE_SZ; else if (inuse(p)) return chunksize(p) - SIZE_SZ; } return 0; } /* ------------------------------ mallinfo ------------------------------ */ struct mallinfo mALLINFo() { mstate av = get_malloc_state(); struct mallinfo mi; int i; mbinptr b; mchunkptr p; INTERNAL_SIZE_T avail; INTERNAL_SIZE_T fastavail; int nblocks; int nfastblocks; /* Ensure initialization */ if (av->top == 0) malloc_consolidate(av); check_malloc_state(); /* Account for top */ avail = chunksize(av->top); nblocks = 1; /* top always exists */ /* traverse fastbins */ nfastblocks = 0; fastavail = 0; for (i = 0; i < NFASTBINS; ++i) { for (p = av->fastbins[i]; p != 0; p = p->fd) { ++nfastblocks; fastavail += chunksize(p); } } avail += fastavail; /* traverse regular bins */ for (i = 1; i < NBINS; ++i) { b = bin_at(av, i); for (p = last(b); p != b; p = p->bk) { ++nblocks; avail += chunksize(p); } } mi.smblks = nfastblocks; mi.ordblks = nblocks; mi.fordblks = avail; mi.uordblks = av->sbrked_mem - avail; mi.arena = av->sbrked_mem; mi.hblks = av->n_mmaps; mi.hblkhd = av->mmapped_mem; mi.fsmblks = fastavail; mi.keepcost = chunksize(av->top); mi.usmblks = av->max_total_mem; return mi; } /* ------------------------------ malloc_stats ------------------------------ */ void mSTATs() { struct mallinfo mi = mALLINFo(); #ifdef WIN32 { CHUNK_SIZE_T free, reserved, committed; vminfo (&free, &reserved, &committed); Parrot_io_eprintf(NULL, "free bytes = %10lu\n", free); Parrot_io_eprintf(NULL, "reserved bytes = %10lu\n", reserved); Parrot_io_eprintf(NULL, "committed bytes = %10lu\n", committed); } #endif Parrot_io_eprintf(NULL, "max system bytes = %10lu\n", (CHUNK_SIZE_T)(mi.usmblks)); Parrot_io_eprintf(NULL, "system bytes = %10lu\n", (CHUNK_SIZE_T)(mi.arena + mi.hblkhd)); Parrot_io_eprintf(NULL, "in use bytes = %10lu\n", (CHUNK_SIZE_T)(mi.uordblks + mi.hblkhd)); #ifdef WIN32 { CHUNK_SIZE_T kernel, user; if (cpuinfo (TRUE, &kernel, &user)) { Parrot_io_eprintf(NULL, "kernel ms = %10lu\n", kernel); Parrot_io_eprintf(NULL, "user ms = %10lu\n", user); } } #endif } /* ------------------------------ mallopt ------------------------------ */ #if __STD_C int mALLOPt(int param_number, int value) #else int mALLOPt(param_number, value) int param_number; int value; #endif { mstate av = get_malloc_state(); /* Ensure initialization/consolidation */ malloc_consolidate(av); switch (param_number) { case M_MXFAST: if (value >= 0 && value <= MAX_FAST_SIZE) { set_max_fast(av, value); return 1; } else return 0; case M_TRIM_THRESHOLD: av->trim_threshold = value; return 1; case M_TOP_PAD: av->top_pad = value; return 1; case M_MMAP_THRESHOLD: av->mmap_threshold = value; return 1; case M_MMAP_MAX: #if !HAVE_MMAP if (value != 0) return 0; #endif av->n_mmaps_max = value; return 1; default: return 0; } } /* -------------------- Alternative MORECORE functions -------------------- */ /* General Requirements for MORECORE. The MORECORE function must have the following properties: If MORECORE_CONTIGUOUS is false: * MORECORE must allocate in multiples of pagesize. It will only be called with arguments that are multiples of pagesize. * MORECORE(0) must return an address that is at least MALLOC_ALIGNMENT aligned. (Page-aligning always suffices.) else (i.e. If MORECORE_CONTIGUOUS is true): * Consecutive calls to MORECORE with positive arguments return increasing addresses, indicating that space has been contiguously extended. * MORECORE need not allocate in multiples of pagesize. Calls to MORECORE need not have args of multiples of pagesize. * MORECORE need not page-align. In either case: * MORECORE may allocate more memory than requested. (Or even less, but this will generally result in a malloc failure.) * MORECORE must not allocate memory when given argument zero, but instead return one past the end address of memory from previous nonzero call. This malloc does NOT call MORECORE(0) until at least one call with positive arguments is made, so the initial value returned is not important. * Even though consecutive calls to MORECORE need not return contiguous addresses, it must be OK for malloc'ed chunks to span multiple regions in those cases where they do happen to be contiguous. * MORECORE need not handle negative arguments -- it may instead just return MORECORE_FAILURE when given negative arguments. Negative arguments are always multiples of pagesize. MORECORE must not misinterpret negative args as large positive unsigned args. You can suppress all such calls from even occurring by defining MORECORE_CANNOT_TRIM, There is some variation across systems about the type of the argument to sbrk/MORECORE. If size_t is unsigned, then it cannot actually be size_t, because sbrk supports negative args, so it is normally the signed type of the same width as size_t (sometimes declared as "intptr_t", and sometimes "ptrdiff_t"). It doesn't much matter though. Internally, we use "long" as arguments, which should work across all reasonable possibilities. Additionally, if MORECORE ever returns failure for a positive request, and HAVE_MMAP is true, then mmap is used as a noncontiguous system allocator. This is a useful backup strategy for systems with holes in address spaces -- in this case sbrk cannot contiguously expand the heap, but mmap may be able to map noncontiguous space. If you'd like mmap to ALWAYS be used, you can define MORECORE to be a function that always returns MORECORE_FAILURE. Malloc only has limited ability to detect failures of MORECORE to supply contiguous space when it says it can. In particular, multithreaded programs that do not use locks may result in rece conditions across calls to MORECORE that result in gaps that cannot be detected as such, and subsequent corruption. If you are using this malloc with something other than sbrk (or its emulation) to supply memory regions, you probably want to set MORECORE_CONTIGUOUS as false. As an example, here is a custom allocator kindly contributed for pre-OSX macOS. It uses virtually but not necessarily physically contiguous non-paged memory (locked in, present and won't get swapped out). You can use it by uncommenting this section, adding some #includes, and setting up the appropriate defines above: #define MORECORE osMoreCore #define MORECORE_CONTIGUOUS 0 There is also a shutdown routine that should somehow be called for cleanup upon program exit. #define MAX_POOL_ENTRIES 100 #define MINIMUM_MORECORE_SIZE (64 * 1024) static int next_os_pool; void *our_os_pools[MAX_POOL_ENTRIES]; void *osMoreCore(int size) { void *ptr = 0; static void *sbrk_top = 0; if (size > 0) { if (size < MINIMUM_MORECORE_SIZE) size = MINIMUM_MORECORE_SIZE; if (CurrentExecutionLevel() == kTaskLevel) ptr = PoolAllocateResident(size + RM_PAGE_SIZE, 0); if (ptr == 0) { return (void *) MORECORE_FAILURE; } / / save ptrs so they can be freed during cleanup our_os_pools[next_os_pool] = ptr; ++next_os_pool; ptr = (void *) ((((CHUNK_SIZE_T) ptr) + RM_PAGE_MASK) & ~RM_PAGE_MASK); sbrk_top = (char *) ptr + size; return ptr; } else if (size < 0) { / / we don't currently support shrink behavior return (void *) MORECORE_FAILURE; } else { return sbrk_top; } } / / cleanup any allocated memory pools / / called as last thing before shutting down driver void osCleanupMem(void) { void **ptr; for (ptr = our_os_pools; ptr < &our_os_pools[MAX_POOL_ENTRIES]; ptr++) if (*ptr) { PoolDeallocate(*ptr); *ptr = 0; } } */ /* -------------------------------------------------------------- Emulation of sbrk for win32. Donated by J. Walter . For additional information about this code, and malloc on Win32, see http://www.genesys-e.de/jwalter/ */ #ifdef WIN32 # ifdef _DEBUG /* #define TRACE */ # endif /* Support for USE_MALLOC_LOCK */ # ifdef USE_MALLOC_LOCK /* Wait for spin lock */ static int slwait (int *sl) { while (InterlockedCompareExchange ((void **) sl, (void *) 1, (void *) 0) != 0) Sleep (0); return 0; } /* Release spin lock */ static int slrelease (int *sl) { InterlockedExchange (sl, 0); return 0; } # ifdef NEEDED /* Spin lock for emulation code */ static int g_sl; # endif # endif /* USE_MALLOC_LOCK */ /* getpagesize for windows */ static long getpagesize (void) { static long g_pagesize = 0; if (! g_pagesize) { SYSTEM_INFO system_info; GetSystemInfo (&system_info); g_pagesize = system_info.dwPageSize; } return g_pagesize; } static long getregionsize (void) { static long g_regionsize = 0; if (! g_regionsize) { SYSTEM_INFO system_info; GetSystemInfo (&system_info); g_regionsize = system_info.dwAllocationGranularity; } return g_regionsize; } /* A region list entry */ typedef struct _region_list_entry { void *top_allocated; void *top_committed; void *top_reserved; long reserve_size; struct _region_list_entry *previous; } region_list_entry; /* Allocate and link a region entry in the region list */ static int region_list_append (region_list_entry **last, void *base_reserved, long reserve_size) { region_list_entry *next = HeapAlloc (GetProcessHeap (), 0, sizeof (region_list_entry)); if (! next) return FALSE; next->top_allocated = (char *) base_reserved; next->top_committed = (char *) base_reserved; next->top_reserved = (char *) base_reserved + reserve_size; next->reserve_size = reserve_size; next->previous = *last; *last = next; return TRUE; } /* Free and unlink the last region entry from the region list */ static int region_list_remove (region_list_entry **last) { region_list_entry *previous = (*last)->previous; if (! HeapFree (GetProcessHeap (), sizeof (region_list_entry), *last)) return FALSE; *last = previous; return TRUE; } # define CEIL(size,to) (((size)+(to)-1)&~((to)-1)) # define FLOOR(size,to) ((size)&~((to)-1)) # define SBRK_SCALE 0 /* #define SBRK_SCALE 1 */ /* #define SBRK_SCALE 2 */ /* #define SBRK_SCALE 4 */ /* sbrk for windows */ static void *sbrk (long size) { static long g_pagesize, g_my_pagesize; static long g_regionsize, g_my_regionsize; static region_list_entry *g_last; void *result = (void *) MORECORE_FAILURE; # ifdef TRACE Parrot_io_printf (NULL, "sbrk %d\n", size); # endif # if defined (USE_MALLOC_LOCK) && defined (NEEDED) /* Wait for spin lock */ slwait (&g_sl); # endif /* First time initialization */ if (! g_pagesize) { g_pagesize = getpagesize (); g_my_pagesize = g_pagesize << SBRK_SCALE; } if (! g_regionsize) { g_regionsize = getregionsize (); g_my_regionsize = g_regionsize << SBRK_SCALE; } if (! g_last) { if (! region_list_append (&g_last, 0, 0)) goto sbrk_exit; } /* Assert invariants */ assert (g_last); assert ((char *) g_last->top_reserved - g_last->reserve_size <= (char *) g_last->top_allocated && g_last->top_allocated <= g_last->top_committed); assert ((char *) g_last->top_reserved - g_last->reserve_size <= (char *) g_last->top_committed && g_last->top_committed <= g_last->top_reserved && (unsigned) g_last->top_committed % g_pagesize == 0); assert ((unsigned) g_last->top_reserved % g_regionsize == 0); assert ((unsigned) g_last->reserve_size % g_regionsize == 0); /* Allocation requested? */ if (size >= 0) { /* Allocation size is the requested size */ long allocate_size = size; /* Compute the size to commit */ long to_commit = (char *) g_last->top_allocated + allocate_size - (char *) g_last->top_committed; /* Do we reach the commit limit? */ if (to_commit > 0) { /* Round size to commit */ long commit_size = CEIL (to_commit, g_my_pagesize); /* Compute the size to reserve */ long to_reserve = (char *) g_last->top_committed + commit_size - (char *) g_last->top_reserved; /* Do we reach the reserve limit? */ if (to_reserve > 0) { /* Compute the remaining size to commit in the current region */ long remaining_commit_size = (char *) g_last->top_reserved - (char *) g_last->top_committed; if (remaining_commit_size > 0) { /* Assert preconditions */ assert ((unsigned) g_last->top_committed % g_pagesize == 0); assert (0 < remaining_commit_size && remaining_commit_size % g_pagesize == 0); { /* Commit this */ void *base_committed = VirtualAlloc(g_last->top_committed, remaining_commit_size, MEM_COMMIT, PAGE_READWRITE); /* Check returned pointer for consistency */ if (base_committed != g_last->top_committed) goto sbrk_exit; /* Assert postconditions */ assert ((unsigned) base_committed % g_pagesize == 0); # ifdef TRACE Parrot_io_printf (NULL, "Commit %p %d\n", base_committed, remaining_commit_size); # endif /* Adjust the regions commit top */ g_last->top_committed = (char *) base_committed + remaining_commit_size; } } { /* Now we are going to search and reserve. */ int contiguous = -1; int found = FALSE; MEMORY_BASIC_INFORMATION memory_info; void *base_reserved; long reserve_size; do { /* Assume contiguous memory */ contiguous = TRUE; /* Round size to reserve */ reserve_size = CEIL (to_reserve, g_my_regionsize); /* Start with the current region's top */ memory_info.BaseAddress = g_last->top_reserved; /* Assert preconditions */ assert ((unsigned) memory_info.BaseAddress % g_pagesize == 0); assert (0 < reserve_size && reserve_size % g_regionsize == 0); while (VirtualQuery (memory_info.BaseAddress, &memory_info, sizeof (memory_info))) { /* Assert postconditions */ assert ((unsigned) memory_info.BaseAddress % g_pagesize == 0); # ifdef TRACE Parrot_io_printf (NULL, "Query %p %d %s\n", memory_info.BaseAddress, memory_info.RegionSize, memory_info.State == MEM_FREE ? "FREE": (memory_info.State == MEM_RESERVE ? "RESERVED": (memory_info.State == MEM_COMMIT ? "COMMITTED": "?"))); # endif /* Region is free, well aligned and big * enough: we are done */ if (memory_info.State == MEM_FREE && (unsigned) memory_info.BaseAddress % g_regionsize == 0 && memory_info.RegionSize >= (unsigned) reserve_size) { found = TRUE; break; } /* From now on we can't get contiguous memory! */ contiguous = FALSE; /* Recompute size to reserve */ reserve_size = CEIL (allocate_size, g_my_regionsize); memory_info.BaseAddress = (char *) memory_info.BaseAddress + memory_info.RegionSize; /* Assert preconditions */ assert ((unsigned) memory_info.BaseAddress % g_pagesize == 0); assert (0 < reserve_size && reserve_size % g_regionsize == 0); } /* Search failed? */ if (! found) goto sbrk_exit; /* Assert preconditions */ assert ((unsigned) memory_info.BaseAddress % g_regionsize == 0); assert (0 < reserve_size && reserve_size % g_regionsize == 0); /* Try to reserve this */ base_reserved = VirtualAlloc (memory_info.BaseAddress, reserve_size, MEM_RESERVE, PAGE_NOACCESS); if (! base_reserved) { int rc = GetLastError (); if (rc != ERROR_INVALID_ADDRESS) goto sbrk_exit; } /* A null pointer signals (hopefully) a race * condition with another thread. */ /* In this case, we try again. */ } while (! base_reserved); /* Check returned pointer for consistency */ if (memory_info.BaseAddress && base_reserved != memory_info.BaseAddress) goto sbrk_exit; /* Assert postconditions */ assert ((unsigned) base_reserved % g_regionsize == 0); # ifdef TRACE Parrot_io_printf (NULL, "Reserve %p %d\n", base_reserved, reserve_size); # endif /* Did we get contiguous memory? */ if (contiguous) { long start_size = (char *) g_last->top_committed - (char *) g_last->top_allocated; /* Adjust allocation size */ allocate_size -= start_size; /* Adjust the regions allocation top */ g_last->top_allocated = g_last->top_committed; /* Recompute the size to commit */ to_commit = (char *) g_last->top_allocated + allocate_size - (char *) g_last->top_committed; /* Round size to commit */ commit_size = CEIL (to_commit, g_my_pagesize); } /* Append the new region to the list */ if (! region_list_append (&g_last, base_reserved, reserve_size)) goto sbrk_exit; /* Didn't we get contiguous memory? */ if (! contiguous) { /* Recompute the size to commit */ to_commit = (char *) g_last->top_allocated + allocate_size - (char *) g_last->top_committed; /* Round size to commit */ commit_size = CEIL (to_commit, g_my_pagesize); } } } /* Assert preconditions */ assert ((unsigned) g_last->top_committed % g_pagesize == 0); assert (0 < commit_size && commit_size % g_pagesize == 0); { /* Commit this */ void *base_committed = VirtualAlloc (g_last->top_committed, commit_size, MEM_COMMIT, PAGE_READWRITE); /* Check returned pointer for consistency */ if (base_committed != g_last->top_committed) goto sbrk_exit; /* Assert postconditions */ assert ((unsigned) base_committed % g_pagesize == 0); # ifdef TRACE Parrot_io_printf(NULL, "Commit %p %d\n", base_committed, commit_size); # endif /* Adjust the regions commit top */ g_last->top_committed = (char *) base_committed + commit_size; } } /* Adjust the regions allocation top */ g_last->top_allocated = (char *) g_last->top_allocated + allocate_size; result = (char *) g_last->top_allocated - size; /* Deallocation requested? */ } else if (size < 0) { long deallocate_size = - size; /* As long as we have a region to release */ while ((char *) g_last->top_allocated - deallocate_size < (char *) g_last->top_reserved - g_last->reserve_size) { /* Get the size to release */ long release_size = g_last->reserve_size; /* Get the base address */ void *base_reserved = (char *) g_last->top_reserved - release_size; /* Assert preconditions */ assert ((unsigned) base_reserved % g_regionsize == 0); assert (0 < release_size && release_size % g_regionsize == 0); { /* Release this */ int rc = VirtualFree (base_reserved, 0, MEM_RELEASE); /* Check returned code for consistency */ if (! rc) goto sbrk_exit; # ifdef TRACE Parrot_io_printf(NULL, "Release %p %d\n", base_reserved,release_size); # endif } /* Adjust deallocation size */ deallocate_size -= (char *) g_last->top_allocated - (char *) base_reserved; /* Remove the old region from the list */ if (! region_list_remove (&g_last)) goto sbrk_exit; } { /* Compute the size to decommit */ long to_decommit = (char *) g_last->top_committed - ((char *) g_last->top_allocated - deallocate_size); if (to_decommit >= g_my_pagesize) { /* Compute the size to decommit */ long decommit_size = FLOOR (to_decommit, g_my_pagesize); /* Compute the base address */ void *base_committed = (char *) g_last->top_committed - decommit_size; /* Assert preconditions */ assert ((unsigned) base_committed % g_pagesize == 0); assert (0 < decommit_size && decommit_size % g_pagesize == 0); { /* Decommit this */ int rc = VirtualFree((char *) base_committed, decommit_size, MEM_DECOMMIT); /* Check returned code for consistency */ if (! rc) goto sbrk_exit; # ifdef TRACE Parrot_io_printf (NULL, "Decommit %p %d\n", base_committed, decommit_size); # endif } /* Adjust deallocation size and regions commit and * allocate top */ deallocate_size -= (char *) g_last->top_allocated - (char *) base_committed; g_last->top_committed = base_committed; g_last->top_allocated = base_committed; } } /* Adjust regions allocate top */ g_last->top_allocated = (char *)g_last->top_allocated - deallocate_size; /* Check for underflow */ if ((char *) g_last->top_reserved - g_last->reserve_size > (char *) g_last->top_allocated || g_last->top_allocated > g_last->top_committed) { /* Adjust regions allocate top */ g_last->top_allocated = (char *) g_last->top_reserved - g_last->reserve_size; goto sbrk_exit; } result = g_last->top_allocated; } /* Assert invariants */ assert (g_last); assert ((char *) g_last->top_reserved - g_last->reserve_size <= (char *) g_last->top_allocated && g_last->top_allocated <= g_last->top_committed); assert ((char *) g_last->top_reserved - g_last->reserve_size <= (char *) g_last->top_committed && g_last->top_committed <= g_last->top_reserved && (unsigned) g_last->top_committed % g_pagesize == 0); assert ((unsigned) g_last->top_reserved % g_regionsize == 0); assert ((unsigned) g_last->reserve_size % g_regionsize == 0); sbrk_exit: # if defined (USE_MALLOC_LOCK) && defined (NEEDED) /* Release spin lock */ slrelease (&g_sl); # endif return result; } /* mmap for windows */ static void *mmap (void *ptr, long size, long prot, long type, long handle, long arg) { static long g_pagesize; static long g_regionsize; # ifdef TRACE Parrot_io_printf (NULL, "mmap %d\n", size); # endif # if defined (USE_MALLOC_LOCK) && defined (NEEDED) /* Wait for spin lock */ slwait (&g_sl); # endif /* First time initialization */ if (! g_pagesize) g_pagesize = getpagesize (); if (! g_regionsize) g_regionsize = getregionsize (); /* Assert preconditions */ assert ((unsigned) ptr % g_regionsize == 0); assert (size % g_pagesize == 0); /* Allocate this */ ptr = VirtualAlloc (ptr, size, MEM_RESERVE | MEM_COMMIT | MEM_TOP_DOWN, PAGE_READWRITE); if (! ptr) { ptr = (void *) MORECORE_FAILURE; goto mmap_exit; } /* Assert postconditions */ assert ((unsigned) ptr % g_regionsize == 0); # ifdef TRACE Parrot_io_printf (NULL, "Commit %p %d\n", ptr, size); # endif mmap_exit: # if defined (USE_MALLOC_LOCK) && defined (NEEDED) /* Release spin lock */ slrelease (&g_sl); # endif return ptr; } /* munmap for windows */ static long munmap (void *ptr, long size) { static long g_pagesize; static long g_regionsize; int rc = MUNMAP_FAILURE; # ifdef TRACE Parrot_io_printf (NULL, "munmap %p %d\n", ptr, size); # endif # if defined (USE_MALLOC_LOCK) && defined (NEEDED) /* Wait for spin lock */ slwait (&g_sl); # endif /* First time initialization */ if (! g_pagesize) g_pagesize = getpagesize (); if (! g_regionsize) g_regionsize = getregionsize (); /* Assert preconditions */ assert ((unsigned) ptr % g_regionsize == 0); assert (size % g_pagesize == 0); /* Free this */ if (! VirtualFree (ptr, 0, MEM_RELEASE)) goto munmap_exit; rc = 0; # ifdef TRACE Parrot_io_printf (NULL, "Release %p %d\n", ptr, size); # endif munmap_exit: # if defined (USE_MALLOC_LOCK) && defined (NEEDED) /* Release spin lock */ slrelease (&g_sl); # endif return rc; } static void vminfo (CHUNK_SIZE_T *free, CHUNK_SIZE_T *reserved, CHUNK_SIZE_T *committed) { MEMORY_BASIC_INFORMATION memory_info; memory_info.BaseAddress = 0; *free = *reserved = *committed = 0; while (VirtualQuery (memory_info.BaseAddress, &memory_info, sizeof (memory_info))) { switch (memory_info.State) { case MEM_FREE: *free += memory_info.RegionSize; break; case MEM_RESERVE: *reserved += memory_info.RegionSize; break; case MEM_COMMIT: *committed += memory_info.RegionSize; break; } memory_info.BaseAddress = (char *) memory_info.BaseAddress + memory_info.RegionSize; } } static int cpuinfo (int whole, CHUNK_SIZE_T *kernel, CHUNK_SIZE_T *user) { if (whole) { __int64 creation64, exit64, kernel64, user64; int rc = GetProcessTimes (GetCurrentProcess (), (FILETIME *) &creation64, (FILETIME *) &exit64, (FILETIME *) &kernel64, (FILETIME *) &user64); if (! rc) { *kernel = 0; *user = 0; return FALSE; } *kernel = (CHUNK_SIZE_T) (kernel64 / 10000); *user = (CHUNK_SIZE_T) (user64 / 10000); return TRUE; } else { __int64 creation64, exit64, kernel64, user64; int rc = GetThreadTimes (GetCurrentThread (), (FILETIME *) &creation64, (FILETIME *) &exit64, (FILETIME *) &kernel64, (FILETIME *) &user64); if (! rc) { *kernel = 0; *user = 0; return FALSE; } *kernel = (CHUNK_SIZE_T) (kernel64 / 10000); *user = (CHUNK_SIZE_T) (user64 / 10000); return TRUE; } } #endif /* WIN32 */ /* ------------------------------------------------------------ History: V2.7.2 Sat Aug 17 09:07:30 2002 Doug Lea (dl at gee) * Fix malloc_state bitmap array misdeclaration V2.7.1 Thu Jul 25 10:58:03 2002 Doug Lea (dl at gee) * Allow tuning of FIRST_SORTED_BIN_SIZE * Use PTR_UINT as type for all ptr->int casts. Thanks to John Belmonte. * Better detection and support for non-contiguousness of MORECORE. Thanks to Andreas Mueller, Conal Walsh, and Wolfram Gloger * Bypass most of malloc if no frees. Thanks To Emery Berger. * Fix freeing of old top non-contiguous chunk im sysmalloc. * Raised default trim and map thresholds to 256K. * Fix mmap-related #defines. Thanks to Lubos Lunak. * Fix copy macros; added LACKS_FCNTL_H. Thanks to Neal Walfield. * Branch-free bin calculation * Default trim and mmap thresholds now 256K. V2.7.0 Sun Mar 11 14:14:06 2001 Doug Lea (dl at gee) * Introduce independent_comalloc and independent_calloc. Thanks to Michael Pachos for motivation and help. * Make optional .h file available * Allow > 2GB requests on 32bit systems. * new WIN32 sbrk, mmap, munmap, lock code from . Thanks also to Andreas Mueller , and Anonymous. * Allow override of MALLOC_ALIGNMENT (Thanks to Ruud Waij for helping test this.) * memalign: check alignment arg * realloc: don't try to shift chunks backwards, since this leads to more fragmentation in some programs and doesn't seem to help in any others. * Collect all cases in malloc requiring system memory into sYSMALLOc * Use mmap as backup to sbrk * Place all internal state in malloc_state * Introduce fastbins (although similar to 2.5.1) * Many minor tunings and cosmetic improvements * Introduce USE_PUBLIC_MALLOC_WRAPPERS, USE_MALLOC_LOCK * Introduce MALLOC_FAILURE_ACTION, MORECORE_CONTIGUOUS Thanks to Tony E. Bennett and others. * Include errno.h to support default failure action. V2.6.6 Sun Dec 5 07:42:19 1999 Doug Lea (dl at gee) * return null for negative arguments * Added Several WIN32 cleanups from Martin C. Fong * Add 'LACKS_SYS_PARAM_H' for those systems without 'sys/param.h' (e.g. WIN32 platforms) * Cleanup header file inclusion for WIN32 platforms * Cleanup code to avoid Microsoft Visual C++ compiler complaints * Add 'USE_DL_PREFIX' to quickly allow co-existence with existing memory allocation routines * Set 'malloc_getpagesize' for WIN32 platforms (needs more work) * Use 'assert' rather than 'ASSERT' in WIN32 code to conform to usage of 'assert' in non-WIN32 code * Improve WIN32 'sbrk()' emulation's 'findRegion()' routine to avoid infinite loop * Always call 'fREe()' rather than 'free()' V2.6.5 Wed Jun 17 15:57:31 1998 Doug Lea (dl at gee) * Fixed ordering problem with boundary-stamping V2.6.3 Sun May 19 08:17:58 1996 Doug Lea (dl at gee) * Added pvalloc, as recommended by H.J. Liu * Added 64bit pointer support mainly from Wolfram Gloger * Added anonymously donated WIN32 sbrk emulation * Malloc, calloc, getpagesize: add optimizations from Raymond Nijssen * malloc_extend_top: fix mask error that caused wastage after foreign sbrks * Add linux mremap support code from HJ Liu V2.6.2 Tue Dec 5 06:52:55 1995 Doug Lea (dl at gee) * Integrated most documentation with the code. * Add support for mmap, with help from Wolfram Gloger (Gloger@lrz.uni-muenchen.de). * Use last_remainder in more cases. * Pack bins using idea from colin@nyx10.cs.du.edu * Use ordered bins instead of best-fit threshold * Eliminate block-local decls to simplify tracing and debugging. * Support another case of realloc via move into top * Fix error occurring when initial sbrk_base not word-aligned. * Rely on page size for units instead of SBRK_UNIT to avoid surprises about sbrk alignment conventions. * Add mallinfo, mallopt. Thanks to Raymond Nijssen (raymond@es.ele.tue.nl) for the suggestion. * Add `pad' argument to malloc_trim and top_pad mallopt parameter. * More precautions for cases where other routines call sbrk, courtesy of Wolfram Gloger (Gloger@lrz.uni-muenchen.de). * Added macros etc., allowing use in linux libc from H.J. Lu (hjl@gnu.ai.mit.edu) * Inverted this history list V2.6.1 Sat Dec 2 14:10:57 1995 Doug Lea (dl at gee) * Re-tuned and fixed to behave more nicely with V2.6.0 changes. * Removed all preallocation code since under current scheme the work required to undo bad preallocations exceeds the work saved in good cases for most test programs. * No longer use return list or unconsolidated bins since no scheme using them consistently outperforms those that don't given above changes. * Use best fit for very large chunks to prevent some worst-cases. * Added some support for debugging V2.6.0 Sat Nov 4 07:05:23 1995 Doug Lea (dl at gee) * Removed footers when chunks are in use. Thanks to Paul Wilson (wilson@cs.texas.edu) for the suggestion. V2.5.4 Wed Nov 1 07:54:51 1995 Doug Lea (dl at gee) * Added malloc_trim, with help from Wolfram Gloger (wmglo@Dent.MED.Uni-Muenchen.DE). V2.5.3 Tue Apr 26 10:16:01 1994 Doug Lea (dl at g) V2.5.2 Tue Apr 5 16:20:40 1994 Doug Lea (dl at g) * realloc: try to expand in both directions * malloc: swap order of clean-bin strategy; * realloc: only conditionally expand backwards * Try not to scavenge used bins * Use bin counts as a guide to preallocation * Occasionally bin return list chunks in first scan * Add a few optimizations from colin@nyx10.cs.du.edu V2.5.1 Sat Aug 14 15:40:43 1993 Doug Lea (dl at g) * faster bin computation & slightly different binning * merged all consolidations to one part of malloc proper (eliminating old malloc_find_space & malloc_clean_bin) * Scan 2 returns chunks (not just 1) * Propagate failure in realloc if malloc returns 0 * Add stuff to allow compilation on non-ANSI compilers from kpv@research.att.com V2.5 Sat Aug 7 07:41:59 1993 Doug Lea (dl at g.oswego.edu) * removed potential for odd address access in prev_chunk * removed dependency on getpagesize.h * misc cosmetics and a bit more internal documentation * anticosmetics: mangled names in macros to evade debugger strangeness * tested on sparc, hp-700, dec-mips, rs6000 with gcc & native cc (hp, dec only) allowing Detlefs & Zorn comparison study (in SIGPLAN Notices.) Trial version Fri Aug 28 13:14:29 1992 Doug Lea (dl at g.oswego.edu) * Based loosely on libg++-1.2X malloc. (It retains some of the overall structure of old version, but most details differ.) */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4: */ gen_class.pl000755000765000765 403311606346603 16732 0ustar00brucebruce000000000000parrot-5.9.0/tools/dev#! perl # Copyright (C) 2001-2008, Parrot Foundation. =head1 NAME tools/dev/gen_class.pl - Create a template PMC file =head1 SYNOPSIS % perl tools/dev/gen_class.pl Foo > src/pmc/Foo.pmc =head1 DESCRIPTION Use this script to generate a template PMC file with stubs for all the methods you need to fill in. See F for more information on adding a new PMC to Parrot. To see what a minimal PMC looks like, create a PMC template and compile it to C. % perl tools/dev/gen_class.pl Foo > src/pmc/foo.pmc % perl tools/build/pmc2c.pl --dump src/pmc/foo.pmc % perl tools/build/pmc2c.pl -c src/pmc/foo.pmc =head1 SEE ALSO F, F. =cut use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../../lib"; use Parrot::Vtable; my $vtbl = parse_vtable("$FindBin::Bin/../../src/vtable.tbl"); my $classname = shift or die "No classname given!\n"; my $year = (localtime())[5] + 1900; # get current year. ## emit file header print <<"EOF"; /* ${classname}.pmc * Copyright (C) $year, Parrot Foundation. * Overview: * These are the vtable functions for the $classname base class * Data Structure and Algorithms: * History: * Notes: * Please remove unneeded entries. * References: */ #include "parrot/parrot.h" pmclass $classname { EOF my %skip_bodies = map { $_ => 1 } qw( type name get_namespace ); ## emit method bodies for (@$vtbl) { my ( $retval, $methname, $args ) = @$_; # default.pmc handles these next if exists $skip_bodies{$methname}; next if $methname =~ /prop/; print " $retval $methname($args) {\n"; if ( $retval ne 'void' ) { print $retval eq 'PMC*' ? " return PMCNULL;\n" : " return ($retval)0;\n"; } print " }\n\n"; } ## emit file footer print qq|} /* * Local Variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4: */|; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: MANIFEST.1defective000644000765000765 16311533177646 22374 0ustar00brucebruce000000000000parrot-5.9.0/t/tools/install/testlib# # generated by hand for testing purposes only CREDITS [] /destination/to/file ChangeLog tutorial_episode_5.pod000644000765000765 3576112101554066 24666 0ustar00brucebruce000000000000parrot-5.9.0/examples/languages/squaak/doc# Copyright (C) 2008-2012, Parrot Foundation. =pod =head1 DESCRIPTION This is the fifth episode in a tutorial series on building a compiler with the Parrot Compiler Tools. =head1 Episode 5: Variable Declaration and Scope Episode 4 discussed the implementation of some statement types, such as the if-statement. In this episode we'll talk about variable declarations and scope handling. It's going to be a long story, so take your time to read this episode. =head2 Globals, locals and default values Squaak variables have one of two scopes: either they're global, or they're local. In order to create a global variable, you just assign some expression to an identifier (which hasn't been declared as a local). Local variables, on the other hand, must be declared using the "var" keyword. In other words, at any given point during the parsing phase, we have a list of variables that are known to be local variables. When an identifier is parsed, it is looked up and if found, its scope is set to local. If not, its scope is assumed to be global. When using an uninitialized variable, its value is set to an object called C<"Undef">. Some examples are shown below. x = 42 # x was not declared, so it is global var k = 10 # k is local and initialized to 10 a + b # neither a nor b was declared; # both default to the value "Undef" =head2 Scoping and Symbol Tables Earlier we mentioned the need to store declared local variables. In compiler jargon, such a data structure to store declarations is called a I. For each individual scope, there's a separate symbol table. Squaak has a so-called do-block statement, that is defined below. rule statement:sym { 'end' } Each do-block defines a new scope; local variables declared between the C and C keywords are local to that block. An example to clarify this is shown below: do var x = 1 print(x) # prints 1 do var x = 2 print(x) # prints 2 end print(x) # prints 1 end So, each do/end pair defines a new scope, in which any declared variables hide variables with the same name in outer scopes. This behavior is common in many programming languages. The PCT has built-in support for symbol tables; a C object has a method symbol that can be used to enter new symbols and query the table for existing ones. In PCT, a C object represents a scope. There are two blocktypes: C and C. An "immediate" block can be used to represent the blocks of statements in an do-block statement, for instance: do end When executing this statement, block is executed immediately. A "declaration" block, on the other hand, represents a block of statements that can be invoked at a later point, typically these are subroutines. So, in this example: sub foo(x) print(x) end a C object is created for the subroutine "foo". The blocktype is set to "declaration", as the subroutine is defined, not executed (immediately). For now you can forget about the blocktype, but now that I've told you, you'll recognize it when you see it. We'll come back to it in a later episode. =head2 Implementing Scope So, we know how to use global variables, declare local variables, and about C objects representing scopes. How do we make our compiler to generate the right PIR instructions? After all, when handling a global variable, Parrot must handle this differently from handling a local variable. When creating C nodes to represent the variables, we must know whether the variable is a local or a global variable. So, when handling variable declarations (of local variables; globals are not declared), we need to register the identifier as a local in the current block's symbol table. First, we'll take a look at the implementation of variable declarations. =head2 Variable declaration The following is the grammar rule for variable declarations. This is a type of statement, so I assume you know how to extend the statement rule to allow for variable declarations. rule statement:sym { ['=' ]? } A local variable is declared using the C keyword, and has an optional initialization expression. If the latter is missing, the variable's value defaults to the undefined value called "Undef". Let's see what the parse action looks like: method statement:sym($/) { # get the PAST for the identifier my $past := $.ast; # this is a local (it's being defined) $past.scope('lexical'); # set a declaration flag $past.isdecl(1); # check for the initialization expression if $ { # use the viviself clause to add a # an initialization expression $past.viviself($[0].ast); } else { # no initialization, default to "Undef" $past.viviself('Undef'); } make $past; } Well, that wasn't too hard, was it? Let's analyze what we just did. First we retrieved the PAST node for the identifier, which we then decorated by setting its scope to "lexical" (a local variable is said to be lexically scoped, hence "lexical"), and setting a flag indicating this node represents a declaration (C). So, besides representing variables in other statements (for instance, assignments), a C node is also used as a declaration statement. Earlier in this episode we mentioned the need to register local variables in the current scope block when they are declared. So, when executing the parse action for variable-declaration, there should already be a C node around, that can be used to register the symbol being declared. As we learned in Episode 4, PAST nodes are created in a depth-first fashion; the leafs are created first, and then the nodes "higher" in the parse tree. This implies that a C node is created after the statement nodes (which C is) that will be the children of the block. In the next section we'll see how to solve this problem. =head2 Implementing a scope stack In order to make sure that a PAST::Block node is created before any statements are parsed (and their parse actions are executed -- these might need to enter symbols in the block's symbol table), we add a few extra parse actions. Let's take a look at them. Add this token to the grammar: token begin_TOP { } It uses something we haven't seen before, . The null pattern always returns true without consuming any text. Tokens consisting of only are frequently used to invoke additional action methods. Add this method to Actions.pm: method begin_TOP ($/) { our $?BLOCK := PAST::Block.new(:blocktype, :node($/), :hll); our @?BLOCK; @?BLOCK.unshift($?BLOCK); } We create a new C node and assign it to a strange-looking (if you don't know Perl, like me. Oh wait, this is Perl. Never mind..) variable called C<$?BLOCK>. This variable is declared as "our", which means that it is a package variable. This means that the variable is shared by all methods in the same package (or class), and, equally important, the variable is still around after the parse action is done. Please refer to the Perl 6 specification for more semantics on "our". The variable C<$?BLOCK> holds the current block. After that, this block is unshifted onto another funny-looking variable, called C<@?BLOCK>. This variable has a "@" sigil, meaning this is an array. The unshift method puts its argument on the front of the list. In a sense, you could think of the front of this list as the top of a stack. Later we'll see why this stack is necessary. This C<@?BLOCK> variable is also declared with "our", meaning it's also package-scoped. Since it's an array variable, it is automatically initialized with an empty ResizablePMCArray. Now we need to modify our TOP rule to call begin_TOP. rule TOP { <.begin_TOP> [ $ || <.panic: "Syntax error"> ] } "<.begin_TOP>" is just like , calling the subrule begin_TOP, with one difference: The <.subrule> form does not capture. Normally, when match a subrule , $ on the match object is bound to the subrule's match result. With <.foo>, $ is not bound. The parse action for begin_TOP is executed before any input is parsed, which is particularly suitable for any initialization actions you might need. The action for TOP is executed after the whole input string is parsed. Now we can create a C node before any statements are parsed, so that when we need the current block, it's there (somewhere, later we'll see where exactly). Let's take a look at the parse action for TOP. method TOP($/, $key) { our @?BLOCK; my $past := @?BLOCK.shift(); $past.push($.ast); make $past; } Let's take a quick look at the updated parse action for TOP, which is executed after the whole input string is parsed. The C node is retrieved from C<@?BLOCK>, which makes sense, as it was created in the first part of the method and unshifted on C<@?BLOCK>. Now this node can be used as the final result object of TOP. So, now we've seen how to use the scope stack, let's have a look at its implementation. =head2 Storing Symbols Now, we set up the necessary infrastructure to store the current scope block, and we created a datastructure that acts as a scope stack, which we will need later. We'll now go back to the parse action for statement:sym, because we didn't enter the declared variable into the current block's symbol table yet. We'll see how to do that now. First, we need to make the current block accessible from the method statement:sym. We've already seen how to do that, using the "our" keyword. It doesn't really matter where in the action method we enter the symbol's name into the symbol table, but let's do it at the end, after the initialization stuff. Naturally, we're only going to enter the symbol if it's not there already; duplicate variable declarations (in the same scope) should result in an error message (using the panic method of the match object). The code to be added to the method statement:sym looks then like this: method statement:sym($/) { our $?BLOCK; # get the PAST node for identifier # set the scope and declaration flag # do the initialization stuff # cache the name into a local variable my $name := $past.name(); if $?BLOCK.symbol( $name ) { # symbol is already present $/.CURSOR.panic("Error: symbol " ~ $name ~ " was already defined.\n"); } else { $?BLOCK.symbol( $name, :scope('lexical') ); } make $past; } =head2 What's Next? With this code in place, variable declarations are handled correctly. However, we didn't update the parse action for identifier, which creates the C node and sets its scope; currently all identifiers' scope is set to C (which means it's a global variable). As we already covered a lot of material in this episode, we'll leave this for the next episode. In the next episode, we'll also cover subroutines, which is another important aspect of any programming language. Hope to catch you later! =head2 Exercises =over 4 =item * In this episode, we changed the action method for the C rule; it is now invokes the new begin_TOP action at the beginning of the parse. The block rule, which defines a block to be a series of statements, represents a new scope. This rule is used in for instance if-statement (the then-part and else-part), while-statement (the loop body) and others. Add a new begin_block rule consisting of ; in the action for it, create a new PAST::Block and store it onto the scope stack. Update the rule for block so that it calls begin_block before parsing the statements. Update the parse action for block after parsing the statements, during which this PAST node is set as the result object. Make sure C<$?BLOCK> is always pointing to the current block. In order to do this exercise correctly, you should understand well what the shift and unshift methods do, and why we didn't implement methods to push and pop, which are more appropriate words in the context of a (scope) stack. =back =head2 Solution to the exercise =head3 Keeping the Current block up to date Sometimes we need to access the current block's symbol table. In order to be able to do so, we need a reference to the "current block". We do this by declaring a package variable called C<$?BLOCK>, declared with "our" (as opposed with "my"). This variable will always point to the "current" block. As blocks can nest, we use a "stack", on which newly created blocks are stored. Whenever a new block is created, we assign this to C<$?BLOCK>, and store it onto the stack, so that the next time a new block is created, the "old" current block isn't lost. Whenever a scope is closed, we pop off the current block from the stack, and restore the previous "current" block. =head3 Why unshift/shift and not push/pop? When we're talking about stacks, it would seem logical to talk about stack operations such as "push" and "pop". Instead, we use the operations "unshift" and "shift". If you're not a Perl programmer (such as myself), these names might not make sense. However, it's pretty easy. Instead of pushing a new object onto the "top" of the stack, you unshift objects onto this stack. Just see it as an old school bus, with only one entrance (at the front of the bus). Pushing a new person means taking the first free seat when entering, while unshifting a new person means everybody moves (shifts) one place to the back, so the new person can sit in the front seat. You might think this is not as efficient (more stuff is moved around), but that's not really true (actually: I guess (and certainly hope) the shift and unshift operations are implemented more effectively than the bus metaphor; I don't know how it is implemented). So why unshift/shift, and not push/pop? When restoring the previous "current block", we need to know exactly where it is (what position). It would be nice to be able to always refer to the "first passenger on the bus", instead of the last person. We know how to reference the first passenger (it's on seat no. 0 (it was designed by an IT guy)); we don't really know what is the seat no. of the last person: s/he might sit in the middle, or at the back. I hope it's clear what I mean here... otherwise, have a look at the code, and try to figure out what's happening: # In src/Squaak/Grammar.pm token begin_block { } rule block { <.begin_block> * } # In src/Squaak/Actions.pm method begin_block { our $?BLOCK; our @?BLOCK; $?BLOCK := PAST::Block.new(:blocktype('immediate'), :node($/)); @?BLOCK.unshift($?BLOCK); } method block($/, $key) { our $?BLOCK; our @?BLOCK; my $past := @?BLOCK.shift(); $?BLOCK := @?BLOCK[0]; for $ { $past.push($_.ast); } make $past; } =cut abc_basic000644000765000765 1704011533177634 21132 0ustar00brucebruce000000000000parrot-5.9.0/examples/languages/abc/t# single non-negative integer 1 1\n positive int 1 0 0\n zero 2 2\n positive int 12345678 12345678\n another positive int # single negative integer -1 -1\n negative one -12345678 -12345678\n another negative int # positive and negative Integers -1 -1\n unary - 0 0\n 0 without sign -0 0\n negative 0 -10 -10\n another negative int 0001 1\n int with pad -0001 -1\n negative int with pad # floats .1 + 1 1.1\n float with leading dot -1.0001 -1.0001\n negative float 1.2 1.2\n positive float 1.2*2-2.0+3 3.4\n float operation # binary plus 1+2 3\n two summands 1+2+3 6\n three summands 1+0+3 4\n three summands including 0 1+2+3+4+5+6+7+8+9+10 55\n ten summands -1+10 9\n negative int in expression # binary minus 2-1 1\n subtraction with two operands 1-1 0\n subtraction with two operands 1-2 -1\n subtraction with two operands -1- -2 1\n subtraction with two operands -1+ -2- -4+10 11\n subtraction with four operands -1- -6+3-2 6\n subtraction with five operands # multiplication 2*2 4\n multiplication with two operands 2*2*2 8\n multiplication with three operands 2*0 0\n multiplication with zero # division 2/2 1\n division with two operands 2/2/2 0.5\n division with three operands 0/2 0\n division with zero (not by zero) # modulus 2%2 0\n modulus with remainder zero 3%2 1\n modulus with remainder not zero # precedences 2/2+.1 1.1\n precedence of div 2*2+.4 4.4\n precedence of mul .1-6/2 -2.9\n precedente of div 2%2+4 4\n precedence of modulus # parenthesis (1) 1\n one in parenthesis (1+2)-3 0\n precedence of parenthesis -(1+2)-3 -6\n parenthesis with minus (1+2)-(5+1-2)+7-(8-100) 98\n various parenthesis (1+2)*3 9\n precedence of parenthesis (1*2)*3 6\n parenthesis with mul (1*2)+3 5\n parenthesis with plus (1*2)+((((3+4)+5)*6)*7) 506\n parenthesis within parenthesis # semicolons ; '' one semicolon ;1 1\n semicolon at the begging of line ;;;1 1\n more that one semicolon ;; '' only semicolons 1; 1\n semicolon at end of line 1;; 1\n more than one semicolon at the end 1; ; ; ;; 1\n more than one semicolon at end of line with ws 1; 2 1\n2\n two expressions separated by a semicolon 1;;;;; ; ; 2 1\n2\n two expressions separated by a semicolon and ws 1+1+1;2+2+2;3+3-1+3+1 3\n6\n9\n 3 additive expression with semicolons 1+1*1;2+2*2 2\n6\n additive and mul expression with semicolons 3-3/3;4+4%4; 5-5+5 2\n4\n5\n minus, mul, plus, mod expression # newlines 1\n1+1\n1+1+1 1\n2\n3 TODO parse error with newlines and new grammar # named expressions a 0\n uninitialized a a;b;c 0\n0\n0\n more uninitialized vars a;a=1;a 0\n1\n assign number to lexical a=11;-a -11\n assign number to lexical a;a=1+1;a 0\n2\n assign number to expression a;b;a=4;b=5;c=6;a;b;c 0\n0\n4\n5\n6\n assign several lexicals # increment and decrement a=a+1;a;a 1\n1\n simple increment ++k;k 1\n1\n pre-increment k++;k 0\n1\n post-increment --k;k -1\n-1\n pre-decrement k--;k 0\n-1\n post-decrement a;a=1;a;++a;a 0\n1\n2\n2\n increment test a;a=1;1;--a;a 0\n1\n0\n0\n decrement test # pow 1^1 1\n simple pow 2^2 4\n another simple pow 2^2^2 16\n two pows 2^2+1 5\n pow precedence 2^(2+1) 8\n pow precedence # strictly less 1<1 0\n false less 1<2 1\n true less 2<1 0\n false less 1+1<2+2 1\n precedence with plus # less than or equal 1<=1 1\n true less or equal 1<=2 1\n true less or equal 2<=1 0\n false less or equal 1+1<=1+1 1\n precedence with plus # strictly greater 1>1 0\n false greater 1>2 0\n false greater 2>1 1\n true greater 2+2>1+1 1\n precedence with plus # greater than or equal 1>=1 1\n true greater or equal 1>=2 0\n false greater or equal 2>=1 1\n true greater or equal 1+1<=1+1 1\n precedence with plus # equal and not equal 1==1 1\n true equal 1==0 0\n false equal 1!=1 0\n false not equal 1!=0 1\n true not equal # boolean operators !1 0\n not 1 !-1 0\n not negative 1 !0 1\n not 0 !0 1\n not 0 !!1 1\n not not 1 !!9 1\n not not 9 !!-1 1\n not not negative 1 !!0 0\n not not 0 1&&1 1\n 1 and 1 9&&-1 1\n and with other true integers 1&&0 0\n 1 and 0 0&&1 0\n 0 and 1 0&&0 0\n 0 and 0 1||1 1\n 1 or 1 1||0 1\n 1 or 0 0||1 1\n 0 or 1 0||0 0\n 0 or 0 1&&0||0&&1 0\n and/or precedence test 1 1||0&&0||1 1\n and/or precedence test 2 # Strings "basic calculator" basic calculator string "123456789" 123456789 string with digits only "abc 123456789" abc 123456789 string with digits and letters "first\nsecond" first\nsecond string with a newline managedstruct.t000644000765000765 1327411631440404 16605 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc#!./parrot # Copyright (C) 2001-2008, Parrot Foundation. =head1 NAME t/pmc/managedstruct.t - Managed C Structure =head1 SYNOPSIS % prove t/pmc/managedstruct.t =head1 DESCRIPTION Tests the ManagedStruct PMC. Checks element access and memory allocation. =cut .sub main :main .include 'test_more.pir' plan(26) set_managedstruct_size() element_access() named_element_access_int16() nested_struct_offsets() interface_check() destroy_custom() #clone_custom() realloc_free() .end .sub set_managedstruct_size new $P0, ['ManagedStruct'] set $I0,$P0 is($I0, 0, "empty ManagedStruct has size 0") set $P0,1 set $I0,$P0 is($I0, 1, "non-empty ManagedStruct has correct size") set $P0,2 set $I0,$P0 is($I0, 2, "non-empty ManagedStruct has correct size") .end #pasm_output_is( <<'CODE', <<'OUTPUT', "element access - float, double" ); .sub element_access #element access - float, double new $P2, ['ResizablePMCArray'] .include "datatypes.pasm" push $P2, .DATATYPE_FLOAT push $P2, 2 # 2 elem array push $P2, 0 push $P2, .DATATYPE_DOUBLE push $P2, 0 push $P2, 0 new $P0, ['ManagedStruct'], $P2 # must have set size automatically # this is hopefully 2*4+8 everywhere set $I0, $P0 is($I0, 16, "ManagedStruct has correct size") set $P0[0;0], 14.1 set $N0, $P0[0;0] set $P0[0;1], 14.2 set $P0[1], 14.3 set $N0, $P0[0;0] sub $N1, $N0, 14.1 cmp $I0, $N1, 0.000001 ok($I0, "stored float has correct value") set $N0, $P0[0;1] sub $N1, $N0, 14.2 cmp $I0, $N1, 0.000001 ok($I0, "stored float has correct value") set $N0, $P0[1] sub $N1, $N0, 14.3 cmp $I0, $N1, 0.000001 ok($I0, "stored float has correct value") #element access - char, short new $P2, ['ResizablePMCArray'] push $P2, .DATATYPE_CHAR push $P2, 2 # 2 elem char array push $P2, 0 new $P0, ['ManagedStruct'], $P2 set $I0, $P0 $I1 = isge $I0, 2 ok($I1, "ManagedStruct size is at least 2") set $P0[0;0], 1 set $P0[0;1], 258 # must be truncated to 2 set $I0, $P0[0;0] is($I0, 1, "char val of 1 is correct") set $I0, $P0[0;1] is($I0, 2, "char val of 258 retrieved as 2") # now access that as a short new $P2, ['ResizablePMCArray'] push $P2, .DATATYPE_SHORT push $P2, 1 push $P2, 0 assign $P0, $P2 # should be 2*256+1 or 1*256+2 set $I0, $P0[0] $I1 = $I0 == 513 $I2 = $I0 == 258 $I0 = $I1 | $I2 ok($I0, "short val retrieved correctly") .end .sub named_element_access_int16 new $P1, ['OrderedHash'] set $P1['x'], .DATATYPE_INT16 push $P1, 0 push $P1, 0 set $P1['y'], .DATATYPE_INTVAL push $P1, 0 push $P1, 0 # need a ManagedStruct to allocate data memory new $P2, ['ManagedStruct'], $P1 # set struct values by name set $I0, 2 set $P2["x"], $I0 set $I1, 16 set $S0, "y" set $P2[$S0], $I1 # get struct values by struct item idx set $I2, $P2[0] set $I3, $P2[1] is($I2, 2, "'x' value by idx is correct") is($I3, 16, "'y' value by idx is correct") # get struct values by name set $I2, $P2["x"] set $I3, $P2["y"] is($I2, 2, "'x' value by name is correct") is($I3, 16, "'y' value by name is correct") # try getting a string push_eh eh set $S0, $P2["x"] ok(0, "able to get a DATATYPE_INT16 as string") goto finally eh: .get_results($P3) is($P3, "returning unhandled string type in struct", "raised correct exception when trying to get DATATYPE_INT16 as string") finally: pop_eh .end #pasm_output_is( <<'CODE', <<'OUTPUT', "nested struct offsets" ); .sub nested_struct_offsets # the nested structure new $P3, ['ResizablePMCArray'] push $P3, .DATATYPE_INT push $P3, 0 push $P3, 0 push $P3, .DATATYPE_INT push $P3, 0 push $P3, 0 new $P4, ['UnManagedStruct'], $P3 # outer structure new $P2, ['ResizablePMCArray'] push $P2, .DATATYPE_INT push $P2, 0 push $P2, 0 push $P2, .DATATYPE_STRUCT # attach the unmanged struct as property set $P1, $P2[-1] setprop $P1, "_struct", $P4 push $P2, 0 push $P2, 0 push $P2, .DATATYPE_INT push $P2, 0 push $P2, 0 # attach struct initializer new $P5, ['UnManagedStruct'], $P2 # now check offsets set $I0, $P2[2] is($I0, 0, "offset 2 looks good") set $I0, $P2[5] is($I0, 4, "offset 5 looks good") set $I0, $P2[8] is($I0, 12, "offset 8 looks good") # nested set $I0, $P3[2] is($I0, 0, "nested offest 2 looks good") set $I0, $P3[5] is($I0, 4, "nested offset 5 looks good") # check struct size set $I0, $P5 is($I0, 16, "struct size looks good") # nested set $I0, $P4 is($I0, 8, "nested struct size looks good") .end .sub interface_check .local pmc pmc1 pmc1 = new ['ManagedStruct'] .local int bool1 does bool1, pmc1, "scalar" is(bool1, 1, "ManagedStruct does scalar") does bool1, pmc1, "no_interface" is(bool1, 0, "ManagedStruct doesn't do no_interface") .end .sub destroy_custom .local pmc pmc1 pmc1 = new ['ManagedStruct'] $P0 = get_global 'test_handler' # I'm not sure how to set custom_destroy func? #setattribute pmc1, "custom_free_func", $P0 null pmc1 sweep 1 .end .sub custom_destroyer say "ManagedStruct being custom destroyed here" #ok() .end .sub realloc_free .local pmc pmc1 pmc1 = new ['ManagedStruct'] # Allocate memory for the ms pmc1 = 1337 # And free is by setting it to zero. pmc1 = 0 ok(1, "Allocate and free") .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: oo5.pir000644000765000765 171311533177634 17676 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks# Copyright (C) 2004-2009, Parrot Foundation. .sub bench :main .local pmc cl cl = newclass "Foo" addattribute cl, ".i" addattribute cl, ".j" .local int typ .local int i i = 1 .local pmc o o = new "Foo" loop: $P4 = o."i"() .local pmc x x = new 'Integer' assign x, $P4 $P5 = o."j"() .local pmc y y = new 'Integer' assign y, $P5 inc i if i <= 50000 goto loop $P2 = o."i"() print $P2 print "\n" end .end .namespace ["Foo"] .sub init :method :vtable new $P10, 'Integer' set $P10, 10 setattribute self, ".i", $P10 new $P10, 'Integer' set $P10, 20 setattribute self, ".j", $P10 .end .sub i :method .local pmc r r = getattribute self, ".i" .return( r ) .end .sub j :method .local pmc r r = getattribute self, ".j" .return( r ) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: random.pir000644000765000765 137511533177635 20230 0ustar00brucebruce000000000000parrot-5.9.0/examples/shootout#!./parrot # Copyright (C) 2005-2009, Parrot Foundation. # # random.pir N (N = 900000 for shootout) # by Joshua Isom .sub main :main .param pmc argv $S0 = argv[1] $I0 = $S0 while_1: gen_random(100.0) dec $I0 if $I0 > 1 goto while_1 $N0 = gen_random(100.0) $P0 = new 'FixedFloatArray' $P0 = 1 $P0[0] = $N0 $S0 = sprintf "%.9f\n", $P0 print $S0 .return(0) .end .const num IM = 139968.0 .const num IA = 3877.0 .const num IC = 29573.0 .sub gen_random .param num max .local num last last = 42.0 loop: $N0 = last $N0 *= IA $N0 += IC $N0 %= IM $N1 = max $N1 *= $N0 $N1 /= IM last = $N0 .yield($N1) get_params "0", max goto loop .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: Group.pm000644000765000765 2056212101554067 17076 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/Docs# Copyright (C) 2004-2007, Parrot Foundation. =head1 NAME Parrot::Docs::Group - Group of documentation items =head1 SYNOPSIS use Parrot::Docs::Group; =head1 DESCRIPTION A documentation I is a number of items with some optional descriptive text. C is a subclass of C. =head2 Class Methods =over =cut package Parrot::Docs::Group; use strict; use warnings; use base qw( Parrot::Docs::Item ); =item C Returns a new group. Use this when creating groups within a C subclass's C method. =cut sub new_group { my $self = shift; return Parrot::Docs::Group->new(@_); } =item C Returns a new group. C<$name> and C<$text> are required, though the text can be an empty string. C<@contents> is one or more C instances, or relative paths. =cut sub new { my $self = ref $_[0] ? ref shift : shift; my $name = shift || die "No name.\n"; my $text = shift; my @contents = @_; $self = $self->SUPER::new( $text, @contents ); $self->{NAME} = $name; $self->{TITLE} = $name; $self->{PATH} = $text; return $self; } =back =head2 Instance Methods =over 4 =item C Returns the name of the group. =cut sub name { my $self = shift; return $self->{NAME}; } =item C Returns the documentation version number. =cut sub version { my $self = shift; return $self->{VERSION}; } =item C Groups have no HTML link. This method returns an empty string which will be discarded when building the navigation bar. =cut sub html_link { return ''; } =item C C is called on each item in the group. Some HTML-formatted text describing the files linked to is returned. =cut sub write_html { my $self = shift; my $index_html = $self->write_contents_html(@_); if ($index_html) { $index_html = "

    $self->{TITLE}

    \n\n
      $index_html
    \n\n"; } return $index_html; } =item C Iterates over the group's contents and calls C on each one. Some HTML-formatted text describing the files linked to is returned. =cut sub write_contents_html { my $self = shift; my $source = shift || die "No source\n"; my $target = shift || die "No target\n"; my $silent = shift || 0; my $index_html = ''; print "\n\n", $self->name unless $silent; foreach my $content ( $self->contents_relative_to_source($source) ) { $content->{TESTING} = 1 if $self->{TESTING}; $index_html .= $content->write_html( $source, $target, $silent ); } return $index_html; } =item C Returns the contents of the group interpreted relative to the source directory. =cut sub contents_relative_to_source { my $self = shift; my $source = shift; my @contents = (); foreach my $content ( @{ $self->{CONTENTS} } ) { if ( ref($content) ) { push @contents, $content; } else { # It would be good to check the short description for each # file and create an item for sequences of files with the # same description. push @contents, map { $self->new_item( '', $_ ) } $self->file_paths_relative_to_source( $source, $content ); } } foreach my $content (@contents) { # We wait until now to do this because only now are all # the contents guaranteed to be instances. # Remember that this method is also used by section. $content->set_parent($self); } return @contents; } sub build_toc_chm { my $self = shift; my $source = shift; my $indent = shift || "\t"; my $toc = q{}; $toc .= qq{$indent
  • \n}; $toc .= qq{$indent\t\n}; $toc .= qq{$indent\t\n} if ( exists $self->{INDEX_PATH} ); $indent .= "\t"; $toc .= qq{$indent\n}; $toc .= qq{$indent
      \n}; foreach my $content ( @{ $self->{CONTENTS} } ) { if ( ref $content ) { if ( $content->isa( 'Parrot::Docs::Group' ) ) { $toc .= $content->build_toc_chm( $source, $indent ); } else { foreach my $item ( @{ $content->{CONTENTS} } ) { my @rel_paths = $self->file_paths_relative_to_source( $source, $item ); foreach my $rel_path (@rel_paths) { my $file = $source->file_with_relative_path( $rel_path ); next if ( !$file->contains_pod && !$file->is_docs_link ); my $title = $file->title || $rel_path; $toc .= qq{$indent
    • \n}; $toc .= qq{$indent\t\n}; $toc .= qq{$indent\t\n}; $toc .= qq{$indent\t\n}; } } } } else { my @rel_paths = $self->file_paths_relative_to_source( $source, $content ); foreach my $rel_path (@rel_paths) { my $file = $source->file_with_relative_path( $rel_path ); next if ( !$file->contains_pod && !$file->is_docs_link ); my $title = $file->title || $rel_path; $toc .= qq{$indent
    • \n}; $toc .= qq{$indent\t\n}; $toc .= qq{$indent\t\n}; $toc .= qq{$indent\t\n}; } } } $toc .= qq{$indent
    \n}; return $toc; } sub build_index_chm { my $self = shift; my $source = shift; eval 'require Pod::PseudoPod::Index'; return q{} if $@; sub Pod::PseudoPod::Index::ourkeys { my $self = shift; $self->scan($self->{'index'}); return $self->{'ourkeys'}; } sub Pod::PseudoPod::Index::scan { my ($self,$node) = @_; foreach my $key (sort {lc($a) cmp lc($b)} keys %{$node}) { next if $key eq 'page'; push @{$self->{'ourkeys'}}, $key; $self->scan($node->{$key}); } } foreach my $content ( @{ $self->{CONTENTS} } ) { my @to_process; if ( ref $content && $content->isa( 'Parrot::Docs::Group' ) ) { $content->build_index_chm( $source ); } elsif ( ref $content ) { push @to_process, @{ $content->{CONTENTS} }; } else { push @to_process, $content; } foreach my $item ( @to_process ) { my @rel_paths = $self->file_paths_relative_to_source( $source, $item ); foreach my $rel_path (@rel_paths) { my $file = $source->file_with_relative_path( $rel_path ); next if ( !$file->contains_pod && !$file->is_docs_link ); my $title = $file->title || $rel_path; my $index_parser = Pod::PseudoPod::Index->new(); $index_parser->parse_file($file->{'PATH'}); my $ourkeys = $index_parser->ourkeys(); foreach my $k (@{$ourkeys}) { push @{$source->{'_INDEX'}{$k}}, $rel_path; } } } } my $index; for my $key (%{$source->{_INDEX}}) { next if ! defined $source->{_INDEX}{$key}; next if $key =~ /^\s*$/; $index .= qq{\t
  • \n}; $index .= qq{\t\t\n}; foreach my $ref (@{$source->{_INDEX}{$key}}) { (my $shortkey = $key) =~ s/( opcode \(PASM\)| directive| \(.*\)| \(.*\) instruction (PIR))//; $index .= qq{\t\t\n}; } $index .= qq{\t\t\n}; } return $index; } =back =head1 SEE ALSO =over 4 =item C =item C =back =cut 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: io.ops000644000765000765 1300312101554067 15251 0ustar00brucebruce000000000000parrot-5.9.0/src/ops/* * Copyright (C) 2002-2012, Parrot Foundation. ** io.ops */ BEGIN_OPS_PREAMBLE #include "../io/io_private.h" END_OPS_PREAMBLE =head1 NAME io.ops - I/O Opcodes =cut =head1 DESCRIPTION Parrot IO API When making changes to any ops file, run C to regenerate all generated ops files. =cut ############################################################################### =head2 Parrot IO API Operations =over 4 =cut ######################################## =item B(in INT) =item B(in NUM) =item B(invar PMC) =item B(in STR) Print $1 to standard output. =cut inline op print(in INT) :base_io { Parrot_io_printf(interp, INTVAL_FMT, (INTVAL)$1); } inline op print(in NUM) :base_io { #ifdef PARROT_HAS_NEGATIVE_ZERO Parrot_io_printf(interp, FLOATVAL_FMT, $1); #else /* Workaround for older msvcrt and openbsd. GH #366 */ if (Parrot_is_nzero($1)) { Parrot_io_printf(interp, "-0"); } else { Parrot_io_printf(interp, FLOATVAL_FMT, $1); } #endif } op print(in STR) :base_io { STRING * const s = $1; if (s && Parrot_str_byte_length(interp, s)) Parrot_io_putps(interp, _PIO_STDOUT(interp), s); } op print(invar PMC) :base_io { PMC * const p = $1; STRING * const s = (VTABLE_get_string(interp, p)); if (s) Parrot_io_putps(interp, _PIO_STDOUT(interp), s); } =item B(in INT) =item B(in NUM) =item B(invar PMC) =item B(in STR) Print $1 to standard output with a trailing newline. =cut inline op say(in INT) :base_io { Parrot_io_printf(interp, INTVAL_FMT "\n", (INTVAL)$1); } inline op say(in NUM) :base_io { #ifdef PARROT_HAS_NEGATIVE_ZERO Parrot_io_printf(interp, FLOATVAL_FMT "\n", $1); #else /* Workaround for older msvcrt and openbsd. GH #366 */ if (Parrot_is_nzero($1)) { Parrot_io_printf(interp, "-0\n"); } else { Parrot_io_printf(interp, FLOATVAL_FMT "\n", $1); } #endif } /* If the string argument can be extended by \n without copying, concat the strings before calling io_putps to provider better atomicity with threads. To avoid mixing strings with newlines in most cases. This is not foolproof of course. [GH #893] */ op say(in STR) :base_io { STRING * const s = $1; STRING * const nl = Parrot_str_new_constant(interp, "\n"); #ifdef PARROT_HAS_THREADS if (s) { int len = STRING_IS_NULL(s) ? 0 : s->bufused; if (len < 80) { Parrot_io_putps(interp, _PIO_STDOUT(interp), Parrot_str_concat(interp, s, nl)); } else { Parrot_io_putps(interp, _PIO_STDOUT(interp), s); Parrot_io_putps(interp, _PIO_STDOUT(interp), nl); } } else Parrot_io_putps(interp, _PIO_STDOUT(interp), nl); #else if (s) Parrot_io_putps(interp, _PIO_STDOUT(interp), s); Parrot_io_putps(interp, _PIO_STDOUT(interp), nl); #endif } op say(invar PMC) :base_io { PMC * const p = $1; if (PMC_IS_NULL(p)) { opcode_t *handler = Parrot_ex_throw_from_op_args(interp, expr NEXT(), EXCEPTION_UNEXPECTED_NULL, "Null PMC in say"); goto ADDRESS(handler); } else { STRING * const s = VTABLE_get_string(interp, p); STRING * const nl = Parrot_str_new_constant(interp, "\n"); #ifdef PARROT_HAS_THREADS if (s) { int len = STRING_IS_NULL(s) ? 0 : s->bufused; if (len < 80) { Parrot_io_putps(interp, _PIO_STDOUT(interp), Parrot_str_concat(interp, s, nl)); } else { Parrot_io_putps(interp, _PIO_STDOUT(interp), s); Parrot_io_putps(interp, _PIO_STDOUT(interp), nl); } } else Parrot_io_putps(interp, _PIO_STDOUT(interp), nl); #else if (s) Parrot_io_putps(interp, _PIO_STDOUT(interp), s); Parrot_io_putps(interp, _PIO_STDOUT(interp), nl); #endif } } ########################################## =item B(invar PMC, in INT) =item B(invar PMC, in NUM) =item B(invar PMC, in STR) =item B(invar PMC, invar PMC) Print $2 on the IO stream object $1. =cut op print(invar PMC, in INT) :base_io { if ($1) { STRING * const s = Parrot_str_from_int(interp, $2); Parrot_io_putps(interp, $1, s); } } op print(invar PMC, in NUM) :base_io { if ($1) { STRING * const s = Parrot_sprintf_c(interp, FLOATVAL_FMT, $2); Parrot_io_putps(interp, $1, s); } } op print(invar PMC, in STR) :base_io { if ($2 && $1) { Parrot_io_putps(interp, $1, $2); } } op print(invar PMC, invar PMC) :base_io { if ($2 && $1) { STRING * const s = VTABLE_get_string(interp, $2); Parrot_io_putps(interp, $1, s); } } =item B(out PMC) Create a new ParrotIO object for the stdin file descriptor and store it in $1 =item B(out PMC) Create a new ParrotIO object for the stdout file descriptor and store it in $1 =item B(out PMC) Create a new ParrotIO object for the stderr file descriptor and store it in $1 =cut inline op getstdin(out PMC) :base_io { $1 = _PIO_STDIN(interp); } inline op getstdout(out PMC) :base_io { $1 = _PIO_STDOUT(interp); } inline op getstderr(out PMC) :base_io { $1 = _PIO_STDERR(interp); } ############################################################################### /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ mandel.pir000644000765000765 355011533177634 17112 0ustar00brucebruce000000000000parrot-5.9.0/examples/pir# Copyright (C) 2005-2008, Parrot Foundation. =head1 NAME examples/pir/mandel.pir - Print the Mandelbrot set =head1 SYNOPSIS % ./parrot examples/pir/mandel.pir =head1 DESCRIPTION This prints an ASCII-art representation of the Mandelbrot set. Translated from C code by Glenn Rhoads into Parrot assembler by Leon Brocard . Translated from PASM to PIR by Bernhard Schmalhofer. The C code is: main() { int x, y, k; char *b = " .:,;!/>)|&IH%*#"; float r, i, z, Z, t, c, C; for (y=30; puts(""), C = y*0.1 - 1.5, y--;) { for (x=0; c = x*0.04 - 2, z=0, Z=0, x++ < 75;) { for (r=c, i=C, k=0; t = z*z - Z*Z + r, Z = 2*z*Z + i, z=t, k<112; k++) if (z*z + Z*Z > 10) break; printf ("%c", b[k%16]); } } } =cut .sub 'main' :main .local string b .local int x, y, k .local num r, i, z, Z, t, c, C b = " .:,;!/>)|&IH%*#" y = 30 YREDO: # C = y*0.1 - 1.5 C = y * 0.1 C -= 1.5 x = 0 XREDO: # c = x*0.04 - 2 c = x * 0.04 c -= 2 z = 0 Z = 0 r = c i = C k = 0 KREDO: # t = z*z - Z*Z + r $N1 = z * z $N2 = Z * Z t = $N1 - $N2 t += r # Z = 2*z*Z + i Z = 2 * Z Z = z * Z Z += i # z = t z = t # if (z*z + Z*Z > 10) break; $N1 = z * z $N2 = Z * Z $N1 += $N2 if $N1 > 10 goto PRINT inc k if k < 112 goto KREDO PRINT: $I1 = k % 16 $S1 = substr b, $I1, 1 print $S1 inc x if x < 75 goto XREDO print "\n" dec y if y > 0 goto YREDO .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: tutorial_episode_3.pod000644000765000765 4146312101554066 24660 0ustar00brucebruce000000000000parrot-5.9.0/examples/languages/squaak/doc# Copyright (C) 2008-2012, Parrot Foundation. =pod =head1 DESCRIPTION This is the third episode in a tutorial series on building a compiler with the Parrot Compiler Tools. =head1 Episode 3: Squaak Details and First Steps =head2 Introduction In the previous episodes we introduced the Parrot Compiler Tools (PCT). Starting from a high-level overview, we quickly created our own little scripting language called I, using a Perl script provided with Parrot. We discussed the general structure of PCT-based compilers, and each of the default four transformation phases. This third episode is where the Fun begins. In this episode, we'll introduce the full specification of Squaak. In this and following episodes, we'll implement this specification step by step in small easy-to-digest increments. So let's get started! =head2 Squaak Grammar Without further ado, here is the full grammar specification for Squaak. This specification uses the following meta-syntax: statement indicates a non-terminal, named "statement" {statement} indicates zero or more statements [step] indicates an optional step 'do' indicates the keyword 'do' Below is Squaak's grammar. The start symbol is C. program ::= {stat-or-def} stat-or-def ::= statement | sub-definition statement ::= if-statement | while-statement | for-statement | try-statement | throw-statement | variable-declaration | assignment | sub-call | do-block block ::= {statement} do-block ::= 'do' block 'end' if-statement ::= 'if' expression 'then' block ['else' block] 'end' while-statement ::= 'while' expression 'do' block 'end' for-statement ::= 'for' for-init ',' expression [step] 'do' block 'end' step ::= ',' expression for-init ::= 'var' identifier '=' expression try-statement ::= 'try' block 'catch' identifier block 'end' throw-statement ::= 'throw' expression sub-definition ::= 'sub' identifier parameters block 'end' parameters ::= '(' [identifier {',' identifier}] ')' variable-declaration ::= 'var' identifier ['=' expression] assignment ::= primary '=' expression sub-call ::= primary arguments primary ::= identifier postfix-expression* postfix-expression ::= key | index | member key ::= '{' expression '}' index ::= '[' expression ']' member ::= '.' identifier arguments ::= '(' [expression {',' expression}] ')' expression ::= expression {binary-op expression} | unary-op expression | '(' expression ')' | term term ::= float-constant | integer-constant | string-constant | array-constructor | hash-constructor | primary hash-constructor ::= '{' [named-field {',' named-field}] '}' named-field ::= string-constant '=>' expression array-constructor ::= '[' [expression {',' expression} ] ']' binary-op ::= '+' | '-' | '/' | '*' | '%' | '..' | 'and | 'or' | '>' | '>=' | '<' | '<=' | '==' | '!=' unary-op ::= 'not' | '-' Gee, that's a lot, isn't it? Actually, this grammar is rather small compared to "real world" languages such as C, not to mention Perl 6. No worries though, we won't implement the whole thing at once, but in small steps. What's more, the exercises section contains enough exercises for you to learn to use the PCT yourself! The solutions to these exercises are in later episodes if you don't want to take the time to solve them yourself. =head2 Semantics Most of the Squaak language is straightforward; the C executes exactly as you would expect. When we discuss a grammar rule (for its implementation), a semantic specification will be included. This is to avoid writing a complete language manual since that's probably not what you're here for. =head2 Let's get started! In the rest of this episode we will implement the basic parts of the grammar, such as the basic data types and assignments. At the end of this episode, you'll be able to assign simple values to (global) variables. It's not much but it's a very important first step. Once these basics are in place, you'll notice that adding a certain syntactic construct can be done in a matter of minutes. First, open your editor and open the files F and F. The former implements the parser using Perl 6 rules and the latter contains the parse actions, which are executed during the parsing stage. In the file Grammar.pm you'll see the top-level rule, named C. It's located at, ehm... the top. When the parser is invoked, it will start at this rule. A rule is nothing else than a method of the Grammar class. When we generated this language some default rules were defined. Now we're going to make some small changes, just enough to get us started. Replace the C rule with this rule: rule statement { } Replace the statement_list rule with this: rule statement_list { * } When you work on the action methods later, you'll also want to replace $ in the action method with $ Add these rules: rule stat_or_def { } rule assignment { '=' } rule primary { } token identifier { } token keyword { ['and'|'catch'|'do' |'else' |'end' |'for' |'if' |'not'|'or' |'sub' |'throw'|'try' |'var'|'while']>> } token term:sym { } Rename the token C<< term:sym >> to C<< term:sym >> and C<< term:sym >> to C<< term:sym >> (to better match our language specification). In F remove action methods for term:sym and term:sym in and add action methods for term:sym and term:sym: method term:sym($/) { make PAST::Val.new(:value($.ast), :returns); } method term:sym($/) { my $past := $.ast; $past.returns('String'); make $past; } method term:sym($/) { make $.ast; } PAST::Val nodes are used the represent constant values. Replace the statement_list method in F with this: method statement_list($/) { my $past := PAST::Stmts.new( :node($/) ); for $ { $past.push( $_.ast ); } make $past; } Finally, remove the rules C, C<< rule statement_control:sym >>, and C<< rule statement_control:sym >>. Phew, that was a lot of information! Let's have a closer look at some things that may look unfamiliar. The first new thing is in the rule C. Instead of the C keyword, you see the keyword C. In short, a token doesn't skip whitespace between the different parts specified in the token, while a rule does. For now, it's enough to remember to use a token if you want to match a string that doesn't contain any whitespace (such as literal constants and identifiers) and use a rule if your string does (and should) contain whitespace (such as a an if-statement). We shall use the word C in a general sense, which could refer to a token. For more information on rules and tokens take a look at Synopsis 5 or look at Moritz's blog post on the subject in the references. In rule C, the subrule is one that we haven't defined. The EXPR rule is inherited from HLL::Grammar, and it initiates the grammar's operator-precedence parser to parse an expression. For now, don't worry about it. All you need to know is that it will give us one of our terms. In token C the first subrule is called an assertion. It asserts that an C does not match the rule keyword. In other words a keyword cannot be used as an identifier. The second subrule is called C which is a built-in rule in the class C, the parent class of this grammar. In token C, all keywords of Squaak are listed. At the end there's a C<<< >> >>> marker, which indicates a word boundary. Without this marker, an identifier such as "forloop" would wrongly be disqualified, because the part "for" would match the rule keyword, and the part "loop" would match the rule "ident". However, as the assertion is false (as "for" could be matched), the string "forloop" cannot be matched as an identifier. The required presence of the word boundary prevents this. =head2 Testing the Parser It is useful to test the parser before writing any action methods. This can save you a lot of work; if you write the actions immediately after writing the grammar rules, and only later find out that your parser must be updated, then your action methods probably need to be updated as well. In Episode 2 we saw the target command line option. In order to test the parser, the "parse" target is especially helpful. When specifying this option, your compiler will print the parse tree of your input string, or print a syntax error. It is wise to test your parser with both correct and incorrect input, so you know for sure your parser doesn't accept input that it shouldn't. =head2 And... Action! Now we have implemented the initial version of the Squaak grammar, it's time to implement the parse actions we mentioned before. The actions are written in a file called F. If you look at the methods in this file, here and there you'll see that the C method being called on the match object ($/) , or rather, hash fields of it (like $). The special make function can be used to set the ast to a value. This means that each node in the parse tree (a Match object) can also hold its PAST representation. Thus we use the make function to set the PAST representation of the current node in the parse tree, and later use the C method to retrieve the PAST representation from it. In recap, the match object ($/) and any subrules of it (for instance $) represent the parse tree; of course, $ represents only the parse tree what the $ rule matched. So, any action method has access to the parse tree that the equally named grammar rule matched, as the match object is always passed as an argument. Calling the C method on a parse tree yields the PAST representation (obviously, this PAST object should be set using the make function). If you're following this tutorial, I highly advise you to get your feet wet, and do the exercises. Remember, learning and not doing is not learning (or something like that :-). This week's exercises are not that difficult, and after doing them, you'll have implemented the first part of our little Squaak language. Also note that your Squaak will not be running properly without completing them. =head2 What's next? In this episode we introduced the full grammar of Squaak. We took the first steps to implement this language. The first, and currently only, statement type is assignments. We briefly touched on how to write the action methods that are invoked during the parsing phase. In the next episode, we shall take a closer look on the different PAST node types, and implement some more parts of the Squaak language. Once we have all basic parts in place, adding statement types will be rather straightforward. In the mean time, if you have any questions or are stuck, don't hesitate to leave a comment or contact me. =head2 Exercises This episode's exercises are simple enough to get started on implementing Squaak. =over 4 =item 1. Look at the grammar rule for statement. A statement currently consists of an assignment. Implement the action method "statement" to retrieve the result object of this assignment and set it as statement's result object using the special make function. Do the same for rule primary. =item 2. Write the action method for the rule identifier. As a result object of this "match", a new PAST::Var node should be set, taking as name a string representation of the match object ($/). For now, you can set the scope to 'package'. See "pdd26: ast" for details on PAST::Var nodes. =item 3. Write the action method for assignment. Retrieve the result objects for "primary" and for "expression", and create a PAST::Op node that binds the expression to the primary. (Check out pdd26 for PAST::Op node types, and find out how you do such a binding). =item 4. Write the action method for stat_or_def. Simply retrieve the result object from statement and make that the result object. =item 5. Run your compiler on a script or in interactive mode. Use the target option to see what PIR is being generated on the input "x = 42". =back =head2 Some Notes =over 4 =item * Help! I get the error message "no result object". This means that the result object was not set properly (duh!). Make sure there is an action method for that rule and that "make" is used to set the appropriate PAST node. Note that not all rules have action methods, for instance the C rule (there's no point in that). =item * While we're constructing parts of Squaak's grammar, we'll sometimes make a shortcut, by forgetting about certain rules for a while. For instance, you might have noticed we're ignoring float-constants right now. That's ok. When we'll need them, these rules will be added. =back =head2 References =over 4 =item * rules, regexes and tokens: http://perlgeek.de/blog-en/perl-5-to-6/07-rules.writeback#Named_Regexes_and_Grammars =item * pdd26: ast =item * synopsis 5: Rules =item * docs/pct/*.pod =back =head2 Solutions to the exercises By now, you may have finished the PCT tutorial. If you felt too lazy to do the exercises or if you want to see what solution I had in mind, here are the solutions to the exercises in Episode 3 (Episode 1's exercise was discussed at the end of Episode 2, and the latter didn't have any coding assignments). =over 4 =item 1 Look at the grammar rule for statement. A statement currently consists of an assignment. Implement the action method "statement" to retrieve the result object of this assignment and set it as statement's result object using the special make function. Do the same for rule primary. method statement($/) { make $.ast; } method primary($/) { make $.ast; } =item 2 Write the action method for the rule identifier. As a result object of this "match", a new C node should be set, taking as name a string representation of the match object ($/). For now, you can set the scope to 'package'. See "pdd26: ast" for details on C nodes. method identifier($/) { make PAST::Var.new( :name(~$/), :scope('package'), :node($/) ); } =item 3 Write the action method for assignment. Retrieve the result objects for "primary" and for "expression", and create a C node that binds the expression to the primary. (Check out pdd26 for C node types, and find out how you do such a binding). method assignment($/) { my $lhs := $.ast; my $rhs := $.ast; $lhs.lvalue(1); make PAST::Op.new( $lhs, $rhs, :pasttype('bind'), :node($/) ); } Note that we set the lvalue flag on $lhs. See PDD26 for details on this flag. =item 4 Write the action method for stat_or_def. Simply retrieve the result object from statement and make that the result object. method stat_or_def($/) { make $.ast; } =item 5 Run your compiler on a script or in interactive mode. Use the target option to see what PIR is being generated on the input "x = 42". .namespace.sub "_block10" new $P11, "Integer" assign $P11, 42 set_global "x", $P11 .return ($P11) .end The first two lines of code in the sub create an object to store the number 42, the third line stores this number as "x". The PAST compiler will always generate an instruction to return the result of the last statement, in this case C<$P11>. =back =cut socket_ipv6.t000644000765000765 1140411606346603 16201 0ustar00brucebruce000000000000parrot-5.9.0/t/pmc#!./parrot # Copyright (C) 2010, Parrot Foundation. =head1 NAME t/pmc/socket_ipv6.t - tests for the Socket PMC that require IPv6 =head1 SYNOPSIS % prove t/pmc/socket_ipv6.t =head1 DESCRIPTION IPv6-related tests for the Socket PMC. =cut .include 'socket.pasm' .include 'iglobals.pasm' .include 'errors.pasm' .sub main :main .include 'test_more.pir' plan(11) check_for_ipv6() test_tcp_socket6() test_udp_socket6() test_bind() test_server() .end .sub test_bind .local pmc sock, addrinfo, addr, it .local string str .local string expected_host, expected_port, expected_str .local int count, port sock = new 'Socket' sock.'socket'(.PIO_PF_INET6, .PIO_SOCK_STREAM, .PIO_PROTO_TCP) port = 1234 push_eh error_6 retry_6: addrinfo = sock.'getaddrinfo'('::1', port, .PIO_PROTO_TCP, .PIO_PF_INET6, 1) # output addresses for debugging it = iter addrinfo count = 1 loop: addr = shift it print '# address ' print count print ': family ' $I0 = addr[0] print $I0 print ', type ' $I0 = addr[1] print $I0 print ', protocol ' $I0 = addr[2] print $I0 print "\n" inc count if it goto loop sock.'bind'(addrinfo) goto started_6 error_6: inc port if port < 1244 goto retry_6 pop_eh .local pmc exception .get_results(exception) throw exception started_6: pop_eh str = sock.'local_address'() expected_port = port # need to coerce into a string expected_str = "::1:" . expected_port is(str, expected_str, "local address of bound socket is ::1") sock.'close'() # start again with an IPv4 address retry_4: push_eh error_4 sock.'socket'(.PIO_PF_INET, .PIO_SOCK_STREAM, .PIO_PROTO_TCP) addrinfo = sock.'getaddrinfo'('127.0.0.1', port, .PIO_PROTO_TCP, .PIO_PF_INET, 1) sock.'bind'(addrinfo) goto started_4 error_4: inc port if port < 1244 goto retry_4 pop_eh .local pmc exception .get_results(exception) throw exception started_4: pop_eh str = sock.'local_address'() expected_port = port # need to coerce into a string expected_str = "127.0.0.1:" . expected_port is(str, expected_str, "local address of bound socket is 127.0.0.1") sock.'close'() .end .sub test_server .local pmc interp, conf, server, sock, address, result .local string command, str, null_string, part, expected_str .local int status, port interp = getinterp conf = interp[.IGLOBALS_CONFIG_HASH] run_tests: command = '"' str = conf['build_dir'] command .= str str = conf['slash'] command .= str command .= 'parrot' str = conf['exe'] command .= str command .= '" t/pmc/testlib/test_server_ipv6.pir' server = new 'FileHandle' server.'open'(command, 'rp') str = server.'readline'() part = substr str, 0, 34 is(part, 'Server started, listening on port ', 'Server process started') part = substr str, 34, 4 port = part sock = new 'Socket' sock.'socket'(.PIO_PF_INET6, .PIO_SOCK_STREAM, .PIO_PROTO_TCP) address = sock.'getaddrinfo'(null_string, port, .PIO_PROTO_TCP, .PIO_PF_INET6, 0) sock.'connect'(address) str = server.'readline'() expected_str = "Connection from ::1:" . part expected_str .= "\n" is(str, expected_str, 'Server got a connection') status = sock.'send'('test message') is(status, '12', 'send') str = sock.'recv'() is(str, 'test message', 'recv') sock.'close'() server.'close'() status = server.'exit_status'() nok(status, 'Exit status of server process') .end .sub check_for_ipv6 $P0 = getinterp $P1 = $P0[.IGLOBALS_CONFIG_HASH] $P2 = $P1['HAS_IPV6'] $I1 = isnull $P2 if $I1, no_ipv6 say '# This Parrot is IPv6-aware' goto done no_ipv6: diag( 'No IPv6' ) skip(11) exit 0 done: .end .sub test_tcp_socket6 .local pmc sock, sockaddr sock = new 'Socket' sock.'socket'(.PIO_PF_INET6, .PIO_SOCK_STREAM, .PIO_PROTO_TCP) sockaddr = sock."sockaddr"('::1', 80, .PIO_PF_INET6) isa_ok(sockaddr,'Sockaddr',"A TCP ipv6 sockaddr to localhost was set") sockaddr = sock."sockaddr"("::1", 80, .PIO_PF_INET6) isa_ok(sockaddr,'Sockaddr',"A TCP ipv6 sockaddr to ::1 was set") .end .sub test_udp_socket6 .local pmc sock, sockaddr sock = new 'Socket' sock.'socket'(.PIO_PF_INET6, .PIO_SOCK_DGRAM, .PIO_PROTO_UDP) sockaddr = sock."sockaddr"('::1', 80, .PIO_PF_INET6) isa_ok(sockaddr,'Sockaddr', "A UDP ipv6 sockaddr to localhost was set:") sockaddr = sock."sockaddr"("::1", 80, .PIO_PF_INET6) isa_ok(sockaddr,'Sockaddr', "A UDP ipv6 sockaddr to ::1 was set:") .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: c_function_docs.t000644000765000765 537312144503005 20260 0ustar00brucebruce000000000000parrot-5.9.0/t/codingstd#! perl # Copyright (C) 2006-2012, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Config qw(%PConfig); use Parrot::Distribution; use Parrot::Headerizer; =head1 NAME t/codingstd/c_function_docs.t - checks for missing function documentation =head1 SYNOPSIS # test all files % prove t/codingstd/c_function_docs.t # test specific files % perl t/codingstd/c_function_docs.t src/foo.c include/parrot/bar.h =head1 DESCRIPTION Checks that all C language source files have documentation for each function declared. =cut my $DIST = Parrot::Distribution->new; my $headerizer = Parrot::Headerizer->new; # can not handle .ops or .pmc files yet my @files = grep {/\.(c|h)$/ } @ARGV ? @ARGV : map {s/^$PConfig{build_dir}\///; $_} map {s/\\/\//g; $_} map {$_->path} $DIST->get_c_language_files(); plan tests => (scalar @files) * 2; my %todos; while () { next if /^#/; next if /^\s*$/; chomp; $todos{$_} = 1; } foreach my $path (@files) { my $buf = $DIST->slurp($path); my @missing_docs; my @bad_order; my @function_decls = $headerizer->extract_function_declarations($buf); for my $function_decl (@function_decls) { if ($function_decl =~ m/^(\S+)\s+PARROT_EXPORT/s and $1 !~ /^PARROT_CAN(?:NOT)?_RETURN_NULL/) { push @bad_order, $function_decl; } my $escaped_decl = $headerizer->generate_documentation_signature($function_decl); my $missing = ''; if ( $buf =~ m/^\Q$escaped_decl\E$(.*?)^=cut/sm ) { my $docs = $1; $docs =~ s/\s//g; if ($docs eq '') { $missing = 'boilerplate only'; } # else: docs! } else { $missing = 'missing'; } if ($missing) { if ($missing eq 'boilerplate only') { push @missing_docs, "$path ($missing)\nIn:\n$escaped_decl\n"; } else { push @missing_docs, "$path ($missing)\n$function_decl\nWant:\n$escaped_decl\n"; } } } TODO: { local $TODO = 'Missing function docs' if $todos{$path}; is( @missing_docs, 0, "$path: C functions documented") or diag( @missing_docs . " function(s) lacking documentation:\n" . join ("\n", @missing_docs, "\n")); } is( @bad_order, 0, "$path: PARROT_EXPORT, if present, is in correct position") or diag( @bad_order . " function(s) have PARROT_EXPORT in position other than first:\n" . join ("\n", @bad_order, "\n")); } __DATA__ # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: CREDITS000644000765000765 127411567202623 15566 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx=pod Following in the steps of other open source projects that eventually take over the world, here is the partial list of people who have contributed to Rakudo and its supporting works. It is sorted by name and formatted to allow easy grepping and beautification by scripts. The fields are: name (N), email (E), web-address (W), description (D), Git username (U) and snail-mail address (S). Thanks, The NQP Team PS: Yes, this looks remarkably like the Linux CREDITS format PPS: This file is encoded in UTF-8 ---------- N: Patrick R. Michaud U: pmichaud D: Perl 6 (Rakudo Perl) lead developer, pumpking E: pmichaud@pobox.com =cut 47-loop-control.t000644000765000765 61112135343346 20625 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx/t/nqp#!./parrot-nqp plan(3); my $runs := 0; while $runs < 5 { $runs++; last if $runs == 3; } ok($runs == 3, "last works in while"); $runs := 0; my $i := 0; while $runs < 5 { $runs++; next if $runs % 2; $i++; } ok($i == 2, "next works in while"); $runs := 0; $i := 0; while $i < 5 { $runs++; redo if $runs % 2; $i++; } ok($runs == 10, "redo works in while"); utf8_base64.pl000644000765000765 266212101554066 20370 0ustar00brucebruce000000000000parrot-5.9.0/examples/library#! perl # Copyright (C) 2012, Parrot Foundation. =head1 NAME examples/mime_base64/utf_base64.pl - Conformant MIME::Base64 utf8 handling =head1 SYNOPSIS % perl examples/mime_base64/utf_base64.pl =head1 DESCRIPTION Compare conformant coreutils C and F against parrots. See L Note: Unicode stored as MIME::Base64 is inherently endian-dependent. =cut use strict; use warnings; use MIME::Base64 qw(encode_base64 decode_base64); use Encode qw(encode); my $encoded = encode_base64(encode("UTF-8", "\x{a2}")); print "encode: utf-8:\"\\x{a2}\" - ", encode("UTF-8", "\x{a2}"), "\n"; print "expected: wqI=\n"; print "result: $encoded\n"; print "decode: ",decode_base64("wqI="),"\n\n"; # 302 242 my $encoded = encode_base64(encode("UTF-8", "\x{203e}")); print "encode: utf-8:\"\\x{203e}\" -> ",encode("UTF-8", "\x{203e}"),"\n"; print "expected: 4oC+\n"; print "result: $encoded\n"; # 342 200 276 print "decode: ",decode_base64("4oC+"),"\n"; for ([qq(a2)],[qq(c2a2)],[qw(203e)],[qw(3e 20)],[qw(1000)],[qw(00c7)],[qw(00ff 0000)]){ $s = pack "H*",@{$_}; printf "0x%s\t=> %s", join("",@{$_}), encode_base64($s); } =head1 AUTHORS ronaldxs, Reini Urban =head1 SEE ALSO F, =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: inter_cb.c000644000765000765 2560612101554067 16564 0ustar00brucebruce000000000000parrot-5.9.0/src/interp/* Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME src/interp/inter_cb.c - Parrot Interpreter - Callback Function Handling =head1 DESCRIPTION NCI callback functions may run whenever the C code executes the callback. To be prepared for asynchronous callbacks these are converted to callback events. Often callbacks should run synchronously. This can only happen when the C-library calls the callback, because Parrot called a function in the C-library. =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" #include "parrot/extend.h" #include "pmc/pmc_parrotinterpreter.h" #include "pmc/pmc_callback.h" #include "inter_cb.str" static Interp * default_interp = NULL; /* HEADERIZER HFILE: include/parrot/interpreter.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void callback_CD(PARROT_INTERP, ARGIN(char *external_data), ARGMOD(PMC *user_data)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*user_data); static void verify_CD( ARGIN(char *external_data), ARGMOD_NULLOK(PMC *user_data)) __attribute__nonnull__(1) FUNC_MODIFIES(*user_data); #define ASSERT_ARGS_callback_CD __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(external_data) \ , PARROT_ASSERT_ARG(user_data)) #define ASSERT_ARGS_verify_CD __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(external_data)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Create a callback function according to pdd16. =cut */ PARROT_EXPORT PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT PMC* Parrot_make_cb(PARROT_INTERP, ARGMOD(PMC* sub), ARGIN(PMC* user_data), ARGIN(STRING *cb_signature)) { ASSERT_ARGS(Parrot_make_cb) PMC *cb, *cb_sig; int type = 0; STRING *sc; /* * we stuff all the information into the user_data PMC and pass that * on to the external sub */ PMC * const interp_pmc = VTABLE_get_pmc_keyed_int(interp, interp->iglobals, (INTVAL) IGLOBALS_INTERPRETER); if (default_interp == NULL) default_interp = interp; /* be sure __LINE__ is consistent */ sc = CONST_STRING(interp, "_interpreter"); Parrot_pmc_setprop(interp, user_data, sc, interp_pmc); sc = CONST_STRING(interp, "_sub"); Parrot_pmc_setprop(interp, user_data, sc, sub); /* only ASCII signatures are supported */ if (STRING_length(cb_signature) == 3) { /* Callback return type ignored */ if (STRING_ord(interp, cb_signature, 1) == 'U') { type = 'D'; } else { if (STRING_ord(interp, cb_signature, 2) == 'U') { type = 'C'; } } } if (type != 'C' && type != 'D') Parrot_ex_throw_from_c_args(interp, NULL, 1, "unhandled signature '%Ss' in make_cb", cb_signature); cb_sig = Parrot_pmc_new(interp, enum_class_String); VTABLE_set_string_native(interp, cb_sig, cb_signature); sc = CONST_STRING(interp, "_signature"); Parrot_pmc_setprop(interp, user_data, sc, cb_sig); /* * We are going to be passing the user_data PMC to external code, but * it may go out of scope until the callback is called -- we don't know * for certain as we don't know when the callback will be called. * Therefore, to prevent the PMC from being destroyed by a GC sweep, * we need to anchor it. * */ Parrot_pmc_gc_register(interp, user_data); /* * Finally, the external lib awaits a function pointer. * Create a PMC that points to Parrot_callback_C (or _D); * it can be passed on with signature 'p'. */ cb = Parrot_pmc_new(interp, enum_class_UnManagedStruct); /* * Currently, we handle only 2 types: * _C ... user_data is 2nd parameter * _D ... user_data is 1st parameter */ if (type == 'C') VTABLE_set_pointer(interp, cb, F2DPTR(Parrot_callback_C)); else VTABLE_set_pointer(interp, cb, F2DPTR(Parrot_callback_D)); Parrot_pmc_gc_register(interp, cb); return cb; } /* =item C Verify user_data PMC then continue with callback_CD =cut */ static void verify_CD(ARGIN(char *external_data), ARGMOD_NULLOK(PMC *user_data)) { ASSERT_ARGS(verify_CD) PARROT_INTERP = default_interp; PMC *interp_pmc; STRING *sc; /* * 1.) user_data is from external code so: * verify that we get a PMC that is one that we have passed in * as user data, when we prepared the callback */ /* a NULL pointer or a pointer not aligned is very likely wrong */ if (!user_data) PANIC(interp, "user_data is NULL"); if (PMC_IS_NULL(user_data)) PANIC(interp, "user_data is PMCNULL"); if ((ptrcast_t)user_data & 3) PANIC(interp, "user_data doesn't look like a pointer"); /* Fetch original interpreter from prop */ sc = CONST_STRING(interp, "_interpreter"); interp_pmc = Parrot_pmc_getprop(interp, user_data, sc); GETATTR_ParrotInterpreter_interp(interp, interp_pmc, interp); if (!interp) PANIC(interp, "interpreter not found for callback"); /* * 2) some more checks * now we should have the interpreter where that callback * did originate - do some further checks on the PMC */ /* if that doesn't look like a PMC we are still lost */ if (!PObj_is_PMC_TEST(user_data)) PANIC(interp, "user_data isn't a PMC"); if (!user_data->vtable) PANIC(interp, "user_data hasn't a vtable"); /* * ok fine till here */ callback_CD(interp, external_data, user_data); } /* =item C Common callback function handler. See pdd16. =cut */ static void callback_CD(PARROT_INTERP, ARGIN(char *external_data), ARGMOD(PMC *user_data)) { ASSERT_ARGS(callback_CD) PMC *passed_interp; /* the interp that originated the CB */ PMC *passed_synchronous; /* flagging synchronous execution */ int synchronous = 0; /* cb is hitting this sub somewhen * inmidst, or not */ STRING *sc; /* * 3) check interpreter ... */ sc = CONST_STRING(interp, "_interpreter"); passed_interp = Parrot_pmc_getprop(interp, user_data, sc); if (VTABLE_get_pointer(interp, passed_interp) != interp) PANIC(interp, "callback gone to wrong interpreter"); sc = CONST_STRING(interp, "_synchronous"); passed_synchronous = Parrot_pmc_getprop(interp, user_data, sc); if (!PMC_IS_NULL(passed_synchronous) && VTABLE_get_bool(interp, passed_synchronous)) synchronous = 1; /* * 4) check if the call_back is synchronous: * - if yes we are inside the NCI call * we could run the Sub immediately now (I think) * - if no, and that's always safe, post a callback event */ if (synchronous) { /* * just call the sub */ Parrot_run_callback(interp, user_data, external_data); } else { /* * create a CB_EVENT, put user_data and data inside and finito * * *if* this function is finally no void, i.e. the calling * C program awaits a return result from the callback, * then wait for the CB_EVENT_xx to finish and return the * result */ PMC * const callback = Parrot_pmc_new(interp, enum_class_Callback); Parrot_Callback_attributes * const cb_data = PARROT_CALLBACK(callback); cb_data->user_data = user_data; cb_data->external_data = (PMC*) external_data; Parrot_cx_schedule_immediate(interp, callback); } } /* =item C Run a callback function. The PMC* user_data holds all necessary items in its properties. =cut */ PARROT_EXPORT void Parrot_run_callback(PARROT_INTERP, ARGMOD(PMC* user_data), ARGIN(void* external_data)) { ASSERT_ARGS(Parrot_run_callback) PMC *signature; PMC *sub; STRING *sig_str; INTVAL ch; char pasm_sig[5]; INTVAL i_param; PMC *p_param; void *param = NULL; /* avoid -Ox warning */ STRING *sc; sc = CONST_STRING(interp, "_sub"); sub = Parrot_pmc_getprop(interp, user_data, sc); sc = CONST_STRING(interp, "_signature"); signature = Parrot_pmc_getprop(interp, user_data, sc); sig_str = VTABLE_get_string(interp, signature); pasm_sig[0] = 'P'; ch = STRING_ord(interp, sig_str, 1); if (ch == 'U') /* user_data Z in pdd16 */ ch = STRING_ord(interp, sig_str, 2); /* ch is now type of external data */ switch (ch) { case 'v': pasm_sig[1] = 'v'; break; case 'l': /* FIXME: issue #742 */ i_param = (INTVAL)(long)(INTVAL) external_data; goto case_I; case 'i': /* FIXME: issue #742 */ i_param = (INTVAL)(int)(INTVAL) external_data; goto case_I; case 's': /* FIXME: issue #742 */ i_param = (INTVAL)(short)(INTVAL) external_data; goto case_I; case 'c': /* FIXME: issue #742 */ i_param = (INTVAL)(char)(INTVAL) external_data; case_I: pasm_sig[1] = 'I'; param = (void*) i_param; break; case 'p': /* created a UnManagedStruct */ p_param = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, p_param, external_data); pasm_sig[1] = 'P'; param = (void*) p_param; break; case 't': pasm_sig[1] = 'S'; param = Parrot_str_new(interp, (const char*)external_data, 0); break; default: Parrot_ex_throw_from_c_args(interp, NULL, 1, "unhandled signature char '%c' in run_cb", ch); } pasm_sig[2] = '-'; pasm_sig[3] = '>'; /* no return value supported yet */ pasm_sig[4] = '\0'; Parrot_ext_call(interp, sub, pasm_sig, user_data, param); } /* =item C =item C NCI callback functions. See pdd16. =cut */ PARROT_EXPORT void Parrot_callback_C(ARGIN(char *external_data), ARGMOD_NULLOK(PMC *user_data)) { ASSERT_ARGS(Parrot_callback_C) verify_CD(external_data, user_data); } PARROT_EXPORT void Parrot_callback_D(ARGMOD(PMC *user_data), ARGMOD_NULLOK(char *external_data)) { ASSERT_ARGS(Parrot_callback_D) verify_CD(external_data, user_data); } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ test_c.in000644000765000765 161311567202622 20731 0ustar00brucebruce000000000000parrot-5.9.0/config/auto/attributes/* Copyright (C) 2007-2009, Parrot Foundation. figure out if the compiler supports attributes. see parrot/compiler.h for attribute value definitions. */ #include #include #include "parrot/compiler.h" __attribute__malloc__ __attribute__noreturn__ __attribute__warn_unused_result__ __attribute__deprecated__ void * dummyfunc(const char *my_format, ...) __attribute__format__(printf, 1, 2) __attribute__nonnull__(1) ; __attribute__const__ int constfunc(int x); __attribute__pure__ int purefunc(int x); __attribute__hot__ int hotfunc(int x); __attribute__cold__ int coldfunc(int x); static int useless(void) { int x __attribute__unused__; return 0; } /* as long as the file compiles, everything is okay */ int main() { return EXIT_SUCCESS; } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ pdd11_extending.pod000644000765000765 2763712101554066 21214 0ustar00brucebruce000000000000parrot-5.9.0/docs/pdds/draft# Copyright (C) 2001-2010, Parrot Foundation. =head1 [DRAFT] PDD 11: Extending =head2 Abstract The extension API for Parrot is a simple, somewhat abstract, interface to Parrot for code written in C or other compiled languages. It provides about the same level of access to Parrot that bytecode programs have. =head2 Description The API presents to C programs roughly the same interface presented to bytecode programs--that is, a C extension can see everything that a bytecode program can see, including Parrot's base architecture, registers, stacks, and whatnot. This view isn't required, however, and often extension code won't need or want to know what Parrot's internal structures look like. For this reason the functions in the extension API are divided into two broad groups, one that has no particular knowledge of the internals and one that does. The stability of the two API groups is guaranteed separately. Group 1, the internals unaware group, should be good basically forever. Group 2, the internals aware group, is only guaranteed for the lifetime of the current architecture. (It's likely that both groups will last equally long; however, the Group 1 interface could reasonably be emulated on a different engine, while the Group 2 interface is more closely tied to Parrot). B The extension API has not yet been completely specified. New functions may be added, and those described below may change or be removed. You have been warned... =head2 Implementation =head3 API - Group 1: Internals-unaware functions These functions are the ones that are largely unaware of the structure and architecture of Parrot. They deal mainly in data as abstract entities, and Parrot itself as a black box that, at best, can make subroutine or method calls. This is sufficient for many extensions which act as black box processing units and in turn treat Parrot itself as a black box. =head4 PMC access functions The following functions are for storing and retrieving data inside PMCs. Note that use of the _keyed functions with non-aggregate PMCs will generally just result in Parrot throwing an exception. =over 4 =item C Returns a Parrot_String that represents the string value of the PMC. =item C Keyed version of C. Returns a Parrot_String representing the string value of whatever is stored at the element of the PMC indexed by C. =item C Returns a pointer to some item of data. The details of what the pointer points to depend on the particular PMC. This function is useful for dealing with PMCs that hold pointers to arbitrary data. =item C A keyed version of C. Returns the pointer value of whatever is stored at the element of the PMC indexed by C. =item C Returns the integer value of the PMC. =item C A keyed version of C. Returns the integer value of whatever is stored at the element of the PMC indexed by C. =item C Returns the numeric value of the PMC. =item C A keyed version of C. Returns the numeric value of whatever is stored at the element of the PMC indexed by C. =item C Returns a C-string (char *) that represents the string value of the PMC. The memory the char * points to is a copy of the original value, and changing it will not change the original in any way. This memory will I be reclaimed by garbage collection, nor may it be returned to the system with C. It must be returned with C. =item C A keyed version of C. Returns a C-string representing the string value of whatever is stored at the element of the PMC indexed by C. =item C Returns a C-string (char *) that represents the string value of the PMC. The memory the char * points to is a copy of the original value, and changing it will not change the original in any way. The C parameter is the address of an integer that will get the length of the string as Parrot knows it. This memory will I be reclaimed by garbage collection, nor may it be returned to the system with C. It must be returned with C. =item C A keyed version of C. Returns a C-string representing the string value of whatever is stored at the element of the PMC indexed by C. Stores the length of the string in C. =item C Returns the PMC stored at the element of the passed-in PMC that is indexed by C. =item C Assign the passed-in Parrot_String to the passed-in PMC. =item C Keyed version of C. Assigns C to the PMC stored at element of the passed-in PMC. =item C Assign the passed-in pointer to the passed-in PMC. =item C Keyed version of C. Assigns C to the PMC stored at element of the passed-in PMC. =item C Assigns C to the PMC stored at element of the passed-in PMC. =item C Assign the passed-in Parrot integer to the passed-in PMC. =item C Keyed version of C. Assigns C to the PMC stored at element of the passed-in PMC. =item C Assign the passed-in Parrot number to the passed-in PMC. =item C Keyed version of C. Assigns C to the PMC stored at element of the passed-in PMC. =item C Convert the passed-in null-terminated C string to a Parrot_String and assign it to the passed-in PMC. =item C Keyed version of C. Converts C to a Parrot_String and assigns it to the PMC stored at element of the passed-in PMC. =item C Convert the passed-in null-terminated C string to a Parrot_String of length C and assign it to the passed-in PMC. If C is longer than C, then only the first C characters will be converted. If C is shorter than C, then the extra characters in the Parrot_String should be assumed to contain garbage. =item C Keyed version of C. Converts the first C characters of C to a Parrot_String and assigns the resulting string to the PMC stored at element of the passed-in PMC. =item C Push a float onto an aggregate PMC, such as a ResizablePMCArray. Returns void. =item C Push a integer onto an aggregate PMC, such as a ResizableIntegerArray. Returns void. =item C Push a PMC value onto an aggregate PMC, such as a ResizablePMCArray. Returns void. =item C Push a Parrot_String onto an aggregate PMC, such as a ResizableStringArray. Returns void. =item C Pop a Parrot_Float off of an aggregate PMC and returns it. =item C Pop a Parrot_Int off of an aggregate PMC and returns it. =item C Pop a PMC off of an aggregate PMC and returns it. =item C Pop a Parrot_String off of an aggregate PMC and returns it. =back =head4 Creation and destruction Functions used to create and destroy PMCs, Parrot_Strings, etc. =over 4 =item C Creates and returns a new PMC. C is an integer identifier that specifies the type of PMC required. The C corresponding to a particular PMC class name can be found using C. =item C Returns the internal integer identifier corresponding to a PMC with class name C. =item C Returns the special C PMC. =item C Create a new Parrot string from a passed-in buffer. If the C, C are unspecified (i.e. if you pass in 0), then the defaults are used. Otherwise, the functions C, or C (both described below) can be used to find the appropriate values for a particular choice of encoding, or chartype. Flag values are currently undocumented. Note that a copy of the buffer is made. =item C Find the magic token for an encoding, by name. =item C Find the magic token for a chartype, by name. =item C Deallocates a C string that the interpreter has handed to you. This function must be used to free strings produced by C and C, as these will not be reclaimed by the garbage collector. It should not be used to deallocate strings that do not come from Parrot. =item C Add a reference to the PMC to the interpreter's GC registry. This prevents PMCs known only to extensions from getting destroyed during GC runs. =item C Remove a reference to the PMC from the interpreter's GC registry. If the reference count reaches zero, the PMC will be destroyed during the next GC run. =back =head4 Subroutine and method calls Functions to call Parrot subroutines and methods =over 4 TODO: Add new call functions here =back =head3 API - Group 2: Internals aware The internals-aware functions are for those extensions that need to query or alter the state of Parrot's internals in some way. Register access functions The following functions allow the values stored in Parrot's registers to be accessed. An attempt to access a non-existent register (e.g. string register -123) will cause the function to throw an exception (well, it will once we actually implement some bounds-checking...). The value stored in an uninitialized register is undefined; it may well be zero (or NULL), but do not rely on this being the case. =over 4 =item C Return the value of an integer register. =item C Return the value of a numeric register. =item C Return the value of a string register. =item C Return the value of a PMC register. =back =head2 References F =cut __END__ Local Variables: fill-column:78 End: vim: expandtab shiftwidth=4: time.c000644000765000765 274311567202624 17173 0ustar00brucebruce000000000000parrot-5.9.0/src/platform/ansi/* * Copyright (C) 2007-2010, Parrot Foundation. */ /* =head1 NAME src/platform/ansi/time.c =head1 DESCRIPTION Time-related functions. =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" #include /* HEADERIZER HFILE: none */ /* =item C Parrot wrapper around standard library C function, returning an INTVAL. =cut */ INTVAL Parrot_intval_time(void) { return time(NULL); } /* =item C Note: We are unable to provide this level of precision under ANSI-C, so we just fall back to intval time for this. =cut */ FLOATVAL Parrot_floatval_time(void) { Parrot_warn(NULL, PARROT_WARNINGS_PLATFORM_FLAG, "Parrot_floatval_time not accurate"); return (FLOATVAL)Parrot_intval_time(); } /* =item C Sleep for at least the specified number of seconds. =cut */ void Parrot_sleep(unsigned int seconds) { Parrot_warn(NULL, PARROT_WARNINGS_PLATFORM_FLAG, "Parrot_sleep not implemented"); return; } /* =item C Sleep for at least the specified number of microseconds (millionths of a second). =cut */ void Parrot_usleep(unsigned int microseconds) { Parrot_warn(NULL, PARROT_WARNINGS_PLATFORM_FLAG, "Parrot_usleep not implemented"); return; } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ rx_captures000644000765000765 1153611466337263 22132 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/pge/perl6regex## captures (a.)..(..) zzzabcdefzzz y basic match (a.)..(..) zzzabcdefzzz /mob: / basic $0 (a.)..(..) zzzabcdefzzz /mob 0: / basic $1 (a.)..(..) zzzabcdefzzz /mob 1: / basic $2 (a(b(c))(d)) abcd y nested match (a(b(c))(d)) abcd /mob: / nested match (a(b(c))(d)) abcd /mob 0: / nested match (a(b(c))(d)) abcd /mob 0 0: / nested match (a(b(c))(d)) abcd /mob 0 0 0: / nested match (a(b(c))(d)) abcd /mob 0 1: / nested match ((\w+)+) abcd /mob: / nested match ((\w+)+) abcd /mob 0: / nested match ((\w+)+) abcd /mob 0 0 0: / nested match ((\w+)+) ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz /mob: / alt subpattern before group (a) [ (bc) (d) | .* (ef) ] .* (g) abcdefg /mob 1: / alt subpattern in group (a) [ (bc) (d) | .* (ef) ] .* (g) abcdefg /mob 2: / alt subpattern in group (a) [ (bc) (d) | .* (ef) ] .* (g) abcdefg /mob 3: / alt subpattern after group (a) [ (bc) (x) | .* (ef) ] .* (g) abcdefg /mob 1: / 2nd alt subpattern in group (a) [ (bc) (x) | .* (ef) ] .* (g) abcdefg /mob 3: / 2nd alt subpattern after group ( (.) )* abc /mob 0 1 0: / nested repeated captures [ (.) ]* abc /mob 0 1: / nested repeated captures ( [.] )* abc /mob 0 1: / nested repeated captures (.) (.) $7=(.) (.) $4=(.) abcdefg /mob 0: / numbered aliases $1 (.) (.) $7=(.) (.) $4=(.) abcdefg /mob 1: / numbered aliases $2 (.) (.) $7=(.) (.) $4=(.) abcdefg /mob 7: / numbered aliases $7 (.) (.) $7=(.) (.) $4=(.) abcdefg /mob 8: / numbered aliases $8 (.) (.) $7=(.) (.) $4=(.) abcdefg /mob 4: / numbered aliases $4 $1=[ (.) (.) (.) ] (.) abcdefg /mob 1: / perl5 numbered captures $1 $1=[ (.) (.) (.) ] (.) abcdefg /mob 2: / perl5 numbered captures $1 $1=[ (.) (.) (.) ] (.) abcdefg /mob 3: / perl5 numbered captures $1 $1=[ (.) (.) (.) ] (.) abcdefg /mob 4: / perl5 numbered captures $1 $1=[ (.) (.) (.) ] (.) abcdefg /mob 5: / perl5 numbered captures $1 # todo :pugs :s $=[\w+] \= $=[\S+] abc = 123 /mob: / named capture # todo :pugs :s $=[\w+] \= $=[\S+] abc = 123 /mob: <123 @ 7>/ named capture # todo :pugs :s (\w+) $=(\w+) (\w+) abc def ghi /mob: / mixing named and unnamed capture # todo :pugs :s (\w+) $=(\w+) (\w+) abc def ghi /mob 1: / mixing named and unnamed capture # todo :pugs [ \- ]? abc def ghi /mob 0: / multiple subrule captures in same scope # todo :pugs [(.)$0]+ bookkeeper y backreference # todo :pugs (\w+) <+ws> $0 hello hello y backreference at end of string # todo :pugs [(.)$0]+ bookkeeper /mob 0 0: / backref $1 # todo :pugs [(.)$0]+ bookkeeper /mob 0 1: / backref $1 # todo :pugs [(.)$0]+ bookkeeper /mob 0 2: / backref $1 # todo :pugs (.)*x 123x /mob: <123x @ 0>/ repeated dot capture $= 12ab34 /mob: / alias capture 12ab34 /mob: / alias capture ## vim: noexpandtab tabstop=4 shiftwidth=4 select.t000644000765000765 731112101554067 15715 0ustar00brucebruce000000000000parrot-5.9.0/t/dynpmc#!./parrot # Copyright (C) 2010-2011, Parrot Foundation. =head1 NAME t/dynpmc/select.t - tests the Select PMC =head1 SYNOPSIS % prove t/dynpmc/select.t =head1 DESCRIPTION Tests the Select PMC: a PMC for monitoring multiple file handles, waiting for it to become ready for an I/O operation. =cut .sub main :main .include 'test_more.pir' .include 'iglobals.pasm' load_bytecode 'osutils.pbc' plan(14) .local pmc interp interp = getinterp .local pmc config config = interp[.IGLOBALS_CONFIG_HASH] .local string osname osname = config['osname'] if osname == 'MSWin32' goto todo_all if osname == 'msys' goto todo_all goto tests todo_all: skip(14, 'Behavior of select() is undefined on Windows') goto end tests: test_load() test_update() test_read() test_write() test_select(osname) end: .end .sub 'test_load' $P0 = loadlib 'select' $I0 = defined $P0 ok($I0, "Loaded 'select' library") .end .sub 'test_update' $P9 = new 'String' $P9 = 'FH1' $P0 = new ['FileHandle'] $P0.'open'('README.pod') $P1 = new ['Select'] $P1.'update'($P0, $P9, 5) $P3 = new ['FileHandle'] $P3.'open'('README.pod') $P9 = new 'String' $P9 = 'FH2' $P1.'update'($P3, $P9, 5) $I1 = $P0.'handle'() $I2 = $P3.'handle'() if $I1 > $I2 goto a $I1 = $I2 a: $I0 = $P1.'max_fd'() is($I0, $I1, 'Check maximum number of file handles') $P2 = $P1.'fd_map'() $I3 = $P2 is($I3, 2, 'Two file handles in Select PMC') $I0 = $P0.'handle'() $S0 = $P2[$I0] is($S0, 'FH1', 'Check fd_map() for FH1') $I0 = $P3.'handle'() $S0 = $P2[$I0] is($S0, 'FH2', 'Check fd_map for FH2') $P1.'remove'($P0) $I3 = $P2 is($I3, 1, 'One file handle in Select PMC') $P6 = $P1.'can_read'(1) .end .sub 'test_read' $P9 = new 'String' $P9 = 'FH1' $P0 = new ['FileHandle'] $P0.'open'('README.pod') $P1 = new ['Select'] $P1.'update'($P0, $P9, 5) $P6 = $P1.'can_read'(1) $I0 = $P6 is($I0, 1, 'Test can_read() for README.pod') $P6 = $P1.'can_write'(0) $I0 = $P6 is($I0, 0, 'Test can_write() for README.pod') .end .sub 'test_write' $S0 = 'README2' $P9 = new 'String' $P9 = 'FH1' $P0 = new ['FileHandle'] $P0.'open'($S0, 'w') $P1 = new ['Select'] $P1.'update'($P0, $P9, 2) sweep 1 $P9 = new 'String' $P9 = 'FH2' $P6 = $P1.'can_write'(1) $I0 = $P6 is($I0, 1, 'Test can_write() for README2') $P2 = $P6[0] is($P2, "FH1", 'can_write() returned the correct payload') $P6 = $P1.'can_read'(0) $I0 = $P6 is($I0, 0, 'Test can_read() for README2') unlink($S0) .end .sub 'test_select' .param string osname $S0 = 'README2' $P9 = new 'String' $P9 = 'FH1' $P0 = new ['FileHandle'] $P0.'open'('README.pod', 'r') $P1 = new ['Select'] $P1.'update'($P0, $P9, 5) $P9 = new 'String' $P9 = 'FH2' $P0 = new ['FileHandle'] $P0.'open'($S0, 'w') $P1.'update'($P0, $P9, 6) $P6 = $P1.'select'(1) $P7 = $P6[0] $I0 = $P7 is($I0, 1, 'Test can_read() for README2 (array index)') $P7 = $P6[1] $I0 = $P7 is($I0, 1, 'Test can_write() for README2 (array index)') $P7 = $P6[2] $I0 = $P7 if osname == 'linux' goto good if osname == 'cygwin' goto good if osname == 'freebsd' goto good todo: is($I0, 0, 'Test has_exception() for README2 (array index)', 'varies across OSes' :named('todo')) goto out good: is($I0, 0, 'Test has_exception() for README2 (array index)') out: unlink($S0) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: rx_syntax000644000765000765 371111466337263 21606 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/pge/perl6regex## syntax errors {{ abcdef /Missing closing braces/ unterminated closure \1 abcdef /reserved/ back references \x[ abcdef /Missing close bracket/ unterminated \x[..] \X[ abcdef /Missing close bracket/ unterminated \X[..] * abc abcdef /Quantifier follows nothing/ bare * at start * abc abcdef /Quantifier follows nothing/ bare * after ws [*|a] abcdef /Quantifier follows nothing/ bare * after [ [ *|a] abcdef /Quantifier follows nothing/ bare * after [+sp [a|*] abcdef /Quantifier follows nothing/ bare * after | [a| *] abcdef /Quantifier follows nothing/ bare * after |+sp + abc abcdef /Quantifier follows nothing/ bare + at start + abc abcdef /Quantifier follows nothing/ bare + after ws [+|a] abcdef /Quantifier follows nothing/ bare + after [ [ +|a] abcdef /Quantifier follows nothing/ bare + after [+sp [a|+] abcdef /Quantifier follows nothing/ bare + after | [a| +] abcdef /Quantifier follows nothing/ bare + after |+sp ? abc abcdef /Quantifier follows nothing/ bare ? at start ? abc abcdef /Quantifier follows nothing/ bare ? after ws [?|a] abcdef /Quantifier follows nothing/ bare ? after [ [ ?|a] abcdef /Quantifier follows nothing/ bare ? after [+sp [a|?] abcdef /Quantifier follows nothing/ bare ? after | [a| ?] abcdef /Quantifier follows nothing/ bare ? after |+sp : abc abcdef /Quantifier follows nothing/ bare : at start : abc abcdef /Quantifier follows nothing/ bare : after ws [:|a] abcdef /Quantifier follows nothing/ bare : after [ [ :|a] abcdef /Quantifier follows nothing/ bare : after [+sp [a|:] abcdef /Quantifier follows nothing/ bare : after | [a| :] abcdef /Quantifier follows nothing/ bare : after |+sp abcdef /Null pattern illegal/ null pattern abcdef /Null pattern illegal/ ws null pattern =abc abcdef /LHS of alias must be lvalue/ bare : after ws [ =a] abcdef /LHS of alias must be lvalue/ bare : after [+sp [a| =a] abcdef /LHS of alias must be lvalue/ bare : after |+sp main.c000644000765000765 2406611716253437 16106 0ustar00brucebruce000000000000parrot-5.9.0/src/runcore/* Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME src/runcore/main.c - main functions for Parrot runcores =head1 DESCRIPTION The runcore API handles running the operations. =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" #include "parrot/runcore_api.h" #include "parrot/runcore_profiling.h" #include "parrot/runcore_subprof.h" #include "parrot/oplib/core_ops.h" #include "parrot/oplib/ops.h" #include "main.str" #include "parrot/dynext.h" #include "pmc/pmc_parrotlibrary.h" #include "pmc/pmc_callcontext.h" /* HEADERIZER HFILE: include/parrot/runcore_api.h */ /* XXX Needs to get done at the same time as the other interpreter files */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static oplib_init_f get_dynamic_op_lib_init(PARROT_INTERP, ARGIN(const PMC *lib)) __attribute__nonnull__(2); #define ASSERT_ARGS_get_dynamic_op_lib_init __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(lib)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Initializes the runcores. =cut */ void Parrot_runcore_init(PARROT_INTERP) { ASSERT_ARGS(Parrot_runcore_init) STRING * const default_core = CONST_STRING(interp, "fast"); interp->cores = NULL; interp->num_cores = 0; Parrot_runcore_slow_init(interp); Parrot_runcore_fast_init(interp); Parrot_runcore_subprof_init(interp); Parrot_runcore_exec_init(interp); Parrot_runcore_gc_debug_init(interp); Parrot_runcore_debugger_init(interp); Parrot_runcore_profiling_init(interp); /* set the default runcore */ Parrot_runcore_switch(interp, default_core); } /* =item C Registers a new runcore with Parrot. Returns 1 on success, 0 on failure. =cut */ PARROT_EXPORT INTVAL Parrot_runcore_register(PARROT_INTERP, ARGIN(Parrot_runcore_t *coredata)) { ASSERT_ARGS(Parrot_runcore_register) size_t i = interp->num_cores++; interp->cores = mem_gc_realloc_n_typed_zeroed(interp, interp->cores, interp->num_cores, i, Parrot_runcore_t *); interp->cores[i] = coredata; return 1; } /* =item C Switches to a named runcore. Throws an exception on an unknown runcore. =cut */ PARROT_EXPORT void Parrot_runcore_switch(PARROT_INTERP, ARGIN(STRING *name)) { ASSERT_ARGS(Parrot_runcore_switch) size_t num_cores = interp->num_cores; size_t i; if (interp->run_core && STRING_equal(interp, name, interp->run_core->name)) return; for (i = 0; i < num_cores; ++i) { if (STRING_equal(interp, name, interp->cores[i]->name)) { interp->run_core = interp->cores[i]; return; } } Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED, "Invalid runcore %Ss requested\n", name); } /* =item C Returns an dynamic oplib's opcode's library C init function. C will be a C PMC. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static oplib_init_f get_dynamic_op_lib_init(SHIM_INTERP, ARGIN(const PMC *lib)) { ASSERT_ARGS(get_dynamic_op_lib_init) return (oplib_init_f)D2FPTR( ((Parrot_ParrotLibrary_attributes *)PMC_data(lib))->oplib_init); } /* =item C Prepares to run the interpreter's run core. =cut */ void prepare_for_run(PARROT_INTERP) { ASSERT_ARGS(prepare_for_run) const runcore_prepare_fn_type prepare_run = interp->run_core->prepare_run; if (prepare_run) (*prepare_run)(interp, interp->run_core); } /* =item C Run Parrot operations of loaded code segment until an end opcode is reached. Run core is selected depending on the C. When a C opcode is encountered, a different core may be selected and evaluation of opcode continues. =cut */ void runops_int(PARROT_INTERP, size_t offset) { ASSERT_ARGS(runops_int) interp->resume_offset = offset; interp->resume_flag |= RESUME_RESTART; while (interp->resume_flag & RESUME_RESTART) { opcode_t * const pc = (opcode_t *) interp->code->base.data + interp->resume_offset; const runcore_runops_fn_type core = interp->run_core->runops; interp->resume_offset = 0; interp->resume_flag &= ~(RESUME_RESTART | RESUME_INITIAL); (*core)(interp, interp->run_core, pc); /* if we have fallen out with resume and we were running CGOTO, set * the stacktop again to a sane value, so that restarting the runloop * is ok. */ if (interp->resume_flag & RESUME_RESTART) { if ((int)interp->resume_offset < 0) Parrot_ex_throw_from_c_args(interp, NULL, 1, "branch_cs: illegal resume offset"); } } } /* =item C Shuts down the runcores and deallocates any dynops memory. =cut */ void Parrot_runcore_destroy(PARROT_INTERP) { ASSERT_ARGS(Parrot_runcore_destroy) size_t num_cores = interp->num_cores; size_t i; for (i = 0; i < num_cores; ++i) { Parrot_runcore_t * const core = interp->cores[i]; const runcore_destroy_fn_type destroy = core->destroy; if (destroy) (*destroy)(interp, core); mem_gc_free(interp, core); } if (interp->cores) mem_gc_free(interp, interp->cores); interp->cores = NULL; interp->run_core = NULL; if (interp->all_op_libs) mem_gc_free(interp, interp->all_op_libs); interp->all_op_libs = NULL; } /* =back =head2 Dynamic Loading Functions =over 4 =item C Register a dynamic oplib. =cut */ PARROT_EXPORT void dynop_register(PARROT_INTERP, ARGIN(PMC *lib_pmc)) { ASSERT_ARGS(dynop_register) op_lib_t *lib; oplib_init_f init_func; if (!interp->all_op_libs) interp->all_op_libs = mem_gc_allocate_n_zeroed_typed(interp, interp->n_libs + 1, op_lib_t*); else interp->all_op_libs = mem_gc_realloc_n_typed_zeroed(interp, interp->all_op_libs, interp->n_libs + 1, interp->n_libs, op_lib_t *); init_func = get_dynamic_op_lib_init(interp, lib_pmc); lib = init_func(interp, 1); interp->all_op_libs[interp->n_libs++] = lib; /* if we are registering an op_lib variant, called from below the base * names of this lib and the previous one are the same */ if (interp->n_libs >= 2 && (STREQ(interp->all_op_libs[interp->n_libs-2]->name, lib->name))) return; parrot_hash_oplib(interp, lib); } /* =item C Add the ops in C to the global name => op_info hash. =cut */ void parrot_hash_oplib(PARROT_INTERP, ARGIN(op_lib_t *lib)) { ASSERT_ARGS(parrot_hash_oplib) int i; DECL_CONST_CAST; for (i = 0; i < lib->op_count; i++) { op_info_t *op = &lib->op_info_table[i]; Parrot_hash_put(interp, interp->op_hash, PARROT_const_cast(char *, op->full_name), (void *)op); if (!Parrot_hash_exists(interp, interp->op_hash, PARROT_const_cast(char *, op->name))) Parrot_hash_put(interp, interp->op_hash, PARROT_const_cast(char *, op->name), (void *)op); } } /* =item C Restore old function table. XXX This is only implemented for the function core at present. =cut */ PARROT_EXPORT void Parrot_runcore_disable_event_checking(PARROT_INTERP) { ASSERT_ARGS(Parrot_runcore_disable_event_checking) PackFile_ByteCode *cs = interp->code; /* restore func table */ PARROT_ASSERT(cs->save_func_table); cs->op_func_table = cs->save_func_table; cs->save_func_table = NULL; } /* =item C Replace func table with one that does event checking for all opcodes. NOTE: C is called async by the event handler thread. All action done from here has to be async safe. XXX This is only implemented for the function core at present. =cut */ PARROT_EXPORT void Parrot_runcore_enable_event_checking(PARROT_INTERP) { ASSERT_ARGS(Parrot_runcore_enable_event_checking) PackFile_ByteCode *cs = interp->code; /* only save if we're not already event checking */ if (cs->save_func_table == NULL) cs->save_func_table = cs->op_func_table; /* ensure event checking table is big enough */ if (interp->evc_func_table_size < cs->op_count) { size_t i; op_lib_t *core_lib = get_core_op_lib_init(interp, interp->run_core)(interp, 1); interp->evc_func_table = interp->evc_func_table ? mem_gc_realloc_n_typed_zeroed(interp, interp->evc_func_table, cs->op_count, interp->evc_func_table_size, op_func_t) : mem_gc_allocate_n_zeroed_typed(interp, cs->op_count, op_func_t); for (i = interp->evc_func_table_size; i < cs->op_count; i++) interp->evc_func_table[i] = core_lib->op_func_table[PARROT_OP_check_events__]; interp->evc_func_table_size = cs->op_count; } /* put evc table in place */ cs->op_func_table = interp->evc_func_table; } /* =back =head1 SEE ALSO F, F, F, F, F. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ stringiterator.pmc000644000765000765 2264511716253437 17702 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME src/pmc/stringiterator.pmc - StringIterator PMC =head1 DESCRIPTION Implementation of Iterator for String PMC. =head1 SYNOPSIS =head1 Methods =over 4 =cut */ /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* HEADERIZER END: static */ pmclass StringIterator auto_attrs extends Iterator provides iterator { ATTR STRING *str_val; /* String to iterate over */ ATTR String_iter iter; /* String iterator */ ATTR INTVAL reverse; /* Direction of iteration. 1 - for reverse iteration */ /* =item C Initialize StringIterator. =cut */ VTABLE void init_pmc(PMC *string) { String_iter * const iter = &PARROT_STRINGITERATOR(SELF)->iter; STRING * const str_val = VTABLE_get_string(INTERP, string); SET_ATTR_str_val(INTERP, SELF, str_val); STRING_ITER_INIT(INTERP, iter); SET_ATTR_reverse(INTERP, SELF, ITERATE_FROM_START); PObj_custom_mark_SET(SELF); } /* =item C Marks the current idx/key and the aggregate as live. =cut */ VTABLE void mark() { STRING *str_val; GET_ATTR_str_val(INTERP, SELF, str_val); Parrot_gc_mark_STRING_alive(INTERP, str_val); } /* =item C =cut */ VTABLE PMC* clone() { String_iter * const iter = &PARROT_STRINGITERATOR(SELF)->iter; PMC * const str_pmc = Parrot_pmc_new(INTERP, enum_class_String); PMC *clone; String_iter *clone_iter; STRING *str_val; INTVAL reverse; GET_ATTR_str_val(INTERP, SELF, str_val); VTABLE_set_string_native(INTERP, str_pmc, str_val); clone = Parrot_pmc_new_init(INTERP, enum_class_StringIterator, str_pmc); clone_iter = &PARROT_STRINGITERATOR(clone)->iter; *clone_iter = *iter; GET_ATTR_reverse(INTERP, SELF, reverse); SET_ATTR_reverse(INTERP, clone, reverse); return clone; } /* =item C Returns true if there is more elements to iterate over. =cut */ VTABLE INTVAL get_bool() { return SELF.elements() > 0; } /* =item C Returns the number of remaining elements in the C. =cut */ VTABLE INTVAL elements() { String_iter * const iter = &PARROT_STRINGITERATOR(SELF)->iter; STRING *str_val; INTVAL reverse; GET_ATTR_str_val(INTERP, SELF, str_val); GET_ATTR_reverse(INTERP, SELF, reverse); if (reverse) return iter->charpos; else return str_val->strlen - iter->charpos; } VTABLE INTVAL get_integer() { return SELF.elements(); } /* =item C Reset the Iterator. C must be one of ITERATE_FROM_START ... Iterate from start ITERATE_FROM_END ... Iterate from end =cut */ VTABLE void set_integer_native(INTVAL value) { STRING *str_val; String_iter * const iter = &PARROT_STRINGITERATOR(SELF)->iter; GET_ATTR_str_val(INTERP, SELF, str_val); if (value == ITERATE_FROM_START) { SET_ATTR_reverse(INTERP, SELF, 0); STRING_ITER_INIT(INTERP, iter); } else if (value == ITERATE_FROM_END) { SET_ATTR_reverse(INTERP, SELF, 1); iter->bytepos = str_val->bufused; iter->charpos = str_val->strlen; } else { Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "Wrong direction for StringIterator"); } } /* =item C Returns this Iterator's string. =cut */ VTABLE PMC *get_pmc() { PMC * const string = Parrot_pmc_new(INTERP, Parrot_hll_get_ctx_HLL_type( interp, enum_class_String)); STRING *str_val; GET_ATTR_str_val(INTERP, SELF, str_val); VTABLE_set_string_native(interp, string, str_val); return string; } /* =item C Shift next character from C as PMC. =cut */ VTABLE PMC *shift_pmc() { String_iter * const iter = &PARROT_STRINGITERATOR(SELF)->iter; PMC *ret; STRING *str_val, *substr; const String_iter old_iter = *iter; GET_ATTR_str_val(INTERP, SELF, str_val); if (iter->charpos >= str_val->strlen) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "StopIteration"); ret = Parrot_pmc_new(INTERP, Parrot_hll_get_ctx_HLL_type(interp, enum_class_String)); STRING_iter_skip(INTERP, str_val, iter, 1); substr = Parrot_str_iter_substr(INTERP, str_val, &old_iter, iter); VTABLE_set_string_native(INTERP, ret, substr); return ret; } /* =item C Shift next character from C. =cut */ VTABLE STRING *shift_string() { String_iter * const iter = &PARROT_STRINGITERATOR(SELF)->iter; STRING *str_val; const String_iter old_iter = *iter; GET_ATTR_str_val(INTERP, SELF, str_val); if (iter->charpos >= str_val->strlen) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "StopIteration"); STRING_iter_skip(INTERP, str_val, iter, 1); return Parrot_str_iter_substr(INTERP, str_val, &old_iter, iter); } /* =item C Shift next character code from C. =cut */ VTABLE INTVAL shift_integer() { String_iter * const iter = &PARROT_STRINGITERATOR(SELF)->iter; STRING *str_val; GET_ATTR_str_val(INTERP, SELF, str_val); if (iter->charpos >= str_val->strlen) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "StopIteration"); return STRING_iter_get_and_advance(INTERP, str_val, iter); } /* =item C Shift "next" character from C for reverse iterator as PMC. =cut */ VTABLE PMC *pop_pmc() { String_iter * const iter = &PARROT_STRINGITERATOR(SELF)->iter; STRING *str_val, *substr; PMC *ret; const String_iter old_iter = *iter; GET_ATTR_str_val(INTERP, SELF, str_val); /* Shouldn't this test be (iter->charpos <= 0) ? */ if (SELF.elements() <= 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "StopIteration"); ret = Parrot_pmc_new(INTERP, Parrot_hll_get_ctx_HLL_type(interp, enum_class_String)); STRING_iter_skip(INTERP, str_val, iter, -1); substr = Parrot_str_iter_substr(INTERP, str_val, iter, &old_iter); VTABLE_set_string_native(INTERP, ret, substr); return ret; } /* =item C Shift "next" character from C for reverse iterator. =cut */ VTABLE STRING *pop_string() { String_iter * const iter = &PARROT_STRINGITERATOR(SELF)->iter; STRING *str_val; const String_iter old_iter = *iter; GET_ATTR_str_val(INTERP, SELF, str_val); /* Shouldn't this test be (iter->charpos <= 0) ? */ if (SELF.elements() <= 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "StopIteration"); STRING_iter_skip(INTERP, str_val, iter, -1); return Parrot_str_iter_substr(INTERP, str_val, iter, &old_iter); } /* =item C Shift "next" character code from C for reverse iterator. =cut */ VTABLE INTVAL pop_integer() { String_iter * const iter = &PARROT_STRINGITERATOR(SELF)->iter; STRING *str_val; GET_ATTR_str_val(INTERP, SELF, str_val); /* Shouldn't this test be (iter->charpos <= 0) ? */ if (SELF.elements() <= 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "StopIteration"); STRING_iter_skip(INTERP, str_val, iter, -1); return STRING_iter_get(INTERP, str_val, iter, 0); } /* =item C Get integer value of current position plus idx. =cut */ VTABLE INTVAL get_integer_keyed_int(INTVAL idx) { String_iter * const iter = &PARROT_STRINGITERATOR(SELF)->iter; STRING *str_val; const UINTVAL offset = iter->charpos + idx; GET_ATTR_str_val(INTERP, SELF, str_val); if (offset >= str_val->strlen) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "StopIteration"); return STRING_iter_get(INTERP, str_val, iter, idx); } /* =item C Get string value of current position plus idx. =cut */ VTABLE STRING *get_string_keyed_int(INTVAL idx) { String_iter iter = PARROT_STRINGITERATOR(SELF)->iter; String_iter next_iter; STRING *str_val; const UINTVAL offset = iter.charpos + idx; GET_ATTR_str_val(INTERP, SELF, str_val); if (offset >= str_val->strlen) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "StopIteration"); if (idx != 0) STRING_iter_skip(INTERP, str_val, &iter, idx); next_iter = iter; STRING_iter_skip(INTERP, str_val, &next_iter, 1); return Parrot_str_iter_substr(INTERP, str_val, &iter, &next_iter); } } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ spill.t000644000765000765 1574611533177643 20020 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/imcc/reg#!./parrot # Copyright (C) 2001-2010, Parrot Foundation. .sub main :main .include 'test_more.pir' plan(78) test_allocate_1() test_spill_1() test_pcc_arg_overflow_1() test_spill_4() .end .sub test_allocate_1 # # Test the ability of the register allocator to # generate spills. # $I0 = 0 $I1 = 1 $I2 = 2 $I3 = 3 $I4 = 4 $I5 = 5 $I6 = 6 $I7 = 7 $I8 = 8 $I9 = 9 $I10 = 10 $I11 = 11 $I12 = 12 $I13 = 13 $I14 = 14 $I15 = 15 $I16 = 16 $I17 = 17 $I18 = 18 $I19 = 19 $I20 = 20 $I21 = 21 $I22 = 22 $I23 = 23 $I24 = 24 $I25 = 25 $I26 = 26 $I27 = 27 $I28 = 28 $I29 = 29 $I30 = 30 $I31 = 31 $I32 = 32 $I33 = 33 $I34 = 34 $I35 = 35 $I36 = 36 $I37 = 37 $I38 = 38 $I39 = 39 $I40 = 40 is($I0, 0, "allocate 1") is($I10, 10, "allocate 1") is($I20, 20, "allocate 1") is($I30, 30, "allocate 1") is($I40, 40, "allocate 1") .end .sub test_spill_1 # # Test the ability of the register allocator to # generate spills. # $I0 = 0 $I1 = 1 $I2 = 2 $I3 = 3 $I4 = 4 $I5 = 5 $I6 = 6 $I7 = 7 $I8 = 8 $I9 = 9 $I10 = 10 $I11 = 11 $I12 = 12 $I13 = 13 $I14 = 14 $I15 = 15 $I16 = 16 $I17 = 17 $I18 = 18 $I19 = 19 $I20 = 20 $I21 = 21 $I22 = 22 $I23 = 23 $I24 = 24 $I25 = 25 $I26 = 26 $I27 = 27 $I28 = 28 $I29 = 29 $I30 = 30 $I31 = 31 $I32 = 32 $I33 = 33 $I34 = 34 $I35 = 35 $I36 = 36 $I37 = 37 $I38 = 38 $I39 = 39 $I40 = $I0 + $I1 $I41 = $I2 + $I3 $I42 = $I4 + $I5 $I43 = $I6 + $I7 $I44 = $I8 + $I9 $I50 = $I10 + $I11 $I51 = $I12 + $I13 $I52 = $I14 + $I15 $I53 = $I16 + $I17 $I54 = $I18 + $I19 $I60 = $I20 + $I21 $I61 = $I22 + $I23 $I62 = $I24 + $I25 $I63 = $I26 + $I27 $I64 = $I28 + $I29 $I70 = $I30 + $I31 $I71 = $I32 + $I33 $I72 = $I34 + $I35 $I73 = $I36 + $I37 $I74 = $I38 + $I39 is($I0, 0, 'spill 1') is($I1, 1, 'spill 1') is($I2, 2, 'spill 1') is($I3, 3, 'spill 1') is($I4, 4, 'spill 1') is($I5, 5, 'spill 1') is($I6, 6, 'spill 1') is($I7, 7, 'spill 1') is($I8, 8, 'spill 1') is($I9, 9, 'spill 1') is($I10, 10, 'spill 1') is($I11, 11, 'spill 1') is($I12, 12, 'spill 1') is($I13, 13, 'spill 1') is($I14, 14, 'spill 1') is($I15, 15, 'spill 1') is($I16, 16, 'spill 1') is($I17, 17, 'spill 1') is($I18, 18, 'spill 1') is($I19, 19, 'spill 1') is($I20, 20, 'spill 1') is($I21, 21, 'spill 1') is($I22, 22, 'spill 1') is($I23, 23, 'spill 1') is($I24, 24, 'spill 1') is($I25, 25, 'spill 1') is($I26, 26, 'spill 1') is($I27, 27, 'spill 1') is($I28, 28, 'spill 1') is($I29, 29, 'spill 1') is($I30, 30, 'spill 1') is($I31, 31, 'spill 1') is($I32, 32, 'spill 1') is($I33, 33, 'spill 1') is($I34, 34, 'spill 1') is($I35, 35, 'spill 1') is($I36, 36, 'spill 1') is($I37, 37, 'spill 1') is($I38, 38, 'spill 1') is($I39, 39, 'spill 1') is($I40, 1, 'spill 1') is($I41, 5, 'spill 1') is($I42, 9, 'spill 1') is($I43, 13, 'spill 1') is($I44, 17, 'spill 1') is($I50, 21, 'spill 1') is($I51, 25, 'spill 1') is($I52, 29, 'spill 1') is($I53, 33, 'spill 1') is($I54, 37, 'spill 1') is($I60, 41, 'spill 1') is($I61, 45, 'spill 1') is($I62, 49, 'spill 1') is($I63, 53, 'spill 1') is($I64, 57, 'spill 1') is($I70, 61, 'spill 1') is($I71, 65, 'spill 1') is($I72, 69, 'spill 1') is($I73, 73, 'spill 1') is($I74, 77, 'spill 1') .end .sub test_pcc_arg_overflow_1 # # Test the ability of the register allocator in # combination with PCC calling convention and overflow arguments. # Slightly redundant with tests in t/syn/pcc.t but please leave. # _foo(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40) .end .sub _foo .param int i1 .param int i2 .param int i3 .param int i4 .param int i5 .param int i6 .param int i7 .param int i8 .param int i9 .param int i10 .param int i11 .param int i12 .param int i13 .param int i14 .param int i15 .param int i16 .param int i17 .param int i18 .param int i19 .param int i20 .param int i21 .param int i22 .param int i23 .param int i24 .param int i25 .param int i26 .param int i27 .param int i28 .param int i29 .param int i30 .param int i31 .param int i32 .param int i33 .param int i34 .param int i35 .param int i36 .param int i37 .param int i38 .param int i39 .param int i40 is(i1, 1, 'pcc arg overflow 1') is(i2, 2, 'pcc arg overflow 1') is(i3, 3, 'pcc arg overflow 1') is(i4, 4, 'pcc arg overflow 1') is(i5, 5, 'pcc arg overflow 1') is(i10, 10, 'pcc arg overflow 1') is(i15, 15, 'pcc arg overflow 1') is(i20, 20, 'pcc arg overflow 1') is(i25, 25, 'pcc arg overflow 1') is(i30, 30, 'pcc arg overflow 1') is(i35, 35, 'pcc arg overflow 1') is(i40, 40, 'pcc arg overflow 1') .end .sub test_spill_4 # # Another spill test # $I0 = 0 $I1 = 1 $I2 = 2 $I3 = 3 $I4 = 4 $I5 = 5 $I6 = 6 $I7 = 7 $I8 = 8 $I9 = 9 $I10 = 10 $I11 = 11 $I12 = 12 $I13 = 13 $I14 = 14 $I15 = 15 $I16 = 16 $I17 = 17 $I18 = 18 $I19 = 19 $I20 = 20 $I21 = 21 $I22 = 22 $I23 = 23 $I24 = 24 $I25 = 25 $I26 = 26 $I27 = 27 $I28 = 28 $I29 = 29 $I30 = 30 $I31 = 31 $I32 = 32 $I33 = 33 $I34 = 34 $I35 = 35 $I36 = 36 $I37 = 37 $I38 = 38 $I39 = 39 if $I0 != 0 goto err if $I1 != 1 goto err if $I2 != 2 goto err if $I3 != 3 goto err if $I4 != 4 goto err if $I5 != 5 goto err if $I6 != 6 goto err if $I7 != 7 goto err if $I8 != 8 goto err if $I9 != 9 goto err if $I10 != 10 goto err if $I11 != 11 goto err if $I12 != 12 goto err if $I13 != 13 goto err if $I14 != 14 goto err if $I15 != 15 goto err if $I16 != 16 goto err if $I17 != 17 goto err if $I18 != 18 goto err if $I19 != 19 goto err if $I20 != 20 goto err if $I21 != 21 goto err if $I22 != 22 goto err if $I23 != 23 goto err if $I24 != 24 goto err if $I25 != 25 goto err if $I26 != 26 goto err if $I27 != 27 goto err if $I28 != 28 goto err if $I29 != 29 goto err if $I30 != 30 goto err if $I31 != 31 goto err if $I32 != 32 goto err if $I33 != 33 goto err if $I34 != 34 goto err if $I35 != 35 goto err if $I36 != 36 goto err if $I37 != 37 goto err if $I38 != 38 goto err if $I39 != 39 goto err ok(1, 'spill 4') .return() err: ok(0, 'spill 4') .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: 016-no_return_but_result.t000644000765000765 515411533177643 21730 0ustar00brucebruce000000000000parrot-5.9.0/t/configure#! perl # Copyright (C) 2007, Parrot Foundation. # 016-no_return_but_result.t use strict; use warnings; use Test::More tests => 13; use Carp; use lib qw( lib t/configure/testlib ); use Parrot::Configure; use Parrot::Configure::Options qw( process_options ); use IO::CaptureOutput qw | capture |; $| = 1; is( $|, 1, "output autoflush is set" ); my ($args, $step_list_ref) = process_options( { argv => [], mode => q{configure}, } ); ok( defined $args, "process_options returned successfully" ); my %args = %$args; my $conf = Parrot::Configure->new; ok( defined $conf, "Parrot::Configure->new() returned okay" ); my $step = q{init::zeta}; my $description = 'Determining if your computer does zeta'; $conf->add_steps($step); my @confsteps = @{ $conf->steps }; isnt( scalar @confsteps, 0, "Parrot::Configure object 'steps' key holds non-empty array reference" ); is( scalar @confsteps, 1, "Parrot::Configure object 'steps' key holds ref to 1-element array" ); my $nontaskcount = 0; foreach my $k (@confsteps) { $nontaskcount++ unless $k->isa("Parrot::Configure::Task"); } is( $nontaskcount, 0, "Each step is a Parrot::Configure::Task object" ); is( $confsteps[0]->step, $step, "'step' element of Parrot::Configure::Task struct identified" ); ok( !ref( $confsteps[0]->object ), "'object' element of Parrot::Configure::Task struct is not yet a ref" ); $conf->options->set(%args); is( $conf->options->{c}->{debugging}, 1, "command-line option '--debugging' has been stored in object" ); { my $rv; my ($stdout, $stderr); capture ( sub {$rv = $conf->runsteps}, \$stdout, \$stderr ); ok( $rv, "runsteps successfully ran $step" ); like( $stdout, qr/$description/s, "Got correct description for $step" ); like( $stderr, qr/step $step failed:\sGoodbye, cruel world/, "Got error message expected upon running $step"); } pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME 016-no_return_but_result.t - see what happens when configuration step returns undefined value but has a defined result method =head1 SYNOPSIS % prove t/configure/016-no_return_but_result.t =head1 DESCRIPTION The files in this directory test functionality used by F. The tests in this file examine what happens when your configuration step module returns something other than the object but has some other defined result method. =head1 AUTHOR James E Keenan =head1 SEE ALSO Parrot::Configure, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: manifest.pm000644000765000765 213612101554066 17067 0ustar00brucebruce000000000000parrot-5.9.0/config/init# Copyright (C) 2001-2003, Parrot Foundation. =head1 NAME config/init/manifest.pm - MANIFEST Check =head1 DESCRIPTION Uses C to check that the distribution is complete. =cut package init::manifest; use strict; use warnings; use base qw(Parrot::Configure::Step); use Parrot::Configure::Step; use Parrot::Configure::Utils ':gen'; use ExtUtils::Manifest qw(manicheck); sub _init { my $self = shift; my %data; $data{description} = q{Check MANIFEST}; $data{result} = q{}; return \%data; } sub runstep { my ( $self, $conf ) = @_; if ( $conf->options->get('nomanicheck') ) { $self->set_result('skipped'); return 1; } my @missing = ExtUtils::Manifest::manicheck(); if (@missing) { print <<"END"; Ack, some files were missing! I can't continue running without everything here. Please try to find the above files and then try running Configure again. END return; } return 1; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: hello.pasm000644000765000765 116611567202623 17264 0ustar00brucebruce000000000000parrot-5.9.0/examples/pasm# Copyright (C) 2005-2009, Parrot Foundation. =head1 NAME hello.pasm - Hello World =head1 DESCRIPTION This is also used in the top Makefile, for showing how to create an executable from PASM. =cut .pcc_sub :main main: # Get @ARGV as a ResizableStringArray get_params "0", P0 # Discard the program name shift S0, P0 # Look for additional args if P0, FOUND_EXTRA_ARG print "Hello World\n" end FOUND_EXTRA_ARG: shift S1, P0 print "Hello " print S1 print "\n" end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: PCT_Tutorial.pm000644000765000765 417211533177636 21711 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/Docs/Section# Copyright (C) 2010, Parrot Foundation. =head1 NAME Parrot::Docs::Section::PCT_Tutorial - Tutorial of Parrot Comiler Tools =head1 SYNOPSIS use Parrot::Docs::Section::PCT_Tutorial; =head1 DESCRIPTION A tutorial series on building a compiler with the Parrot Compiler Tools. =head2 Class Methods =over =cut package Parrot::Docs::Section::PCT_Tutorial; use strict; use warnings; use base qw( Parrot::Docs::Section ); use Parrot::Docs::Item; use Parrot::Docs::Group; =item C Returns a new section. =cut sub new { my $self = shift; return $self->SUPER::new( 'PCT Tutorial', 'PCT_Tutorial.html', '', $self->new_group( 'Tutorial of Parrot Compiler Tools', '', $self->new_item( 'Episode 1: Introduction', 'examples/languages/squaak/doc/tutorial_episode_1.pod'), $self->new_item( 'Episode 2: Poking in Compiler Guts', 'examples/languages/squaak/doc/tutorial_episode_2.pod'), $self->new_item( 'Episode 3: Squaak Details and First Steps', 'examples/languages/squaak/doc/tutorial_episode_3.pod'), $self->new_item( 'Episode 4: PAST Nodes and More Statements', 'examples/languages/squaak/doc/tutorial_episode_4.pod'), $self->new_item( 'Episode 5: Variable Declaration and Scope', 'examples/languages/squaak/doc/tutorial_episode_5.pod'), $self->new_item( 'Episode 6: Scope and Subroutines', 'examples/languages/squaak/doc/tutorial_episode_6.pod'), $self->new_item( 'Episode 7: Operators and Precedence', 'examples/languages/squaak/doc/tutorial_episode_7.pod'), $self->new_item( 'Episode 8: Hashtables and Arrays', 'examples/languages/squaak/doc/tutorial_episode_8.pod'), $self->new_item( 'Episode 9: Wrap up and Conclusion', 'examples/languages/squaak/doc/tutorial_episode_9.pod'), ), ); } =back =cut 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: disassemble.c000644000765000765 1571211716253437 15776 0ustar00brucebruce000000000000parrot-5.9.0/src/* Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME src/disassemble.c - The Parrot Disassembler =head1 DESCRIPTION This file implements some logic for the parrot disassembler, and related routines. =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" #include "parrot/disassemble.h" #include "parrot/oplib/ops.h" #include "pmc/pmc_sub.h" #include "parrot/oplib/core_ops.h" /* HEADERIZER HFILE: include/parrot/disassemble.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void print_constant_table(PARROT_INTERP, ARGIN(PMC *output)) __attribute__nonnull__(1) __attribute__nonnull__(2); #define ASSERT_ARGS_print_constant_table __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(output)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Prints the contents of the constants table. =cut */ static void print_constant_table(PARROT_INTERP, ARGIN(PMC *output)) { ASSERT_ARGS(print_constant_table) const PackFile_ConstTable *ct = interp->code->const_table; INTVAL i; /* TODO: would be nice to print the name of the file as well */ Parrot_io_fprintf(interp, output, "=head1 Constant-table\n\n"); for (i = 0; i < ct->num.const_count; i++) Parrot_io_fprintf(interp, output, "NUM_CONST(%d): %f\n", i, ct->num.constants[i]); for (i = 0; i < ct->str.const_count; i++) Parrot_io_fprintf(interp, output, "STR_CONST(%d): %S\n", i, ct->str.constants[i]); for (i = 0; i < ct->pmc.const_count; i++) { PMC * const c = ct->pmc.constants[i]; Parrot_io_fprintf(interp, output, "PMC_CONST(%d): ", i); switch (c->vtable->base_type) { /* each PBC file has a ParrotInterpreter, but it can't * stringify by itself */ case enum_class_ParrotInterpreter: Parrot_io_fprintf(interp, output, "'ParrotInterpreter'"); break; /* FixedIntegerArrays used for signatures, handy to print */ case enum_class_FixedIntegerArray: { const INTVAL n = VTABLE_elements(interp, c); INTVAL j; Parrot_io_fprintf(interp, output, "["); for (j = 0; j < n; ++j) { const INTVAL val = VTABLE_get_integer_keyed_int(interp, c, j); Parrot_io_fprintf(interp, output, "%d", val); if (j < n - 1) Parrot_io_fprintf(interp, output, ","); } Parrot_io_fprintf(interp, output, "]"); break; } case enum_class_NameSpace: case enum_class_String: case enum_class_Key: case enum_class_ResizableStringArray: { STRING * const s = VTABLE_get_string(interp, c); if (s) Parrot_io_fprintf(interp, output, "%Ss", s); break; } case enum_class_Sub: Parrot_io_fprintf(interp, output, "%S", VTABLE_get_string(interp, c)); break; default: Parrot_io_fprintf(interp, output, "(PMC constant)"); break; } Parrot_io_fprintf(interp, output, "\n"); } Parrot_io_fprintf(interp, output, "\n=cut\n\n"); } /* =item C Disassembles and prints out the interpreter's bytecode. This is used by the Parrot disassembler. TODO: Move this to a dedicated file, or some place more related to disassembly. =cut */ PARROT_EXPORT void Parrot_disassemble(PARROT_INTERP, ARGIN_NULLOK(const char *outfile), Parrot_disassemble_options options) { ASSERT_ARGS(Parrot_disassemble) PDB_line_t *line; PDB_t * const pdb = mem_gc_allocate_zeroed_typed(interp, PDB_t); int num_mappings = 0; int curr_mapping = 0; int op_code_seq_num = 0; int debugs; PMC *output; if (outfile != NULL) { output = Parrot_io_open_handle(interp, PMCNULL, Parrot_str_new(interp, outfile, 0), Parrot_str_new_constant(interp, "tw")); } else output = Parrot_io_stdhandle(interp, PIO_STDOUT_FILENO, PMCNULL); interp->pdb = pdb; pdb->cur_opcode = interp->code->base.data; PDB_disassemble(interp, NULL); line = pdb->file->line; debugs = (interp->code->debugs != NULL); print_constant_table(interp, output); if (options & enum_DIS_HEADER) return; if (!(options & enum_DIS_BARE)) Parrot_io_fprintf(interp, output, "# %12s-%12s", "Seq_Op_Num", "Relative-PC"); if (debugs) { if (!(options & enum_DIS_BARE)) Parrot_io_fprintf(interp, output, " %6s:\n", "SrcLn#"); num_mappings = interp->code->debugs->num_mappings; } else { Parrot_io_fprintf(interp, output, "\n"); } while (line->next) { const char *c; /* Parrot_io_fprintf(interp, output, "%i < %i %i == %i \n", curr_mapping, * num_mappings, op_code_seq_num, * interp->code->debugs->mappings[curr_mapping].offset); */ if (debugs && curr_mapping < num_mappings) { if (op_code_seq_num == interp->code->debugs->mappings[curr_mapping].offset) { const int filename_const_offset = interp->code->debugs->mappings[curr_mapping].filename; Parrot_io_fprintf(interp, output, "# Current Source Filename '%Ss'\n", interp->code->const_table->str.constants[filename_const_offset]); ++curr_mapping; } } if (!(options & enum_DIS_BARE)) Parrot_io_fprintf(interp, output, "%012i-%012i", op_code_seq_num, line->opcode - interp->code->base.data); if (debugs && !(options & enum_DIS_BARE)) Parrot_io_fprintf(interp, output, " %06i: ", interp->code->debugs->base.data[op_code_seq_num]); /* If it has a label print it */ if (line->label) Parrot_io_fprintf(interp, output, "L%li:\t", line->label->number); else Parrot_io_fprintf(interp, output, "\t"); c = pdb->file->source + line->source_offset; while (c && *c != '\n') Parrot_io_fprintf(interp, output, "%c", *(c++)); Parrot_io_fprintf(interp, output, "\n"); line = line->next; ++op_code_seq_num; } if (outfile != NULL) Parrot_io_close_handle(interp, output); return; } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ resizablestringarray.pmc000644000765000765 3511512171255037 21056 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME src/pmc/resizablestringarray.pmc - resizable array for strings only =head1 DESCRIPTION ResizableStringArray implements a resizeable array which stores Parrot strings only. Any ints or floats assigned to elements of the array will first be converted to String PMCs and then to native Parrot strings. PMCs assigned to to elements of the array will be stringified by having their C method called. =cut */ /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* HEADERIZER END: static */ pmclass ResizableStringArray extends FixedStringArray auto_attrs provides array { ATTR UINTVAL resize_threshold; /*max capacity before resizing */ /* =head2 Functions =over 4 =item C Initializes the array. =cut */ VTABLE void init_int(INTVAL size) { SUPER(size); if (size) SET_ATTR_resize_threshold(INTERP, SELF, size); } /* =item C Returns the Parrot string value of the element at index C. =cut */ VTABLE STRING *get_string_keyed_int(INTVAL key) { STRING **str_array; INTVAL size; GET_ATTR_size(INTERP, SELF, size); if (key < 0) { if (key < -size) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "ResizableStringArray: index out of bounds!"); else key += size; } if (key >= size) return CONST_STRING(INTERP, ""); GET_ATTR_str_array(INTERP, SELF, str_array); if (!str_array[key]) str_array[key] = Parrot_str_new(INTERP, NULL, 0); return str_array[key]; } /* =item C Sets the Parrot string value of the element at index C to C. =cut */ VTABLE void set_string_keyed_int(INTVAL key, STRING *value) { STRING **str_array; INTVAL size; GET_ATTR_size(INTERP, SELF, size); if (key < 0) { if (key < -size) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "ResizableStringArray: index out of bounds!"); else key += size; } if (key >= size) SELF.set_integer_native(key+1); GET_ATTR_str_array(INTERP, SELF, str_array); str_array[key] = value; } /* =item C Extends the array by adding an element of value C<*value> to the end of the array. =cut */ VTABLE void push_string(STRING *value) { INTVAL next_idx; GET_ATTR_size(INTERP, SELF, next_idx); SELF.set_string_keyed_int(next_idx, value); } /* =item C Removes and returns the last element in the array. =cut */ VTABLE STRING *pop_string() { STRING *value; INTVAL size; GET_ATTR_size(INTERP, SELF, size); if (size == 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "ResizableStringArray: Can't pop from an empty array!"); value = SELF.get_string_keyed_int(size - 1); SELF.set_integer_native(size - 1); return value; } /* =item C Removes and returns the last element in the array. =cut */ VTABLE PMC *pop_pmc() { STRING *strval = SELF.pop_string(); PMC *value = Parrot_pmc_new(INTERP, enum_class_String); VTABLE_set_string_native(INTERP, value, strval); return value; } /* =item C Removes and returns the last element in the array. =cut */ VTABLE INTVAL pop_integer() { PMC * const pmcval = SELF.pop_pmc(); return VTABLE_get_integer(INTERP, pmcval); } /* =item C Removes and returns the last element in the array. =cut */ VTABLE FLOATVAL pop_float() { PMC * const pmcval = SELF.pop_pmc(); return VTABLE_get_number(INTERP, pmcval); } /* =item C Resizes the array to C elements. =cut */ VTABLE void set_integer_native(INTVAL new_size) { STRING **str_array; INTVAL resize_threshold; if (new_size < 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "ResizableStringArray: Can't resize!"); GET_ATTR_str_array(INTERP, SELF, str_array); GET_ATTR_resize_threshold(INTERP, SELF, resize_threshold); if (!str_array) { /* empty - used fixed routine */ if (new_size < 8) { SUPER(8); SET_ATTR_size(INTERP, SELF, new_size); SET_ATTR_resize_threshold(INTERP, SELF, 8); } else { SUPER(new_size); SET_ATTR_resize_threshold(INTERP, SELF, new_size); } } else if (new_size <= resize_threshold) { /* zero out anything that was previously allocated * if we're growing the array */ INTVAL old_size; GET_ATTR_size(INTERP, SELF, old_size); if (new_size > old_size) { INTVAL i; for (i = old_size; i < new_size; ++i) str_array[i] = NULL; } SET_ATTR_size(INTERP, SELF, new_size); /* we could shrink here if necessary */ return; } else { INTVAL i = resize_threshold; INTVAL cur = i; if (cur < 8192) cur = (new_size < 2 * cur) ? (2 * cur) : new_size; else { cur = new_size + 4096; cur &= ~0xfff; } SET_ATTR_str_array(INTERP, SELF, mem_gc_realloc_n_typed_zeroed(INTERP, str_array, cur, resize_threshold, STRING*)); GET_ATTR_str_array(INTERP, SELF, str_array); for (; i < cur; ++i) str_array[i] = NULL; SET_ATTR_size(INTERP, SELF, new_size); SET_ATTR_resize_threshold(INTERP, SELF, cur); } } /* =item C Creates and returns a copy of the array. =cut */ VTABLE PMC *clone() { PMC * const copy = SUPER(); INTVAL size; GET_ATTR_size(INTERP, SELF, size); /* copy trimmed extra space */ SET_ATTR_resize_threshold(INTERP, copy, size); return copy; } /* =item C Removes and returns an item from the start of the array. =cut */ VTABLE STRING *shift_string() { STRING *value; INTVAL size; GET_ATTR_size(INTERP, SELF, size); if (size == 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "ResizableStringArray: Can't shift from an empty array!"); value = SELF.get_string_keyed_int(0); SELF.delete_keyed_int(0); return value; } /* =item C Removes and returns the first element in the array. =cut */ VTABLE INTVAL shift_integer() { PMC * const pmcval = SELF.shift_pmc(); return VTABLE_get_integer(INTERP, pmcval); } /* =item C Removes and returns the first element in the array. =cut */ VTABLE FLOATVAL shift_float() { PMC * const pmcval = SELF.shift_pmc(); return VTABLE_get_number(INTERP, pmcval); } /* =item C Extends the array by adding an element of value C<*value> to the end of the array. =cut */ VTABLE void push_pmc(PMC *value) { STRING * const strvalue = VTABLE_get_string(INTERP, value); SELF.push_string(strvalue); } /* =item C Extends the array by adding an element of value C<*value> to the end of the array. =cut */ VTABLE void push_integer(INTVAL value) { PMC * const ret = Parrot_pmc_new(INTERP, enum_class_String); STRING *val; VTABLE_set_integer_native(INTERP, ret, value); val = VTABLE_get_string(INTERP, ret); SELF.push_string(val); } /* =item C Extends the array by adding an element of value C<*value> to the end of the array. =cut */ VTABLE void push_float(FLOATVAL value) { PMC * const ret = Parrot_pmc_new(INTERP, enum_class_String); STRING *val; VTABLE_set_number_native(INTERP, ret, value); val = VTABLE_get_string(INTERP, ret); SELF.push_string(val); } /* =item C Removes and returns a String PMC from the start of the array. =cut */ VTABLE PMC *shift_pmc() { UINTVAL size; PMC *ret; STRING *value; GET_ATTR_size(INTERP, SELF, size); if (size == 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "ResizableStringArray: Can't shift from an empty array!"); value = SELF.get_string_keyed_int(0); ret = Parrot_pmc_new(INTERP, enum_class_String); VTABLE_set_string_native(INTERP, ret, value); SELF.delete_keyed_int(0); return ret; } /* =item C Extends the array by adding an element of value C<*value> to the start of the array. =cut */ VTABLE void unshift_string(STRING *value) { STRING **str_array; UINTVAL size, i; GET_ATTR_size(INTERP, SELF, size); SELF.set_integer_native(size + 1); GET_ATTR_str_array(INTERP, SELF, str_array); for (i = size; i; --i) str_array[i] = str_array[i - 1]; SELF.set_string_keyed_int(0, value); } /* =item C Extends the array by adding an element of value C<*value> to the front of the array. =cut */ VTABLE void unshift_pmc(PMC *value) { STRING * const strvalue = VTABLE_get_string(INTERP, value); SELF.unshift_string(strvalue); } /* =item C Extends the array by adding an element of value C<*value> to the front of the array. =cut */ VTABLE void unshift_integer(INTVAL value) { PMC * const ret = Parrot_pmc_new(INTERP, enum_class_String); STRING *val; VTABLE_set_integer_native(INTERP, ret, value); val = VTABLE_get_string(INTERP, ret); SELF.unshift_string(val); } /* =item C Extends the array by adding an element of value C<*value> to the front of the array. =cut */ VTABLE void unshift_float(FLOATVAL value) { PMC * const ret = Parrot_pmc_new(INTERP, enum_class_String); STRING *val; VTABLE_set_number_native(INTERP, ret, value); val = VTABLE_get_string(INTERP, ret); SELF.unshift_string(val); } /* =item C Converts C to a PMC key and calls C with it. =cut */ VTABLE void delete_keyed_int(INTVAL key) { STRING **str_array; UINTVAL size, i; GET_ATTR_str_array(INTERP, SELF, str_array); GET_ATTR_size(INTERP, SELF, size); for (i = key; i < size - 1; ++i) str_array[i] = str_array[i + 1]; SELF.set_integer_native(size - 1); } /* =item C Removes the element at C<*key>. =cut */ VTABLE void delete_keyed(PMC *key) { const INTVAL idx = VTABLE_get_integer(INTERP, key); STRING **str_array; UINTVAL size, i; GET_ATTR_str_array(INTERP, SELF, str_array); GET_ATTR_size(INTERP, SELF, size); for (i = idx; i < size - 1; ++i) str_array[i] = str_array[i + 1]; SELF.set_integer_native(size - 1); } /* =item C Replaces C elements starting at C with the elements in C. Note that the C PMC can be of any of the various array types. Note that this implementation can be *VERY *inefficient as it manipulates everything via the VTABLE api. =cut */ VTABLE void splice(PMC *value, INTVAL offset, INTVAL count) { INTVAL length, elems, shift, i; if (value->vtable->base_type != SELF->vtable->base_type && value->vtable->base_type != enum_class_FixedStringArray) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "ResizableStringArray: illegal type for splice!"); length = VTABLE_elements(INTERP, SELF); elems = VTABLE_elements(INTERP, value); shift = elems - count; /* start from end? */ if (offset < 0) offset += length; if (offset < 0) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, "illegal splice offset\n"); /* shrink the array */ if (shift < 0) { /* start at offset so we don't overwrite values we'll need */ for (i = offset+count; i < length; ++i) VTABLE_set_pmc_keyed_int(INTERP, SELF, i + shift, VTABLE_get_pmc_keyed_int(INTERP, SELF, i)); SELF.set_integer_native(length + shift); } /* grow the array */ else if (shift > 0) { SELF.set_integer_native(length + shift); /* move the existing values */ /* start at length-1 so we don't overwrite values we'll need */ for (i = length - 1; i >= offset; --i) VTABLE_set_pmc_keyed_int(INTERP, SELF, i + shift, VTABLE_get_pmc_keyed_int(INTERP, SELF, i)); } /* copy the new values */ for (i = 0; i < elems; ++i) VTABLE_set_pmc_keyed_int(INTERP, SELF, i + offset, VTABLE_get_pmc_keyed_int(INTERP, value, i)); } /* =item METHOD PMC* shift() =item METHOD PMC* pop() Method forms to remove and return a PMC from the beginning or end of the array. =cut */ METHOD shift() { PMC * const value = SELF.shift_pmc(); RETURN(PMC *value); } METHOD pop() { PMC * const value = SELF.pop_pmc(); RETURN(PMC *value); } /* =item METHOD unshift(PMC* value) =item METHOD push(PMC* value) Method forms to add a PMC to the beginning or end of the array. =cut */ METHOD unshift(PMC* value) { SELF.unshift_pmc(value); } METHOD push(PMC* value) { SELF.push_pmc(value); } } /* =back =head1 SEE ALSO F. =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ LICENSE000644000765000765 2130011533177635 15572 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx The Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. pmc_freeze.h000644000765000765 1763512101554067 17770 0ustar00brucebruce000000000000parrot-5.9.0/include/parrot/* pmc_freeze.h * Copyright (C) 2001-2003, Parrot Foundation. * Overview: * PMC freeze and thaw interface * Data Structure and Algorithms: * History: * Notes: * References: */ #ifndef PARROT_PMC_FREEZE_H_GUARD #define PARROT_PMC_FREEZE_H_GUARD #include "parrot/packfile.h" typedef enum { VISIT_HOW_PMC_TO_VISITOR = 0x00, /* push to visitor */ VISIT_HOW_VISITOR_TO_PMC = 0x01, /* shift from visitor */ VISIT_HOW_PMC_TO_PMC = 0x02, /* push to visitor; then shift from visitor */ VISIT_HOW_VISITOR_TO_VISITOR = 0x03 /* shift from visitor; then push to visitor */ } visit_how_enum_t; #define VISIT_HOW_MASK 0x03 typedef enum { VISIT_WHAT_PMC = 0x04, VISIT_WHAT_STRING = 0x08, VISIT_WHAT_FLOATVAL = 0x10, VISIT_WHAT_INTVAL = 0x20 } visit_what_enum_t; #define VISIT_WHAT_MASK 0x3c /* backwards-compat defns */ #define visit_enum_type INTVAL #define VISIT_FREEZE_NORMAL (VISIT_HOW_PMC_TO_VISITOR | VISIT_WHAT_PMC) #define VISIT_THAW_NORMAL (VISIT_HOW_VISITOR_TO_PMC | VISIT_WHAT_PMC) #define VISIT_THAW_CONSTANTS VISIT_THAW_NORMAL typedef enum { EXTRA_IS_NULL, EXTRA_IS_PROP_HASH } extra_flags_enum; #define VISIT_PMC(interp, visit, pmc) do {\ const INTVAL _visit_pmc_flags = VTABLE_get_integer((interp), (visit)); \ if (_visit_pmc_flags & VISIT_WHAT_PMC) { \ switch (_visit_pmc_flags & VISIT_HOW_MASK) { \ case VISIT_HOW_PMC_TO_VISITOR: \ VTABLE_push_pmc((interp), (visit), (pmc)); \ break; \ case VISIT_HOW_VISITOR_TO_PMC: \ (pmc) = VTABLE_shift_pmc((interp), (visit)); \ break; \ case VISIT_HOW_PMC_TO_PMC: \ VTABLE_push_pmc((interp), (visit), (pmc)); \ (pmc) = VTABLE_shift_pmc((interp), (visit)); \ break; \ case VISIT_HOW_VISITOR_TO_VISITOR: \ (pmc) = VTABLE_shift_pmc((interp), (visit)); \ VTABLE_push_pmc((interp), (visit), (pmc)); \ break; \ default: \ Parrot_x_panic_and_exit((interp), "Bad VISIT_HOW in VISIT_PMC", __FILE__, __LINE__); \ } \ } \ } while (0) #define VISIT_PMC_ATTR(interp, visit, self, pmclass, attr_name) do {\ const INTVAL _visit_pmc_attr_flags = VTABLE_get_integer((interp), (visit)); \ if (_visit_pmc_attr_flags & VISIT_WHAT_PMC) { \ PMC *_visit_pmc_attr; \ switch (_visit_pmc_attr_flags & VISIT_HOW_MASK) { \ case VISIT_HOW_PMC_TO_VISITOR: \ GETATTR_ ## pmclass ## _ ## attr_name((interp), (self), _visit_pmc_attr); \ VTABLE_push_pmc((interp), (visit), _visit_pmc_attr); \ break; \ case VISIT_HOW_VISITOR_TO_PMC: \ _visit_pmc_attr = VTABLE_shift_pmc((interp), (visit)); \ SETATTR_ ## pmclass ## _ ## attr_name((interp), (self), _visit_pmc_attr); \ break; \ case VISIT_HOW_PMC_TO_PMC: \ GETATTR_ ## pmclass ## _ ## attr_name((interp), (self), _visit_pmc_attr); \ VTABLE_push_pmc((interp), (visit), _visit_pmc_attr); \ _visit_pmc_attr = VTABLE_shift_pmc((interp), (visit)); \ SETATTR_ ## pmclass ## _ ## attr_name((interp), (self), _visit_pmc_attr); \ break; \ case VISIT_HOW_VISITOR_TO_VISITOR: \ _visit_pmc_attr = VTABLE_shift_pmc((interp), (visit)); \ SETATTR_ ## pmclass ## _ ## attr_name((interp), (self), _visit_pmc_attr); \ GETATTR_ ## pmclass ## _ ## attr_name((interp), (self), _visit_pmc_attr); \ VTABLE_push_pmc((interp), (visit), _visit_pmc_attr); \ break; \ default: \ Parrot_x_panic_and_exit((interp), "Bad VISIT_HOW in VISIT_PMC_ATTR", __FILE__, __LINE__); \ } \ } \ } while (0) /* * public interfaces */ /* HEADERIZER BEGIN: src/packfile/object_serialization.c */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL PMC* Parrot_clone(PARROT_INTERP, ARGIN(PMC *pmc)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING* Parrot_freeze(PARROT_INTERP, ARGIN(PMC *pmc)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL opcode_t * Parrot_freeze_pbc(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(const PackFile_ConstTable *pf), ARGOUT(opcode_t *cursor), ARGOUT(Hash **seen)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) __attribute__nonnull__(5) FUNC_MODIFIES(*cursor) FUNC_MODIFIES(*seen); PARROT_EXPORT PARROT_WARN_UNUSED_RESULT UINTVAL Parrot_freeze_pbc_size(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(const PackFile_ConstTable *pf), ARGOUT(Hash **seen)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) FUNC_MODIFIES(*seen); PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_freeze_strings(PARROT_INTERP, ARGIN(PMC *pmc)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_thaw(PARROT_INTERP, ARGIN(STRING *image)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC* Parrot_thaw_constants(PARROT_INTERP, ARGIN(STRING *image)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL PMC* Parrot_thaw_pbc(PARROT_INTERP, ARGIN(PackFile_ConstTable *ct), ARGMOD(const opcode_t **cursor)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*cursor); void Parrot_pf_verify_image_string(PARROT_INTERP, ARGIN(STRING *image)) __attribute__nonnull__(1) __attribute__nonnull__(2); #define ASSERT_ARGS_Parrot_clone __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(pmc)) #define ASSERT_ARGS_Parrot_freeze __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(pmc)) #define ASSERT_ARGS_Parrot_freeze_pbc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(pmc) \ , PARROT_ASSERT_ARG(pf) \ , PARROT_ASSERT_ARG(cursor) \ , PARROT_ASSERT_ARG(seen)) #define ASSERT_ARGS_Parrot_freeze_pbc_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(pmc) \ , PARROT_ASSERT_ARG(pf) \ , PARROT_ASSERT_ARG(seen)) #define ASSERT_ARGS_Parrot_freeze_strings __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(pmc)) #define ASSERT_ARGS_Parrot_thaw __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(image)) #define ASSERT_ARGS_Parrot_thaw_constants __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(image)) #define ASSERT_ARGS_Parrot_thaw_pbc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(ct) \ , PARROT_ASSERT_ARG(cursor)) #define ASSERT_ARGS_Parrot_pf_verify_image_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(image)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: src/packfile/object_serialization.c */ #endif /* PARROT_PMC_FREEZE_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ alarm.c000644000765000765 1214212101554067 14561 0ustar00brucebruce000000000000parrot-5.9.0/src/* Copyright (C) 2010-2012, Parrot Foundation. =head1 NAME src/alarm.c - Implements a mechanism for alarms, setting a flag after a delay. =head1 DESCRIPTION This program implements a mechanism for alarms, setting a flag after a delay. =cut */ #include "parrot/parrot.h" #include "parrot/alarm.h" #include "parrot/thread.h" /* Some per-process state */ static volatile UINTVAL alarm_serial = 0; static volatile FLOATVAL alarm_set_to = 0.0; static volatile FLOATVAL current_alarm = 0.0; /* HEADERIZER HFILE: include/parrot/alarm.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_CAN_RETURN_NULL static void* Parrot_alarm_runloop(void *arg); #define ASSERT_ARGS_Parrot_alarm_runloop __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =over 4 =item C Initialize the alarm queue. This function should only be called from the initial pthread. Any other pthreads should make sure to mask out SIGALRM. =cut */ static Parrot_mutex alarm_lock; static Parrot_cond sleep_cond; void Parrot_alarm_init(void) { ASSERT_ARGS(Parrot_alarm_init) Parrot_thread thread; MUTEX_INIT(alarm_lock); COND_INIT(sleep_cond); THREAD_CREATE_JOINABLE(thread, Parrot_alarm_runloop, NULL); } /* =over 4 =item C The thread function handling alarms. The argument C is currently ignored. =cut */ PARROT_CAN_RETURN_NULL static void* Parrot_alarm_runloop(SHIM(void *arg)) { ASSERT_ARGS(Parrot_alarm_runloop) while (1) { int rc = 0; INTVAL notify = 0; LOCK(alarm_lock); /* First, check if we have any outstanding alarms, and wait for those. */ if (alarm_set_to > 0) { struct timespec ts; ts.tv_sec = (time_t)alarm_set_to; ts.tv_nsec = (long)((alarm_set_to - ts.tv_sec) * 1000000000.0f); current_alarm = alarm_set_to; alarm_set_to = 0; rc = 0; while (alarm_set_to == 0 && rc == 0) COND_TIMED_WAIT(sleep_cond, alarm_lock, &ts, rc); } else { /* no alarms set, just wait for new alarms */ while (alarm_set_to == 0) COND_WAIT(sleep_cond, alarm_lock); } /* Check if we need to notify threads. We need to notify threads if an alarm time has passed, or if there has been a timeout error in waiting for alarms. */ if (alarm_set_to > 0 && alarm_set_to <= Parrot_floatval_time()) { /* New alarm is already in the past. Don't bother waiting, notify immediately */ notify = 1; alarm_set_to = 0; } else { /* notify on timeout but not on setting new alarm */ notify = (rc != 0); } if (notify) current_alarm = 0; UNLOCK(alarm_lock); /* If we need to notify, do that here. Otherwise, back to the top of the loop*/ if (notify) { /* possible racy write with read in Parrot_alarm_check */ LOCK(alarm_lock); alarm_serial += 1; UNLOCK(alarm_lock); Parrot_thread_notify_threads(NULL); } } return NULL; } /* =item C Determine if any alarms have passed since last checked. Possible design improvement: Alert only the thread that set the alarm. =cut */ PARROT_EXPORT int Parrot_alarm_check(ARGMOD(UINTVAL* last_serial)) { ASSERT_ARGS(Parrot_alarm_check) #ifdef PARROT_HAS_THREADS if (*last_serial == alarm_serial) return 0; *last_serial = alarm_serial; return 1; #else return (alarm_set_to <= Parrot_floatval_time()); #endif } /* =item C Sets an alarm to trigger at time 'when'. =cut */ PARROT_EXPORT void Parrot_alarm_set(FLOATVAL when) { ASSERT_ARGS(Parrot_alarm_set) LOCK(alarm_lock); { if (current_alarm > 0 && current_alarm <= when) { /* there's already an active alarm for an earlier point in time */ UNLOCK(alarm_lock); return; } alarm_set_to = when; COND_SIGNAL(sleep_cond); } UNLOCK(alarm_lock); } /* =item C Sleep till the next alarm expires. This is a fallback function which is only used if we try to sleep the interp without threads support. If we have threading enabled, this function will not be used and the normal threads-based mechanism will be used instead. =cut */ PARROT_EXPORT void Parrot_alarm_wait_for_next_alarm(SHIM_INTERP) { ASSERT_ARGS(Parrot_alarm_wait_for_next_alarm) const FLOATVAL now_time = Parrot_floatval_time(); const FLOATVAL time = alarm_set_to - now_time; if (time > 0) Parrot_usleep(time * 1000000); } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ addit.pir000644000765000765 305411533177634 20261 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks# Copyright (C) 2001-2008, Parrot Foundation. =head1 NAME examples/benchmarks/addit.pir - Variable Argument Subroutines =head1 SYNOPSIS % time ./parrot examples/benchmarks/addit.pir =head1 DESCRIPTION An IMC version of Joe Wilson's original PASM version of his C subroutines benchmark rewritten as it would be generated by a compiler using Parrot calling conventions (PDD 3). It calls an "add it" function 50000 times in a loop and prints the result (21001097.970000). =cut .sub addit :main .local pmc a0 a0 = new 'Integer' a0 = 1000 .local pmc a1 a1 = new 'Float' a1 = 7.100 .local pmc a2 a2 = new 'Integer' a2 = 87 .local pmc a3 a3 = new 'String' a3 = "3.87" .local pmc a4 a4 = new 'String' a4 = "21000000" .local pmc x x = new 'Integer' x = 50000 AGAIN: dec x lt x, 0, FIN .local pmc result result = _varargs_adder(a0, a1, a2, a3, a4) branch AGAIN FIN: print result print "\n" end .end .sub _varargs_adder .param pmc a0 .param pmc a1 .param pmc a2 .param pmc a3 .param pmc a4 .local pmc sum sum = new 'Float' add sum, a0 add sum, a1 add sum, a2 add sum, a3 add sum, a4 .return (sum) .end =head1 SEE ALSO F, F, F. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: core_pmcs.pm000644000765000765 1036012140013540 17045 0ustar00brucebruce000000000000parrot-5.9.0/config/gen# Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME config/gen/core_pmcs.pm - Core PMC List =head1 DESCRIPTION Generates the core PMC list F. =cut package gen::core_pmcs; use strict; use warnings; use base qw(Parrot::Configure::Step); use Parrot::Configure::Utils ':gen'; sub _init { my $self = shift; my %data; $data{description} = q{Generate core pmc list}; $data{result} = q{}; return \%data; } sub runstep { my ( $self, $conf ) = @_; $self->generate_h($conf); $self->generate_c($conf); $self->generate_pm($conf); return 1; } sub generate_h { my ( $self, $conf ) = @_; my $file = 'include/parrot/core_pmcs.h'; # $conf->append_configure_log($file); add_to_generated($file, "[main]", "include"); open( my $OUT, '>', "${file}_tmp" ); print {$OUT} <<'END_H'; /* * DO NOT EDIT THIS FILE * * Automatically generated by config/gen/core_pmcs.pm */ #ifndef PARROT_CORE_PMCS_H_GUARD #define PARROT_CORE_PMCS_H_GUARD /* &gen_from_enum(pmctypes.pasm) subst(s/enum_class_(\w+)/$1/e) */ enum { END_H my @pmcs = split( qr/ /, $conf->data->get('pmc_names') ); my $i = 0; foreach (@pmcs) { print {$OUT} " enum_class_$_,\t/* $i */\n"; $i++; } print {$OUT} <<'END_H'; enum_class_core_max }; /* &end_gen */ #endif /* PARROT_CORE_PMCS_H_GUARD */ END_H print {$OUT} coda(); close $OUT or die "Can't close file: $!"; move_if_diff( "${file}_tmp", $file ); return; } sub generate_c { my ( $self, $conf ) = @_; my $file = "src/core_pmcs.c"; my @pmcs = split( qr/ /, $conf->data->get('pmc_names') ); # $conf->append_configure_log($file); add_to_generated($file, "[]", ""); open( my $OUT, '>', "${file}_tmp" ); print {$OUT} <<'END_C'; /* * DO NOT EDIT THIS FILE * * Automatically generated by config/gen/core_pmcs.pm */ /* HEADERIZER HFILE: none */ /* HEADERIZER STOP */ #include "parrot/parrot.h" #include "parrot/global_setup.h" END_C print {$OUT} "extern void Parrot_${_}_class_init(PARROT_INTERP, int, int);\n" foreach (@pmcs); print {$OUT} <<'END_C'; void Parrot_gbl_initialize_core_pmcs(PARROT_INTERP, int pass) { /* first the PMC with the highest enum * this reduces MMD table resize action */ END_C print {$OUT} " Parrot_${_}_class_init(interp, enum_class_${_}, pass);\n" foreach ( @pmcs[ -1 .. -1 ] ); print {$OUT} " Parrot_${_}_class_init(interp, enum_class_${_}, pass);\n" foreach ( @pmcs[ 0 .. $#pmcs - 1 ] ); print {$OUT} <<'END_C'; } static void register_pmc(PARROT_INTERP, ARGIN(PMC *registry), int pmc_id) { STRING * const key = interp->vtables[pmc_id]->whoami; VTABLE_set_integer_keyed_str(interp, registry, key, pmc_id); } void Parrot_gbl_register_core_pmcs(PARROT_INTERP, ARGIN(PMC *registry)) { END_C print {$OUT} " register_pmc(interp, registry, enum_class_$_);\n" foreach (@pmcs); print {$OUT} <<'END_C'; } END_C print {$OUT} coda(); close $OUT or die "Can't close file: $!"; move_if_diff( "${file}_tmp", $file ); return; } sub generate_pm { my ( $self, $conf ) = @_; my $file = "lib/Parrot/PMC.pm"; my @pmcs = split( qr/ /, $conf->data->get('pmc_names') ); # $conf->append_configure_log($file); add_to_generated($file, "[devel]", "lib"); open( my $OUT, '>', "${file}_tmp" ); print $OUT <<'END_PM'; # DO NOT EDIT THIS FILE # # Automatically generated by config/gen/core_pmcs.pm package Parrot::PMC; use strict; use warnings; use vars qw(@ISA %pmc_types @EXPORT_OK); @ISA = qw( Exporter ); @EXPORT_OK = qw( %pmc_types); %pmc_types = ( END_PM for my $num ( 0 .. $#pmcs ) { my $id = $num + 1; print {$OUT} "\t$pmcs[$num] => $id,\n"; } print {$OUT} <<'END_PM'; ); 1; END_PM close $OUT or die "Can't close file: $!"; move_if_diff( "${file}_tmp", $file ); return; } sub coda { my $v = 'vim'; # Translate it in code so vim doesn't think this file itself is readonly return <<"HERE"; /* * Local variables: * c-file-style: "parrot" * End: * ${v}: readonly expandtab shiftwidth=4: */ HERE } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: check_isxxx.t000644000765000765 316111533177643 17452 0ustar00brucebruce000000000000parrot-5.9.0/t/codingstd#! perl # Copyright (C) 2006-2009, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More tests => 1; use Parrot::Distribution; use Parrot::Test::Util::Runloop; =head1 NAME t/codingstd/check_isxxx.t - checks that the isxxx() functions are passed unsigned char =head1 SYNOPSIS # test all files % prove t/codingstd/check_isxxx.t # test specific files % perl t/codingstd/check_isxxx.t src/foo.c include/parrot/bar.h =head1 DESCRIPTION Checks all C language files to make sure that arguments to the isxxx() functions are explicitly cast to unsigned char. =head1 SEE ALSO L =cut my $DIST = Parrot::Distribution->new; my @files = @ARGV ? <@ARGV> : $DIST->get_c_language_files(); my @no_explicit_cast; my @isxxx_functions_list = qw( isalnum isalpha isblank iscntrl isdigit isgraph islower isprint ispunct isspace isupper ); my $isxxx_functions = join '|', @isxxx_functions_list; sub check_isxxx { my $line = shift; # does the line contain an isxxx call? return 1 unless $line =~ /[^_]($isxxx_functions)\([^)]+/; # is the line missing a cast? return 1 unless $line !~ /[^_]($isxxx_functions)\(\(unsigned char\)/; # yes! fail. return 0; } Parrot::Test::Util::Runloop->testloop( name => 'isxxx() functions cast correctly', files => [@files], per_line => \&check_isxxx, diag_prefix => 'isxxx() function not cast to unsigned char' ); # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: pmc.ops000644000765000765 3725712101554067 15442 0ustar00brucebruce000000000000parrot-5.9.0/src/ops/* pmc.ops */ =head1 NAME pmc.ops - PMC Opcodes =head1 DESCRIPTION Operations that deal with PMCs, including creation and destruction, manipulation, and introspection. When making changes to any ops file, run C to regenerate all generated ops files. =cut ############################################################################### =head2 Creation and Types These operations are used to create PMCs and examine type information. =over 4 =cut ######################################## =item B(out PMC, in STR) =item B(out PMC, in STR, in PMC) =item B(out PMC, in PMC) =item B(out PMC, in PMC, in PMC) Instantiate a new object from a string PMC or key name, or from a class object. For strings and keys, first check the namespace for a class object, then fall back to the type ID if no class object is stored in the namespace. new $P0, 'ResizableBooleanArray' Optionally a PMC may be passed to the constructor. It's up to the class what to do with the initializer. See PDD17 and the init_pmc function for more. =cut op new(out PMC, in STR) { STRING * const name = $2; PMC * const _class = Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)) ? Parrot_oo_get_class_str(interp, name) : PMCNULL; if (!PMC_IS_NULL(_class)) $1 = VTABLE_instantiate(interp, _class, PMCNULL); else { const INTVAL type = Parrot_pmc_get_type_str(interp, name); if (type <= 0) { opcode_t * const dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(), EXCEPTION_NO_CLASS, "Class '%Ss' not found", name); goto ADDRESS(dest); } $1 = Parrot_pmc_new(interp, type); } } op new(out PMC, in STR, in PMC) { STRING * const name = $2; PMC * const _class = Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)) ? Parrot_oo_get_class_str(interp, name) : PMCNULL; if (!PMC_IS_NULL(_class)) $1 = VTABLE_instantiate(interp, _class, $3); else { const INTVAL type = Parrot_pmc_get_type_str(interp, name); if (type <= 0) { opcode_t * const dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(), EXCEPTION_NO_CLASS, "Class '%Ss' not found", name); goto ADDRESS(dest); } $1 = Parrot_pmc_new_init(interp, type, $3); } } inline op new(out PMC, in PMC) :object_classes { PMC * const name_key = $2; PMC * const _class = Parrot_oo_get_class(interp, name_key); if (!PMC_IS_NULL(_class)) $1 = VTABLE_instantiate(interp, _class, PMCNULL); else { const INTVAL type = Parrot_pmc_get_type(interp, name_key); if (type <= 0) { opcode_t * const dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(), EXCEPTION_NO_CLASS, "Class '%Ss' not found", VTABLE_get_repr(interp, name_key)); goto ADDRESS(dest); } $1 = Parrot_pmc_new(interp, type); } } op new(out PMC, in PMC, in PMC) { PMC * const name_key = $2; PMC * const _class = Parrot_oo_get_class(interp, name_key); if (!PMC_IS_NULL(_class)) $1 = VTABLE_instantiate(interp, _class, $3); else { const INTVAL type = Parrot_pmc_get_type(interp, name_key); if (type <= 0) { opcode_t * const dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(), EXCEPTION_NO_CLASS, "Class '%Ss' not found", VTABLE_get_repr(interp, name_key)); goto ADDRESS(dest); } $1 = Parrot_pmc_new_init(interp, type, $3); } } ######################################## =item B(out PMC, in PMC) =item B(out PMC, in PMC, in PMC) Instantiate a new object from a key name relative to the root namespace. root_new $P0, ['parrot';'ResizableBooleanArray'] Optionally a PMC may be passed to the constructor. It's up to the class what to do with the initializer. =cut op root_new(out PMC, in PMC) { PMC * const key = $2; PMC * const root_ns = interp->root_namespace; PMC * const ns = Parrot_ns_get_namespace_keyed(interp, root_ns, key); PMC * classobj = PMCNULL; if (!PMC_IS_NULL(ns)) classobj = Parrot_oo_get_class(interp, ns); if (!PMC_IS_NULL(classobj)) $1 = VTABLE_instantiate(interp, classobj, PMCNULL); else { opcode_t * const dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(), EXCEPTION_NO_CLASS, "Class '%Ss' not found", VTABLE_get_repr(interp, key)); goto ADDRESS(dest); } } op root_new(out PMC, in PMC, in PMC) { PMC * const key = $2; PMC * const root_ns = interp->root_namespace; PMC * const ns = Parrot_ns_get_namespace_keyed(interp, root_ns, key); PMC * classobj = PMCNULL; if (!PMC_IS_NULL(ns)) classobj = Parrot_oo_get_class(interp, ns); if (!PMC_IS_NULL(classobj)) $1 = VTABLE_instantiate(interp, classobj, $3); else { opcode_t * const dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(), EXCEPTION_NO_CLASS, "Class '%Ss' not found", VTABLE_get_repr(interp, key)); goto ADDRESS(dest); } } ######################################## =item B(out STR, invar PMC) =item B(out PMC, invar PMC) Return the type of PMC in $2. =cut inline op typeof(out STR, invar PMC) { $1 = VTABLE_name(interp, $2); } inline op typeof(out PMC, invar PMC) { $1 = VTABLE_get_class(interp, $2); } ######################################## =item B(out STR, invar PMC) Set $1 to a string representation of $2 =cut op get_repr(out STR, invar PMC) { $1 = VTABLE_get_repr(interp, $2); } =back =cut ############################################################################### =head2 Basic Operations A few simple and common PMC operations. =over 4 =cut ######################################## =item B(out PMC, invar PMC, in STR) Looks up method $3 in $2's vtable, placing the corresponding method PMC in $1. =cut op find_method(out PMC, invar PMC, in STR) :flow { opcode_t * const resume = expr NEXT(); $1 = VTABLE_find_method(interp, $2, $3); if (PMC_IS_NULL($1) || !VTABLE_defined(interp, $1)) { opcode_t * const dest = Parrot_ex_throw_from_op_args(interp, resume, EXCEPTION_METHOD_NOT_FOUND, "Method '%Ss' not found for invocant of class '%Ss'", $3, VTABLE_get_string(interp, VTABLE_get_class(interp, $2))); goto ADDRESS(dest); } goto ADDRESS(resume); } ######################################## =item B(out INT, invar PMC) =item B(out INT, invar PMC, in INTKEY) =item B(out INT, invar PMC, in KEY) Test PMC for definedness. =item B(out INT, invar PMC, in INTKEY) =item B(out INT, invar PMC, in KEY) Tests whether KEY or INTKEY exists in the aggregate PMC. Places the answer in INT. =cut inline op defined(out INT, invar PMC) { $1 = PMC_IS_NULL($2) ? 0 : VTABLE_defined(interp, $2); } inline op defined(out INT, invar PMC, in INTKEY) { $1 = PMC_IS_NULL($2) ? 0 : VTABLE_defined_keyed_int(interp, $2, $3); } inline op defined(out INT, invar PMC, in KEY) { $1 = PMC_IS_NULL($2) ? 0 : VTABLE_defined_keyed(interp, $2, $3); } inline op exists(out INT, invar PMC, in INTKEY) { $1 = PMC_IS_NULL($2) ? 0 : VTABLE_exists_keyed_int(interp, $2, $3); } inline op exists(out INT, invar PMC, in KEY) { $1 = PMC_IS_NULL($2) ? 0: VTABLE_exists_keyed(interp, $2, $3); } ######################################## =item B(invar PMC, in KEY) =item B(invar PMC, in INTKEY) Delete the specified entry $2 from aggregate $1. =cut inline op delete(invar PMC, in KEY) { VTABLE_delete_keyed(interp, $1, $2); } inline op delete(invar PMC, in INTKEY) { VTABLE_delete_keyed_int(interp, $1, $2); } ######################################## =item B(out INT, invar PMC) Returns the number of items in aggregate $2 =cut inline op elements(out INT, invar PMC) { $1 = VTABLE_elements(interp, $2); } =back =cut ############################################################################### =head2 Fast access ops The fast access ops are shortcuts to common operations implemented in var PMCs. =over 4 =cut ######################################## =item B(invar PMC, in INT) =item B(invar PMC, in NUM) =item B(invar PMC, in STR) =item B(invar PMC, invar PMC) Push $2 onto the end of the aggregate PMC $1, if that operation is defined. =cut inline op push(invar PMC, in INT) { VTABLE_push_integer(interp, $1, $2); } inline op push(invar PMC, in NUM) { VTABLE_push_float(interp, $1, $2); } inline op push(invar PMC, in STR) { VTABLE_push_string(interp, $1, $2); } inline op push(invar PMC, invar PMC) { VTABLE_push_pmc(interp, $1, $2); } ######################################## =item B(out INT, invar PMC) =item B(out NUM, invar PMC) =item B(out STR, invar PMC) =item B(out PMC, invar PMC) Pop off last entry in the aggregate $2, placing the result in $1. =cut inline op pop(out INT, invar PMC) { $1 = VTABLE_pop_integer(interp, $2); } inline op pop(out NUM, invar PMC) { $1 = VTABLE_pop_float(interp, $2); } inline op pop(out STR, invar PMC) { $1 = VTABLE_pop_string(interp, $2); } inline op pop(out PMC, invar PMC) { $1 = VTABLE_pop_pmc(interp, $2); } ######################################## =item B(invar PMC, in INT) =item B(invar PMC, in NUM) =item B(invar PMC, in STR) =item B(invar PMC, invar PMC) Unshift $2 onto the front of the aggregate PMC $1. =cut inline op unshift(invar PMC, in INT) { VTABLE_unshift_integer(interp, $1, $2); } inline op unshift(invar PMC, in NUM) { VTABLE_unshift_float(interp, $1, $2); } inline op unshift(invar PMC, in STR) { VTABLE_unshift_string(interp, $1, $2); } inline op unshift(invar PMC, invar PMC) { VTABLE_unshift_pmc(interp, $1, $2); } ######################################## =item B(out INT, invar PMC) =item B(out NUM, invar PMC) =item B(out STR, invar PMC) =item B(out PMC, invar PMC) Shift off the first entry in the aggregate $2 and places it in $1. =cut inline op shift(out INT, invar PMC) { $1 = VTABLE_shift_integer(interp, $2); } inline op shift(out NUM, invar PMC) { $1 = VTABLE_shift_float(interp, $2); } inline op shift(out STR, invar PMC) { $1 = VTABLE_shift_string(interp, $2); } inline op shift(out PMC, invar PMC) { $1 = VTABLE_shift_pmc(interp, $2); } =item B(invar PMC, invar PMC, in INT, in INT) Replace $4 values at offset $3 in aggregate $1 with the PMCs in aggregate $2. The values are put into the aggregate by a shallow copy. If the values would be reused, they have to be Bd. =cut inline op splice(invar PMC, invar PMC, in INT, in INT) { VTABLE_splice(interp, $1, $2, $3, $4); } =back =cut ############################################################################### =head2 Properties Ops to deal with PMC properties. =over 4 =cut ######################################## =item B(invar PMC, in STR, invar PMC) Set property $2 to value $3 for PMC $1. =cut op setprop(invar PMC, in STR, invar PMC) { Parrot_pmc_setprop(interp, $1, $2, $3); } ######################################## =item B(out PMC, in STR, invar PMC) Get property $2 of PMC $3 and put it in $1. Deprecated. =item B(out PMC, invar PMC, in STR) Get property $3 of PMC $2 and put it in $1. =cut op getprop(out PMC, in STR, invar PMC) :deprecated { Parrot_warn_deprecated(interp, "getprop_p_s_p is deprecated. Use getprop_p_p_s instead"); $1 = Parrot_pmc_getprop(interp, $3, $2); } op getprop(out PMC, invar PMC, in STR) { $1 = Parrot_pmc_getprop(interp, $2, $3); } ######################################## =item B(invar PMC, in STR) Delete property $2 from PMC $1. =cut op delprop(invar PMC, in STR) { Parrot_pmc_delprop(interp, $1, $2); } ######################################## =item B(out PMC, invar PMC) Get a hash for the properties invar PMC $2 and put it in $1. If the property hash doesn't exist, the C PMC is returned. =cut op prophash(out PMC, invar PMC) { $1 = Parrot_pmc_getprops(interp, $2); } =back =cut ############################################################################### =head2 Freeze, thaw and friends Ops to PMC freeze, thaw. =over 4 =cut ######################################## =item B(out STR, invar PMC) Set $1 to the frozen image of $2. =item B(out PMC, in STR) Set $1 to a newly created PMC from the image $2. =cut op freeze(out STR, invar PMC) { $1 = Parrot_freeze(interp, $2); } op thaw(out PMC, in STR) { $1 = Parrot_thaw(interp, $2); } =back =cut ############################################################################### =head2 Vtable MMD manipulation functions These functions manipulate the vtable MMD function table. These functions allow bytecode to register subs or methods and query which sub or method would get called for a particular vtable operation. This way you're not required to drop to C to register a new method variant for addition or subtraction, or one of the other binary MMD operations. =over 4 =cut ######################################## =item B(in STR, in STR, invar PMC) Register method $3 as the MMD method for the sub named $1 with signature $2. =cut inline op add_multi(in STR, in STR, invar PMC) { Parrot_mmd_add_multi_from_long_sig(interp, $1, $2, $3); } =item B(out PMC, in STR, in STR) Set $1 to the sub that would be called for sub named $2 with signature $3. =cut inline op find_multi(out PMC, in STR, in STR) { $1 = Parrot_mmd_find_multi_from_long_sig(interp, $2, $3); } =back =cut ############################################################################### =head2 Misc PMC related ops =over 4 =cut ######################################## =item B(invar PMC) Add a reference of PMC $1 to the interpreter's root set of PMCs. This is needed for extensions to make sure that the PMC is properly marked during GC, if that PMC is not known to Parrot's core elsewhere. A PMC can be registered multiple times. If it's unregistered and the registration count reaches zero, it will be destroyed during the next GC run. =item B(invar PMC) Remove one reference of $1. =cut op register(invar PMC) { Parrot_pmc_gc_register(interp, $1); } op unregister(invar PMC) { Parrot_pmc_gc_unregister(interp, $1); } ######################################## =item B(out PMC, in INT) =item B(out PMC, in NUM) =item B(out PMC, in STR) Create a HLL-mapped PMC containing the provided primitive. =cut op box(out PMC, in INT) { $1 = Parrot_pmc_box_integer(interp, $2); } op box(out PMC, in NUM) { $1 = Parrot_pmc_box_number(interp, $2); } op box(out PMC, in STR) { $1 = Parrot_pmc_box_string(interp, $2); } ######################################## =item B(out PMC, invar PMC) Return a new Iterator PMC $1 for aggregate $2. =cut inline op iter(out PMC, invar PMC) { $1 = VTABLE_get_iter(interp, $2); } ######################################## =item B(invar PMC, in PMC) Have $1 turn itself into a PMC of type $2. $2 should be a Class PMC. =cut inline op morph(invar PMC, in PMC) { VTABLE_morph(interp, $1, $2); } =back =head1 COPYRIGHT Copyright (C) 2001-2010, Parrot Foundation. =head1 LICENSE This program is free software. It is subject to the same license as the Parrot interpreter itself. =cut /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ pasm.t000644000765000765 343411631440403 15717 0ustar00brucebruce000000000000parrot-5.9.0/t/examples#! perl # Copyright (C) 2005-2011, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Test tests => 2; use Parrot::Config; =head1 NAME t/examples/pasm.t - Test examples in F =head1 SYNOPSIS % prove t/examples/pasm.t =head1 DESCRIPTION Test the examples in F. =head1 SEE ALSO F =cut # Set up expected output for examples my %expected = ( 'hello.pasm' => << 'END_EXPECTED', Hello World END_EXPECTED ); SKIP: { skip( 'GMP is not available', 1 ) unless $PConfig{gmp}; $expected{'fact.pasm'} = << 'END_EXPECTED' fact of 0 is: 1 fact of 1 is: 1 fact of 2 is: 2 fact of 3 is: 6 fact of 4 is: 24 fact of 5 is: 120 fact of 6 is: 720 fact of 7 is: 5040 fact of 8 is: 40320 fact of 9 is: 362880 fact of 10 is: 3628800 fact of 11 is: 39916800 fact of 12 is: 479001600 fact of 13 is: 6227020800 fact of 14 is: 87178291200 fact of 15 is: 1307674368000 fact of 16 is: 20922789888000 fact of 17 is: 355687428096000 fact of 18 is: 6402373705728000 fact of 19 is: 121645100408832000 fact of 20 is: 2432902008176640000 fact of 21 is: 51090942171709440000 fact of 22 is: 1124000727777607680000 fact of 23 is: 25852016738884976640000 fact of 24 is: 620448401733239439360000 fact of 25 is: 15511210043330985984000000 fact of 26 is: 403291461126605635584000000 fact of 27 is: 10888869450418352160768000000 fact of 28 is: 304888344611713860501504000000 fact of 29 is: 8841761993739701954543616000000 fact of 30 is: 265252859812191058636308480000000 END_EXPECTED } while ( my ( $example, $expected ) = each %expected ) { example_output_is( "examples/pasm/$example", $expected ); } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: Dumper.pir000644000765000765 270011533177637 21675 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library/YAML# Copyright (C) 2008-2009, Parrot Foundation. .sub __library_data_dumper_onload :load .local pmc yd_class yd_class = get_class ['YAML'; 'Dumper'] if null yd_class goto load_library goto END load_library: load_bytecode 'YAML/Dumper/Default.pbc' newclass $P0, ['YAML'; 'Dumper'] END: .return () .end .namespace ['YAML'; 'Dumper'] .sub yaml :method .param pmc dump .param string name :optional .param int has_name :opt_flag .param string indent :optional .param int has_indent :opt_flag .local pmc style if has_indent goto no_def_indent set indent, " " no_def_indent: # use a default name if has_name goto no_def_name set name, "VAR1" no_def_name: # XXX: support different output styles .local pmc ydd_class push_eh ERROR2 ydd_class = get_class ['YAML'; 'Dumper'; 'Default'] style = ydd_class."new"() pop_eh style."prepare"( self, indent ) print "---\n{\n" style."dumpWithName"( name, name, dump ) print ",\n}\n" .return ( 1 ) ERROR2: pop_eh print "can not find class ['YAML'; 'Dumper'; 'Default']!\n" end .return ( 0 ) ERROR: print "Syntax:\n" print "yaml( pmc )\n" print "yaml( pmc, name )\n" print "yaml( pmc, name, indent )\n" .return ( 0 ) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: string_cmp.t000644000765000765 4745711533177645 16001 0ustar00brucebruce000000000000parrot-5.9.0/t/op#!./parrot # Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME t/op/string.t - Parrot Strings =head1 SYNOPSIS % prove t/op/string.t =head1 DESCRIPTION Tests Parrot string registers and operations. =cut .sub main :main .include 'test_more.pir' plan(24) test_eq_s_s_ic() test_eq_sc_s_ic() test_eq_s_sc_ic() test_eq_sc_sc_ic() test_ne_s_s_ic() test_ne_sc_s_ic() test_ne_s_sc_ic() test_ne_sc_sc_ic() test_lt_s_s_ic() test_lt_sc_s_ic() test_lt_s_sc_ic() test_lt_sc_sc_ic() test_le_s_s_ic() test_le_sc_s_ic() test_le_s_sc_ic() test_le_sc_sc_ic() test_gt_s_s_ic() test_gt_sc_s_ic() test_gt_s_sc_ic() test_gt_sc_sc_ic() test_ge_s_s_ic() test_ge_sc_s_ic() test_ge_s_sc_ic() test_ge_sc_sc_ic() .end .sub test_eq_s_s_ic set $S0, "hello" set $S1, "hello" eq $S0, $S1, OK1 branch ERROR OK1: set $S0, "hello" set $S1, "world" eq $S0, $S1, ERROR OK2: set $S0, "world" set $S1, "hello" eq $S0, $S1, ERROR OK3: set $S0, "hello" set $S1, "hellooo" eq $S0, $S1, ERROR OK4: set $S0, "hellooo" set $S1, "hello" eq $S0, $S1, ERROR OK5: set $S0, "hello" set $S1, "hella" eq $S0, $S1, ERROR OK6: set $S0, "hella" set $S1, "hello" eq $S0, $S1, ERROR OK7: set $S0, "hella" set $S1, "hellooo" eq $S0, $S1, ERROR OK8: set $S0, "hellooo" set $S1, "hella" eq $S0, $S1, ERROR OK9: set $S0, "hElLo" set $S1, "HeLlO" eq $S0, $S1, ERROR OK10: set $S0, "hElLo" set $S1, "hElLo" eq $S0, $S1, OK11 branch ERROR OK11: ok( 1, 'eq_s_s_ic' ) goto END ERROR: ok( 0, 'eq_s_s_ic' ) END: .end .sub test_eq_sc_s_ic set $S0, "hello" eq "hello", $S0, OK1 branch ERROR OK1: set $S0, "world" eq "hello", $S0, ERROR OK2: set $S0, "hello" eq "world", $S0, ERROR OK3: set $S0, "hellooo" eq "hello", $S0, ERROR OK4: set $S0, "hello" eq "hellooo", $S0, ERROR OK5: set $S0, "hella" eq "hello", $S0, ERROR OK6: set $S0, "hello" eq "hella", $S0, ERROR OK7: set $S0, "hellooo" eq "hella", $S0, ERROR OK8: set $S0, "hella" eq "hellooo", $S0, ERROR OK9: set $S0, "HeLlO" eq "hElLo", $S0, ERROR OK10: set $S0, "hElLo" eq "hElLo", $S0, OK11 branch ERROR OK11: ok( 1, 'eq_sc_s_ic' ) goto END ERROR: ok( 0, 'eq_sc_s_ic' ) END: .end .sub test_eq_s_sc_ic set $S0, "hello" eq $S0, "hello", OK1 branch ERROR OK1: set $S0, "hello" eq $S0, "world", ERROR OK2: set $S0, "world" eq $S0, "hello", ERROR OK3: set $S0, "hello" eq $S0, "hellooo", ERROR OK4: set $S0, "hellooo" eq $S0, "hello", ERROR OK5: set $S0, "hello" eq $S0, "hella", ERROR OK6: set $S0, "hella" eq $S0, "hello", ERROR OK7: set $S0, "hella" eq $S0, "hellooo", ERROR OK8: set $S0, "hellooo" eq $S0, "hella", ERROR OK9: set $S0, "hElLo" eq $S0, "HeLlO", ERROR OK10: set $S0, "hElLo" eq $S0, "hElLo", OK11 branch ERROR OK11: ok( 1, 'eq_s_sc_ic' ) goto END ERROR: ok( 0, 'eq_s_sc_ic' ) END: .end .sub test_eq_sc_sc_ic eq "hello", "hello", OK1 branch ERROR OK1: eq "hello", "world", ERROR OK2: eq "world", "hello", ERROR OK3: eq "hello", "hellooo", ERROR OK4: eq "hellooo", "hello", ERROR OK5: eq "hello", "hella", ERROR OK6: eq "hella", "hello", ERROR OK7: eq "hella", "hellooo", ERROR OK8: eq "hellooo", "hella", ERROR OK9: eq "hElLo", "HeLlO", ERROR OK10: eq "hElLo", "hElLo", OK11 branch ERROR OK11: ok( 1, 'eq_sc_sc_ic' ) goto END ERROR: ok( 0, 'eq_sc_sc_ic' ) END: .end .sub test_ne_s_s_ic set $S0, "hello" set $S1, "hello" ne $S0, $S1, ERROR OK1: set $S0, "hello" set $S1, "world" ne $S0, $S1, OK2 branch ERROR OK2: set $S0, "world" set $S1, "hello" ne $S0, $S1, OK3 branch ERROR OK3: set $S0, "hello" set $S1, "hellooo" ne $S0, $S1, OK4 branch ERROR OK4: set $S0, "hellooo" set $S1, "hello" ne $S0, $S1, OK5 branch ERROR OK5: set $S0, "hello" set $S1, "hella" ne $S0, $S1, OK6 branch ERROR OK6: set $S0, "hella" set $S1, "hello" ne $S0, $S1, OK7 branch ERROR OK7: set $S0, "hella" set $S1, "hellooo" ne $S0, $S1, OK8 branch ERROR OK8: set $S0, "hellooo" set $S1, "hella" ne $S0, $S1, OK9 branch ERROR OK9: set $S0, "hElLo" set $S1, "HeLlO" ne $S0, $S1, OK10 branch ERROR OK10: set $S0, "hElLo" set $S1, "hElLo" ne $S0, $S1, ERROR OK11: ok( 1, 'ne_s_s_ic' ) goto END ERROR: ok( 0, 'ne_s_s_ic' ) END: .end .sub test_ne_sc_s_ic set $S0, "hello" ne "hello", $S0, ERROR OK1: set $S0, "world" ne "hello", $S0, OK2 branch ERROR OK2: set $S0, "hello" ne "world", $S0, OK3 branch ERROR OK3: set $S0, "hellooo" ne "hello", $S0, OK4 branch ERROR OK4: set $S0, "hello" ne "hellooo", $S0, OK5 branch ERROR OK5: set $S0, "hella" ne "hello", $S0, OK6 branch ERROR OK6: set $S0, "hello" ne "hella", $S0, OK7 branch ERROR OK7: set $S0, "hellooo" ne "hella", $S0, OK8 branch ERROR OK8: set $S0, "hella" ne "hellooo", $S0, OK9 branch ERROR OK9: set $S0, "HeLlO" ne "hElLo", $S0, OK10 branch ERROR OK10: set $S0, "hElLo" ne "hElLo", $S0, ERROR OK11: ok( 1, 'ne_sc_s_ic' ) goto END ERROR: ok( 0, 'ne_sc_s_ic' ) END: .end .sub test_ne_s_sc_ic set $S0, "hello" ne $S0, "hello", ERROR OK1: set $S0, "hello" ne $S0, "world", OK2 branch ERROR OK2: set $S0, "world" ne $S0, "hello", OK3 branch ERROR OK3: set $S0, "hello" ne $S0, "hellooo", OK4 branch ERROR OK4: set $S0, "hellooo" ne $S0, "hello", OK5 branch ERROR OK5: set $S0, "hello" ne $S0, "hella", OK6 branch ERROR OK6: set $S0, "hella" ne $S0, "hello", OK7 branch ERROR OK7: set $S0, "hella" ne $S0, "hellooo", OK8 branch ERROR OK8: set $S0, "hellooo" ne $S0, "hella", OK9 branch ERROR OK9: set $S0, "hElLo" ne $S0, "HeLlO", OK10 branch ERROR OK10: set $S0, "hElLo" ne $S0, "hElLo", ERROR OK11: ok( 1, 'ne_s_sc_ic' ) goto END ERROR: ok( 0, 'ne_s_sc_ic' ) END: .end .sub test_ne_sc_sc_ic ne "hello", "hello", ERROR OK1: ne "hello", "world", OK2 branch ERROR OK2: ne "world", "hello", OK3 branch ERROR OK3: ne "hello", "hellooo", OK4 branch ERROR OK4: ne "hellooo", "hello", OK5 branch ERROR OK5: ne "hello", "hella", OK6 branch ERROR OK6: ne "hella", "hello", OK7 branch ERROR OK7: ne "hella", "hellooo", OK8 branch ERROR OK8: ne "hellooo", "hella", OK9 branch ERROR OK9: ne "hElLo", "HeLlO", OK10 branch ERROR OK10: ne "hElLo", "hElLo", ERROR OK11: ok( 1, 'ne_sc_sc_ic' ) goto END ERROR: ok( 0, 'ne_sc_sc_ic' ) END: .end .sub test_lt_s_s_ic set $S0, "hello" set $S1, "hello" lt $S0, $S1, ERROR OK1: set $S0, "hello" set $S1, "world" lt $S0, $S1, OK2 branch ERROR OK2: set $S0, "world" set $S1, "hello" lt $S0, $S1, ERROR OK3: set $S0, "hello" set $S1, "hellooo" lt $S0, $S1, OK4 branch ERROR OK4: set $S0, "hellooo" set $S1, "hello" lt $S0, $S1, ERROR OK5: set $S0, "hello" set $S1, "hella" lt $S0, $S1, ERROR OK6: set $S0, "hella" set $S1, "hello" lt $S0, $S1, OK7 branch ERROR OK7: set $S0, "hella" set $S1, "hellooo" lt $S0, $S1, OK8 branch ERROR OK8: set $S0, "hellooo" set $S1, "hella" lt $S0, $S1, ERROR OK9: set $S0, "hElLo" set $S1, "HeLlO" lt $S0, $S1, ERROR OK10: set $S0, "hElLo" set $S1, "hElLo" lt $S0, $S1, ERROR OK11: ok( 1, 'lt_s_s_ic' ) goto END ERROR: ok( 0, 'lt_s_s_ic' ) END: .end .sub test_lt_sc_s_ic set $S0, "hello" lt "hello", $S0, ERROR OK1: set $S0, "world" lt "hello", $S0, OK2 branch ERROR OK2: set $S0, "hello" lt "world", $S0, ERROR OK3: set $S0, "hellooo" lt "hello", $S0, OK4 branch ERROR OK4: set $S0, "hello" lt "hellooo", $S0, ERROR OK5: set $S0, "hella" lt "hello", $S0, ERROR OK6: set $S0, "hello" lt "hella", $S0, OK7 branch ERROR OK7: set $S0, "hellooo" lt "hella", $S0, OK8 branch ERROR OK8: set $S0, "hella" lt "hellooo", $S0, ERROR OK9: set $S0, "HeLlO" lt "hElLo", $S0, ERROR OK10: set $S0, "hElLo" lt "hElLo", $S0, ERROR OK11: ok( 1, 'lt_sc_s_ic' ) goto END ERROR: ok( 0, 'lt_sc_s_ic' ) END: .end .sub test_lt_s_sc_ic set $S0, "hello" lt $S0, "hello", ERROR OK1: set $S0, "hello" lt $S0, "world", OK2 branch ERROR OK2: set $S0, "world" lt $S0, "hello", ERROR OK3: set $S0, "hello" lt $S0, "hellooo", OK4 branch ERROR OK4: set $S0, "hellooo" lt $S0, "hello", ERROR OK5: set $S0, "hello" lt $S0, "hella", ERROR OK6: set $S0, "hella" lt $S0, "hello", OK7 branch ERROR OK7: set $S0, "hella" lt $S0, "hellooo", OK8 branch ERROR OK8: set $S0, "hellooo" lt $S0, "hella", ERROR OK9: set $S0, "hElLo" lt $S0, "HeLlO", ERROR OK10: set $S0, "hElLo" lt $S0, "hElLo", ERROR OK11: ok( 1, 'lt_s_sc_ic' ) goto END ERROR: ok( 0, 'lt_s_sc_ic' ) END: .end .sub test_lt_sc_sc_ic lt "hello", "hello", ERROR OK1: lt "hello", "world", OK2 branch ERROR OK2: lt "world", "hello", ERROR OK3: lt "hello", "hellooo", OK4 branch ERROR OK4: lt "hellooo", "hello", ERROR OK5: lt "hello", "hella", ERROR OK6: lt "hella", "hello", OK7 branch ERROR OK7: lt "hella", "hellooo", OK8 branch ERROR OK8: lt "hellooo", "hella", ERROR OK9: lt "hElLo", "HeLlO", ERROR OK10: lt "hElLo", "hElLo", ERROR OK11: ok( 1, 'lt_sc_sc_ic' ) goto END ERROR: ok( 0, 'lt_sc_sc_ic' ) END: .end .sub test_le_s_s_ic set $S0, "hello" set $S1, "hello" le $S0, $S1, OK1 branch ERROR OK1: set $S0, "hello" set $S1, "world" le $S0, $S1, OK2 branch ERROR OK2: set $S0, "world" set $S1, "hello" le $S0, $S1, ERROR OK3: set $S0, "hello" set $S1, "hellooo" le $S0, $S1, OK4 branch ERROR OK4: set $S0, "hellooo" set $S1, "hello" le $S0, $S1, ERROR OK5: set $S0, "hello" set $S1, "hella" le $S0, $S1, ERROR OK6: set $S0, "hella" set $S1, "hello" le $S0, $S1, OK7 branch ERROR OK7: set $S0, "hella" set $S1, "hellooo" le $S0, $S1, OK8 branch ERROR OK8: set $S0, "hellooo" set $S1, "hella" le $S0, $S1, ERROR OK9: set $S0, "hElLo" set $S1, "HeLlO" le $S0, $S1, ERROR OK10: set $S0, "hElLo" set $S1, "hElLo" le $S0, $S1, OK11 branch ERROR OK11: ok( 1, 'le_s_s_ic' ) goto END ERROR: ok( 0, 'le_s_s_ic' ) END: .end .sub test_le_sc_s_ic set $S0, "hello" le "hello", $S0, OK1 branch ERROR OK1: set $S0, "world" le "hello", $S0, OK2 branch ERROR OK2: set $S0, "hello" le "world", $S0, ERROR OK3: set $S0, "hellooo" le "hello", $S0, OK4 branch ERROR OK4: set $S0, "hello" le "hellooo", $S0, ERROR OK5: set $S0, "hella" le "hello", $S0, ERROR OK6: set $S0, "hello" le "hella", $S0, OK7 branch ERROR OK7: set $S0, "hellooo" le "hella", $S0, OK8 branch ERROR OK8: set $S0, "hella" le "hellooo", $S0, ERROR OK9: set $S0, "HeLlO" le "hElLo", $S0, ERROR OK10: set $S0, "hElLo" le "hElLo", $S0, OK11 branch ERROR OK11: ok( 1, 'le_sc_s_ic' ) goto END ERROR: ok( 0, 'le_sc_s_ic' ) END: .end .sub test_le_s_sc_ic set $S0, "hello" le $S0, "hello", OK1 branch ERROR OK1: set $S0, "hello" le $S0, "world", OK2 branch ERROR OK2: set $S0, "world" le $S0, "hello", ERROR OK3: set $S0, "hello" le $S0, "hellooo", OK4 branch ERROR OK4: set $S0, "hellooo" le $S0, "hello", ERROR OK5: set $S0, "hello" le $S0, "hella", ERROR OK6: set $S0, "hella" le $S0, "hello", OK7 branch ERROR OK7: set $S0, "hella" le $S0, "hellooo", OK8 branch ERROR OK8: set $S0, "hellooo" le $S0, "hella", ERROR OK9: set $S0, "hElLo" le $S0, "HeLlO", ERROR OK10: set $S0, "hElLo" le $S0, "hElLo", OK11 branch ERROR OK11: ok( 1, 'le_s_sc_ic' ) goto END ERROR: ok( 0, 'le_s_sc_ic' ) END: .end .sub test_le_sc_sc_ic le "hello", "hello", OK1 branch ERROR OK1: le "hello", "world", OK2 branch ERROR OK2: le "world", "hello", ERROR OK3: le "hello", "hellooo", OK4 branch ERROR OK4: le "hellooo", "hello", ERROR OK5: le "hello", "hella", ERROR OK6: le "hella", "hello", OK7 branch ERROR OK7: le "hella", "hellooo", OK8 branch ERROR OK8: le "hellooo", "hella", ERROR OK9: le "hElLo", "HeLlO", ERROR OK10: le "hElLo", "hElLo", OK11 branch ERROR OK11: ok( 1, 'le_sc_sc_ic' ) goto END ERROR: ok( 0, 'le_sc_sc_ic' ) END: .end .sub test_gt_s_s_ic set $S0, "hello" set $S1, "hello" gt $S0, $S1, ERROR OK1: set $S0, "hello" set $S1, "world" gt $S0, $S1, ERROR OK2: set $S0, "world" set $S1, "hello" gt $S0, $S1, OK3 branch ERROR OK3: set $S0, "hello" set $S1, "hellooo" gt $S0, $S1, ERROR OK4: set $S0, "hellooo" set $S1, "hello" gt $S0, $S1, OK5 branch ERROR OK5: set $S0, "hello" set $S1, "hella" gt $S0, $S1, OK6 branch ERROR OK6: set $S0, "hella" set $S1, "hello" gt $S0, $S1, ERROR OK7: set $S0, "hella" set $S1, "hellooo" gt $S0, $S1, ERROR OK8: set $S0, "hellooo" set $S1, "hella" gt $S0, $S1, OK9 branch ERROR OK9: set $S0, "hElLo" set $S1, "HeLlO" gt $S0, $S1, OK10 branch ERROR OK10: set $S0, "hElLo" set $S1, "hElLo" gt $S0, $S1, ERROR OK11: ok( 1, 'gt_s_s_ic' ) goto END ERROR: ok( 0, 'gt_s_s_ic' ) END: .end .sub test_gt_sc_s_ic set $S0, "hello" gt "hello", $S0, ERROR OK1: set $S0, "world" gt "hello", $S0, ERROR OK2: set $S0, "hello" gt "world", $S0, OK3 branch ERROR OK3: set $S0, "hellooo" gt "hello", $S0, ERROR OK4: set $S0, "hello" gt "hellooo", $S0, OK5 branch ERROR OK5: set $S0, "hella" gt "hello", $S0, OK6 branch ERROR OK6: set $S0, "hello" gt "hella", $S0, ERROR OK7: set $S0, "hellooo" gt "hella", $S0, ERROR OK8: set $S0, "hella" gt "hellooo", $S0, OK9 branch ERROR OK9: set $S0, "HeLlO" gt "hElLo", $S0, OK10 branch ERROR OK10: set $S0, "hElLo" gt "hElLo", $S0, ERROR OK11: ok( 1, 'gt_sc_s_ic' ) goto END ERROR: ok( 0, 'gt_sc_s_ic' ) END: .end .sub test_gt_s_sc_ic set $S0, "hello" gt $S0, "hello", ERROR OK1: set $S0, "hello" gt $S0, "world", ERROR OK2: set $S0, "world" gt $S0, "hello", OK3 branch ERROR OK3: set $S0, "hello" gt $S0, "hellooo", ERROR OK4: set $S0, "hellooo" gt $S0, "hello", OK5 branch ERROR OK5: set $S0, "hello" gt $S0, "hella", OK6 branch ERROR OK6: set $S0, "hella" gt $S0, "hello", ERROR OK7: set $S0, "hella" gt $S0, "hellooo", ERROR OK8: set $S0, "hellooo" gt $S0, "hella", OK9 branch ERROR OK9: set $S0, "hElLo" gt $S0, "HeLlO", OK10 branch ERROR OK10: set $S0, "hElLo" gt $S0, "hElLo", ERROR OK11: ok( 1, 'gt_s_sc_ic' ) goto END ERROR: ok( 0, 'gt_s_sc_ic' ) END: .end .sub test_gt_sc_sc_ic gt "hello", "hello", ERROR OK1: gt "hello", "world", ERROR OK2: gt "world", "hello", OK3 branch ERROR OK3: gt "hello", "hellooo", ERROR OK4: gt "hellooo", "hello", OK5 branch ERROR OK5: gt "hello", "hella", OK6 branch ERROR OK6: gt "hella", "hello", ERROR OK7: gt "hella", "hellooo", ERROR OK8: gt "hellooo", "hella", OK9 branch ERROR OK9: gt "hElLo", "HeLlO", OK10 branch ERROR OK10: gt "hElLo", "hElLo", ERROR OK11: ok( 1, 'gt_sc_sc_ic' ) goto END ERROR: ok( 0, 'gt_sc_sc_ic' ) END: .end .sub test_ge_s_s_ic set $S0, "hello" set $S1, "hello" ge $S0, $S1, OK1 branch ERROR OK1: set $S0, "hello" set $S1, "world" ge $S0, $S1, ERROR OK2: set $S0, "world" set $S1, "hello" ge $S0, $S1, OK3 branch ERROR OK3: set $S0, "hello" set $S1, "hellooo" ge $S0, $S1, ERROR OK4: set $S0, "hellooo" set $S1, "hello" ge $S0, $S1, OK5 branch ERROR OK5: set $S0, "hello" set $S1, "hella" ge $S0, $S1, OK6 branch ERROR OK6: set $S0, "hella" set $S1, "hello" ge $S0, $S1, ERROR OK7: set $S0, "hella" set $S1, "hellooo" ge $S0, $S1, ERROR OK8: set $S0, "hellooo" set $S1, "hella" ge $S0, $S1, OK9 branch ERROR OK9: set $S0, "hElLo" set $S1, "HeLlO" ge $S0, $S1, OK10 branch ERROR OK10: set $S0, "hElLo" set $S1, "hElLo" ge $S0, $S1, OK11 branch ERROR OK11: ok( 1, 'ge_s_s_ic' ) goto END ERROR: ok( 0, 'ge_s_s_ic' ) END: .end .sub test_ge_sc_s_ic set $S0, "hello" ge "hello", $S0, OK1 branch ERROR OK1: set $S0, "world" ge "hello", $S0, ERROR OK2: set $S0, "hello" ge "world", $S0, OK3 branch ERROR OK3: set $S0, "hellooo" ge "hello", $S0, ERROR OK4: set $S0, "hello" ge "hellooo", $S0, OK5 branch ERROR OK5: set $S0, "hella" ge "hello", $S0, OK6 branch ERROR OK6: set $S0, "hello" ge "hella", $S0, ERROR OK7: set $S0, "hellooo" ge "hella", $S0, ERROR OK8: set $S0, "hella" ge "hellooo", $S0, OK9 branch ERROR OK9: set $S0, "HeLlO" ge "hElLo", $S0, OK10 branch ERROR OK10: set $S0, "hElLo" ge "hElLo", $S0, OK11 branch ERROR OK11: ok( 1, 'ge_sc_s_ic' ) goto END ERROR: ok( 0, 'ge_sc_s_ic' ) END: .end .sub test_ge_s_sc_ic set $S0, "hello" ge $S0, "hello", OK1 branch ERROR OK1: set $S0, "hello" ge $S0, "world", ERROR OK2: set $S0, "world" ge $S0, "hello", OK3 branch ERROR OK3: set $S0, "hello" ge $S0, "hellooo", ERROR OK4: set $S0, "hellooo" ge $S0, "hello", OK5 branch ERROR OK5: set $S0, "hello" ge $S0, "hella", OK6 branch ERROR OK6: set $S0, "hella" ge $S0, "hello", ERROR OK7: set $S0, "hella" ge $S0, "hellooo", ERROR OK8: set $S0, "hellooo" ge $S0, "hella", OK9 branch ERROR OK9: set $S0, "hElLo" ge $S0, "HeLlO", OK10 branch ERROR OK10: set $S0, "hElLo" ge $S0, "hElLo", OK11 branch ERROR OK11: ok( 1, 'ge_s_sc_ic' ) goto END ERROR: ok( 0, 'ge_s_sc_ic' ) END: .end .sub test_ge_sc_sc_ic ge "hello", "hello", OK1 branch ERROR OK1: ge "hello", "world", ERROR OK2: ge "world", "hello", OK3 branch ERROR OK3: ge "hello", "hellooo", ERROR OK4: ge "hellooo", "hello", OK5 branch ERROR OK5: ge "hello", "hella", OK6 branch ERROR OK6: ge "hella", "hello", ERROR OK7: ge "hella", "hellooo", ERROR OK8: ge "hellooo", "hella", OK9 branch ERROR OK9: ge "hElLo", "HeLlO", OK10 branch ERROR OK10: ge "hElLo", "hElLo", OK11 branch ERROR OK11: ok( 1, 'ge_sc_sc_ic' ) goto END ERROR: ok( 0, 'ge_sc_sc_ic' ) END: .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: pcc.c000644000765000765 4655712226525704 16400 0ustar00brucebruce000000000000parrot-5.9.0/compilers/imcc/* * Copyright (C) 2003-2010, Parrot Foundation. */ /* =head1 NAME compilers/imcc/pcc.c =head1 DESCRIPTION Parrot calling convention implementation. see: docs/pdds/pdd03_calling_conventions.pod PCC Implementation by Leopold Toetsch =head2 Functions =over 4 =cut */ #include #include #include "imc.h" #include "parser.h" #include "parrot/oplib/core_ops.h" /* HEADERIZER HFILE: compilers/imcc/imc.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void insert_tail_call( ARGMOD(imc_info_t * imcc), ARGIN(IMC_Unit *unit), ARGMOD(Instruction *ins), ARGMOD(SymReg *sub), ARGIN_NULLOK(SymReg *meth)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(*ins) FUNC_MODIFIES(*sub); PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static Instruction * insINS( ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit), ARGIN(Instruction *ins), ARGIN(const char *name), ARGIN(SymReg **regs), int n) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) __attribute__nonnull__(5) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(*unit); PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static Instruction* pcc_get_args( ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit), ARGIN(Instruction *ins), ARGIN(const char *op_name), int n, ARGIN_NULLOK(SymReg * const *args), ARGIN_NULLOK(const int *arg_flags)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4) FUNC_MODIFIES(* imcc) FUNC_MODIFIES(*unit); static void unshift_self( ARGMOD(imc_info_t * imcc), ARGIN(SymReg *sub), ARGIN(SymReg *obj)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(* imcc); #define ASSERT_ARGS_insert_tail_call __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit) \ , PARROT_ASSERT_ARG(ins) \ , PARROT_ASSERT_ARG(sub)) #define ASSERT_ARGS_insINS __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit) \ , PARROT_ASSERT_ARG(ins) \ , PARROT_ASSERT_ARG(name) \ , PARROT_ASSERT_ARG(regs)) #define ASSERT_ARGS_pcc_get_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(unit) \ , PARROT_ASSERT_ARG(ins) \ , PARROT_ASSERT_ARG(op_name)) #define ASSERT_ARGS_unshift_self __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(imcc) \ , PARROT_ASSERT_ARG(sub) \ , PARROT_ASSERT_ARG(obj)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Utility instruction routine. Creates and inserts an instruction into the current block in one call. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static Instruction * insINS(ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit), ARGIN(Instruction *ins), ARGIN(const char *name), ARGIN(SymReg **regs), int n) { ASSERT_ARGS(insINS) /* INS can return NULL, but insert_ins() cannot take one */ Instruction * const tmp = INS(imcc, unit, name, NULL, regs, n, 0, 0); if (tmp) insert_ins(unit, ins, tmp); return tmp; } /* =item C get or create the SymReg =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL SymReg* get_pasm_reg(ARGMOD(imc_info_t * imcc), ARGIN(const char *name)) { ASSERT_ARGS(get_pasm_reg) SymReg * const r = _get_sym(&imcc->cur_unit->hash, name); if (r) return r; return mk_pasm_reg(imcc, name); } /* =item C get or create a constant =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL SymReg* get_const(ARGMOD(imc_info_t * imcc), ARGIN(const char *name), int type) { ASSERT_ARGS(get_const) SymReg * const r = _get_sym(&imcc->ghash, name); if (r && r->set == type) return r; return mk_const(imcc, name, type); } /* =item C set arguments or return values get params or results used by expand_pcc_sub_call and expand_pcc_sub =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static Instruction* pcc_get_args(ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit), ARGIN(Instruction *ins), ARGIN(const char *op_name), int n, ARGIN_NULLOK(SymReg * const *args), ARGIN_NULLOK(const int *arg_flags)) { ASSERT_ARGS(pcc_get_args) /* Notes: * The created string is in the format "\"(0x0010,0x0220,0x0010)\"". * flags always has exactly 4 hex digits. * The hex number at the end of the list has no "," but we can safely * ignore this. */ static const char pref[] = {'"', '('}; static const char item[] = {'0', 'x', 'f', 'f', 'f', 'f', ','}; /* The list suffix includes the '\0' terminator */ static const char subf[] = {')', '"', '\0'}; static const unsigned int lenpref = sizeof pref; static const unsigned int lenitem = sizeof item; static const unsigned int lensubf = sizeof subf; int i, flags; char s[16]; /* Avoid allocations on frequent number of params. * Arbitrary value, some fine tuning may be good. */ #define PCC_GET_ARGS_LIMIT 15 SymReg *regcache[PCC_GET_ARGS_LIMIT + 1]; char bufcache[sizeof (pref) + sizeof (item) * PCC_GET_ARGS_LIMIT + sizeof (subf)]; SymReg ** const regs = n < PCC_GET_ARGS_LIMIT ? regcache : mem_gc_allocate_n_zeroed_typed(imcc->interp, n + 1, SymReg *); unsigned int bufpos = 0; unsigned int bufsize = lenpref + lenitem * n + lensubf; char *buf = n < PCC_GET_ARGS_LIMIT ? bufcache : mem_gc_allocate_n_typed(imcc->interp, bufsize, char); memcpy(buf, pref, lenpref); bufpos += lenpref; for (i = 0; i < n; i++) { SymReg *arg = args[i]; if (arg->type & VT_CONSTP) { arg = arg->reg; if (! arg) IMCC_fatal(imcc, 1, "wrong .const value"); } regs[i + 1] = arg; flags = 0; /* TODO: Should we be throwing normal Parrot exceptions here or IMCC_fatal exceptions? */ if (arg_flags[i] & VT_CALL_SIG) { if ((n > 1 || i != 0) && !(n == 2 && strcmp(args[0]->name, "self") == 0)) Parrot_ex_throw_from_c_args(imcc->interp, NULL, EXCEPTION_INTERNAL_PANIC, ":call_sig must be the first and only parameter besides self"); if (arg_flags[i] & (VT_FLAT | VT_OPTIONAL | VT_OPT_FLAG | VT_NAMED)) Parrot_ex_throw_from_c_args(imcc->interp, NULL, EXCEPTION_INTERNAL_PANIC, ":call_sig cannot be combined with any other flags"); if (arg->set != 'P') Parrot_ex_throw_from_c_args(imcc->interp, NULL, EXCEPTION_INTERNAL_PANIC, ":call_sig must be a PMC"); flags |= PARROT_ARG_CALL_SIG; flags |= PARROT_ARG_PMC; } else { if (arg_flags[i] & VT_FLAT) flags |= PARROT_ARG_FLATTEN; if (arg_flags[i] & VT_OPTIONAL) flags |= PARROT_ARG_OPTIONAL; else if (arg_flags[i] & VT_OPT_FLAG) flags |= PARROT_ARG_OPT_FLAG; if (arg_flags[i] & VT_NAMED) flags |= PARROT_ARG_NAME; /* add argument type bits */ if (arg->type & VTCONST) flags |= PARROT_ARG_CONSTANT; /* TODO verify if const is allowed */ switch (arg->set) { case 'I': break; case 'S': flags |= PARROT_ARG_STRING; break; case 'N': flags |= PARROT_ARG_FLOATVAL; break; case 'K': case 'P': flags |= PARROT_ARG_PMC; break; default : break; } } snprintf(s, sizeof (s), "0x%.4x,", flags); if (bufpos + lenitem >= bufsize) Parrot_ex_throw_from_c_args(imcc->interp, NULL, EXCEPTION_INTERNAL_PANIC, "arg string is longer than allocated buffer"); memcpy(buf + bufpos, s, lenitem); bufpos += lenitem; } /* Backtrack over the ending comma if this is a non-empty list. */ if (bufpos != lenpref) bufpos--; memcpy(buf + bufpos, subf, lensubf); regs[0] = mk_const(imcc, buf, 'P'); regs[0]->pmc_type = enum_class_FixedIntegerArray; ins = insINS(imcc, unit, ins, op_name, regs, n + 1); if (n >= PCC_GET_ARGS_LIMIT) { mem_sys_free(regs); mem_sys_free(buf); } return ins; #undef PCC_GET_ARGS_LIMIT } /* =item C prepend the object to args or self to params =cut */ static void unshift_self(ARGMOD(imc_info_t * imcc), ARGIN(SymReg *sub), ARGIN(SymReg *obj)) { ASSERT_ARGS(unshift_self) struct pcc_sub_t * const pcc_sub = sub->pcc_sub; const int n = pcc_sub->nargs; int i; pcc_sub->args = mem_gc_realloc_n_typed(imcc->interp, pcc_sub->args, n + 1, SymReg *); pcc_sub->arg_flags = mem_gc_realloc_n_typed(imcc->interp, pcc_sub->arg_flags, n + 1, int); for (i = n; i; --i) { pcc_sub->args[i] = pcc_sub->args[i - 1]; pcc_sub->arg_flags[i] = pcc_sub->arg_flags[i - 1]; } pcc_sub->args[0] = obj; pcc_sub->arg_flags[0] = 0; pcc_sub->nargs++; } /* =item C Expand a PCC (Parrot Calling Convention) subroutine by generating the appropriate prologue and epilogue for parameter passing/returning. =cut */ void expand_pcc_sub(ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit), ARGIN(Instruction *ins)) { ASSERT_ARGS(expand_pcc_sub) int nargs; SymReg *sub = ins->symregs[0]; SymReg *regs[2]; /* if this sub is a method, unshift 'self' as first param */ if ((unit->type & IMC_HAS_SELF) || (sub->pcc_sub->pragma & (P_METHOD | P_VTABLE))) { SymReg *self = get_sym(imcc, "self"); if (!self) { self = mk_symreg(imcc, "self", 'P'); self->type = VTIDENTIFIER; } if (sub->pcc_sub->nargs == 0 || STRNEQ(sub->pcc_sub->args[0]->name, "self")) unshift_self(imcc, sub, self); } /* Don't generate any parameter checking code if there * are no named arguments. */ nargs = sub->pcc_sub->nargs; if (nargs) ins = pcc_get_args(imcc, unit, ins, "get_params", nargs, sub->pcc_sub->args, sub->pcc_sub->arg_flags); /* check if there is a return */ if (unit->last_ins->type & (ITPCCSUB) && unit->last_ins->symreg_count == 1) { sub = unit->last_ins->symregs[0]; if (sub->pcc_sub && !sub->pcc_sub->object /* s. src/inter_call.c:119 */ && sub->pcc_sub->tailcall) { return; } } if (unit->last_ins->type != (ITPCCSUB|ITLABEL) && STRNEQ(unit->last_ins->opname, "ret") && STRNEQ(unit->last_ins->opname, "exit") && STRNEQ(unit->last_ins->opname, "end") && STRNEQ(unit->last_ins->opname, "branch") /* was adding rets multiple times... */ && STRNEQ(unit->last_ins->opname, "returncc")) { Instruction *tmp; /* check to make sure the sub is ok before we try to use it */ if (!sub) Parrot_ex_throw_from_c_args(imcc->interp, NULL, 1, "NULL sub detected"); if (!sub->pcc_sub) Parrot_ex_throw_from_c_args(imcc->interp, NULL, 1, "NULL sub->pcc_sub detected"); { Instruction *unused_ins = pcc_get_args(imcc, unit, unit->last_ins, "set_returns", 0, NULL, NULL); UNUSED(unused_ins); tmp = INS(imcc, unit, "returncc", NULL, regs, 0, 0, 0); } IMCC_debug(imcc, DEBUG_IMC, "add sub ret - %d\n", tmp); insert_ins(unit, unit->last_ins, tmp); } } /* =item C Expand a PCC sub return directive into its PASM instructions =cut */ void expand_pcc_sub_ret(ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit), ARGIN(Instruction *ins)) { ASSERT_ARGS(expand_pcc_sub_ret) const int is_yield = ins->type & ITPCCYIELD; SymReg * const sub = ins->symregs[0]; const int n = sub->pcc_sub->nret; /* TODO implement return conventions */ ins = pcc_get_args(imcc, unit, ins, "set_returns", n, sub->pcc_sub->ret, sub->pcc_sub->ret_flags); /* we have a pcc_begin_yield */ if (is_yield) { SymReg *regs[2]; ins = insINS(imcc, unit, ins, "yield", regs, 0); ins->type |= ITPCCYIELD; } else { SymReg *regs[2]; /* insert return invoke */ ins = insINS(imcc, unit, ins, "returncc", regs, 0); ins->type |= ITPCCRET; } } typedef struct move_info_t { IMC_Unit *unit; NOTNULL(Instruction *ins); int n; SymReg **dest; SymReg **src; } move_info_t; /* =item C Creates and inserts an appropriate tailcall instruction for either a sub call or a method call. =cut */ static void insert_tail_call(ARGMOD(imc_info_t * imcc), ARGIN(IMC_Unit *unit), ARGMOD(Instruction *ins), ARGMOD(SymReg *sub), ARGIN_NULLOK(SymReg *meth)) { ASSERT_ARGS(insert_tail_call) SymReg *regs[3]; if (meth) { regs[0] = sub->pcc_sub->object; regs[1] = meth; ins = insINS(imcc, unit, ins, "tailcallmethod", regs, 2); } else { regs[0] = sub->pcc_sub->sub; ins = insINS(imcc, unit, ins, "tailcall", regs, 1); } /* don't leak this sub SymReg; it gets detached here */ if (regs[0]->pcc_sub) free_pcc_sub(regs[0]->pcc_sub); /* this register is always the symbol "self", global to this IMC_Unit */ regs[0]->pcc_sub = sub->pcc_sub; sub->pcc_sub = NULL; ins->type |= ITPCCSUB; } /* =item C Expand a PCC subroutine call (IMC) into its PASM instructions This is the nuts and bolts of pdd03 routine call style =cut */ void expand_pcc_sub_call(ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit), ARGMOD(Instruction *ins)) { ASSERT_ARGS(expand_pcc_sub_call) SymReg *arg, *reg, *regs[3]; int n; int tail_call; int meth_call = 0; SymReg *meth = NULL; Instruction *get_name; SymReg * const sub = ins->symregs[0]; PARROT_ASSERT(sub); PARROT_ASSERT(sub->pcc_sub); if (ins->type & ITRESULT) { const int n = sub->pcc_sub->nret; ins = pcc_get_args(imcc, unit, ins, "get_results", n, sub->pcc_sub->ret, sub->pcc_sub->ret_flags); return; } tail_call = sub->pcc_sub->tailcall; if (sub->pcc_sub->object) meth_call = 1; /* * See if we need to create a temporary sub object for the short * function call syntax _f() */ get_name = NULL; if (ins->type & ITCALL) { SymReg * const the_sub = sub->pcc_sub->sub; /* If this condition is true the generator must haven't be called, * but check it as a last resort. * See also TT #737 */ if (the_sub == NULL) IMCC_fatal(imcc, 1, "expand_pcc_sub_call: no such sub"); if (!meth_call && (the_sub->type & VTADDRESS)) { /* sub->pcc_sub->sub is an actual subroutine name, not a variable */ reg = mk_temp_reg(imcc, 'P'); add_pcc_sub(sub, reg); /* insert set_p_pc with the sub as constant */ the_sub->set = 'p'; the_sub->usage |= U_FIXUP; the_sub->type &= ~VTADDRESS; the_sub->type |= VTCONST; /* preserve VT_ENCODED */ regs[0] = reg; regs[1] = the_sub; /* * set_p_pc gets replaced in imcc/pbc.c, if the * function can't located in the current namespace */ get_name = INS(imcc, unit, "set_p_pc", "", regs, 2, 0, 0); ins->type &= ~ITCALL; } } if (sub->pcc_sub->object) unshift_self(imcc, sub, sub->pcc_sub->object); /* insert arguments */ n = sub->pcc_sub->nargs; ins = pcc_get_args(imcc, unit, ins, "set_args", n, sub->pcc_sub->args, sub->pcc_sub->arg_flags); /* * insert get_name after args have been setup, so that * a possible MMD call can inspect the passed arguments */ if (get_name) { insert_ins(unit, ins, get_name); ins = get_name; } arg = sub->pcc_sub->sub; if (arg == NULL) Parrot_ex_throw_from_c_args(imcc->interp, NULL, EXCEPTION_UNEXPECTED_NULL, "Subroutine is not defined"); if (meth_call) { meth = arg; if (arg->set != 'P') { if (!(arg->type == VTIDENTIFIER || arg->type == VTPASM || arg->type == VTREG)) { if (arg->type & VT_ENCODED) { meth = mk_const(imcc, arg->name, 'U'); } else { meth = mk_const(imcc, arg->name, 'S'); } } } } /* if we have a tail call then insert a tailcall opcode */ if (tail_call) { insert_tail_call(imcc, unit, ins, sub, meth); return; } /* insert the call */ if (meth_call) { regs[0] = sub->pcc_sub->object; regs[1] = meth; arg = sub->pcc_sub->cc; if (arg) { regs[2] = arg; ins = insINS(imcc, unit, ins, "callmethod" , regs, 3); } else { ins = insINS(imcc, unit, ins, "callmethodcc" , regs, 2); } } else { regs[0] = sub->pcc_sub->sub; arg = sub->pcc_sub->cc; if (arg) { regs[1] = arg; ins = insINS(imcc, unit, ins, "invoke" , regs, 2); } else { ins = insINS(imcc, unit, ins, "invokecc" , regs, 1); } } ins->type |= ITPCCSUB; /* handle return results */ n = sub->pcc_sub->nret; ins = pcc_get_args(imcc, unit, ins, "get_results", n, sub->pcc_sub->ret, sub->pcc_sub->ret_flags); } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ comp.t000644000765000765 475311715102034 14520 0ustar00brucebruce000000000000parrot-5.9.0/t/op#!./parrot # Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME t/op/comp.t - Conditionals =head1 SYNOPSIS % prove t/op/comp.t =head1 DESCRIPTION Tests various conditional branch operations. =cut # some of these were failing with JIT/i386 .sub main :main .include 'test_more.pir' plan(17) test_gt_ic_i_ic() test_ge_ic_i_ic() test_le_ic_i_ic() test_lt_ic_i_ic() test_eq_ic_i_ic() test_ne_ic_i_ic() test_eq_num() .end .sub test_gt_ic_i_ic set $I0, 10 gt 11, $I0, ok1 ok(0, "nok gt1") branch nok1 ok1: ok(1, "ok gt1") nok1: gt 9, $I0, nok2 ok(1, "ok gt2") .return() nok2: ok(0,"nok gt 2") .end .sub test_ge_ic_i_ic set $I0, 10 ge 11, $I0, ok1 ok(0, "nok ge1") branch nok1 ok1: ok(1, "ok ge1") nok1: ge 9, $I0, nok2 ok(1, "ok ge2") branch ok2 nok2: ok(0, "nok ge2") ok2: ge 10, $I0, ok3 ok(0, "nok ge3") .return() ok3: ok(1, "ok ge3") .end .sub test_le_ic_i_ic set $I0, 10 le 9, $I0, ok1 ok(0, "nok le1") branch nok1 ok1: ok(1, "ok le1") nok1: le 11, $I0, nok2 ok(1, "ok le2") branch ok2 nok2: ok(0, "nok le2") ok2: le 10, $I0, ok3 ok(0, "nok le2") .return() ok3: ok(1, "ok le3") .end .sub test_lt_ic_i_ic set $I0, 10 lt 9, $I0, ok1 ok(0, "nok lt1") branch nok1 ok1: ok(1, "ok lt1") nok1: lt 10, $I0, nok2 ok(1, "ok lt2") .return() nok2: ok(0, "nok lt2") .end .sub test_eq_ic_i_ic set $I0, 10 eq 9, $I0, nok1 ok(1, "ok eq1") branch ok1 nok1: ok(0, "nok eq1") ok1: eq 10, $I0, ok2 ok(0, "nok eq2") branch nok2 ok2: ok(1, "ok eq2") nok2: eq 11, 10, nok3 ok(1, "ok eq3") .return() nok3: ok(0, "nok eq3") .end .sub test_ne_ic_i_ic set $I0, 10 ne 9, $I0, ok1 ok(0, "nok neq1") branch nok1 ok1: ok(1, "ok neq1") nok1: ne 10, $I0, nok2 ok(1, "ok neq2") branch ok2 nok2: ok(0, "nok neq2") ok2: ne 11, 10, ok3 ok(0, "nok neq2") .return() ok3: ok(1, "ok neq3") .end .sub test_eq_num new $P0, 'Float' set $P0, -1.2 new $P1, 'String' # # fix problems with g++ 4.4.1 (with --optimize) on i386 - GH #677 # set $P1, "-1.2" set $P1, "-1.2000000000" eq_num $P0, $P1, OK ok(0, "not eq_num") .return() OK: ok(1, "eq_num") .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: box.t000644000765000765 775511533177644 14400 0ustar00brucebruce000000000000parrot-5.9.0/t/op#!./parrot # Copyright (C) 2008-2010, Parrot Foundation. =head1 NAME t/op/box.t - the box opcode =head1 SYNOPSIS % prove t/op/box.t =head1 DESCRIPTION Tests all box operators. =cut .const int TESTS = 26 # must set these up before the hll_map calls later .sub '__setup' :immediate $P0 = subclass 'Integer', 'MyInt' $P0 = subclass 'String', 'MyString' $P0 = subclass 'Float', 'MyFloat' .end .sub 'main' :main .include 'test_more.pir' 'plan'(TESTS) 'box_int'() 'box_num'() 'box_string'() 'box_null_string'() .local pmc box_int_hll box_int_hll = get_root_global [ 'for_test' ], 'box_int' .local pmc box_num_hll box_num_hll = get_root_global [ 'for_test' ], 'box_num' .local pmc box_string_hll box_string_hll = get_root_global [ 'for_test' ], 'box_string' box_int_hll() box_num_hll() box_string_hll() .end .sub 'box_int' $P0 = box 100 $I0 = $P0 is( $I0, 100, 'value preserved when boxing int' ) isa_ok( $P0, 'Integer', 'int boxed to appropriate base type' ) $I0 = 200 $P0 = box $I0 $I0 = $P0 is( $I0, 200, 'value preserved when boxing int from reg' ) isa_ok( $P0, 'Integer', 'int boxed to appropriate base type from reg' ) .end .sub 'box_num' $P0 = box 77.7 $N0 = $P0 is( $N0, 77.7, 'value preserved when boxing num' ) isa_ok( $P0, 'Float', 'num boxed to appropriate base type' ) $N0 = 88.8 $P0 = box $N0 $N0 = $P0 is( $N0, 88.8, 'value preserved when boxing num from reg' ) isa_ok( $P0, 'Float', 'num boxed to appropriate base type from reg' ) .end .sub 'box_string' $P0 = box 'Hi, there' $S0 = $P0 is( $S0, 'Hi, there', 'value preserved when boxing string' ) isa_ok( $P0, 'String', 'string boxed to appropriate base type' ) $S0 = 'Hello, there' $P0 = box $S0 $S0 = $P0 is( $S0, 'Hello, there', 'value preserved when boxing string from reg' ) isa_ok( $P0, 'String', 'string boxed to appropriate base type from reg' ) .end .sub 'box_null_string' null $S0 $P0 = box $S0 $S1 = $P0 is( $S1, '', 'NULL STRING boxed to empty String PMC' ) $P1 = clone $P0 $S1 = $P0 is( $S1, '', '... and survives clone of boxed PMC (TT #964)' ) .end .HLL 'for_test' .sub anon :anon :init .local pmc interp .local pmc cint, myint .local pmc cstr, mystr .local pmc cnum, mynum interp = getinterp cint = get_class 'Integer' myint = get_class 'MyInt' interp.'hll_map'(cint,myint) cstr = get_class 'String' mystr = get_class 'MyString' interp.'hll_map'(cstr,mystr) cnum = get_class 'Float' mynum = get_class 'MyFloat' interp.'hll_map'(cnum,mynum) .end .sub 'box_int' .include 'test_more.pir' $P0 = box -100 $I0 = $P0 is( $I0, -100, 'value preserved when boxing int in HLL' ) isa_ok( $P0, 'MyInt', 'int boxed to appropriate base type for HLL' ) $I0 = -999 $P0 = box $I0 $I0 = $P0 is( $I0, -999, 'value preserved when boxing int in HLL from reg' ) isa_ok( $P0, 'MyInt', 'int boxed to appropriate type for HLL from reg') .end .sub 'box_num' $P0 = box -77.7 $N0 = $P0 is( $N0, -77.7, 'value preserved when boxing num in HLL' ) isa_ok( $P0, 'MyFloat', 'num boxed to appropriate base type for HLL' ) $N0 = -222222.222222 $P0 = box $N0 $N0 = $P0 is( $N0, -222222.222222, 'value preserved when boxing num in HLL from reg' ) isa_ok( $P0, 'MyFloat', 'num boxed to appropriate type for HLL from reg' ) .end .sub 'box_string' $P0 = box 'Bye, bye!' $S0 = $P0 is( $S0, 'Bye, bye!', 'value preserved when boxing string in HLL' ) isa_ok( $P0, 'MyString', 'string boxed to appropriate base type for HLL' ) $S0 = 'Hello, goodbye!' $P0 = box $S0 $S0 = $P0 is( $S0, 'Hello, goodbye!', 'value preserved when boxing string in HLL from reg' ) isa_ok($P0, 'MyString', 'string boxed to appropriate type for HLL from reg') .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: ncurses.pir000644000765000765 5621611533177637 21414 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/library# Copyright (C) 2004-2009, Parrot Foundation. .sub __ncurses_init :load loadlib $P1, 'libform' if $P1 goto has_lib loadlib $P1, 'cygform-8' has_lib: dlfunc $P2, $P1, 'new_field', 'piiiiii' set_global 'ncurses::new_field', $P2 dlfunc $P2, $P1, 'dup_field', 'ppii' set_global 'ncurses::dup_field', $P2 dlfunc $P2, $P1, 'link_field', 'ppii' set_global 'ncurses::link_field', $P2 dlfunc $P2, $P1, 'free_field', 'ip' set_global 'ncurses::free_field', $P2 dlfunc $P2, $P1, 'field_info', 'ip333333' set_global 'ncurses::field_info', $P2 dlfunc $P2, $P1, 'dynamic_field_info', 'ip333' set_global 'ncurses::dynamic_field_info', $P2 dlfunc $P2, $P1, 'set_max_field', 'ipi' set_global 'ncurses::set_max_field', $P2 dlfunc $P2, $P1, 'move_field', 'ipii' set_global 'ncurses::move_field', $P2 dlfunc $P2, $P1, 'set_new_page', 'ipl' set_global 'ncurses::set_new_page', $P2 dlfunc $P2, $P1, 'set_field_just', 'ipi' set_global 'ncurses::set_field_just', $P2 dlfunc $P2, $P1, 'field_just', 'ip' set_global 'ncurses::field_just', $P2 dlfunc $P2, $P1, 'set_field_fore', 'ipl' set_global 'ncurses::set_field_fore', $P2 dlfunc $P2, $P1, 'set_field_back', 'ipl' set_global 'ncurses::set_field_back', $P2 dlfunc $P2, $P1, 'set_field_pad', 'ipi' set_global 'ncurses::set_field_pad', $P2 dlfunc $P2, $P1, 'field_pad', 'ip' set_global 'ncurses::field_pad', $P2 dlfunc $P2, $P1, 'set_field_buffer', 'ipit' set_global 'ncurses::set_field_buffer', $P2 dlfunc $P2, $P1, 'set_field_status', 'ipl' set_global 'ncurses::set_field_status', $P2 dlfunc $P2, $P1, 'set_field_userptr', 'ipp' set_global 'ncurses::set_field_userptr', $P2 dlfunc $P2, $P1, 'set_field_opts', 'ipi' set_global 'ncurses::set_field_opts', $P2 dlfunc $P2, $P1, 'field_opts_on', 'ipi' set_global 'ncurses::field_opts_on', $P2 dlfunc $P2, $P1, 'field_opts_off', 'ipi' set_global 'ncurses::field_opts_off', $P2 dlfunc $P2, $P1, 'field_fore', 'lp' set_global 'ncurses::field_fore', $P2 dlfunc $P2, $P1, 'field_back', 'ip' set_global 'ncurses::field_back', $P2 dlfunc $P2, $P1, 'new_page', 'lp' set_global 'ncurses::new_page', $P2 dlfunc $P2, $P1, 'field_status', 'lp' set_global 'ncurses::field_status', $P2 dlfunc $P2, $P1, 'field_arg', 'pp' set_global 'ncurses::field_arg', $P2 dlfunc $P2, $P1, 'field_userptr', 'pp' set_global 'ncurses::field_userptr', $P2 dlfunc $P2, $P1, 'field_type', 'pp' set_global 'ncurses::field_type', $P2 dlfunc $P2, $P1, 'field_buffer', 'tpi' set_global 'ncurses::field_buffer', $P2 dlfunc $P2, $P1, 'field_opts', 'lp' set_global 'ncurses::field_opts', $P2 dlfunc $P2, $P1, 'new_form', 'pb' set_global 'ncurses::new_form', $P2 dlfunc $P2, $P1, 'current_field', 'pp' set_global 'ncurses::current_field', $P2 dlfunc $P2, $P1, 'form_win', 'pp' set_global 'ncurses::form_win', $P2 dlfunc $P2, $P1, 'form_sub', 'pp' set_global 'ncurses::form_sub', $P2 dlfunc $P2, $P1, 'free_form', 'ip' set_global 'ncurses::free_form', $P2 dlfunc $P2, $P1, 'set_form_fields', 'ipb' set_global 'ncurses::set_form_fields', $P2 dlfunc $P2, $P1, 'field_count', 'ip' set_global 'ncurses::field_count', $P2 dlfunc $P2, $P1, 'set_form_win', 'ipp' set_global 'ncurses::set_form_win', $P2 dlfunc $P2, $P1, 'set_form_sub', 'ipp' set_global 'ncurses::set_form_sub', $P2 dlfunc $P2, $P1, 'set_current_field', 'ipp' set_global 'ncurses::set_current_field', $P2 dlfunc $P2, $P1, 'field_index', 'ip' set_global 'ncurses::field_index', $P2 dlfunc $P2, $P1, 'set_form_page', 'ipi' set_global 'ncurses::set_form_page', $P2 dlfunc $P2, $P1, 'form_page', 'ip' set_global 'ncurses::form_page', $P2 dlfunc $P2, $P1, 'scale_form', 'ip33' set_global 'ncurses::scale_form', $P2 dlfunc $P2, $P1, 'post_form', 'ip' set_global 'ncurses::post_form', $P2 dlfunc $P2, $P1, 'unpost_form', 'ip' set_global 'ncurses::unpost_form', $P2 dlfunc $P2, $P1, 'pos_form_cursor', 'ip' set_global 'ncurses::pos_form_cursor', $P2 dlfunc $P2, $P1, 'form_driver', 'ipi' set_global 'ncurses::form_driver', $P2 dlfunc $P2, $P1, 'set_form_userptr', 'ipp' set_global 'ncurses::set_form_userptr', $P2 dlfunc $P2, $P1, 'set_form_opts', 'ipi' set_global 'ncurses::set_form_opts', $P2 dlfunc $P2, $P1, 'form_opts_on', 'ipi' set_global 'ncurses::form_opts_on', $P2 dlfunc $P2, $P1, 'form_opts_off', 'ipi' set_global 'ncurses::form_opts_off', $P2 dlfunc $P2, $P1, 'form_request_by_name', 'it' set_global 'ncurses::form_request_by_name', $P2 dlfunc $P2, $P1, 'form_request_name', 'ti' set_global 'ncurses::form_request_name', $P2 dlfunc $P2, $P1, 'form_userptr', 'pp' set_global 'ncurses::form_userptr', $P2 dlfunc $P2, $P1, 'form_opts', 'ip' set_global 'ncurses::form_opts', $P2 dlfunc $P2, $P1, 'data_ahead', 'lp' set_global 'ncurses::data_ahead', $P2 dlfunc $P2, $P1, 'data_behind', 'lp' set_global 'ncurses::data_behind', $P2 loadlib $P1, 'libncurses' if $P1 goto has_lib1 loadlib $P1, 'cygncurses-8' has_lib1: dlfunc $P2, $P1, 'keybound', 'tii' set_global 'ncurses::keybound', $P2 dlfunc $P2, $P1, 'curses_version', 't' set_global 'ncurses::curses_version', $P2 dlfunc $P2, $P1, 'assume_default_colors', 'iii' set_global 'ncurses::assume_default_colors', $P2 dlfunc $P2, $P1, 'define_key', 'iti' set_global 'ncurses::define_key', $P2 dlfunc $P2, $P1, 'keyok', 'iii' set_global 'ncurses::keyok', $P2 dlfunc $P2, $P1, 'resizeterm', 'iii' set_global 'ncurses::resizeterm', $P2 dlfunc $P2, $P1, 'use_default_colors', 'i' set_global 'ncurses::use_default_colors', $P2 dlfunc $P2, $P1, 'use_extended_names', 'ii' set_global 'ncurses::use_extended_names', $P2 dlfunc $P2, $P1, 'wresize', 'ipii' set_global 'ncurses::wresize', $P2 dlfunc $P2, $P1, 'addch', 'il' set_global 'ncurses::addch', $P2 dlfunc $P2, $P1, 'addchnstr', 'i4i' set_global 'ncurses::addchnstr', $P2 dlfunc $P2, $P1, 'addchstr', 'i4' set_global 'ncurses::addchstr', $P2 dlfunc $P2, $P1, 'addnstr', 'iti' set_global 'ncurses::addnstr', $P2 dlfunc $P2, $P1, 'addstr', 'it' set_global 'ncurses::addstr', $P2 dlfunc $P2, $P1, 'attroff', 'il' set_global 'ncurses::attroff', $P2 dlfunc $P2, $P1, 'attron', 'il' set_global 'ncurses::attron', $P2 dlfunc $P2, $P1, 'attrset', 'il' set_global 'ncurses::attrset', $P2 dlfunc $P2, $P1, 'attr_get', 'i42p' set_global 'ncurses::attr_get', $P2 dlfunc $P2, $P1, 'attr_off', 'ilp' set_global 'ncurses::attr_off', $P2 dlfunc $P2, $P1, 'attr_on', 'ilp' set_global 'ncurses::attr_on', $P2 dlfunc $P2, $P1, 'attr_set', 'ilsp' set_global 'ncurses::attr_set', $P2 dlfunc $P2, $P1, 'baudrate', 'i' set_global 'ncurses::baudrate', $P2 dlfunc $P2, $P1, 'beep', 'i' set_global 'ncurses::beep', $P2 dlfunc $P2, $P1, 'bkgd', 'il' set_global 'ncurses::bkgd', $P2 dlfunc $P2, $P1, 'bkgdset', 'vl' set_global 'ncurses::bkgdset', $P2 dlfunc $P2, $P1, 'border', 'villllllll' set_global 'ncurses::border', $P2 dlfunc $P2, $P1, 'box', 'ipll' set_global 'ncurses::box', $P2 dlfunc $P2, $P1, 'can_change_color', 'l' set_global 'ncurses::can_change_color', $P2 dlfunc $P2, $P1, 'cbreak', 'i' set_global 'ncurses::cbreak', $P2 dlfunc $P2, $P1, 'chgat', 'iilsp' set_global 'ncurses::chgat', $P2 dlfunc $P2, $P1, 'clear', 'i' set_global 'ncurses::clear', $P2 dlfunc $P2, $P1, 'clearok', 'ipl' set_global 'ncurses::clearok', $P2 dlfunc $P2, $P1, 'clrtobot', 'i' set_global 'ncurses::clrtobot', $P2 dlfunc $P2, $P1, 'clrtoeol', 'i' set_global 'ncurses::clrtoeol', $P2 dlfunc $P2, $P1, 'color_content', 'is222' set_global 'ncurses::color_content', $P2 dlfunc $P2, $P1, 'color_set', 'isp' set_global 'ncurses::color_set', $P2 dlfunc $P2, $P1, 'COLOR_PAIR', 'ii' set_global 'ncurses::COLOR_PAIR', $P2 dlfunc $P2, $P1, 'copywin', 'ippiiiiiiii' set_global 'ncurses::copywin', $P2 dlfunc $P2, $P1, 'curs_set', 'ii' set_global 'ncurses::curs_set', $P2 dlfunc $P2, $P1, 'def_prog_mode', 'i' set_global 'ncurses::def_prog_mode', $P2 dlfunc $P2, $P1, 'def_shell_mode', 'i' set_global 'ncurses::def_shell_mode', $P2 dlfunc $P2, $P1, 'delay_output', 'ii' set_global 'ncurses::delay_output', $P2 dlfunc $P2, $P1, 'delch', 'i' set_global 'ncurses::delch', $P2 dlfunc $P2, $P1, 'delscreen', 'vp' set_global 'ncurses::delscreen', $P2 dlfunc $P2, $P1, 'delwin', 'ip' set_global 'ncurses::delwin', $P2 dlfunc $P2, $P1, 'deleteln', 'i' set_global 'ncurses::deleteln', $P2 dlfunc $P2, $P1, 'derwin', 'ppiiii' set_global 'ncurses::derwin', $P2 dlfunc $P2, $P1, 'doupdate', 'i' set_global 'ncurses::doupdate', $P2 dlfunc $P2, $P1, 'dupwin', 'pp' set_global 'ncurses::dupwin', $P2 dlfunc $P2, $P1, 'echo', 'i' set_global 'ncurses::echo', $P2 dlfunc $P2, $P1, 'echochar', 'il' set_global 'ncurses::echochar', $P2 dlfunc $P2, $P1, 'erase', 'i' set_global 'ncurses::erase', $P2 dlfunc $P2, $P1, 'endwin', 'i' set_global 'ncurses::endwin', $P2 dlfunc $P2, $P1, 'erasechar', 'c' set_global 'ncurses::erasechar', $P2 dlfunc $P2, $P1, 'filter', 'v' set_global 'ncurses::filter', $P2 dlfunc $P2, $P1, 'flash', 'i' set_global 'ncurses::flash', $P2 dlfunc $P2, $P1, 'flushinp', 'i' set_global 'ncurses::flushinp', $P2 dlfunc $P2, $P1, 'getbkgd', 'lp' set_global 'ncurses::getbkgd', $P2 dlfunc $P2, $P1, 'getch', 'i' set_global 'ncurses::getch', $P2 dlfunc $P2, $P1, 'getnstr', 'iti' set_global 'ncurses::getnstr', $P2 dlfunc $P2, $P1, 'getstr', 'it' set_global 'ncurses::getstr', $P2 dlfunc $P2, $P1, 'getwin', 'pp' set_global 'ncurses::getwin', $P2 dlfunc $P2, $P1, 'halfdelay', 'ii' set_global 'ncurses::halfdelay', $P2 dlfunc $P2, $P1, 'has_colors', 'i' set_global 'ncurses::has_colors', $P2 dlfunc $P2, $P1, 'has_ic', 'i' set_global 'ncurses::has_ic', $P2 dlfunc $P2, $P1, 'has_il', 'i' set_global 'ncurses::has_il', $P2 dlfunc $P2, $P1, 'hline', 'ili' set_global 'ncurses::hline', $P2 dlfunc $P2, $P1, 'idcok', 'vpl' set_global 'ncurses::idcok', $P2 dlfunc $P2, $P1, 'idlok', 'ipl' set_global 'ncurses::idlok', $P2 dlfunc $P2, $P1, 'immedok', 'vpl' set_global 'ncurses::immedok', $P2 dlfunc $P2, $P1, 'inch', 'l' set_global 'ncurses::inch', $P2 dlfunc $P2, $P1, 'inchnstr', 'i4i' set_global 'ncurses::inchnstr', $P2 dlfunc $P2, $P1, 'inchstr', 'i4' set_global 'ncurses::inchstr', $P2 dlfunc $P2, $P1, 'initscr', 'p' set_global 'ncurses::initscr', $P2 dlfunc $P2, $P1, 'init_color', 'issss' set_global 'ncurses::init_color', $P2 dlfunc $P2, $P1, 'init_pair', 'isss' set_global 'ncurses::init_pair', $P2 dlfunc $P2, $P1, 'innstr', 'iti' set_global 'ncurses::innstr', $P2 dlfunc $P2, $P1, 'insstr', 'it' set_global 'ncurses::insstr', $P2 dlfunc $P2, $P1, 'instr', 'it' set_global 'ncurses::instr', $P2 dlfunc $P2, $P1, 'intrflush', 'ipl' set_global 'ncurses::intrflush', $P2 dlfunc $P2, $P1, 'isendwin', 'l' set_global 'ncurses::isendwin', $P2 dlfunc $P2, $P1, 'is_linetouched', 'lpi' set_global 'ncurses::is_linetouched', $P2 dlfunc $P2, $P1, 'is_wintouched', 'lp' set_global 'ncurses::is_wintouched', $P2 dlfunc $P2, $P1, 'keyname', 'ti' set_global 'ncurses::keyname', $P2 dlfunc $P2, $P1, 'keypad', 'ipl' set_global 'ncurses::keypad', $P2 dlfunc $P2, $P1, 'killchar', 'c' set_global 'ncurses::killchar', $P2 dlfunc $P2, $P1, 'leaveok', 'ipl' set_global 'ncurses::leaveok', $P2 dlfunc $P2, $P1, 'longname', 't' set_global 'ncurses::longname', $P2 dlfunc $P2, $P1, 'meta', 'ipl' set_global 'ncurses::meta', $P2 dlfunc $P2, $P1, 'move', 'iii' set_global 'ncurses::move', $P2 dlfunc $P2, $P1, 'mvaddch', 'iiil' set_global 'ncurses::mvaddch', $P2 dlfunc $P2, $P1, 'mvaddchnstr', 'iii4i' set_global 'ncurses::mvaddchnstr', $P2 dlfunc $P2, $P1, 'mvaddchstr', 'iii4' set_global 'ncurses::mvaddchstr', $P2 dlfunc $P2, $P1, 'mvaddnstr', 'iiiti' set_global 'ncurses::mvaddnstr', $P2 dlfunc $P2, $P1, 'mvaddstr', 'iiit' set_global 'ncurses::mvaddstr', $P2 dlfunc $P2, $P1, 'mvchgat', 'iiiilsp' set_global 'ncurses::mvchgat', $P2 #dlfunc $P2, $P1, 'mvcur', 'iiiii' #set_global 'ncurses::mvcur', $P2 dlfunc $P2, $P1, 'mvdelch', 'iii' set_global 'ncurses::mvdelch', $P2 dlfunc $P2, $P1, 'mvderwin', 'ipii' set_global 'ncurses::mvderwin', $P2 dlfunc $P2, $P1, 'mvgetch', 'iii' set_global 'ncurses::mvgetch', $P2 dlfunc $P2, $P1, 'mvgetnstr', 'iiiti' set_global 'ncurses::mvgetnstr', $P2 dlfunc $P2, $P1, 'mvgetstr', 'iiit' set_global 'ncurses::mvgetstr', $P2 dlfunc $P2, $P1, 'mvhline', 'iiili' set_global 'ncurses::mvhline', $P2 dlfunc $P2, $P1, 'mvinch', 'lii' set_global 'ncurses::mvinch', $P2 dlfunc $P2, $P1, 'mvinchnstr', 'iiiti' set_global 'ncurses::mvinchnstr', $P2 dlfunc $P2, $P1, 'mvinchstr', 'iii4' set_global 'ncurses::mvinchstr', $P2 dlfunc $P2, $P1, 'mvinnstr', 'iiiti' set_global 'ncurses::mvinnstr', $P2 dlfunc $P2, $P1, 'mvinsch', 'iiil' set_global 'ncurses::mvinsch', $P2 dlfunc $P2, $P1, 'mvinsnstr', 'iiiti' set_global 'ncurses::mvinsnstr', $P2 dlfunc $P2, $P1, 'mvinsstr', 'iiit' set_global 'ncurses::mvinsstr', $P2 dlfunc $P2, $P1, 'mvvline', 'iiili' set_global 'ncurses::mvvline', $P2 dlfunc $P2, $P1, 'mvwaddch', 'ipiil' set_global 'ncurses::mvwaddch', $P2 dlfunc $P2, $P1, 'mvwaddchnstr', 'ipii4i' set_global 'ncurses::mvwaddchnstr', $P2 dlfunc $P2, $P1, 'mvwaddchstr', 'ipii4' set_global 'ncurses::mvwaddchstr', $P2 dlfunc $P2, $P1, 'mvwaddnstr', 'ipiiti' set_global 'ncurses::mvwaddnstr', $P2 dlfunc $P2, $P1, 'mvwaddstr', 'ipiit' set_global 'ncurses::mvwaddstr', $P2 dlfunc $P2, $P1, 'mvwchgat', 'ipiiilsp' set_global 'ncurses::mvwchgat', $P2 dlfunc $P2, $P1, 'mvwdelch', 'ipii' set_global 'ncurses::mvwdelch', $P2 dlfunc $P2, $P1, 'mvwgetch', 'ipii' set_global 'ncurses::mvwgetch', $P2 dlfunc $P2, $P1, 'mvwgetnstr', 'ipiiti' set_global 'ncurses::mvwgetnstr', $P2 dlfunc $P2, $P1, 'mvwgetstr', 'ipiit' set_global 'ncurses::mvwgetstr', $P2 dlfunc $P2, $P1, 'mvwhline', 'ipiili' set_global 'ncurses::mvwhline', $P2 dlfunc $P2, $P1, 'mvwin', 'ipii' set_global 'ncurses::mvwin', $P2 dlfunc $P2, $P1, 'mvwinch', 'lpii' set_global 'ncurses::mvwinch', $P2 dlfunc $P2, $P1, 'mvwinchnstr', 'ipii4i' set_global 'ncurses::mvwinchnstr', $P2 dlfunc $P2, $P1, 'mvwinchstr', 'ipii4' set_global 'ncurses::mvwinchstr', $P2 dlfunc $P2, $P1, 'mvwinnstr', 'ipiiti' set_global 'ncurses::mvwinnstr', $P2 dlfunc $P2, $P1, 'mvwinsch', 'ipiil' set_global 'ncurses::mvwinsch', $P2 dlfunc $P2, $P1, 'mvwinsnstr', 'ipiiti' set_global 'ncurses::mvwinsnstr', $P2 dlfunc $P2, $P1, 'mvwinsstr', 'ipiit' set_global 'ncurses::mvwinsstr', $P2 dlfunc $P2, $P1, 'mvwinstr', 'ipiit' set_global 'ncurses::mvwinstr', $P2 dlfunc $P2, $P1, 'mvwvline', 'ipiili' set_global 'ncurses::mvwvline', $P2 dlfunc $P2, $P1, 'napms', 'ii' set_global 'ncurses::napms', $P2 dlfunc $P2, $P1, 'newpad', 'pii' set_global 'ncurses::newpad', $P2 dlfunc $P2, $P1, 'newterm', 'ptpp' set_global 'ncurses::newterm', $P2 dlfunc $P2, $P1, 'newwin', 'piiii' set_global 'ncurses::newwin', $P2 dlfunc $P2, $P1, 'nl', 'i' set_global 'ncurses::nl', $P2 dlfunc $P2, $P1, 'nocbreak', 'i' set_global 'ncurses::nocbreak', $P2 dlfunc $P2, $P1, 'nodelay', 'ipl' set_global 'ncurses::nodelay', $P2 dlfunc $P2, $P1, 'noecho', 'i' set_global 'ncurses::noecho', $P2 dlfunc $P2, $P1, 'nonl', 'i' set_global 'ncurses::nonl', $P2 dlfunc $P2, $P1, 'noqiflush', 'v' set_global 'ncurses::noqiflush', $P2 dlfunc $P2, $P1, 'noraw', 'i' set_global 'ncurses::noraw', $P2 dlfunc $P2, $P1, 'notimeout', 'ipl' set_global 'ncurses::notimeout', $P2 dlfunc $P2, $P1, 'overlay', 'ipp' set_global 'ncurses::overlay', $P2 dlfunc $P2, $P1, 'overwrite', 'ipp' set_global 'ncurses::overwrite', $P2 dlfunc $P2, $P1, 'pair_content', 'is22' set_global 'ncurses::pair_content', $P2 dlfunc $P2, $P1, 'PAIR_NUMBER', 'ii' set_global 'ncurses::PAIR_NUMBER', $P2 dlfunc $P2, $P1, 'pechochar', 'ipl' set_global 'ncurses::pechochar', $P2 dlfunc $P2, $P1, 'pnoutrefresh', 'ipiiiiii' set_global 'ncurses::pnoutrefresh', $P2 dlfunc $P2, $P1, 'prefresh', 'ipiiiiii' set_global 'ncurses::prefresh', $P2 dlfunc $P2, $P1, 'putp', 'it' set_global 'ncurses::putp', $P2 dlfunc $P2, $P1, 'putwin', 'ipp' set_global 'ncurses::putwin', $P2 dlfunc $P2, $P1, 'qiflush', 'v' set_global 'ncurses::qiflush', $P2 dlfunc $P2, $P1, 'raw', 'i' set_global 'ncurses::raw', $P2 dlfunc $P2, $P1, 'redrawwin', 'ip' set_global 'ncurses::redrawwin', $P2 dlfunc $P2, $P1, 'refresh', 'i' set_global 'ncurses::refresh', $P2 dlfunc $P2, $P1, 'resetty', 'i' set_global 'ncurses::resetty', $P2 dlfunc $P2, $P1, 'reset_prog_mode', 'i' set_global 'ncurses::reset_prog_mode', $P2 dlfunc $P2, $P1, 'reset_shell_mode', 'i' set_global 'ncurses::reset_shell_mode', $P2 dlfunc $P2, $P1, 'ripoffline', 'iiip' set_global 'ncurses::ripoffline', $P2 dlfunc $P2, $P1, 'savetty', 'i' set_global 'ncurses::savetty', $P2 dlfunc $P2, $P1, 'scr_dump', 'it' set_global 'ncurses::scr_dump', $P2 dlfunc $P2, $P1, 'scr_init', 'it' set_global 'ncurses::scr_init', $P2 dlfunc $P2, $P1, 'scrl', 'ii' set_global 'ncurses::scrl', $P2 dlfunc $P2, $P1, 'scroll', 'ip' set_global 'ncurses::scroll', $P2 dlfunc $P2, $P1, 'scrollok', 'ipl' set_global 'ncurses::scrollok', $P2 dlfunc $P2, $P1, 'scr_restore', 'it' set_global 'ncurses::scr_restore', $P2 dlfunc $P2, $P1, 'scr_set', 'it' set_global 'ncurses::scr_set', $P2 dlfunc $P2, $P1, 'setscrreg', 'iii' set_global 'ncurses::setscrreg', $P2 dlfunc $P2, $P1, 'set_term', 'pp' set_global 'ncurses::set_term', $P2 dlfunc $P2, $P1, 'slk_attroff', 'il' set_global 'ncurses::slk_attroff', $P2 dlfunc $P2, $P1, 'slk_attron', 'il' set_global 'ncurses::slk_attron', $P2 dlfunc $P2, $P1, 'slk_attrset', 'il' set_global 'ncurses::slk_attrset', $P2 dlfunc $P2, $P1, 'slk_attr', 'l' set_global 'ncurses::slk_attr', $P2 dlfunc $P2, $P1, 'slk_attr_set', 'ilsp' set_global 'ncurses::slk_attr_set', $P2 dlfunc $P2, $P1, 'slk_clear', 'i' set_global 'ncurses::slk_clear', $P2 dlfunc $P2, $P1, 'slk_color', 'is' set_global 'ncurses::slk_color', $P2 dlfunc $P2, $P1, 'slk_init', 'ii' set_global 'ncurses::slk_init', $P2 dlfunc $P2, $P1, 'slk_label', 'ti' set_global 'ncurses::slk_label', $P2 dlfunc $P2, $P1, 'slk_noutrefresh', 'i' set_global 'ncurses::slk_noutrefresh', $P2 dlfunc $P2, $P1, 'slk_refresh', 'i' set_global 'ncurses::slk_refresh', $P2 dlfunc $P2, $P1, 'slk_restore', 'i' set_global 'ncurses::slk_restore', $P2 dlfunc $P2, $P1, 'slk_set', 'iiti' set_global 'ncurses::slk_set', $P2 dlfunc $P2, $P1, 'slk_touch', 'i' set_global 'ncurses::slk_touch', $P2 dlfunc $P2, $P1, 'standout', 'i' set_global 'ncurses::standout', $P2 dlfunc $P2, $P1, 'standend', 'i' set_global 'ncurses::standend', $P2 dlfunc $P2, $P1, 'start_color', 'i' set_global 'ncurses::start_color', $P2 dlfunc $P2, $P1, 'subpad', 'ppiiii' set_global 'ncurses::subpad', $P2 dlfunc $P2, $P1, 'subwin', 'ppiiii' set_global 'ncurses::subwin', $P2 dlfunc $P2, $P1, 'syncok', 'ipl' set_global 'ncurses::syncok', $P2 dlfunc $P2, $P1, 'termattrs', 'l' set_global 'ncurses::termattrs', $P2 dlfunc $P2, $P1, 'termname', 't' set_global 'ncurses::termname', $P2 dlfunc $P2, $P1, 'tigetflag', 'it' set_global 'ncurses::tigetflag', $P2 dlfunc $P2, $P1, 'tigetnum', 'it' set_global 'ncurses::tigetnum', $P2 dlfunc $P2, $P1, 'tigetstr', 'tt' set_global 'ncurses::tigetstr', $P2 dlfunc $P2, $P1, 'timeout', 'vi' set_global 'ncurses::timeout', $P2 dlfunc $P2, $P1, 'typeahead', 'ii' set_global 'ncurses::typeahead', $P2 dlfunc $P2, $P1, 'ungetch', 'ii' set_global 'ncurses::ungetch', $P2 dlfunc $P2, $P1, 'untouchwin', 'ip' set_global 'ncurses::untouchwin', $P2 dlfunc $P2, $P1, 'use_env', 'vl' set_global 'ncurses::use_env', $P2 dlfunc $P2, $P1, 'vidattr', 'il' set_global 'ncurses::vidattr', $P2 dlfunc $P2, $P1, 'vidputs', 'ilp' set_global 'ncurses::vidputs', $P2 dlfunc $P2, $P1, 'vline', 'ili' set_global 'ncurses::vline', $P2 dlfunc $P2, $P1, 'waddch', 'ipl' set_global 'ncurses::waddch', $P2 dlfunc $P2, $P1, 'waddchnstr', 'ip4i' set_global 'ncurses::waddchnstr', $P2 dlfunc $P2, $P1, 'waddchstr', 'ip4' set_global 'ncurses::waddchstr', $P2 dlfunc $P2, $P1, 'waddnstr', 'ipti' set_global 'ncurses::waddnstr', $P2 dlfunc $P2, $P1, 'waddstr', 'ipt' set_global 'ncurses::waddstr', $P2 dlfunc $P2, $P1, 'wattron', 'ipi' set_global 'ncurses::wattron', $P2 dlfunc $P2, $P1, 'wattroff', 'ipi' set_global 'ncurses::wattroff', $P2 dlfunc $P2, $P1, 'wattrset', 'ipi' set_global 'ncurses::wattrset', $P2 dlfunc $P2, $P1, 'wattr_get', 'ip42p' set_global 'ncurses::wattr_get', $P2 dlfunc $P2, $P1, 'wattr_on', 'iplp' set_global 'ncurses::wattr_on', $P2 dlfunc $P2, $P1, 'wattr_off', 'iplp' set_global 'ncurses::wattr_off', $P2 dlfunc $P2, $P1, 'wattr_set', 'iplsp' set_global 'ncurses::wattr_set', $P2 dlfunc $P2, $P1, 'wbkgd', 'ipl' set_global 'ncurses::wbkgd', $P2 dlfunc $P2, $P1, 'wbkgdset', 'vpl' set_global 'ncurses::wbkgdset', $P2 dlfunc $P2, $P1, 'wborder', 'ipllllllll' set_global 'ncurses::wborder', $P2 dlfunc $P2, $P1, 'wchgat', 'ipilsp' set_global 'ncurses::wchgat', $P2 dlfunc $P2, $P1, 'wclear', 'ip' set_global 'ncurses::wclear', $P2 dlfunc $P2, $P1, 'wclrtobot', 'ip' set_global 'ncurses::wclrtobot', $P2 dlfunc $P2, $P1, 'wclrtoeol', 'ip' set_global 'ncurses::wclrtoeol', $P2 dlfunc $P2, $P1, 'wcolor_set', 'ipsp' set_global 'ncurses::wcolor_set', $P2 dlfunc $P2, $P1, 'wcursyncup', 'vp' set_global 'ncurses::wcursyncup', $P2 dlfunc $P2, $P1, 'wdelch', 'ip' set_global 'ncurses::wdelch', $P2 dlfunc $P2, $P1, 'wdeleteln', 'ip' set_global 'ncurses::wdeleteln', $P2 dlfunc $P2, $P1, 'wechochar', 'ipl' set_global 'ncurses::wechochar', $P2 dlfunc $P2, $P1, 'werase', 'ip' set_global 'ncurses::werase', $P2 dlfunc $P2, $P1, 'wgetch', 'ip' set_global 'ncurses::wgetch', $P2 dlfunc $P2, $P1, 'wgetnstr', 'ipti' set_global 'ncurses::wgetnstr', $P2 dlfunc $P2, $P1, 'wgetstr', 'ipt' set_global 'ncurses::wgetstr', $P2 dlfunc $P2, $P1, 'whline', 'ipli' set_global 'ncurses::whline', $P2 dlfunc $P2, $P1, 'winch', 'lp' set_global 'ncurses::winch', $P2 dlfunc $P2, $P1, 'winchnstr', 'ip4i' set_global 'ncurses::winchnstr', $P2 dlfunc $P2, $P1, 'winnstr', 'ipti' set_global 'ncurses::winnstr', $P2 dlfunc $P2, $P1, 'winsch', 'ipl' set_global 'ncurses::winsch', $P2 dlfunc $P2, $P1, 'winsdelln', 'ipi' set_global 'ncurses::winsdelln', $P2 dlfunc $P2, $P1, 'winsertln', 'ip' set_global 'ncurses::winsertln', $P2 dlfunc $P2, $P1, 'winsnstr', 'ipti' set_global 'ncurses::winsnstr', $P2 dlfunc $P2, $P1, 'winsstr', 'ipt' set_global 'ncurses::winsstr', $P2 dlfunc $P2, $P1, 'winstr', 'ipt' set_global 'ncurses::winstr', $P2 dlfunc $P2, $P1, 'wmove', 'ipii' set_global 'ncurses::wmove', $P2 dlfunc $P2, $P1, 'wnoutrefresh', 'ip' set_global 'ncurses::wnoutrefresh', $P2 dlfunc $P2, $P1, 'wredrawln', 'ipii' set_global 'ncurses::wredrawln', $P2 dlfunc $P2, $P1, 'wrefresh', 'ip' set_global 'ncurses::wrefresh', $P2 dlfunc $P2, $P1, 'wscrl', 'ipi' set_global 'ncurses::wscrl', $P2 dlfunc $P2, $P1, 'wsetscrreg', 'ipii' set_global 'ncurses::wsetscrreg', $P2 dlfunc $P2, $P1, 'wstandout', 'ip' set_global 'ncurses::wstandout', $P2 dlfunc $P2, $P1, 'wstandend', 'ip' set_global 'ncurses::wstandend', $P2 dlfunc $P2, $P1, 'wsyncdown', 'vp' set_global 'ncurses::wsyncdown', $P2 dlfunc $P2, $P1, 'wsyncup', 'vp' set_global 'ncurses::wsyncup', $P2 dlfunc $P2, $P1, 'wtimeout', 'vpi' set_global 'ncurses::wtimeout', $P2 dlfunc $P2, $P1, 'wtouchln', 'ipiii' set_global 'ncurses::wtouchln', $P2 dlfunc $P2, $P1, 'wvline', 'ipli' set_global 'ncurses::wvline', $P2 dlfunc $P2, $P1, 'getmouse', 'ip' set_global 'ncurses::getmouse', $P2 dlfunc $P2, $P1, 'ungetmouse', 'ip' set_global 'ncurses::ungetmouse', $P2 dlfunc $P2, $P1, 'mousemask', 'll4' set_global 'ncurses::mousemask', $P2 dlfunc $P2, $P1, 'wenclose', 'lpii' set_global 'ncurses::wenclose', $P2 dlfunc $P2, $P1, 'mouseinterval', 'ii' set_global 'ncurses::mouseinterval', $P2 dlfunc $P2, $P1, 'wmouse_trafo', 'lp33l' set_global 'ncurses::wmouse_trafo', $P2 dlfunc $P2, $P1, 'mouse_trafo', 'l33l' set_global 'ncurses::mouse_trafo', $P2 dlfunc $P2, $P1, 'mcprint', 'iti' set_global 'ncurses::mcprint', $P2 dlfunc $P2, $P1, 'has_key', 'ii' set_global 'ncurses::has_key', $P2 .begin_return .end_return .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: api.c000644000765000765 16746012222605431 14677 0ustar00brucebruce000000000000parrot-5.9.0/src/io/* Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME src/io/api.c - Parrot I/O API =head1 DESCRIPTION The Parrot I/O subsystem provides the core I/O functionality for all parts of Parrot. This file implements the public interface to the I/O subsystem. =head1 Functions =over 4 =cut */ #include "parrot/parrot.h" #include "parrot/extend.h" #include "io_private.h" #include "api.str" #include "pmc/pmc_handle.h" #include "pmc/pmc_filehandle.h" #include "pmc/pmc_stringhandle.h" #include "pmc/pmc_socket.h" #include "pmc/pmc_sockaddr.h" #include "pmc/pmc_bytebuffer.h" #include PIOOFF_T piooffsetzero; /* HEADERIZER HFILE: include/parrot/io.h */ /* HEADERIZER BEGIN: static */ /* HEADERIZER END: static */ /* =item C Sets up the interpreter's I/O storage and creates the C handles. Called when creating an interpreter. =item C Called during PIO subsystem initialization. This creates the vtables for FileHandle, Pipe, Socket, StringHandle and UserHandle. =cut */ PARROT_EXPORT void Parrot_io_init(PARROT_INTERP) { ASSERT_ARGS(Parrot_io_init) /* Has interp been initialized already? */ if (interp->piodata) { /* memsub system is up and running: */ /* Init IO stacks and handles for interp instance. */ PIOHANDLE os_handle; PMC *handle; io_setup_vtables(interp); os_handle = Parrot_io_internal_std_os_handle(interp, PIO_STDIN_FILENO); handle = Parrot_io_fdopen_flags(interp, PMCNULL, os_handle, PIO_F_READ); Parrot_io_buffer_add_to_handle(interp, handle, IO_PTR_IDX_READ_BUFFER, BUFFER_SIZE_ANY, PIO_BF_BLKBUF); _PIO_STDIN(interp) = handle; os_handle = Parrot_io_internal_std_os_handle(interp, PIO_STDOUT_FILENO); handle = Parrot_io_fdopen_flags(interp, PMCNULL, os_handle, PIO_F_WRITE); /* Parrot_io_buffer_add_to_handle(interp, handle, IO_PTR_IDX_WRITE_BUFFER, BUFFER_SIZE_ANY, PIO_BF_LINEBUF); */ _PIO_STDOUT(interp) = handle; os_handle = Parrot_io_internal_std_os_handle(interp, PIO_STDERR_FILENO); _PIO_STDERR(interp) = Parrot_io_fdopen_flags(interp, PMCNULL, os_handle, PIO_F_WRITE); if (Interp_debug_TEST(interp, PARROT_START_DEBUG_FLAG)) { Parrot_io_eprintf(NULL, "I/O system initialized.\n"); } return; } interp->piodata = mem_gc_allocate_zeroed_typed(interp, ParrotIOData); if (interp->piodata == NULL) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "PIO alloc piodata failure."); interp->piodata->table = mem_gc_allocate_n_zeroed_typed(interp, PIO_NR_OPEN, PMC *); if (!interp->piodata->table) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "PIO alloc table failure."); } void io_setup_vtables(PARROT_INTERP) { ASSERT_ARGS(io_setup_vtables) const int number_of_vtables = 5; interp->piodata->vtables = (const IO_VTABLE*)mem_gc_allocate_n_zeroed_typed(interp, number_of_vtables, const IO_VTABLE); interp->piodata->num_vtables = number_of_vtables; io_filehandle_setup_vtable(interp, NULL, IO_VTABLE_FILEHANDLE); io_socket_setup_vtable(interp, NULL, IO_VTABLE_SOCKET); io_pipe_setup_vtable(interp, NULL, IO_VTABLE_PIPE); io_stringhandle_setup_vtable(interp, NULL, IO_VTABLE_STRINGHANDLE); io_userhandle_setup_vtable(interp, NULL, IO_VTABLE_USER); } /* =item C Allocates a new IO_VTABLE * structure with the given name. =item C Retrieves the vtable at index C. If C is -1, the vtable is instead searched for by C. Notice that name lookups are much slower. =cut */ PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT PARROT_MALLOC const IO_VTABLE * Parrot_io_allocate_new_vtable(PARROT_INTERP, ARGIN(const char *name)) { ASSERT_ARGS(Parrot_io_allocate_new_vtable) const int number_of_vtables = interp->piodata->num_vtables; IO_VTABLE *vtable; interp->piodata->vtables = mem_gc_realloc_n_typed(interp, (void *)interp->piodata->vtables, number_of_vtables + 1, const IO_VTABLE); vtable = IO_EDITABLE_IO_VTABLE(interp, number_of_vtables); vtable->name = name; vtable->number = number_of_vtables; interp->piodata->num_vtables++; return (const IO_VTABLE *)vtable; } PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL const IO_VTABLE * Parrot_io_get_vtable(PARROT_INTERP, INTVAL idx, ARGIN_NULLOK(const char * name)) { ASSERT_ARGS(Parrot_io_get_vtable) INTVAL i; if (idx >= interp->piodata->num_vtables) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Cannot get IO VTABLE %d", idx); if (idx >= 0) return &(interp->piodata->vtables[idx]); if (!name) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Cannot get IO VTABLE with no index and no name"); for (i = 0; i < interp->piodata->num_vtables; i++) { if (!strcmp(name, interp->piodata->vtables[i].name)) return &(interp->piodata->vtables[i]); } Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Cannot get IO VTABLE %s", name); return NULL; } /* =item C Closes the interpreter's IO resources. Called during its interpreter destruction. =cut */ PARROT_EXPORT void Parrot_io_finish(PARROT_INTERP) { ASSERT_ARGS(Parrot_io_finish) /* * TODO free IO of std-handles */ Parrot_io_flush(interp, _PIO_STDOUT(interp)); mem_gc_free(interp, interp->piodata->table); interp->piodata->table = NULL; mem_gc_free(interp, interp->piodata); interp->piodata = NULL; } /* =item C Called from C to mark the standard IO handles (C, C and C) and other global data for the IO subsystem. =cut */ void Parrot_io_mark(PARROT_INTERP, ARGIN(ParrotIOData *piodata)) { ASSERT_ARGS(Parrot_io_mark) INTVAL i; PMC ** const table = piodata->table; /* this was i < PIO_NR_OPEN, but only standard handles 0..2 need * to be kept alive AFAIK -leo */ for (i = 0; i < 3; ++i) { Parrot_gc_mark_PMC_alive(interp, table[i]); } } /* =back =head2 Generic I/O interface =over 4 =cut */ /* =item C Get the current standard IO object with the specified filenumber. If the C parameter is non-null, set that to be the new standard IO object of that number. Returns the old IO object before the new one is set, so it can be cached for later. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL PMC * Parrot_io_stdhandle(PARROT_INTERP, INTVAL fileno, ARGIN_NULLOK(PMC *newhandle)) { ASSERT_ARGS(Parrot_io_stdhandle) PMC * result = PMCNULL; if (fileno == PIO_STDIN_FILENO || fileno == PIO_STDOUT_FILENO || fileno == PIO_STDERR_FILENO) { result = interp->piodata->table[fileno]; if (! PMC_IS_NULL(newhandle)) interp->piodata->table[fileno] = newhandle; } return result; } /* =item C Open the given handle C with the given C and C strings. If C is null, create a new FileHandle PMC or whatever is currently mapped to FileHandle for opening. Notice that C and C may not be required for all types and may be type-dependent. =item C Legacy wrapper for Parrot_io_open(). Do not use. This is deprecated. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_io_open_handle(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(STRING *path), ARGIN(STRING *mode)) { ASSERT_ARGS(Parrot_io_open_handle) return Parrot_io_open(interp, pmc, path, mode); } PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_io_open(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(STRING *path), ARGIN(STRING *mode)) { ASSERT_ARGS(Parrot_io_open) PMC *handle; const IO_VTABLE * vtable; /* If a handle is not provided, create a new FileHandle */ if (PMC_IS_NULL(pmc)) handle = io_get_new_filehandle(interp); else handle = pmc; PARROT_ASSERT(!PMC_IS_NULL(handle)); vtable = IO_GET_VTABLE(interp, handle); /* Unless flagged otherwise, a path is required for open */ if ((vtable->flags & PIO_VF_PATH_NOT_REQUIRED) == 0 && STRING_IS_NULL(path)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Cannot open %s, no path", vtable->name); /* If not specified, default to read mode */ if (STRING_IS_NULL(mode)) mode = CONST_STRING(interp, "r"); { const INTVAL flags = Parrot_io_parse_open_flags(interp, mode); IO_BUFFER * const read_buffer = IO_GET_READ_BUFFER(interp, handle); INTVAL status = vtable->open(interp, handle, path, flags, mode); if (!status) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Unable to open %s from path '%Ss'", vtable->name, path); /* If this type uses buffers by default, set them up, and if we're in an acceptable mode, set up buffers. */ if (vtable->flags & PIO_VF_DEFAULT_READ_BUF && flags & PIO_F_READ) Parrot_io_buffer_add_to_handle(interp, handle, IO_PTR_IDX_READ_BUFFER, BUFFER_SIZE_ANY, PIO_BF_BLKBUF); if (vtable->flags & PIO_VF_DEFAULT_WRITE_BUF && flags & PIO_F_WRITE) Parrot_io_buffer_add_to_handle(interp, handle, IO_PTR_IDX_WRITE_BUFFER, BUFFER_SIZE_ANY, PIO_BF_BLKBUF); } return handle; } /* =item C Create a low-level socket structure and add it to the C PMC. if C is null, create a new Socket PMC (or whatever is mapped to it). Use the given C, C and C values to configure the new socket. Returns the C. =item C Legacy wrapper function for Parrot_io_socket. This is deprecated, do not use. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL INTVAL Parrot_io_socket_handle(PARROT_INTERP, ARGMOD_NULLOK(PMC *socket), INTVAL fam, INTVAL type, INTVAL proto) { ASSERT_ARGS(Parrot_io_socket_handle) PMC * const dummy = Parrot_io_socket(interp, socket, fam, type, proto); UNUSED(dummy); /* For historical reasons, this function always returns 0 to signal unconditional success */ return 0; } PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_io_socket(PARROT_INTERP, ARGMOD_NULLOK(PMC *socket), INTVAL fam, INTVAL type, INTVAL proto) { ASSERT_ARGS(Parrot_io_socket) PMC *new_socket; PIOHANDLE os_handle; if (PMC_IS_NULL(socket)) new_socket = io_get_new_socket(interp); else new_socket = socket; /* TODO: Move this logic into src/io/socket.c */ os_handle = Parrot_io_internal_socket(interp, fam, type, proto); SETATTR_Socket_os_handle(interp, new_socket, os_handle); SETATTR_Socket_family(interp, new_socket, fam); SETATTR_Socket_type(interp, new_socket, type); SETATTR_Socket_protocol(interp, new_socket, proto); /* TODO: How do we signal errors here? */ return socket; } /* =item C Creates and returns a C PMC for a given set of flags on an existing, open file descriptor. This is used particularly to initialize the C IO handles onto the OS IO handles (0, 1, 2). =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_io_fdopen(PARROT_INTERP, ARGIN(PMC *pmc), PIOHANDLE fd, ARGIN(STRING *sflags)) { ASSERT_ARGS(Parrot_io_fdopen) const INTVAL flags = Parrot_io_parse_open_flags(interp, sflags); return Parrot_io_fdopen_flags(interp, pmc, fd, flags); } /* =item C Creates and returns a C PMC for a given set of flags on an existing, open file descriptor. This is used particularly to initialize the C IO handles onto the OS IO handles (0, 1, 2). =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_io_fdopen_flags(PARROT_INTERP, ARGMOD(PMC *filehandle), PIOHANDLE fd, INTVAL flags) { ASSERT_ARGS(Parrot_io_fdopen_flags) if (!flags) return PMCNULL; if (Parrot_io_internal_is_tty(interp, fd)) flags |= PIO_F_CONSOLE; /* fdopened files are always shared */ flags |= PIO_F_SHARED; if (PMC_IS_NULL(filehandle)) filehandle = io_get_new_filehandle(interp); { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, filehandle); if (vtable->number != IO_VTABLE_FILEHANDLE && vtable->number != IO_VTABLE_PIPE) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Cannot set an OS file descriptor to a %s PMC", vtable->name); vtable->set_flags(interp, filehandle, flags); io_filehandle_set_os_handle(interp, filehandle, fd); } return filehandle; } /* =item C Initialize a Socket PMC by clearing it's C and marking it as being disconnected (closed). =cut */ PARROT_EXPORT void Parrot_io_socket_initialize(SHIM_INTERP, ARGMOD(PMC *socket)) { ASSERT_ARGS(Parrot_io_socket_initialize) /* TODO: Move this logic into src/io/socket.c */ PARROT_SOCKET(socket)->os_handle = (PIOHANDLE)PIO_INVALID_HANDLE; } /* =item C Closes the Handle object C. If C is C<1>, flush the handle. If it is C<-1> use type-specific default behavior to determine whether we flush or not. If it is C<0> do not flush the handle before closing. Notice that buffers are flushed to the handle no matter what, but the handle may not also be flushed. This may cause problems for e.g. file descriptors that may require to be flushed at the OS level before closing to ensure that data is delivered. =item C Legacy wrapper for Parrot_io_close. Deprecated. Do not use. =cut */ PARROT_EXPORT INTVAL Parrot_io_close_handle(PARROT_INTERP, ARGMOD(PMC *pmc)) { ASSERT_ARGS(Parrot_io_close_handle) return Parrot_io_close(interp, pmc, -1); } PARROT_EXPORT INTVAL Parrot_io_close(PARROT_INTERP, ARGMOD(PMC *handle), INTVAL autoflush) { ASSERT_ARGS(Parrot_io_close) if (PMC_IS_NULL(handle)) return 0; else { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); IO_BUFFER * const write_buffer = IO_GET_WRITE_BUFFER(interp, handle); IO_BUFFER * const read_buffer = IO_GET_READ_BUFFER(interp, handle); if (write_buffer) Parrot_io_buffer_flush(interp, write_buffer, handle, vtable); if (read_buffer) Parrot_io_buffer_clear(interp, read_buffer); /* TODO: We need to better-document the autoflush values, and maybe turn it into an enum or a series of typedefs */ if (autoflush == -1) autoflush == (vtable->flags & PIO_VF_FLUSH_ON_CLOSE) ? 1 : 0; if (autoflush == 1) vtable->flush(interp, handle); return vtable->close(interp, handle); } } /* =item C Test whether the handle C is closed. Return C<1> if it is closed, C<0> otherwise. If C is NULL or not a valid handle, it may always return C<1>. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT INTVAL Parrot_io_is_closed(PARROT_INTERP, ARGIN(PMC *pmc)) { ASSERT_ARGS(Parrot_io_is_closed) if (PMC_IS_NULL(pmc)) return 1; else { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, pmc); return !vtable->is_open(interp, pmc); } } /* =item C Flush the handle C. Write buffers are flushed to the handle first, then the handle is flushed. Notice that read buffers are not modified. =item C Flush the handle. This is a legacy wrapper function and is deprecated. Use Parrot_io_flush instead. =cut */ PARROT_EXPORT void Parrot_io_flush_handle(PARROT_INTERP, ARGMOD(PMC *pmc)) { ASSERT_ARGS(Parrot_io_flush_handle) Parrot_io_flush(interp, pmc); } PARROT_EXPORT size_t Parrot_io_flush(PARROT_INTERP, ARGMOD(PMC *handle)) { ASSERT_ARGS(Parrot_io_flush) if (PMC_IS_NULL(handle)) return 0; if (Parrot_io_is_closed(interp, handle)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Cannot flush a closed handle"); else { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); IO_BUFFER * const write_buffer = IO_GET_WRITE_BUFFER(interp, handle); if (write_buffer) Parrot_io_buffer_flush(interp, write_buffer, handle, vtable); return vtable->flush(interp, handle); } } /* =item C Return a new C containing C characters read from handle C. Notice that the number of bytes read may be more than the number of characters requested for multi-byte encodings. Notice that incomplete codepoints will not be included in the returned string. This routine will throw an exception if the handle C is null or if it is not opened for reading. Notice that this routine may automatically add a read buffer to the handle if required for multi-byte encodings. =item C This is a legacy wrapper for Parrot_io_read_s. Do not use. This is deprecated. =item C A legacy wrapper around Parrot_io_read_s, typically used for sockets. Deprecated. Do not use. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * Parrot_io_reads(PARROT_INTERP, ARGMOD(PMC *pmc), size_t length) { ASSERT_ARGS(Parrot_io_reads) return Parrot_io_read_s(interp, pmc, length); } PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * Parrot_io_read_s(PARROT_INTERP, ARGMOD(PMC *handle), size_t length) { ASSERT_ARGS(Parrot_io_read_s) if (PMC_IS_NULL(handle)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Attempt to read from null or invalid PMC"); if (!length) return STRINGNULL; { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); IO_BUFFER * read_buffer = IO_GET_READ_BUFFER(interp, handle); IO_BUFFER * const write_buffer = IO_GET_WRITE_BUFFER(interp, handle); const STR_VTABLE * encoding = vtable->get_encoding(interp, handle); STRING * s; /* read_s requires us to read in a whole number of characters, which might be multi-byte. This requires a read buffer. */ /* TODO: If we have a fixed8 encoding or similar, we should be able to avoid using a read_buffer here. Detect that case and don't assign a buffer if not needed. */ if (read_buffer == NULL) read_buffer = io_verify_has_read_buffer(interp, handle, vtable, BUFFER_SIZE_ANY); io_verify_is_open_for(interp, handle, vtable, PIO_F_READ); io_sync_buffers_for_read(interp, handle, vtable, read_buffer, write_buffer); s = io_read_encoded_string(interp, handle, vtable, read_buffer, encoding, length); PARROT_ASSERT(s->strlen <= length); return s; } } PARROT_EXPORT PARROT_CANNOT_RETURN_NULL STRING * Parrot_io_recv_handle(PARROT_INTERP, ARGMOD(PMC *pmc), size_t len) { ASSERT_ARGS(Parrot_io_recv_handle) return Parrot_io_read_s(interp, pmc, len); } /* =item C Read the remainder of text from the handle, returning all complete codepoints in a C. Notice that some bytes which represent incomplete an incomplete codepoint at the end of the input may be omitted. Notice that this routine may automatically allocate a read buffer for multi-byte encodeded inputs. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * Parrot_io_readall_s(PARROT_INTERP, ARGMOD(PMC *handle)) { ASSERT_ARGS(Parrot_io_readall_s) const IO_VTABLE * vtable; if (PMC_IS_NULL(handle)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Attempt to read from null or invalid PMC"); vtable = IO_GET_VTABLE(interp, handle); io_verify_is_open_for(interp, handle, vtable, PIO_F_READ); { /* TODO: Refactor this stuff out into helper methods to be less confusing and verbose here. */ /* TODO: Do not automatically allocate a buffer for fixed8 encoded strings. */ IO_BUFFER * const write_buffer = IO_GET_WRITE_BUFFER(interp, handle); const STR_VTABLE * const encoding = io_get_encoding(interp, handle, vtable, PIO_F_READ); size_t total_size = vtable->total_size(interp, handle); if (total_size == 0) return Parrot_str_new_init(interp, "", 0, encoding, 0); if (total_size == PIO_UNKNOWN_SIZE) { IO_BUFFER * const read_buffer = io_verify_has_read_buffer(interp, handle, vtable, BUFFER_FLAGS_ANY); size_t available_bytes = Parrot_io_buffer_fill(interp, read_buffer, handle, vtable); STRING * const s = io_get_new_empty_string(interp, encoding, -1, PIO_STRING_BUFFER_MINSIZE); io_sync_buffers_for_read(interp, handle, vtable, read_buffer, write_buffer); while (available_bytes > 0 && !Parrot_io_eof(interp, handle)) { io_read_chars_append_string(interp, s, handle, vtable, read_buffer, available_bytes); available_bytes = Parrot_io_buffer_fill(interp, read_buffer, handle, vtable); } return s; } else { size_t remaining_size = total_size - vtable->get_position(interp, handle); IO_BUFFER * const read_buffer = IO_GET_READ_BUFFER(interp, handle); STRING * const s = io_get_new_empty_string(interp, encoding, -1, remaining_size); io_sync_buffers_for_read(interp, handle, vtable, read_buffer, write_buffer); if (remaining_size > 0 && !Parrot_io_eof(interp, handle)) io_read_chars_append_string(interp, s, handle, vtable, read_buffer, remaining_size); return s; } } } /* =item C Read C bytes from the C into the C (ByteBuffer) PMC. =item C Write C bytes (or the total length of C, whichever is smaller) from C to the C =cut */ PARROT_EXPORT PARROT_CANNOT_RETURN_NULL PMC * Parrot_io_read_byte_buffer_pmc(PARROT_INTERP, ARGMOD(PMC *handle), ARGMOD_NULLOK(PMC *buffer), size_t byte_length) { ASSERT_ARGS(Parrot_io_read_byte_buffer_pmc) if (PMC_IS_NULL(handle)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Attempt to read bytes from a null or invalid PMC"); if (PMC_IS_NULL(buffer)) buffer = Parrot_pmc_new(interp, enum_class_ByteBuffer); if (!byte_length) return buffer; { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); IO_BUFFER * const read_buffer = IO_GET_READ_BUFFER(interp, handle); IO_BUFFER * const write_buffer = IO_GET_WRITE_BUFFER(interp, handle); size_t bytes_read; char * content; /* Prepare to read */ io_verify_is_open_for(interp, handle, vtable, PIO_F_READ); io_sync_buffers_for_read(interp, handle, vtable, read_buffer, write_buffer); /* If the user has not specified a read size, we want to get data as lazily as possible. If we have something in the buffer, read that out. Otherwise, fill the buffer and use whatever we get. */ if (byte_length == PIO_READ_SIZE_ANY) { const size_t available_bytes = BUFFER_USED_SIZE(read_buffer); if (available_bytes >= read_buffer->encoding->max_bytes_per_codepoint) byte_length = available_bytes; else byte_length = Parrot_io_buffer_fill(interp, read_buffer, handle, vtable); if (byte_length <= 0) return buffer; } VTABLE_set_integer_native(interp, buffer, byte_length); content = (char *)VTABLE_get_pointer(interp, buffer); bytes_read = Parrot_io_buffer_read_b(interp, read_buffer, handle, vtable, content, byte_length); /* If we read less than we requested, re-size the buffer. If we got no bytes, we're at EOF. If we got something, advance the handle to account for whatever we read. */ if (bytes_read != byte_length) VTABLE_set_integer_native(interp, buffer, bytes_read); if (bytes_read == 0) vtable->set_eof(interp, handle, 1); vtable->adv_position(interp, handle, bytes_read); return buffer; } } INTVAL Parrot_io_write_byte_buffer_pmc(PARROT_INTERP, ARGMOD(PMC * handle), ARGMOD(PMC *buffer), size_t byte_length) { ASSERT_ARGS(Parrot_io_write_byte_buffer_pmc) if (PMC_IS_NULL(buffer)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Attempt to read bytes from a null or invalid ByteBuffer"); if (!byte_length) return 0; { char *content = (char *)VTABLE_get_pointer(interp, buffer); size_t real_length = (size_t)VTABLE_elements(interp, buffer); if (real_length < byte_length) byte_length = real_length; return Parrot_io_write_b(interp, handle, content, byte_length); } } /* =item C Return a new C holding the next line read from the file starting from the current read position until the next instance of the C character or the end of the input. This function will not return incomplete codepoints at the end of the string if enough data to complete the final codepoint is not available to be read. Notice that this function may automatically allocate a buffer for multi-byte encoded strings. =item C Legacy wrapper for Parrot_io_readline_s. Deprecated. Do not use. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * Parrot_io_readline(PARROT_INTERP, ARGMOD(PMC *handle)) { ASSERT_ARGS(Parrot_io_readline) STRING * terminator; GETATTR_Handle_record_separator(interp, handle, terminator); return Parrot_io_readline_s(interp, handle, terminator); } PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * Parrot_io_readline_s(PARROT_INTERP, ARGMOD(PMC *handle), ARGIN(STRING * terminator)) { ASSERT_ARGS(Parrot_io_readline_s) if (PMC_IS_NULL(handle)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Attempt to read bytes from a null or invalid PMC"); if (STRING_IS_NULL(terminator) || STRING_length(terminator) == 0) terminator = CONST_STRING(interp, "\n"); { /* TODO: Try not to automatically allocate a read buffer for fixed8 strings. */ const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); IO_BUFFER * read_buffer = IO_GET_READ_BUFFER(interp, handle); IO_BUFFER * const write_buffer = IO_GET_WRITE_BUFFER(interp, handle); INTVAL flags = Parrot_io_get_flags(interp, handle); size_t bytes_read; STRING *result; size_t max_delimiter_byte_size = 0; io_sync_buffers_for_read(interp, handle, vtable, read_buffer, write_buffer); io_verify_is_open_for(interp, handle, vtable, PIO_F_READ); if (read_buffer == NULL) read_buffer = io_verify_has_read_buffer(interp, handle, vtable, BUFFER_SIZE_ANY); /* Because of the way buffering works, the terminator sequence may be, at most, one character shorter than half the size of the buffer. Most cases will use "\n" or "\r\n" or some permutation thereof, so this isn't a big deal. */ max_delimiter_byte_size = (read_buffer->buffer_size / 2) - STRING_max_bytes_per_codepoint(terminator); if (terminator->bufused > max_delimiter_byte_size) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Readline terminator string must be smaller than %d bytes for this buffer"); return io_readline_encoded_string(interp, handle, vtable, read_buffer, NULL, terminator); } } /* =item C Writes C bytes from C<*buffer> to C<*pmc>. This is for raw outputs and does not take into account string encodings or other features. The handle C must be a valid handle type and must be opened for writing. If the handle has a buffer set up, the data may be written to the buffer and not written out to the handle, depending on settings. =item C Legacy wrapper for Parrot_io_write_b. Deprecated. Do not use. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT size_t Parrot_io_write_b(PARROT_INTERP, ARGMOD(PMC *handle), ARGIN(const void *buffer), size_t byte_length) { ASSERT_ARGS(Parrot_io_write_b) if (PMC_IS_NULL(handle)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Attempt to write bytes to a null or invalid PMC"); if (!byte_length) return 0; { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); IO_BUFFER * const write_buffer = IO_GET_WRITE_BUFFER(interp, handle); IO_BUFFER * const read_buffer = IO_GET_READ_BUFFER(interp, handle); size_t bytes_written; io_verify_is_open_for(interp, handle, vtable, PIO_F_WRITE); io_sync_buffers_for_write(interp, handle, vtable, read_buffer, write_buffer); bytes_written = Parrot_io_buffer_write_b(interp, write_buffer, handle, vtable, (char *)buffer, byte_length); vtable->adv_position(interp, handle, bytes_written); /* If we are writing to a r/w handle, advance the pointer in the associated read-buffer since we're overwriting those characters. */ Parrot_io_buffer_advance_position(interp, read_buffer, bytes_written); return bytes_written; } } /* =item C Write Parrot C C to the handle C. C may be re-encoded to match the specified encoding for C. If the C has a write buffer set up, the data may be written to the buffer only and not written to the C. Returns the total number of bytes written. =cut */ PARROT_EXPORT INTVAL Parrot_io_write_s(PARROT_INTERP, ARGMOD(PMC *handle), ARGIN(STRING *s)) { ASSERT_ARGS(Parrot_io_write_s) if (PMC_IS_NULL(handle)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Attempt to write a string to a null or invalid PMC"); if (STRING_IS_NULL(s) || STRING_length(s) == 0) return 0; { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); IO_BUFFER * const write_buffer = IO_GET_WRITE_BUFFER(interp, handle); IO_BUFFER * const read_buffer = IO_GET_READ_BUFFER(interp, handle); STRING *out_s; size_t bytes_written; io_verify_is_open_for(interp, handle, vtable, PIO_F_WRITE); io_sync_buffers_for_write(interp, handle, vtable, read_buffer, write_buffer); out_s = io_verify_string_encoding(interp, handle, vtable, s, PIO_F_WRITE); bytes_written = Parrot_io_buffer_write_b(interp, write_buffer, handle, vtable, out_s->strstart, out_s->bufused); vtable->adv_position(interp, handle, bytes_written); /* If we are writing to a r/w handle, advance the pointer in the associated read-buffer since we're overwriting those characters. */ Parrot_io_buffer_advance_position(interp, read_buffer, bytes_written); return bytes_written; } } /* =item C Moves the read/write position of C<*pmc> to offset C from the position indicated by C. Typically C will be C<0> for the start of the file, C<1> for the current position, and C<2> for the end. Notice that this affects Parrot's in-memory file position and not necessarily the on-disk file position according to the operating system (or whatever the equivalent operation is for the given type of C). =item C Legacy wrapper for Parrot_io_seek. Deprecated. Do not use. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PIOOFF_T Parrot_io_seek_handle(PARROT_INTERP, ARGMOD(PMC *handle), PIOOFF_T offset, INTVAL w) { ASSERT_ARGS(Parrot_io_seek_handle) return Parrot_io_seek(interp, handle, offset, w); } PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PIOOFF_T Parrot_io_seek(PARROT_INTERP, ARGMOD(PMC *handle), PIOOFF_T offset, INTVAL w) { ASSERT_ARGS(Parrot_io_seek) if (Parrot_io_is_closed(interp, handle)) return -1; { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); IO_BUFFER * const read_buffer = IO_GET_READ_BUFFER(interp, handle); IO_BUFFER * const write_buffer = IO_GET_WRITE_BUFFER(interp, handle); /* Because of buffering we cannot really seek from the current file position. Take the current file position and turn it into an offset relative to the beginning of the file. */ if (w == SEEK_CUR) { const PIOOFF_T file_pos = vtable->get_position(interp, handle); offset += file_pos; w = SEEK_SET; } /* If we have a write buffer, flush that out to disk before we attempt to do any seek operation. We need the data there before we can seek. */ if (write_buffer) Parrot_io_buffer_flush(interp, write_buffer, handle, vtable); if (read_buffer && w != SEEK_END) { const PIOOFF_T new_offset = Parrot_io_buffer_seek(interp, read_buffer, handle, vtable, offset, w); vtable->set_position(interp, handle, new_offset); return new_offset; } return vtable->seek(interp, handle, offset, w); } } /* =item C Returns the current read/write position of C<*pmc>. Notice that this position information may be calculated depending on the presence of buffers and other factors and may not accurately represent the on-disk position according to the operating system (or the equivalent for other types). =item C Legacy wrapper for Parrot_io_tell. Deprecated. Do not use. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PIOOFF_T Parrot_io_tell_handle(PARROT_INTERP, ARGMOD(PMC *handle)) { ASSERT_ARGS(Parrot_io_tell_handle) return Parrot_io_tell(interp, handle); } PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PIOOFF_T Parrot_io_tell(PARROT_INTERP, ARGMOD(PMC *handle)) { ASSERT_ARGS(Parrot_io_tell) if (Parrot_io_is_closed(interp, handle)) return -1; { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); IO_BUFFER * const read_buffer = IO_GET_READ_BUFFER(interp, handle); IO_BUFFER * const write_buffer = IO_GET_WRITE_BUFFER(interp, handle); if (write_buffer) Parrot_io_buffer_flush(interp, write_buffer, handle, vtable); return Parrot_io_buffer_tell(interp, read_buffer, handle, vtable); } } /* =item C Retrieve the next byte in the stream without modifying the stream. May peek from the read buffer and may configure a read buffer if one does not already exist. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING * Parrot_io_peek(PARROT_INTERP, ARGMOD(PMC *handle)) { ASSERT_ARGS(Parrot_io_peek) if (PMC_IS_NULL(handle) || Parrot_io_is_closed(interp, handle)) return STRINGNULL; { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); IO_BUFFER * const read_buffer = IO_GET_READ_BUFFER(interp, handle); const INTVAL c = Parrot_io_buffer_peek(interp, read_buffer, handle, vtable); if (c == -1) return STRINGNULL; else return Parrot_str_chr(interp, c); } } /* =item C Returns C<1> if the C is at end-of-file (or the type-specific equivalent). Returns C<1> if the handle is null, closed, or otherwise not accessible. Notice that this tells the position of Parrot's in-memory read cursor and not the on-disk position according to the operating system. If the handle has been exhausted but unread data remains in the read buffer, the handle is not considered to be at EOF. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT INTVAL Parrot_io_eof(PARROT_INTERP, ARGMOD(PMC *handle)) { ASSERT_ARGS(Parrot_io_eof) INTVAL flags, result; /* io could be null here, but rather than return a negative error * we just fake EOF since eof test is usually in a boolean context. */ if (PMC_IS_NULL(handle)) return 1; if (Parrot_io_is_closed(interp, handle)) return 1; { IO_BUFFER * const buffer = IO_GET_READ_BUFFER(interp, handle); const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); if (buffer) return BUFFER_IS_EMPTY(buffer) && vtable->is_eof(interp, handle); return vtable->is_eof(interp, handle); } } /* =item C Legacy wrapper for Parrot_io_write_b. Deprecated. Do not use =cut */ PARROT_EXPORT INTVAL Parrot_io_puts(PARROT_INTERP, ARGMOD(PMC *pmc), ARGIN(const char *s)) { ASSERT_ARGS(Parrot_io_puts) return Parrot_io_write_b(interp, pmc, s, strlen(s)); } /* =item C Legacy Wrapper for Parrot_io_write_s. Deprecated. Do not use. =cut */ PARROT_EXPORT INTVAL Parrot_io_putps(PARROT_INTERP, ARGMOD(PMC *pmc), ARGMOD(STRING *s)) { ASSERT_ARGS(Parrot_io_putps) return Parrot_io_write_s(interp, pmc, s); } /* =item C Writes a C string format with varargs to C<*pmc>. Uses Parrot_io_write_s to write the formatted string, and is subject to all the limitations thereof. =cut */ PARROT_EXPORT PARROT_IGNORABLE_RESULT INTVAL Parrot_io_fprintf(PARROT_INTERP, ARGMOD(PMC *pmc), ARGIN(const char *s), ...) { ASSERT_ARGS(Parrot_io_fprintf) va_list args; INTVAL ret; va_start(args, s); { STRING * const str = Parrot_vsprintf_c(interp, s, args); ret = Parrot_io_write_s(interp, pmc, str); } va_end(args); return ret; } /* =item C Writes a C string format with varargs to PIOHANDLE C. Writes directly to the givem C without any intermediate buffering or other logic common to Parrot Handle PMCs. =cut */ PARROT_EXPORT PARROT_IGNORABLE_RESULT INTVAL Parrot_io_pprintf(PARROT_INTERP, PIOHANDLE os_handle, ARGIN(const char *s), ...) { ASSERT_ARGS(Parrot_io_pprintf) va_list args; STRING *str; INTVAL ret; va_start(args, s); str = Parrot_vsprintf_c(interp, s, args); va_end(args); return Parrot_io_internal_write(interp, os_handle, str->strstart, str->bufused); } /* =item C Writes a C string format with varargs to C. This routine uses Parrot_io_write_s to perform the actual right, and is therefore subject to all the same semantics and limitations. =cut */ PARROT_EXPORT PARROT_IGNORABLE_RESULT INTVAL Parrot_io_printf(PARROT_INTERP, ARGIN(const char *s), ...) { ASSERT_ARGS(Parrot_io_printf) va_list args; INTVAL ret; va_start(args, s); if (interp) { STRING * const str = Parrot_vsprintf_c(interp, s, args); ret = Parrot_io_write_s(interp, _PIO_STDOUT(interp), str); } else ret = vfprintf(stdout, s, args); va_end(args); return ret; } /* =item C Writes a C string format with varargs to C. This routine uses Parrot_io_write_s to perform the actual right, and is therefore subject to all the same semantics and limitations. =cut */ PARROT_EXPORT PARROT_IGNORABLE_RESULT INTVAL Parrot_io_eprintf(NULLOK(PARROT_INTERP), ARGIN(const char *s), ...) { ASSERT_ARGS(Parrot_io_eprintf) va_list args; INTVAL ret; va_start(args, s); if (interp) { STRING * const str = Parrot_vsprintf_c(interp, s, args); ret = Parrot_io_write_s(interp, _PIO_STDERR(interp), str); } else ret = vfprintf(stderr, s, args); va_end(args); return ret; } /* =item C This is a legacy wrapper for Parrot_io_get_os_handle. Deprecated. Do not use. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PIOHANDLE Parrot_io_getfd(PARROT_INTERP, ARGIN(PMC *pmc)) { ASSERT_ARGS(Parrot_io_getfd) return Parrot_io_get_os_handle(interp, pmc); } /* =item C Returns a boolean value indicating whether C<*pmc> is a console/tty. Returns C<0> if the C is null or closed. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT INTVAL Parrot_io_is_tty_handle(PARROT_INTERP, ARGIN(PMC *pmc)) { ASSERT_ARGS(Parrot_io_is_tty_handle) if (Parrot_io_is_closed(interp, pmc)) return 0; return (Parrot_io_get_flags(interp, pmc) & PIO_F_CONSOLE) ? 1 : 0; } /* =item C Returns 0 for now. Parrot does not support async operations. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT INTVAL Parrot_io_is_async(PARROT_INTERP, ARGMOD(PMC *pmc)) { ASSERT_ARGS(Parrot_io_is_async) if (Parrot_io_is_closed(interp, pmc)) return 0; /* return (Parrot_io_get_flags(interp, pmc) & PIO_F_ASYNC) ? 1 : 0; */ return 0; } /* =back =head2 C Functions =over 4 =item C Returns the C PMC for C. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_io_STDIN(PARROT_INTERP) { ASSERT_ARGS(Parrot_io_STDIN) return _PIO_STDIN(interp); } /* =item C Returns the C PMC for C. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_io_STDOUT(PARROT_INTERP) { ASSERT_ARGS(Parrot_io_STDOUT) return _PIO_STDOUT(interp); } /* =item C Returns the C PMC for C. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_io_STDERR(PARROT_INTERP) { ASSERT_ARGS(Parrot_io_STDERR) return _PIO_STDERR(interp); } /* =item C Get the raw PIOHANDLE for one of the standard streams. Notice that this will FAIL in a bad way if the standard stream has been overridden with a handle type that isn't backed by a PIOHANDLE (StringHandle, etc). This function is a temporary stopgap solution and SHOULD NOT be used where possible. Instead, use the handle PMCs and functions on those directly instead of attempting lower-level accesses on the PIOHANDLE directly. =cut */ PARROT_WARN_UNUSED_RESULT PIOHANDLE Parrot_io_get_standard_piohandle(PARROT_INTERP, INTVAL idx) { ASSERT_ARGS(Parrot_io_get_standard_piohandle) PMC * handle_pmc; switch (idx) { case PIO_STDIN_FILENO: handle_pmc = _PIO_STDIN(interp); break; case PIO_STDOUT_FILENO: handle_pmc = _PIO_STDOUT(interp); break; case PIO_STDERR_FILENO: handle_pmc = _PIO_STDERR(interp); break; default: Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Unknown standard handle %d", idx); } { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle_pmc); return vtable->get_piohandle(interp, handle_pmc); } } /* =back =head2 Offset Functions These are used to create offsets for the C op. =over 4 =item C Returns C. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PIOOFF_T Parrot_io_make_offset(INTVAL offset) { ASSERT_ARGS(Parrot_io_make_offset) return offset; } /* =item C C is shifted 32 bytes to the left and Ced together with C. This allows 64-bit seeks with only 32-bit C. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PIOOFF_T Parrot_io_make_offset32(INTVAL hi, INTVAL lo) { ASSERT_ARGS(Parrot_io_make_offset32) return ((PIOOFF_T)hi << 31) | lo; } /* =item C Returns the return value of the C vtable on C<*pmc>. =cut */ PARROT_WARN_UNUSED_RESULT PIOOFF_T Parrot_io_make_offset_pmc(PARROT_INTERP, ARGMOD(PMC *pmc)) { ASSERT_ARGS(Parrot_io_make_offset_pmc) /* TODO: This seems worthless. Kill it if not needed. */ return VTABLE_get_integer(interp, pmc); } /* =item C Polls C<*pmc> for the events in C every C seconds + C microseconds. =cut */ PARROT_EXPORT INTVAL Parrot_io_poll(PARROT_INTERP, ARGMOD(PMC *pmc), INTVAL which, INTVAL sec, INTVAL usec) { ASSERT_ARGS(Parrot_io_poll) /* TODO: Can we move this to the IO_VTABLE and make it usable for all types? */ Parrot_Socket_attributes *io = PARROT_SOCKET(pmc); if (Parrot_io_is_closed(interp, pmc)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Can't poll closed socket"); return Parrot_io_internal_poll(interp, io->os_handle, which, sec, usec); } /* =item C Connects Socket C to the given C
    . Notice that this operation is only valid for Sockets. Throws an exception if the socket is closed or if a valid address is not provided. =cut */ PARROT_EXPORT void Parrot_io_socket_connect(PARROT_INTERP, ARGMOD(PMC *pmc), ARGMOD(PMC *address)) { ASSERT_ARGS(Parrot_io_socket_connect) Parrot_Socket_attributes * const io = PARROT_SOCKET(pmc); int i; /* TODO: Move most of this logic to src/io/socket.c */ if (Parrot_io_is_closed(interp, pmc)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Can't connect closed socket"); if (PMC_IS_NULL(address)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Address is null"); /* Iterate over all addresses if an array is passed */ if (address->vtable->base_type != enum_class_Sockaddr) { INTVAL len = VTABLE_elements(interp, address); for (i = 0; i < len; ++i) { PMC *sa = VTABLE_get_pmc_keyed_int(interp, address, i); Parrot_Sockaddr_attributes * const sa_data = PARROT_SOCKADDR(sa); if (!Parrot_io_internal_addr_match(interp, sa, io->family, io->type, io->protocol)) continue; io->remote = sa; Parrot_io_internal_connect(interp, io->os_handle, sa_data->pointer, sa_data->len); return; } Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "No address found for family %d, type %d, proto %d", io->family, io->type, io->protocol); } io->remote = address; Parrot_io_internal_connect(interp, io->os_handle, VTABLE_get_pointer(interp, address), VTABLE_get_integer(interp, address)); } /* =item C Binds Socket C<*pmc>'s socket to the local address and port specified by C<*address>. Throws an exception if the Socket is closed or if C
    is not valid. This operation only works for Sockets. =cut */ PARROT_EXPORT void Parrot_io_socket_bind(PARROT_INTERP, ARGMOD(PMC *pmc), ARGMOD(PMC *address)) { ASSERT_ARGS(Parrot_io_socket_bind) Parrot_Socket_attributes * const io = PARROT_SOCKET(pmc); int i; /* TODO: Move most of this logic to src/io/socket.c */ if (Parrot_io_is_closed(interp, pmc)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Can't bind closed socket"); if (PMC_IS_NULL(address)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Address is null"); /* Iterate over all addresses if an array is passed */ if (address->vtable->base_type != enum_class_Sockaddr) { INTVAL len = VTABLE_elements(interp, address); for (i = 0; i < len; ++i) { PMC *sa = VTABLE_get_pmc_keyed_int(interp, address, i); Parrot_Sockaddr_attributes * const sa_data = PARROT_SOCKADDR(sa); if (!Parrot_io_internal_addr_match(interp, sa, io->family, io->type, io->protocol)) continue; io->local = sa; Parrot_io_internal_bind(interp, io->os_handle, sa_data->pointer, sa_data->len); return; } Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "No address found for family %d, type %d, proto %d", io->family, io->type, io->protocol); } io->local = address; Parrot_io_internal_bind(interp, io->os_handle, VTABLE_get_pointer(interp, address), VTABLE_get_integer(interp, address)); } /* =item C Listens for new connections on socket C<*pmc>. Throws an exception if C is closed. Notice that this operation only works for Sockets. =cut */ PARROT_EXPORT void Parrot_io_socket_listen(PARROT_INTERP, ARGMOD(PMC *pmc), INTVAL backlog) { ASSERT_ARGS(Parrot_io_socket_listen) const Parrot_Socket_attributes * const io = PARROT_SOCKET(pmc); if (Parrot_io_is_closed(interp, pmc)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Can't listen on closed socket"); Parrot_io_internal_listen(interp, io->os_handle, backlog); } /* =item C Accepts a new connection and returns a newly created C socket. Returns C on failure. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_io_socket_accept(PARROT_INTERP, ARGMOD(PMC *pmc)) { ASSERT_ARGS(Parrot_io_socket_accept) /* TODO: Move most of this logic to src/io/socket.c */ Parrot_Socket_attributes *io = PARROT_SOCKET(pmc); Parrot_Socket_attributes *new_io; PMC *new_pmc; if (Parrot_io_is_closed(interp, pmc)) return PMCNULL; new_pmc = io_get_new_socket(interp); new_io = PARROT_SOCKET(new_pmc); new_io->local = io->local; new_io->remote = Parrot_pmc_new(interp, enum_class_Sockaddr); new_io->os_handle = Parrot_io_internal_accept(interp, io->os_handle, new_io->remote); return new_pmc; } /* =item C Creates a new I/O socket object. The value of C is set in the returned PMC. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL PMC * Parrot_io_socket_new(PARROT_INTERP, INTVAL flags) { ASSERT_ARGS(Parrot_io_socket_new) PMC * const sock = io_get_new_socket(interp); Parrot_io_set_flags(interp, sock, flags); return sock; } /* =item C Gets the current handle flags. =item C Sets the current handle flags. =cut */ PARROT_WARN_UNUSED_RESULT INTVAL Parrot_io_get_flags(PARROT_INTERP, ARGIN(PMC *handle)) { ASSERT_ARGS(Parrot_io_get_flags) if (PMC_IS_NULL(handle)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Cannot get flags for null or invalid PMC"); { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); return vtable->get_flags(interp, handle); } } void Parrot_io_set_flags(PARROT_INTERP, ARGIN(PMC *handle), INTVAL flags) { ASSERT_ARGS(Parrot_io_set_flags) if (PMC_IS_NULL(handle)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Cannot set flags for null or invalid PMC"); { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); vtable->set_flags(interp, handle, flags); } } /* =item C Gets the OS handle (socket, file descriptor, etc) for the C PMC. =cut */ PARROT_WARN_UNUSED_RESULT PIOHANDLE Parrot_io_get_os_handle(PARROT_INTERP, ARGIN(PMC *handle)) { ASSERT_ARGS(Parrot_io_get_os_handle) if (PMC_IS_NULL(handle)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Cannot get a PIOHANDLE from a NULL or invalid PMC"); { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); return vtable->get_piohandle(interp, handle); } } /* =item C Sets up buffering on C according to string C. This is a function for legacy compatibility and will disappear eventually. Do not use. =item C Gets a string representation of the current buffer settings for C.This is a function for legacy compatibility and will disappear eventually. Do not use. =item C Legacy routine to pretend get/set buffer size info for the old FileHandle interface. =cut */ void Parrot_io_set_buffer_mode(PARROT_INTERP, ARGMOD(PMC *handle), ARGIN(STRING *mode)) { ASSERT_ARGS(Parrot_io_set_buffer_mode) /* This is a compatibility function for old-style buffer setting by mode name. A newer interface will need to be used with the new buffering system to take advantage of all its power. Notice that the new system uses separate read/write buffers, so we have to act on them separately. */ if (STRING_equal(interp, mode, CONST_STRING(interp, "unbuffered"))) { Parrot_io_buffer_remove_from_handle(interp, handle, IO_PTR_IDX_READ_BUFFER); Parrot_io_buffer_remove_from_handle(interp, handle, IO_PTR_IDX_WRITE_BUFFER); } else if (STRING_equal(interp, mode, CONST_STRING(interp, "line-buffered"))) { Parrot_io_buffer_add_to_handle(interp, handle, IO_PTR_IDX_READ_BUFFER, BUFFER_SIZE_ANY, PIO_BF_LINEBUF); Parrot_io_buffer_add_to_handle(interp, handle, IO_PTR_IDX_WRITE_BUFFER, BUFFER_SIZE_ANY, PIO_BF_LINEBUF); } else if (STRING_equal(interp, mode, CONST_STRING(interp, "full-buffered"))) { Parrot_io_buffer_add_to_handle(interp, handle, IO_PTR_IDX_READ_BUFFER, BUFFER_SIZE_ANY, PIO_BF_BLKBUF); Parrot_io_buffer_add_to_handle(interp, handle, IO_PTR_IDX_WRITE_BUFFER, BUFFER_SIZE_ANY, PIO_BF_BLKBUF); } else Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Unknown buffering type %Ss", mode); } PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT STRING * Parrot_io_get_buffer_mode(PARROT_INTERP, ARGMOD(PMC *handle)) { ASSERT_ARGS(Parrot_io_get_buffer_mode) /* This is a compatibility function for old style buffer mode names. This is a hack, because the current system is much more flexible than the old system and the buffer configuration on a handle cannot really be described in a one-word string like it could previously. Do whatever it takes to replicate the old behavior (even if it doesn't make sense). */ IO_BUFFER * const read_buffer = IO_GET_READ_BUFFER(interp, handle); IO_BUFFER * const write_buffer = IO_GET_WRITE_BUFFER(interp, handle); if (!read_buffer && !write_buffer) return CONST_STRING(interp, "unbuffered"); if (write_buffer->flags & PIO_BF_LINEBUF) return CONST_STRING(interp, "line-buffered"); return CONST_STRING(interp, "full-buffered"); } PARROT_WARN_UNUSED_RESULT INTVAL Parrot_io_buffer_size(PARROT_INTERP, ARGMOD(PMC *handle), INTVAL size, INTVAL has_size) { ASSERT_ARGS(Parrot_io_buffer_size) if (has_size) Parrot_io_buffer_add_to_handle(interp, handle, IO_PTR_IDX_READ_BUFFER, size, PIO_BF_BLKBUF); { IO_BUFFER * const read_buffer = IO_GET_READ_BUFFER(interp, handle); return read_buffer == NULL ? 0 : read_buffer->buffer_size; } } /* =item C Verify that the given string matches the encoding for the given handle. If so, return it directly. If not, create a new string with the proper encoding and return that. =cut */ PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT STRING * Parrot_io_reencode_string_for_handle(PARROT_INTERP, ARGIN(PMC *handle), ARGIN_NULLOK(STRING *str)) { ASSERT_ARGS(Parrot_io_reencode_string_for_handle) if (PMC_IS_NULL(handle)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Handle may not be null"); if (STRING_IS_NULL(str)) return STRINGNULL; { const IO_VTABLE * const vtable = IO_GET_VTABLE(interp, handle); const STR_VTABLE * const encoding = vtable->get_encoding(interp, handle); if (encoding != NULL && str->encoding != encoding) return encoding->to_encoding(interp, str); return str; } } /* =item C Return a protocol number given a protocol name. =cut */ PARROT_EXPORT PARROT_WARN_UNUSED_RESULT INTVAL Parrot_io_getprotobyname(PARROT_INTERP, ARGIN(STRING * name)) { ASSERT_ARGS(Parrot_io_getprotobyname) return Parrot_io_internal_getprotobyname(interp, name); } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ getopt_demo.pir000644000765000765 1016511533177634 21052 0ustar00brucebruce000000000000parrot-5.9.0/examples/library# Copyright (C) 2004-2008, Parrot Foundation. =head1 NAME examples/library/getopt_demo.pir - demonstrating use of the module Getopt/Obj.pir =head1 SYNOPSIS % ./parrot examples/library/getopt_demo.pir --help % ./parrot examples/library/getopt_demo.pir --version % ./parrot examples/library/getopt_demo.pir --string=asdf --bool --integer=42 some thing =head1 DESCRIPTION This demo program shows how to handle command line arguments with the PIR library F. =cut =head1 SUBROUTINES =head2 main This is executed when you call F. =cut .sub main :main .param pmc argv load_bytecode "Getopt/Obj.pbc" # shift name of the program, so that argv contains only options and extra params .local string program_name program_name = shift argv # Specification of command line arguments. .local pmc getopts getopts = new ["Getopt";"Obj"] # getopts."notOptStop"(1) # --version, boolean push getopts, "version|v" # --help, boolean push getopts, "help|h" # --bool, boolean push getopts, "bool|b" # --string, string push getopts, "string|s=s" # --integer, integer push getopts, "integer|i=i" .local pmc opt opt = getopts."get_options"(argv) # Now we do what the passed options tell .local int is_defined # Was '--version' passed ? is_defined = defined opt["version"] unless is_defined goto NO_VERSION_FLAG print "getopt_demo.pir 0.04\n" end NO_VERSION_FLAG: # Was '--help' passed ? is_defined = defined opt["help"] unless is_defined goto NO_HELP_FLAG usage( program_name ) end NO_HELP_FLAG: # Say Hi print "Hi, I am 'getopt_demo.pir'.\n" print "\n" # handle the bool option is_defined = defined opt["bool"] unless is_defined goto NO_BOOL_OPTION print "You have passed the option '--bool'.\n" goto END_BOOL_OPTION NO_BOOL_OPTION: print "You haven't passed the option '--bool'. This is fine with me.\n" END_BOOL_OPTION: # handle the string option is_defined = defined opt["string"] unless is_defined goto NO_STRING_OPTION .local string string_option string_option = opt["string"] print "You have passed the option '--string'. The value is '" print string_option print "'.\n" goto END_STRING_OPTION NO_STRING_OPTION: print "You haven't passed the option '--string'. This is fine with me.\n" END_STRING_OPTION: # handle the integer option is_defined = defined opt["integer"] unless is_defined goto NO_INTEGER_OPTION .local string integer_option integer_option = opt["integer"] print "You have passed the option '--integer'. The value is '" print integer_option print "'.\n" goto END_INTEGER_OPTION NO_INTEGER_OPTION: print "You haven't passed the option '--integer'. This is fine with me.\n" END_INTEGER_OPTION: .local string other_arg .local int cnt_other_args cnt_other_args = 0 .local int num_other_args num_other_args = argv goto CHECK_OTHER_ARG_LOOP REDO_OTHER_ARG_LOOP: other_arg = argv[cnt_other_args] print "You have passed the additional argument: '" print other_arg print "'.\n" inc cnt_other_args CHECK_OTHER_ARG_LOOP: if cnt_other_args < num_other_args goto REDO_OTHER_ARG_LOOP print "All args have been parsed.\n" .end =head2 usage Print the usage message. TODO: Pass a flag for EXIT_FAILURE and EXIT_SUCCESS =cut .sub usage .param string program_name print "Usage: ./parrot " print program_name print " [OPTION]... [STRING]...\n" print "\n" print "Operation modes:\n" print " -h --help display this help and exit\n" print " -v --version output version information and exit\n" print "\n" print "For demo of option parsing:\n" print " -s --string=STRING a string option\n" print " -i --integer=INTEGER an integer option\n" print " -b --bool a boolean option\n" .end =head1 AUTHOR Bernhard Schmalhofer - C =head1 SEE ALSO F =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: parrot.pc000644000765000765 111533177646 21007 0ustar00brucebruce000000000000parrot-5.9.0/t/tools/install/testlib tables.h000644000765000765 135511567202625 20031 0ustar00brucebruce000000000000parrot-5.9.0/src/string/encoding/* * Copyright (C) 2005-2010, Parrot Foundation. * * DO NOT EDIT THIS FILE DIRECTLY! * please update the tools/dev/gen_charset_tables.pl script instead. * * This file contains various charset tables. */ /* HEADERIZER HFILE: none */ #ifndef PARROT_CHARSET_TABLES_H_GUARD #define PARROT_CHARSET_TABLES_H_GUARD #include "parrot/cclass.h" #include "parrot/parrot.h" #define WHITESPACE enum_cclass_whitespace #define WORDCHAR enum_cclass_word #define PUNCTUATION enum_cclass_punctuation #define DIGIT enum_cclass_numeric extern const INTVAL Parrot_iso_8859_1_typetable[256]; #endif /* PARROT_CHARSET_TABLES_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ config_lib_pir.in000644000765000765 137012101554066 21766 0ustar00brucebruce000000000000parrot-5.9.0/config/gen/config_pm# Copyright (C) 2004-2012, Parrot Foundation. .include 'datatypes.pasm' .include 'parrot_version.pir' .sub 'main' :main get_params "(0)", $P5 set $I10, $P5 # argv set $I11, 0 # flag le $I10, 1, no_arg set $S10, $P5[1] ne $S10, "--install", no_arg set $I11, 1 # install flag no_arg: new $P0, 'Hash' $P0.'set_value_type'(.DATATYPE_STRING) $S2 = null @PCONFIG@ if $I11, is_install set $S1, "@PWD@" set $P0["prefix"], $S1 set $P0["installed"], "0" branch freeze_config is_install: set $P0["installed"], "1" @NOINSTALL@ freeze_config: freeze $S0, $P0 print $S0 .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: infant.pod000644000765000765 3115212101554066 16224 0ustar00brucebruce000000000000parrot-5.9.0/docs/dev# Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME docs/dev/infant.pod - Infant Mortality =head1 DESCRIPTION This document compares and contrasts several proposals for Parrot's Garbage Collection system. =head1 OVERVIEW We have a garbage collector that needs to detect all dead objects (the process is called the mark phase of GC). Any Parrot operation that might allocate memory can potentially trigger a GC mark run (if not enough memory is available, we need to free up some unused objects to give us enough room to allocate our new object. But in order to know what can be freed up, we need to know what's alive, so we do a GC mark run.) The GC mark run pass begins with a "root set" of objects that are known to be in use -- the PMC and String registers, the Parrot stack, the global symbol table, etc. Each of these objects is scanned for references to other objects, recursively. All objects found during this search are regarded as live. Everything else is considered dead and so is available for reclamation. The question of what should be in the root set is problematic. Consider the case where you've created a PMC. If you immediately stuff it into a register, then you're all set. But what if you're putting it into an aggregate? If the aggregate isn't large enough, you'll need to resize it, which might allocate memory, which might trigger a GC mark run. And that run may free your freshly-created PMC. In this case, the solution is simple: resize the array, if necessary, before creating the PMC. But many situations are not so simple, and the set of operations which could conceivably require more memory is vast. This problem is referred to as the "infant mortality" problem. Peter Gibbs, Mike Lambert, Dan Sugalski and others have considered various solutions to this problem. Most of those solutions have been implemented in some form or other. =head1 SOLUTION 1: STACK WALKING One possible solution is to add the C stack into the root set. This way, temporary PMCs that have not yet been anchored to the root set will be found on the stack and treated as live. Actually, the C stack is insufficient -- you must also scan through all processor registers, and for some processors there may be a separate backing store for those registers (eg the Sparc's register windows). Uninitialized data on the stack and high alignment requirements for stackframes can fool the GC system with left over pointers from previous calls. This is especially a problem for objects which need early destruction. + No slowdown in the common case of no dead objects + Convenient: the programmer does not need to code differently to accommodate the garbage collection system. - Unportable. Different processors need different code for scanning their registers, stacks, register windows, etc. Also, on some architectures you must scan every possible offset into the stack to find all the pointers, while on others you must NOT scan every possible offset or you'll get a bus error due to a misaligned access. - Slow mark phase. A full stack walk takes quite a while, and this time grows with nested interpreter calls, external code's stack usage, etc. - Complex. The stack walk is necessarily conservative, in that it must consider every valid pointer on the stack to potentially be a traceable object. But some of those pointers may be stale, in which case the memory they point to may have been partially reused for some other purpose. Everything must operate within certain constraints that guarantee that no invalid pointers will be dereferenced and trigger a segmentation fault or bus error. - Another side effect of the conservative nature of stack walking is that the memory for these objects may never be returned to the system, because it is always possible that there will be a stale pointer lying around on the stack or in a register, and all such pointers will be dereferenced. =head1 SOLUTION 2: NEONATE FLAG There are several possible variants of the neonate flag, but the basic idea is to set a flag on newly created objects that prevents them from being collected. At some point, this flag is cleared -- either as the newborn object is anchored to the root set, or during the first mark pass after it was anchored, or explicitly when the object is no longer needed. + Portable + Can return memory to the system when unneeded + Exact: the state of every object is always known precisely (no more "this object MIGHT still be reachable") - The coder must remember to clear the flag before discarding unanchored objects - The flag-clearing takes a small amount of time - For some variants of this scheme, some time is consumed to clear the flag for the common case of rooted objects =head2 Subspecies of neonate flags The variants of the neonate idea all hinge on exactly how and when the flag is cleared. =head2 Variant 1: explicit The flag is always explicitly cleared by the coder. + Very simple + Fast mark phase - Slow for unanchored temporaries - Slow for anchored objects - Easy to forget to clear the flag for unanchored temporaries - Easy to forget to clear the flag for anchored objects - longjmp() can bypass the clearing =head2 Variant 2: explicit for temporaries, cleared during anchoring The flag is explicitly set for temporaries. All routines which anchor an object to the root set also clear the flag. + Simple + Fast mark phase - Slow for unanchored temporaries - Slow for anchored objects - Easy to forget to clear the flag for unanchored temporaries - Forces all anchoring operations to set the flag (so this disallows direct assignment into a PMC register, for example) - longjmp() can bypass the clearing =head2 Variant 3: clear during mark phase The neonate flag is cleared during the mark phase when an object is encountered during the recursive root set traversal. (Leopold Toetsch's trick of setting the live_FLAG during creation is equivalent to this variation, I think.) + Simple + Fast mark phase (GC already manipulates the flags) - If there are multiple mark runs before the object is anchored or dies, it will be prematurely freed =head2 Variant 4: generation count This is the same as variant 3, except a "generation count" is maintained in the interpreter so that the neonate flag is only cleared during a later generation. The generation is incremented only at major control points such between opcodes, so that there is no chance of unanchored temporaries. + Fast mark phase (GC already manipulates the flags) - Generation count must be maintained - Disallows recursive opcode calls (necessary for eg implementing vtable functions in pasm) - Can temporarily use more memory (dead objects accumulate during the current generation) In order to allow recursive opcode calls, we could increment the generation count in more places and make sure nothing is left unanchored at those points, but that would gradually remove all advantages of this scheme and make it more difficult to call existing vtable functions (since you never know when they might start running pasm code.) =head2 Variant 5: generation stack Notice that when using a generational count, you really only need to test whether the current generation is _different_ from an object's creation generation (which eliminates wraparound problems, too.) So rather than testing against a single "current" generation, allow a stack of multiple "current" generations. An object encountered during the mark phase will have its neonate flag cleared only if it doesn't match any of the "current" generation ids. This check can be optimized using a conservative bit mask as a preliminary test. + Still faster mark phase than stackwalking, though slower than the other neonate variants - Generation count must be maintained - Generation stack must be maintained - Disallows longjmp()'ing out of recursive opcode calls - Can temporarily use more memory (dead objects accumulate during all current generations) =head2 Variant 6: Generation based on stack depth Another similar idea is to use a generational system, with the "current generation" as a value on the C stack, passed as an extra argument after the interpreter. If a function creates temporary objects it calls other functions with an increased generational count. During a mark run, any PMC with a generation less than the current generation is considered live. Any PMC with a generation greater than the current generation is considered free. This works through longjmps and recursive run_cores. + Simple + No stack-walking + Works through longjmps and recursive run_cores + No explicit setting and clearing of flags - Needs to change to change the signature of every Parrot function - Nested temporaries can survive if there is no mark run between two function calls with increased generation count =head1 SOLUTION 3: EXPLICIT ROOT SET AUGMENTATION =head2 Variant 1: Temporarily anchor objects Provide a mechanism to temporarily anchor an otherwise unanchored object to the root set. (eg, have an array of objects associated with the interpreter that are all considered to be part of the root set.) This has pretty much the same advantages and disadvantages of explicit neonate flag setting: + Simple + Fast mark phase - Slow for unanchored temporaries - Sometimes slow for anchored objects (depending on whether they need to be temporarily anchored before the final anchoring) - Easy to forget to remove temporaries from the root set - Easy to double-anchor objects and forget to remove the temporary anchoring - longjmp() can bypass the unanchoring Many of the same or similar variations also apply: objects could be automatically removed from the temporary anchoring at generation boundaries, etc. =head2 Variant 2: Anchor early, anchor often First place a new PMC in the root set (e.g. a register), then initialise it. If that's too cumbersome, disable GC; if that's suboptimal, use active anchoring to some root set linked list for temporary PMCs. + Simple + Fast mark phase (No stack-walking) - GC might be turned off for a long time (Maybe a recursive run_core is called) - Easy to forget to reenable GC - longjmp() can bypass reenabling of GC (this might be hidden in the wrapper functions as only one value needs to be restored) =head2 Variant 3: Use a linked list of frames The signature of every Parrot function is extended with an extra parameter which is a parameter to a frame structure. All temporary PMCs needs to put into such a frame structure. The first parameter of this frame structure is a link to the previously used frame structure. If a function that can do a mark run is called a pointer to the current frame is applied. The linked list of frames represents always an exact list of the active temporaries on the C-stack. + Fast mark runs (only the known PMC-pointers are walked) + Exact + works through recursive run_cores and longjmp() - signature of every Parrot function changes - Creation of temporaries is complicated (Need to create a frame first) =head1 REFERENCES =over 4 =item What is neonate? L Brent Dax's better description of the problem than I have here =item Mike Lambert proposing Variant 1 L This also has some macro-heavy proposals that I ignored. =item Leopold Toetsch proposing Variant 3 L Also includes Steve Fink proposing Variant 1 =item Dan Sugalski proposing Variant 3 L =item Peter Gibbs implementing Variant 4 and getting shot down L =item General discussion kicked off by this document L This thread also includes Benjamin Goldberg Variant 6 =item Dan thinks the stackwalk is unavoidable L =item Infant mortality pain L This is a good thread for illustrating the pain that infant mortality causes -- in the context of Parrot, I mean. =item Numbers! L Gives some benchmark numbers for different approaches. =item Generational stuff L Early discussion that has some stuff I didn't go over here. Mostly involves generational schemes. =item Problems with stack-walking L This thread also includes Juergen Boemmels Variant 3 of Solution 3 =back =head1 CHANGES 2002-Dec-30: Initial Version by Steve Fink 2003-Aug-04: Some extra variants added by Juergen Boemmels =cut userhandle.c000644000765000765 1547312101554067 16240 0ustar00brucebruce000000000000parrot-5.9.0/src/io/* Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME src/io/userhandle.c - IO_VTABLE and helpers for user-defined types =head1 DESCRIPTION This file implements the IO_VTABLE for user-defined types. It is not currently used. =head2 IO_VTABLE Functions =over 4 =cut */ #include "parrot/parrot.h" #include "io_private.h" /* HEADERIZER HFILE: src/io/io_private.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static INTVAL io_userhandle_close(PARROT_INTERP, ARGMOD(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); static INTVAL io_userhandle_flush(PARROT_INTERP, ARGMOD(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); PARROT_CAN_RETURN_NULL PARROT_WARN_UNUSED_RESULT static const STR_VTABLE * io_userhandle_get_encoding(PARROT_INTERP, ARGIN(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2); static INTVAL io_userhandle_get_flags(PARROT_INTERP, ARGIN(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2); static PIOHANDLE io_userhandle_get_piohandle(PARROT_INTERP, ARGIN(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2); static INTVAL io_userhandle_is_eof(PARROT_INTERP, ARGMOD(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); static INTVAL io_userhandle_is_open(PARROT_INTERP, ARGMOD(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); static INTVAL io_userhandle_open(PARROT_INTERP, ARGMOD(PMC *handle), ARGIN(STRING *path), INTVAL flags, ARGIN(STRING *mode)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(5) FUNC_MODIFIES(*handle); static INTVAL io_userhandle_read_b(PARROT_INTERP, ARGMOD(PMC *handle), ARGOUT(char *buffer), size_t byte_length) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*handle) FUNC_MODIFIES(*buffer); static INTVAL io_userhandle_seek(PARROT_INTERP, ARGMOD(PMC *handle), PIOOFF_T offset, INTVAL whence) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); static void io_userhandle_set_flags(PARROT_INTERP, ARGIN(PMC *handle), INTVAL flags) __attribute__nonnull__(1) __attribute__nonnull__(2); static PIOOFF_T io_userhandle_tell(PARROT_INTERP, ARGMOD(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*handle); static size_t io_userhandle_total_size(PARROT_INTERP, ARGIN(PMC *handle)) __attribute__nonnull__(1) __attribute__nonnull__(2); static INTVAL io_userhandle_write_b(PARROT_INTERP, ARGMOD(PMC *handle), ARGIN(char *buffer), size_t byte_length) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*handle); #define ASSERT_ARGS_io_userhandle_close __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_userhandle_flush __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_userhandle_get_encoding __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_userhandle_get_flags __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_userhandle_get_piohandle __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_userhandle_is_eof __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_userhandle_is_open __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_userhandle_open __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle) \ , PARROT_ASSERT_ARG(path) \ , PARROT_ASSERT_ARG(mode)) #define ASSERT_ARGS_io_userhandle_read_b __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle) \ , PARROT_ASSERT_ARG(buffer)) #define ASSERT_ARGS_io_userhandle_seek __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_userhandle_set_flags __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_userhandle_tell __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_userhandle_total_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle)) #define ASSERT_ARGS_io_userhandle_write_b __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(handle) \ , PARROT_ASSERT_ARG(buffer)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Setup the IO_VTABLE for custom user-defined types. =cut. */ void io_userhandle_setup_vtable(PARROT_INTERP, ARGMOD_NULLOK(IO_VTABLE *vtable), INTVAL idx) { ASSERT_ARGS(io_userhandle_setup_vtable) if (vtable == NULL) vtable = IO_EDITABLE_IO_VTABLE(interp, idx); vtable->number = idx; vtable->name = "User Handle Type"; /* vtable->read_b = io_userhandle_read_b; vtable->write_b = io_userhandle_write_b; vtable->flush = io_userhandle_flush; vtable->is_eof = io_userhandle_is_eof; vtable->tell = io_userhandle_tell; vtable->seek = io_userhandle_seek; vtable->open = io_userhandle_open; vtable->is_open = io_userhandle_is_open; vtable->close = io_userhandle_close; vtable->get_encoding = io_userhandle_get_encoding; vtable->set_flags = io_userhandle_set_flags; vtable->get_flags = io_userhandle_get_flags; vtable->total_size = io_userhandle_total_size; vtable->get_piohandle = io_userhandle_get_piohandle; */ } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ rational.t000644000765000765 3107311567202625 16276 0ustar00brucebruce000000000000parrot-5.9.0/t/dynpmc#!./parrot # Copyright (C) 2008-2010, Parrot Foundation. =head1 NAME t/dynpmc/rational.t - Rational PMC =head1 SYNOPSIS % prove t/dynpmc/rational.t =head1 DESCRIPTION Tests the Rational PMC. =cut .sub main :main .include 'test_more.pir' .include 'iglobals.pasm' .local pmc config_hash, interp interp = getinterp config_hash = interp[.IGLOBALS_CONFIG_HASH] $S0 = config_hash['gmp'] unless $S0 goto no_gmp plan(79) loadlib $P1, 'rational' test_init() test_destroy() test_version() test_set_get_native_int() test_set_get_native_float() test_set_get_native_string() test_set_get_int() test_set_get_float() test_set_get_string() test_set_get_string_keyed() test_get_bool() test_inc_dec() test_add_int_inplace() test_add_float_inplace() test_add_int_pmc_inplace() test_add_float_pmc_inplace() test_add_rats_inplace() test_subtract_int() test_subtract_float() test_subtract_int_pmc() test_subtract_float_pmc() test_subtract_rats() test_multiply_int() test_multiply_float() test_multiply_int_pmc() test_multiply_float_pmc() test_multiply_rats() test_divide_int() test_divide_float() test_divide_int_pmc() test_divide_float_pmc() test_divide_rats() test_defaults() test_neg() test_abs() test_cmp() test_equal() test_equal_int() .return() no_gmp: skip_all('GMP not found, skipping Rational tests') .return() .end .sub test_neg new $P2, 'Rational' new $P3, 'Rational' $P2 = "-3/2" $P3 = -$P2 neg $P2 is($P2,'3/2','neg') is($P3,'3/2','neg') .end .sub test_abs new $P2, 'Rational' new $P3, 'Rational' $P2 = "-3/2" $P3 = abs $P2 abs $P2 is($P2,'3/2','abs') is($P3,'3/2','abs') .end .sub test_equal new $P2, 'Rational' new $P3, 'Integer' $P2 = "2/1" $P3 = 2 is($P2, $P3, '== on Rational and Integer PMC') throws_substring(<<"CODE", "epsilon", "== on Rational and Float PMC throws exception") .sub main $P0 = new ['Rational'] $P1 = new ['Float'] $P0 = "2/1" $P1 = 2. if $P0 == $P1 goto fail fail: ok(0, '== on Rational and Float PMC') .end CODE throws_substring(<<"CODE", "is_equal not implemented (yet).", "== on Rational and String PMC throws exception") .sub main $P0 = new ['Rational'] $P1 = new ['String'] $P0 = "2/1" $P1 = "foo" if $P0 == $P1 goto fail fail: ok(0, '== on Rational and String PMC') .end CODE .end .sub test_equal_int $P0 = new ['Rational'] $P0 = "2/1" eq $P0, 2, success success: ok(1, 'is_equal on Rational and integer') .end .sub test_cmp new $P2, 'Rational' new $P3, 'Rational' $P2 = "3/2" $P3 = "6/4" is($P2, $P3,'== on Rational PMC') $P3 = "7/4" cmp $I1, $P2, $P3 cmp $I2, $P3, $P2 is($I1,-1,'cmp on Rational PMC') is($I2,1,'cmp on Rational PMC') $P4 = new ['Integer'] $P4 = -1 cmp $I1, $P2, $P4 is($I1, 1, 'cmp with Integer') $P4 = 100 cmp $I1, $P2, $P4 is($I1, -1, 'cmp with Integer') $P4 = new ['Float'] $P4 = -1.0 push_eh eh1 cmp $I1, $P2, $P4 is($I1, -1, 'cmp with Float') goto finally1 eh1: todo(0, "cmp with Float not implemented") finally1: pop_eh $P4 = 100.0 push_eh eh2 cmp $I1, $P2, $P4 is($I1, 1, 'cmp with Float') goto finally2 eh2: todo(0, "cmp with Float not implemented") finally2: pop_eh throws_substring(<<"CODE", "cmp not implemented (yet).", "cmp with default") .sub main $P0 = new ['Rational'] $P0 = "1" $P1 = new ['String'] $P1 = 'foo' cmp $I1, $P0, $P1 .end CODE .end .sub test_divide_int new $P1, 'Rational' new $P2, 'Rational' $I1 = 7 $P1 = "3/2" $P2 = $P1 / $I1 div $P1, $I1 is($P1,'3/14','divide int inplace') is($P2,'3/14','divide int') .end .sub test_divide_float new $P1, 'Rational' new $P2, 'Rational' $N1 = 7. $P1 = "3/2" $P2 = $P1 / $N1 div $P1, $N1 is($P1,'3/14','divide float inplace') is($P2,'3/14','divide float') .end .sub test_divide_int_pmc new $P2, 'Rational' new $P3, 'Rational' new $P4, 'Integer' $P4 = 7 $P2 = "3/2" $P3 = $P2 / $P4 div $P2, $P4 is($P2,'3/14','divide Integer PMC inplace') is($P3,'3/14','divide Integer PMC') .end .sub test_divide_float_pmc new $P2, 'Rational' new $P3, 'Rational' new $P4, 'Float' $P4 = 7. $P2 = "3/2" $P3 = $P2 / $P4 div $P2, $P4 is($P2,'3/14','divide Float PMC inplace') is($P3,'3/14','divide Float PMC') .end .sub test_divide_rats new $P1, 'Rational' new $P2, 'Rational' new $P3, 'Rational' $P2 = "3/2" $P3 = "5/2" $P1 = $P2 / $P3 div $P2, $P3 is($P1,'3/5','divide Rational PMC') is($P2,'3/5','divide Rational PMC inplace') .end .sub test_multiply_int new $P1, 'Rational' new $P2, 'Rational' $I1 = 7 $P1 = "3/2" $P2 = $P1 * $I1 mul $P1, $I1 is($P1,'21/2','multiply int inplace') is($P2,'21/2','multiply int') .end .sub test_multiply_float new $P1, 'Rational' new $P2, 'Rational' $N1 = 7. $P1 = "3/2" $P2 = $P1 * $N1 mul $P1, $N1 is($P1,'21/2','multiply float inplace') is($P2,'21/2','multiply float') .end .sub test_multiply_int_pmc new $P2, 'Rational' new $P3, 'Rational' new $P4, 'Integer' $P4 = 7 $P2 = "3/2" $P3 = $P2 * $P4 mul $P2, $P4 is($P2,'21/2','multiply Integer PMC inplace') is($P3,'21/2','multiply Integer PMC') .end .sub test_multiply_float_pmc new $P2, 'Rational' new $P3, 'Rational' new $P4, 'Float' $P4 = 7. $P2 = "3/2" $P3 = $P2 * $P4 mul $P2, $P4 is($P2,'21/2','multiply Float PMC inplace') is($P3,'21/2','multiply Float PMC') .end .sub test_multiply_rats new $P1, 'Rational' new $P2, 'Rational' new $P3, 'Rational' $P2 = "3/2" $P3 = "5/2" $P1 = $P2 * $P3 mul $P2, $P3 is($P1,'15/4','multiply Rational PMC') is($P2,'15/4','multiply Rational PMC inplace') .end .sub test_subtract_rats new $P1, 'Rational' new $P2, 'Rational' new $P3, 'Rational' $P2 = "3/2" $P3 = "5/2" $P1 = $P2 - $P3 sub $P2, $P3 is($P1,-1,'subtract Rational') is($P2,-1,'subtract Rational inplace') .end .sub test_subtract_int new $P1, 'Rational' new $P2, 'Rational' $I1 = 7 $P1 = "3/2" $P2 = $P1 - $I1 sub $P1, $I1 sub $P1, $I1 is($P1,'-25/2','subtract int inplace') is($P2,'-11/2','subtract int') .end .sub test_subtract_float new $P1, 'Rational' new $P2, 'Rational' $N1 = 7. $P1 = "3/2" $P2 = $P1 - $N1 sub $P1, $N1 sub $P1, $N1 is($P1,'-25/2','subtract float inplace') is($P2,'-11/2','subtract float') .end .sub test_subtract_float_pmc new $P2, 'Rational' new $P3, 'Rational' new $P4, 'Float' $P4 = 7. $P2 = "3/2" $P3 = $P2 - $P4 sub $P2, $P4 is($P2,'-11/2','subtract Float PMC inplace') is($P3,'-11/2','subtract Float PMC') .end .sub test_subtract_int_pmc new $P2, 'Rational' new $P3, 'Rational' new $P4, 'Integer' $P4 = 7 $P2 = "3/2" $P3 = $P2 - $P4 sub $P2, $P4 is($P2,'-11/2','subtract Integer PMC inplace') is($P3,'-11/2','subtract Integer PMC') .end .sub test_add_rats_inplace new $P1, 'Rational' new $P2, 'Rational' new $P3, 'Rational' $P2 = "3/2" $P3 = "5/2" $P1 = $P2 + $P3 add $P2, $P3 is($P1,4,'adding rationals') is($P2,4,'adding rationals inplace') .end .sub test_add_int_pmc_inplace new $P2, 'Rational' new $P3, 'Rational' new $P4, 'Integer' $P4 = 7 $P2 = "3/2" $P3 = $P2 + $P4 add $P2, $P4 is($P2,'17/2','add Integer PMCs inplace') is($P3,'17/2','add Integer PMCs') .end .sub test_add_float_pmc_inplace new $P2, 'Rational' new $P3, 'Rational' new $P4, 'Float' $P4 = 7. $P2 = "3/2" $P3 = $P2 + $P4 add $P2, $P4 is($P2,'17/2','add Float PMCs inplace') is($P3,'17/2','add Float PMCs') .end .sub test_add_int_inplace new $P1, 'Rational' new $P2, 'Rational' $I1 = 7 $P1 = "3/2" $P2 = $P1 + $I1 add $P1, $I1 add $P1, $I1 is($P1,'31/2','add integers inplace') is($P2,'17/2','add integers') .end .sub test_add_float_inplace new $P1, 'Rational' new $P2, 'Rational' $N1 = 7. $P1 = "3/2" $P2 = $P1 + $N1 add $P1, $N1 add $P1, $N1 is($P1,'31/2','add floats inplace') is($P2,'17/2','add floats') .end .sub test_defaults throws_substring(<<"CODE", "Rational, add: Not implemented (yet).", "add string") .sub main $P0 = new ['Rational'] $P0 = "1/2" $P1 = new ['String'] $P1 = "foo" $P2 = $P0 + $P1 .end CODE throws_substring(<<"CODE", "Rational, subtract: Not implemented (yet).", "sub string") .sub main $P0 = new ['Rational'] $P0 = "1/2" $P1 = new ['String'] $P1 = "foo" $P2 = $P0 - $P1 .end CODE throws_substring(<<"CODE", "Rational, multiply: Not implemented (yet).", "mul string") .sub main $P0 = new ['Rational'] $P0 = "1/2" $P1 = new ['String'] $P1 = "foo" $P2 = $P0 * $P1 .end CODE throws_substring(<<"CODE", "Rational, divide: Not implemented (yet).", "div string") .sub main $P0 = new ['Rational'] $P0 = "1/2" $P1 = new ['String'] $P1 = "foo" $P2 = $P0 / $P1 .end CODE throws_substring(<<"CODE", "Rational, i_add: Not implemented (yet).", "i_add string") .sub main $P0 = new ['Rational'] $P0 = "1/2" $P1 = new ['String'] $P1 = "foo" add $P0, $P1 .end CODE throws_substring(<<"CODE", "Rational, i_subtract: Not implemented (yet).", "i_sub string") .sub main $P0 = new ['Rational'] $P0 = "1/2" $P1 = new ['String'] $P1 = "foo" sub $P0, $P1 .end CODE throws_substring(<<"CODE", "Rational, i_multiply: Not implemented (yet).", "i_mul string") .sub main $P0 = new ['Rational'] $P0 = "1/2" $P1 = new ['String'] $P1 = "foo" mul $P0, $P1 .end CODE throws_substring(<<"CODE", "Rational, i_divide: Not implemented (yet).", "i_div string") .sub main $P0 = new ['Rational'] $P0 = "1/2" $P1 = new ['String'] $P1 = "foo" div $P0, $P1 .end CODE .end .sub test_init new $P1, 'Rational' is($P1, 0, 'initialization') .end .sub test_destroy new $P1, 'Rational' null $P1 sweep 1 ok(1, 'destroy') .end .sub test_version new $P1, 'Rational' $S1 = $P1.'version'() ok($S1,'can get version number') .end .sub test_set_get_native_int new $P1, 'Rational' $I1 = 42 $P1 = $I1 $I2 = $P1 is($I2,42,'set and get native int') .end .sub test_set_get_int new $P1, 'Rational' new $P2, 'Integer' new $P3, 'Integer' $P2 = 7 $P1 = $P2 $P3 = $P1 is($P3,7,'set and get int') throws_substring(<<"CODE", "Number is too big", "int too long overflows") .sub main $P0 = new ['Rational'] $P0 = "10000000000000000000" $I0 = $P0 .end CODE .end .sub test_set_get_float new $P1, 'Rational' new $P2, 'Float' new $P3, 'Float' $P2 = 7.110000 $P1 = $P2 $P3 = $P1 is($P3,7.11,'set and set float',0.0001) .end .sub test_inc_dec new $P1, 'Rational' $P1 = "7/4" inc $P1 is($P1,'11/4','increment a rational') dec $P1 dec $P1 is($P1,'3/4','decrement a rational') .end .sub test_set_get_string new $P1, 'Rational' new $P2, 'String' new $P3, 'String' $P2 = "7/4" $P1 = $P2 $P3 = $P1 is($P3,"7/4",'set and get string') .end .sub test_set_get_native_float new $P0, 'Rational' $N0 = 11.1 $P0 = $N0 $N1 = $P0 is($N1,11.1,'set and get a native float') .end .sub test_set_get_native_string new $P1, 'Rational' $S1 = "7/4" $P1 = $S1 $S2 = $P1 is($S2,'7/4','set and get native string') .end .sub test_set_get_string_keyed new $P1, 'Rational' $S1 = "a/b" $P1[16] = $S1 $S2 = $P1[8] is($S2, '12/13', 'set and get string keyed') .end .sub test_get_bool new $P0, 'Rational' $P0 = "0" $I0 = isfalse $P0 ok($I0, '0 should be false') $P0 = "3/4" $I0 = istrue $P0 ok($I0, '3/4 should be true') .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: Directory.pm000644000765000765 322711533177636 17740 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/Docs# Copyright (C) 2004, Parrot Foundation. =head1 NAME Parrot::Docs::Directory - Docs-Related Directory =head1 SYNOPSIS use Parrot::Docs::Directory; =head1 DESCRIPTION This C subclass creates C. It's used by the documentation tools in F. =head2 Class Methods =over =cut package Parrot::Docs::Directory; use strict; use warnings; use base qw( Parrot::IO::Directory ); use Parrot::Docs::File; =item C Returns C. =cut sub file_class { return 'Parrot::Docs::File'; } =item C Returns C. =cut sub directory_class { return 'Parrot::Docs::Directory'; } =back =head2 Instance Methods =over 4 =item C Use this to get a list of the files of a particular type. C<$recursive> and C<$ignore> function as specified in C. =cut sub files_of_type { my $self = shift; my $type = shift; return () unless defined $type; my $recursive = shift; my $ignore = shift; my @files = (); foreach my $file ( $self->files() ) { next unless $file->is_of_type($type); push @files, $file; } if ($recursive) { foreach my $dir ( $self->directories() ) { next if defined $ignore and $dir->name =~ /$ignore/; push @files, $dir->files_of_type( $type, 1, $ignore ); } } return @files; } =back =head1 SEE ALSO =over 4 =item C =back =cut 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: lwp.t000644000765000765 1322611567202625 15441 0ustar00brucebruce000000000000parrot-5.9.0/t/library#!./parrot # Copyright (C) 2010, Parrot Foundation. =head1 NAME t/library/lwp.t =head1 DESCRIPTION Test the LWP library =head1 SYNOPSIS % prove t/library/lwp.t =cut .sub 'main' :main .include 'test_more.pir' load_bytecode 'LWP/UserAgent.pir' load_bytecode 'osutils.pbc' plan(48) test_new() test_unknown_protocol() test_bad_request() test_file_not_found() test_file() test_file_head() test_file_post_delete() test_file_proxy() .end .sub 'test_new' $P0 = new ['LWP';'UserAgent'] $I0 = isa $P0, ['LWP';'UserAgent'] ok($I0, "new ['LWP';'UserAgent']") $P0 = new ['LWP';'Protocol';'file'] $I0 = isa $P0, ['LWP';'Protocol';'file'] ok($I0, "new ['LWP';'Protocol';'file']") $I0 = isa $P0, ['LWP';'Protocol'] ok($I0, "isa ['LWP';'Protocol']") $P0 = new ['LWP';'Protocol';'http'] $I0 = isa $P0, ['LWP';'Protocol';'http'] ok($I0, "new ['LWP';'Protocol';'http']") $I0 = isa $P0, ['LWP';'Protocol'] ok($I0, "isa ['LWP';'Protocol']") $P0 = new ['HTTP';'Request'] $I0 = isa $P0, ['HTTP';'Request'] ok($I0, "new ['HTTP';'Request']") $I0 = isa $P0, ['HTTP';'Message'] ok($I0, "isa ['HTTP';'Message']") $P0 = new ['HTTP';'Response'] $I0 = isa $P0, ['HTTP';'Response'] ok($I0, "new ['HTTP';'Response']") $I0 = isa $P0, ['HTTP';'Message'] ok($I0, "isa ['HTTP';'Message']") .end .sub 'test_unknown_protocol' .local pmc ua, response ua = new ['LWP';'UserAgent'] response = ua.'get'('unk:foo/bar') $I0 = isa response, ['HTTP';'Response'] ok($I0, "GET unk:foo/bar") $I0 = response.'code'() is($I0, 501, "code") $S0 = response.'message'() is($S0, "Not Implemented", "message") $I0 = response.'is_error'() ok($I0, "is error") .end .sub 'test_bad_request' .local pmc ua, response ua = new ['LWP';'UserAgent'] response = ua.'post'('file:foo/bar') $I0 = isa response, ['HTTP';'Response'] ok($I0, "GET unk:foo/bar") $I0 = response.'code'() is($I0, 400, "code bad request") $S0 = response.'message'() is($S0, "Library does not allow method POST for 'file:' URLs", "message") $I0 = response.'is_error'() ok($I0, "is error") .end .sub 'test_file_not_found' unlink('t/no_file') .local pmc ua, response ua = new ['LWP';'UserAgent'] response = ua.'get'('file:t/no_file') $I0 = isa response, ['HTTP';'Response'] ok($I0, "GET file:t/no_file") $I0 = response.'code'() is($I0, 404, "code") $S0 = response.'message'() is($S0, "File `t/no_file' does not exist", "message") $I0 = response.'is_error'() ok($I0, "is error") .end .sub 'test_file' .local pmc ua, response ua = new ['LWP';'UserAgent'] response = ua.'get'('file:t/library/lwp.t') $I0 = isa response, ['HTTP';'Response'] ok($I0, "GET file:t/library/lwp.t") $I0 = response.'code'() is($I0, 200, "code") $I0 = response.'is_success'() ok($I0, "is success") $S0 = response.'content'() $I0 = index $S0, 'Test the LWP library' $I0 = $I0 > 0 ok($I0, "content looks good") $I0 = response.'get_header'('Content-Length') $I0 = $I0 > 2000 ok($I0, "Content-Length") $S0 = response.'get_header'('Last-Modified') diag($S0) $I0 = index $S0, 'GMT' $I0 = $I0 > 0 ok($I0, "Last-Modified contains GMT") .end .sub 'test_file_head' .local pmc ua, response ua = new ['LWP';'UserAgent'] response = ua.'head'('file:t/library/lwp.t') $I0 = isa response, ['HTTP';'Response'] ok($I0, "HEAD file:t/library/lwp.t") $I0 = response.'code'() is($I0, 200, "code") $I0 = response.'is_success'() ok($I0, "is success") $P0 = response.'content'() $I0 = isnull $P0 ok($I0, "no content") $I0 = response.'get_header'('Content-Length') $I0 = $I0 > 2000 ok($I0, "Content-Length") $S0 = response.'get_header'('Last-Modified') diag($S0) $I0 = index $S0, 'GMT' $I0 = $I0 > 0 ok($I0, "Last-Modified contains GMT") .end .sub 'test_file_post_delete' .const string data = "the file contains some text" .const string filename = 't/library/file.txt' .const string url = 'file:t/library/file.txt' unlink(filename) .local pmc ua, response ua = new ['LWP';'UserAgent'] response = ua.'put'(url, data) $I0 = isa response, ['HTTP';'Response'] ok($I0, "PUT file:t/library/file.txt") $I0 = response.'code'() is($I0, 200, "code") $I0 = response.'is_success'() ok($I0, "is success") $S0 = slurp(filename) is($S0, data, "file content comparison") response = ua.'delete'(url) $I0 = isa response, ['HTTP';'Response'] ok($I0, "DELETE file:t/library/file.txt") $I0 = response.'code'() is($I0, 200, "code") $I0 = response.'is_success'() ok($I0, "is success") response = ua.'delete'(url) $I0 = isa response, ['HTTP';'Response'] ok($I0, "DELETE file:t/library/file.txt") $I0 = response.'code'() is($I0, 404, "code") $S0 = response.'message'() is($S0, "File `t/library/file.txt' does not exist", "message") $I0 = response.'is_error'() ok($I0, "is error") .end .sub 'test_file_proxy' .local pmc ua, response ua = new ['LWP';'UserAgent'] ua.'proxy'('file', 'file://proxy.net') response = ua.'get'('file:t/library/lwp.t') $I0 = isa response, ['HTTP';'Response'] ok($I0, "GET file:t/library/lwp.t via a proxy") $I0 = response.'code'() is($I0, 400, "code") $S0 = response.'message'() is($S0, "You can not proxy through the filesystem", "message") $I0 = response.'is_error'() ok($I0, "is error") .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: File.pm000644000765000765 1062012101554067 16272 0ustar00brucebruce000000000000parrot-5.9.0/lib/Parrot/IO# Copyright (C) 2004-2012, Parrot Foundation. =head1 NAME Parrot::IO::File - File =head1 SYNOPSIS use Parrot::IO::File; =head1 DESCRIPTION Use this to query and manipulate files and their contents. =head2 Class Methods =over =cut package Parrot::IO::File; use strict; use warnings; use base qw( Parrot::IO::Path ); use FileHandle; use File::Spec (); use Parrot::IO::Directory; # [GH #820] Win32 stat() for mtime is broken. Try to use Win32::UTCFileTime BEGIN { if ($^O eq 'MSWin32') { eval { require Win32::UTCFileTime; } and Win32::UTCFileTime::import(':globally'); } } =item C Returns the file for C<$path> relative to the default temporary directory. =cut sub tmp_file { my $self = shift; return $self->new( File::Spec->catfile( File::Spec->tmpdir, @_ ) ); } =item C Returns the instance for C<$path>. =cut sub new { my $self = shift; my $path = shift; return unless defined $path and !-d $path; return $self->SUPER::new($path); } =back =head2 Instance Methods =over 4 =item C This is called from C to create the path if necessary. =cut sub create_path { my $self = shift; return unless $self->SUPER::create_path; # Just to touch the file. # Make sure write() doesn't dismiss this as a noop. $self->write('') unless -e $self->path; return -f $self->path; } =item C Returns the file's parent directory. =cut sub parent { my $self = shift; my $path = shift; return Parrot::IO::Directory->new( $self->parent_path ); } =item C This reads the contents of the file and returns it as an array or string depending on the context in which the method is called. $contents = $file->read; @lines = $file->read; =cut sub read { my $self = shift; my $fh = FileHandle->new( $self->path ) or die 'Failed to open ' . $self->path . ": $!"; my @lines = <$fh>; $fh->close; return wantarray ? @lines : join '', @lines; } =item C Writes the specified lines to the file. =cut sub write { my $self = shift; return unless @_; my $fh = FileHandle->new( '>' . $self->path ) or die 'Failed to open ' . $self->path . ": $!"; print $fh @_; $fh->close; } =item C Writes the specified lines to the file. =cut sub append { my $self = shift; return unless @_; my $fh = FileHandle->new( '>>' . $self->path ) or die 'Failed to open ' . $self->path . ": $!"; print $fh @_; $fh->close; } =item C This tells you whether the file is executable. =cut sub is_executable { my $self = shift; return $self->stat->mode & 0111; } =item C Use this to find out whether the file has been modified since the specified time. C<$time> is a number of non-leap seconds since the epoch. =cut sub modified_since { my $self = shift; my $time = shift; return $self->stat->mtime > $time; } =item C Returns whether the file is "hidden", i.e. its name starts with a dot. =cut sub is_hidden { my $self = shift; return $self->name =~ /^\./; } =item C Returns whether the file is generated. =cut sub is_generated { my $self = shift; # CFLAGS # libparrot.def # Makefile # myconfig # include/parrot/config.h # include/parrot/core_pmcs.h # include/parrot/feature.h # runtime/parrot/include/* (all?) # lib/Parrot/Config.pm return 1 if $self->suffix =~ /^(?:dump|html|flag|o)$/ or $self->name =~ /^(?:perl6-config|libparrot.def|CFLAGS|myconfig|(?:core_pmcs|exec_(?:cpu|dep)|fingerprint|jit_(?:cpu|emit)|nci|platform(?:_interface)?)\.[ch]|(?:charclass|feature)\.h)$/ or $self->parent->name eq 'ops' and $self->suffix =~ /^(?:c|pod)$/; return 0; } =item C Deletes the file, removes the instance from the cache, and undefines it. Raises an exception if the delete fails. =cut sub delete { # Use $_[0] so that we can undef the instance in SUPER::delete(). unlink( $_[0]->path ) or die 'Failed to unlink ' . $_[0]->path . ": $!"; $_[0]->SUPER::delete; } =back =head1 SEE ALSO =over 4 =item C =item C =back =cut 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: nsieve-bits.pir_output000644000765000765 13511466337261 22567 0ustar00brucebruce000000000000parrot-5.9.0/examples/shootoutPrimes up to 40000 4203 Primes up to 20000 2262 Primes up to 10000 1229 p6object.t000644000765000765 3604211715102034 16340 0ustar00brucebruce000000000000parrot-5.9.0/t/library#!./parrot # Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME t/library/p6object.t -- P6object tests =head1 SYNOPSIS % prove t/library/p6object.t =head1 DESCRIPTION Testing Perl 6 objects. =cut .sub 'main' :main load_bytecode 'Test/More.pbc' .local pmc exports, curr_namespace, test_namespace curr_namespace = get_namespace test_namespace = get_namespace ['Test';'More'] exports = split ' ', 'plan diag ok nok is todo' test_namespace.'export_to'(curr_namespace, exports) ## set our plan plan(303) ## make sure we can load the P6object library push_eh load_fail load_bytecode 'P6object.pbc' pop_eh ok(1, 'load_bytecode') goto load_success load_fail: ok(0, "load_bytecode 'P6object.pbc' failed -- skipping tests") .return () load_success: ## test the P6metaclass protoobject itself .local pmc p6meta p6meta = get_hll_global 'P6metaclass' p6obj_tests(p6meta, 'P6metaclass', 'isa'=>'P6metaclass') ## register an existing PMCProxy-based class .local pmc hashproto, hashobj, hashns $P0 = p6meta.'register'('Hash') hashproto = get_hll_global 'Hash' hashns = get_hll_namespace ['Hash'] is_same($P0, hashproto, 'return from .register =:= Hash') hashobj = p6obj_tests(hashproto, 'Hash', 'isa'=>'Hash', 'who'=>hashns) ## make sure class of hash object is still a PMCProxy isa_nok(hashobj, 'P6object', 'Hash_obj') $P0 = typeof hashobj $S0 = typeof $P0 is($S0, 'PMCProxy', '< typeof Hash_obj > returns PMCProxy instance') ## make sure Hash objects don't get a .new method $I0 = can hashobj, 'new' nok($I0, '! < can Hash_obj, "new" >') ## create a new standalone class by name .local pmc abcproto, abcobj, abcmeta, abcns $P0 = p6meta.'new_class'('ABC') abcproto = get_hll_global 'ABC' abcns = get_hll_namespace ['ABC'] is_same($P0, abcproto, 'return from .new_class =:= ABC') $P0 = split ' ', 'P6object' abcobj = p6obj_tests(abcproto, 'ABC', 'isa'=>'ABC P6object', 'can'=>'foo', 'who'=>abcns) ## make sure negative tests for 'can' work $I0 = can abcobj, 'bar' nok($I0, '! ') $P0 = abcobj.'HOW'() $I0 = $P0.'can'(abcobj, 'bar') nok($I0, '! ABC_obj.^can("bar")') ## make sure abcobj didn't get a .new method $I0 = can abcobj, 'new' nok($I0, '! ') ## verify .ACCEPTS method $P0 = hashproto.'ACCEPTS'(hashobj) ok($P0, 'Hash.ACCEPTS(Hash_obj)') isa_ok($P0, 'Boolean', 'Boolean') $P0 = hashproto.'ACCEPTS'(abcobj) nok($P0, 'Hash.ACCEPTS(Abc_obj)') isa_ok($P0, 'Boolean', 'Boolean') $P0 = abcproto.'ACCEPTS'(hashobj) nok($P0, 'ABC.ACCEPTS(Hash_obj)') isa_ok($P0, 'Boolean', 'Boolean') $P0 = abcproto.'ACCEPTS'(abcobj) ok($P0, 'ABCh.ACCEPTS(Abc_obj)') isa_ok($P0, 'Boolean', 'Boolean') ## create new class by namespace .local pmc ghins, ghiproto, ghiobj ghins = get_hll_namespace ['GHI'] $P0 = p6meta.'new_class'(ghins) ghiproto = get_hll_global 'GHI' ghiobj = p6obj_tests(ghiproto, 'GHI', 'can'=>'foo', 'who'=>ghins) ## create a subclass called DEF1 from 'ABC' .local pmc defproto, defobj, defns $P0 = p6meta.'new_class'('DEF1', 'parent'=>'ABC') defproto = get_hll_global 'DEF1' defns = get_hll_namespace ['DEF1'] is_same($P0, defproto, 'return from .new_class =:= DEF1') defobj = p6obj_tests(defproto, 'DEF1', 'isa'=>'DEF1 ABC P6object', 'who'=>defns) ## create a subclass called DEF2 from ABC proto $P0 = p6meta.'new_class'('DEF2', 'parent'=>abcproto) defproto = get_hll_global 'DEF2' defns = get_hll_namespace ['DEF2'] is_same($P0, defproto, 'return from .new_class =:= DEF2') defobj = p6obj_tests(defproto, 'DEF2', 'isa'=>'DEF2 ABC P6object', 'who'=>defns) ## create a subclass of a PMC called MyInt .local pmc myintproto, myintobj, myintmeta, myintns $P0 = p6meta.'new_class'('MyInt', 'parent'=>'Integer') myintproto = get_hll_global 'MyInt' myintns = get_hll_namespace ['MyInt'] is_same($P0, myintproto, 'return from .new_class =:= MyInt') myintobj = p6obj_tests(myintproto, 'MyInt', 'isa'=>'MyInt Integer P6object', 'who'=>myintns) ## map Integer PMC objects to MyInt class, don't inherit from MyInt .local pmc integerobj, integermeta p6meta.'register'('Integer', 'protoobject'=>myintproto) integerobj = new 'Integer' $S0 = typeof integerobj is($S0, 'Integer', '< new "Integer" > still gives Integer PMC') $P0 = integerobj.'WHAT'() is_same($P0, myintproto, 'Integer_obj.WHAT =:= MyInt') integermeta = integerobj.'HOW'() myintmeta = myintobj.'HOW'() is_same(integermeta, myintmeta, 'Integer_obj.HOW =:= MyInt.HOW') $I0 = can myintobj, 'foo' ok($I0, '< can MyInt_obj, "foo" >') $I0 = can integerobj, 'foo' nok($I0, '! < can Integer_obj, "foo" >') ## map ResizablePMCArray objects to List class, inherit from List .local pmc listproto, listobj, rpaobj listproto = p6meta.'new_class'('List', 'parent'=>'ResizablePMCArray') p6meta.'register'('ResizablePMCArray', 'parent'=>listproto, 'proto'=>listproto) listobj = new 'List' $I0 = can listobj, 'foo' ok($I0, '< can List_obj, "foo" >') rpaobj = new 'ResizablePMCArray' ok($I0, '< can ResizablePMCArray_obj, "foo" >') $P0 = rpaobj.'HOW'() $I0 = $P0.'can'(rpaobj, 'foo') ok($I0, '< ResizablePMCArray_obj.^can("foo") >') $I0 = $P0.'isa'(rpaobj, listproto) todo($I0, '< ResizablePMCArray_obj.^isa(List) >', 'unimplemented: GH #403') ## create class with a different proto name .local pmc myobjectproto $P0 = p6meta.'new_class'('MyObject', 'name'=>'Object') myobjectproto = get_hll_global 'Object' p6obj_tests(myobjectproto, 'MyObject', 'classname'=>'Object', 'isa'=>'P6object') $P0 = get_hll_global 'MyObject' $I0 = isa $P0, 'P6protoobject' nok($I0, ".new_class didn't store proto as MyObject") ## create class with ::-style name .local pmc jklproto, jklobj, jklns $P0 = p6meta.'new_class'('Foo::JKL') jklproto = get_hll_global ['Foo'], 'JKL' jklns = get_hll_namespace ['Foo';'JKL'] is_same($P0, jklproto, 'return from .new_class =:= Foo::JKL') $P0 = get_hll_global 'Foo::JKL' isa_nok($P0, 'P6protoobject', '["Foo::JKL"]') jklobj = p6obj_tests(jklproto, 'Foo::JKL', 'isa'=>'P6object', 'can'=>'foo', 'who'=>jklns) ## add a method to a class $P0 = get_hll_global ['ABC'], 'foo' p6meta.'add_method'('bar', $P0, 'to'=>jklproto) jklobj = new ['Foo';'JKL'] $S0 = jklobj.'bar'() is($S0, 'ABC::foo', 'JKL.bar via add_method') .local pmc hll_tests hll_tests = get_root_global ['myhll'], 'hll_tests' hll_tests() .local pmc omgproto, omgprotoexport $P0 = p6meta.'new_class'('OMG::Lol') omgproto = get_hll_global ['OMG'], 'Lol' omgprotoexport = get_hll_global ['OMG';'EXPORT';'ALL'], 'Lol' is_same(omgproto,omgprotoexport,'protoobject added to ["EXPORT";"ALL"] subnamespace') .return () .end =head1 SUBROUTINES =over 4 =item p6obj_tests(proto, class [, options]) Run a sequence of standard tests on a protoobject. As part of the tests it also creates an instance using the C<.new> method of C, does some tests on the instance, and returns it. The available options include: shortname the name expected from stringifying the protoobject typename the name expected from C isa a list of classes to test for "isa" semantics =cut .sub 'p6obj_tests' .param pmc proto .param pmc class .param pmc options :slurpy :named .local string classname, shortname, typename classname = hash_default(options, 'classname', class) shortname = hash_default(options, 'shortname', classname) typename = hash_default(options, 'typename', classname) .local pmc who null who who = hash_default(options, 'who', who) shortname = concat shortname, '()' .local string msg isa_ok(proto, 'P6protoobject', classname) msg = 'concat'('< get_string ', classname, ' > eq "', shortname, '"') $S0 = proto is($S0, shortname, msg) msg = 'concat'('< typeof ', classname, ' > eq "', typename, '"') $S0 = typeof proto is($S0, typename, msg) msg = 'concat'('< defined ', classname, ' >') $I0 = defined proto nok($I0, msg) msg = 'concat'(classname, '.WHAT identity') $P0 = proto.'WHAT'() is_same(proto, $P0, msg) .local pmc meta msg = 'concat'(classname, '.HOW') meta = proto.'HOW'() isa_ok(meta, 'P6metaclass', msg) msg = 'concat'(classname, '.WHERE') $P0 = proto.'WHERE'() $I0 = get_id proto is($I0, $P0, msg) if null who goto proto_who_done msg = 'concat'(classname, '.WHO') $P0 = proto.'WHO'() is_same($P0, who, msg) proto_who_done: obj_tests: .local pmc obj, objmeta ## skip object creation and tests for P6metaclass null obj $I0 = isa proto, 'P6metaclass' if $I0 goto obj_done .local string objname objname = 'concat'(shortname, '_obj') obj = proto.'new'() isa_nok(obj, 'P6Protoobject', objname) msg = 'concat'(objname, '.WHAT =:= ', classname) $P0 = obj.'WHAT'() is_same($P0, proto, msg) msg = 'concat'(objname, '.HOW =:= ', classname, '.HOW') objmeta = obj.'HOW'() is_same(objmeta, meta, msg) msg = 'concat'(objname, '.^isa(', classname, ')') $I0 = objmeta.'isa'(obj, proto) ok($I0, msg) msg = 'concat'(objname, '.WHERE') $P0 = obj.'WHERE'() $I0 = get_id obj is($I0, $P0, msg) if null who goto obj_who_done msg = 'concat'(objname, '.WHO') $P0 = obj.'WHO'() is_same($P0, who, msg) obj_who_done: obj_done: ## test 'isa' semantics .local pmc isalist $P0 = hash_default(options, 'isa', class) unless $P0 goto isa_done isalist = qw($P0) .local pmc isaiter, isatest isaiter = iter isalist isa_loop: unless isaiter goto isa_done isatest = shift isaiter isa_ok(proto, isatest, classname) msg = 'concat'(classname, '.^isa("', isatest, '")') $I0 = meta.'isa'(proto, isatest) ok($I0, msg) if null obj goto isa_loop isa_ok(obj, isatest, objname) msg = 'concat'(objname, '.^isa("', isatest, '")') $I0 = meta.'isa'(obj, isatest) ok($I0, msg) goto isa_loop isa_done: ## test 'can' semantics .local pmc canlist $P0 = hash_default(options, 'can', '') unless $P0 goto can_done canlist = qw($P0) .local pmc caniter .local string cantest caniter = iter canlist can_loop: unless caniter goto can_done cantest = shift caniter msg = 'concat'('< can ', classname, ', "', cantest, '" >') $I0 = can proto, cantest ok($I0, msg) msg = 'concat'(classname, '.^can("', cantest, '")') $I0 = meta.'can'(proto, cantest) ok($I0, msg) msg = 'concat'('< can ', objname, ', "', cantest, '" >') if null obj goto can_loop $I0 = can obj, cantest ok($I0, msg) msg = 'concat'(objname, '.^can("', cantest, '")') $I0 = meta.'can'(obj, cantest) ok($I0, msg) goto can_loop can_done: .return (obj) .end =item concat([args]) Concatenate several strings into a single string. =cut .sub 'concat' .param pmc args :slurpy $S0 = join '', args .return ($S0) .end =item qw(value) If C is already an array of some sort, return it, otherwise split C on spaces and return that. =cut .sub 'qw' .param pmc value $I0 = does value, 'array' if $I0 goto done $S0 = value value = split ' ', $S0 done: .return (value) .end =item hash_default(hash, key, default) Return the entry in C if it exists, otherwise return C. =cut .sub 'hash_default' .param pmc hash .param string key .param pmc value $I0 = exists hash[key] unless $I0 goto done value = hash[key] done: .return (value) .end =item is_same(x, y, message) Test for x and y being the same PMC. =cut .sub 'is_same' .param pmc x .param pmc y .param string msg $I0 = issame x, y ok($I0, msg) .end =item isa_ok(object, class, objectname) =item isa_ok(object, class, objectname) Test if C is/isn't an instance of C as reported by the C opcode. C is used to generate the diagnostic message in output (i.e., it's not the actual diagnostic message). =cut .sub 'isa_ok' .param pmc obj .param pmc class .param string objectname $S0 = 'concat'('< isa ', objectname, ', "', class, '" >') $I0 = 0 if null obj goto done $I0 = isa obj, class done: ok($I0, $S0) .end .sub 'isa_nok' .param pmc obj .param pmc class .param string object_name $S0 = 'concat'('! < isa ', object_name, ', "', class, '" >') $I0 = 0 if null obj goto done $I0 = isa obj, class done: nok($I0, $S0) .end .namespace ['ABC'] .sub 'foo' :method :nsentry('foo') .return ('ABC::foo') .end .namespace ['GHI'] .sub 'foo' :method .return ('GHI::foo') .end .namespace ['MyInt'] .sub 'foo' :method .return ('MyInt::foo') .end .namespace ['List'] .sub 'foo' :method .return ('List::foo') .end .namespace ['Foo';'JKL'] .sub 'foo' :method .return ('Foo::JKL::foo') .end .HLL 'myhll' .sub 'hll_tests' .local pmc exports, curr_namespace, root_namespace curr_namespace = get_namespace root_namespace = get_root_namespace ['parrot'] exports = split ' ', 'plan diag ok nok is todo is_same isa_ok isa_nok p6obj_tests' root_namespace.'export_to'(curr_namespace, exports) .local pmc p6meta p6meta = get_root_global ['parrot'], 'P6metaclass' ## build HLL class using namespace .local pmc xyzns, xyzproto, xyzobj xyzns = get_hll_namespace ['XYZ'] $P0 = p6meta.'new_class'(xyzns) xyzproto = get_hll_global 'XYZ' is_same($P0, xyzproto, 'return from .new_class =:= XYZ') $P0 = get_root_global ['parrot'], 'XYZ' $I0 = isnull $P0 ok($I0, ".new_class didn't store ['parrot'], 'XYZ'") p6obj_tests(xyzproto, 'XYZ', 'isa'=>'XYZ P6object', 'can'=>'foo', 'who'=>xyzns) ## build HLL class using name .local pmc wxyproto, wxyobj, wxyns $P0 = p6meta.'new_class'('WXY') wxyproto = get_hll_global 'WXY' wxyns = get_hll_namespace ['WXY'] is_same($P0, wxyproto, 'return from .new_class =:= WXY') $P0 = get_root_global ['parrot'], 'WXY' $I0 = isnull $P0 ok($I0, ".new_class didn't store ['parrot'], 'WXY'") p6obj_tests(wxyproto, 'WXY', 'isa'=>'WXY P6object', 'can'=>'foo', 'who'=>wxyns) ## build a Parrotclass .local pmc vwx_nsarray, vwx_ns, vwx_parrotclass, vwx_proto vwx_nsarray = new 'ResizablePMCArray' push vwx_nsarray, 'VWX' vwx_ns = get_hll_namespace vwx_nsarray vwx_parrotclass = newclass vwx_ns vwx_proto = p6meta.'register'(vwx_parrotclass) p6obj_tests(vwx_proto, 'VWX', 'can'=>'foo', 'who'=>vwx_ns) .end .namespace ['XYZ'] .sub 'foo' :method .return ('XYZ::foo') .end .namespace ['WXY'] .sub 'foo' :method .return ('WXY::foo') .end .namespace ['VWX'] .sub 'foo' :method .return ('WXY::foo') .end =back =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: ops2c.nqp000644000765000765 670111567202622 17227 0ustar00brucebruce000000000000parrot-5.9.0/compilers/opsc#! ./parrot-nqp # workaround nqp-rx not generating :main Q:PIR { .end .sub 'main' :main .const "Sub" $P0 = "MAIN" .tailcall $P0() .end .sub '' :anon }; sub MAIN() { pir::load_bytecode("opsc.pbc"); pir::load_bytecode("Getopt/Obj.pbc"); my $opts := get_options(); return usage() if $opts; #TODO: figure out how to generate line numbers # $emit_lines is currently ignored my $emit_lines := !?$opts; my $core := ?$opts; my $debug := ?$opts; my $quiet := ?$opts; my @files; if $core { @files := < src/ops/core.ops src/ops/bit.ops src/ops/cmp.ops src/ops/io.ops src/ops/math.ops src/ops/object.ops src/ops/pmc.ops src/ops/set.ops src/ops/string.ops src/ops/sys.ops src/ops/var.ops src/ops/experimental.ops >; } elsif $opts { @files.push( $opts); } else { return usage(); } my $trans := Ops::Trans::C.new(); my $start_time := pir::time__N(); my $lib := $core ?? Ops::OpLib.new( :skip_file('src/ops/ops.skip'), :quiet($quiet) ) !! undef; my $f := Ops::File.new(|@files, :oplib($lib), :core($core), :quiet($quiet)); $quiet || say("# Ops parsed in { pir::sprintf__ssp("%.3f", [pir::time__N() - $start_time] ) } seconds."); my $emitter := Ops::Emitter.new( :ops_file($f), :trans($trans), :script('ops2c.nqp'), :file(@files[0]), :flags( hash( core => $core, quiet => $quiet ) ), ); unless $debug { $emitter.print_ops_num_files() if $core; $emitter.print_c_header_files(); $emitter.print_c_source_file(); } } sub get_options() { my $getopts := pir::new(Getopt::Obj); $getopts.notOptStop(); # build core ops $getopts.add_option('core', 'c'); # build the dynops in one .ops file $getopts.add_option('dynamic', 'd', 'String'); # don't write to any files $getopts.add_option('debug', 'g'); # don't add line numbers to generated files (not implemented) $getopts.add_option('no-lines', 'n'); # print anemic usage information and exit $getopts.add_option('help', 'h'); # suppress timing and debug output on stdout $getopts.add_option('quiet', 'q'); $getopts.get_options(pir::getinterp__p()[2]); } sub usage() { say("This is ops2c, part of the Parrot VM's build infrastructure. normal options: -c --core generate the C code for core ops (must be run from within Parrot's build directory) -d --dynamic generate the C code for the dynamic ops in a single .ops file -q --quiet don't report any non-error messages -h --help print this usage information -n --no-lines do not print #line directives in generated C code (line numbers are not currently supported) debugging options: -g --debug perform all processing but do not write to any files "); pir::exit(0); } # Monkey patching module Getopt::Obj { multi method add_option($long, $short, $type?) { my $opt := self.add(); $opt.long($long); $opt.short($short); $opt.type($type) if $type; } } # vim: expandtab shiftwidth=4 ft=perl6: 027-option_or_data.t000644000765000765 347611533177643 20455 0ustar00brucebruce000000000000parrot-5.9.0/t/configure#! perl # Copyright (C) 2007, Parrot Foundation. # 027-option_or_data.t use strict; use warnings; use Test::More tests => 7; use Carp; use lib qw( lib ); use Parrot::Configure; use Parrot::Configure::Options qw( process_options ); use Parrot::Configure::Step::List qw( get_steps_list ); $| = 1; is( $|, 1, "output autoflush is set" ); my $testopt = q{bindir}; my $testoptval = q{mybindir}; my $localargv = [ qq{--$testopt=$testoptval}, ]; my ($args, $step_list_ref) = process_options( { mode => q{configure}, argv => $localargv, } ); ok( defined $args, "process_options returned successfully" ); my %args = %$args; my $conf = Parrot::Configure->new; ok( defined $conf, "Parrot::Configure->new() returned okay" ); isa_ok( $conf, "Parrot::Configure" ); $conf->add_steps( get_steps_list() ); $conf->options->set(%args); is( $conf->options->{c}->{$testopt}, $testoptval, "command-line option '--$testopt' has been stored in object" ); my $val = $conf->option_or_data($testopt); is( $val, $testoptval, 'option_or_data() returned expected value' ); pass("Completed all tests in $0"); ################### DOCUMENTATION ################### =head1 NAME 027-option_or_data.t - test C =head1 SYNOPSIS % prove t/configure/027-option_or_data.t =head1 DESCRIPTION The files in this directory test functionality used by F. This file tests C in the case where a value for the tested option has been set on the command line but where no value for the tested option has been located internally by a configuration step. =head1 AUTHOR James E Keenan =head1 SEE ALSO Parrot::Configure, F. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: oo1.rb000644000765000765 26711466337261 17465 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks#! ruby # # does the perl variant count as oo? # class Foo attr_reader :i, :j def initialize() @i = 10 @j = 20 end end (1..100000).each{ o = Foo.new } o = Foo.new puts o.i subprof.c000644000765000765 13335012101554067 16647 0ustar00brucebruce000000000000parrot-5.9.0/src/runcore/* Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME src/runcore/subprof.c - Parrot's subroutine-level profiler =head1 DESCRIPTION This compilation unit implements Parrot's subroutine-level profiler. =head2 Functions =over 4 =cut */ #include "parrot/runcore_api.h" #include "parrot/runcore_subprof.h" #include "parrot/oplib/ops.h" #include "parrot/oplib/core_ops.h" #include "parrot/dynext.h" #include "subprof.str" #include "pmc/pmc_sub.h" #include "pmc/pmc_callcontext.h" /* HEADERIZER HFILE: include/parrot/runcore_subprof.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void buildcallchain(PARROT_INTERP, ARGIN(subprofiledata *spdata), ARGIN_NULLOK(PMC *ctx), ARGIN_NULLOK(PMC *subpmc)) __attribute__nonnull__(1) __attribute__nonnull__(2); static void createlines(PARROT_INTERP, ARGIN(subprofiledata *spdata), ARGIN(subprofile *sp)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3); static void dump_profile_data(PARROT_INTERP, ARGIN(subprofiledata *spdata)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_CAN_RETURN_NULL static opcode_t * findlineannotations(PARROT_INTERP, subprofiledata *spdata, ARGIN(subprofile *sp), ARGOUT(size_t *cntp)) __attribute__nonnull__(1) __attribute__nonnull__(3) __attribute__nonnull__(4) FUNC_MODIFIES(*cntp); static void finishcallchain(PARROT_INTERP, ARGIN(subprofiledata *spdata)) __attribute__nonnull__(2); static void free_profile_data(PARROT_INTERP, ARGIN(subprofiledata *spdata)) __attribute__nonnull__(1) __attribute__nonnull__(2); static void free_subprofile(PARROT_INTERP, ARGIN(subprofile *sp)) __attribute__nonnull__(2); PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static subprofiledata * get_subprofiledata(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), int type) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_INLINE static UHUGEINTVAL getticks(void); static void Parrot_runcore_subprof_hll_init(PARROT_INTERP) __attribute__nonnull__(1); static void Parrot_runcore_subprof_ops_init(PARROT_INTERP) __attribute__nonnull__(1); static void Parrot_runcore_subprof_sub_init(PARROT_INTERP) __attribute__nonnull__(1); static void popcallchain(PARROT_INTERP, ARGIN(subprofiledata *spdata)) __attribute__nonnull__(2); static void printspname(PARROT_INTERP, const subprofiledata *spdata, ARGIN(const subprofile *sp)) __attribute__nonnull__(1) __attribute__nonnull__(3); static void runops_subprof_destroy(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore)) __attribute__nonnull__(1) __attribute__nonnull__(2); PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static opcode_t * runops_subprof_hll_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3); PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static opcode_t * runops_subprof_ops_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3); PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static opcode_t * runops_subprof_sub_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3); PARROT_CANNOT_RETURN_NULL static INTVAL * sptodebug(PARROT_INTERP, ARGMOD(subprofiledata *spdata), ARGIN(const subprofile *sp)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*spdata); PARROT_INLINE PARROT_CANNOT_RETURN_NULL static char * str2cs(PARROT_INTERP, ARGIN_NULLOK(const STRING *s)) __attribute__nonnull__(1); PARROT_CANNOT_RETURN_NULL static subprofile * sub2subprofile(PARROT_INTERP, ARGIN(subprofiledata *spdata), PMC *ctx, ARGIN(PMC *subpmc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(4); static void sync_callchainchange(PARROT_INTERP, ARGIN(subprofiledata *spdata), ARGIN(PMC *ctx), ARGIN_NULLOK(PMC *subpmc)) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3); PARROT_CANNOT_RETURN_NULL static lineinfo * sync_hll_linechange(PARROT_INTERP, ARGIN(subprofiledata *spdata), ARGIN_NULLOK(opcode_t *pc_op)) __attribute__nonnull__(2); #define ASSERT_ARGS_buildcallchain __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(spdata)) #define ASSERT_ARGS_createlines __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(spdata) \ , PARROT_ASSERT_ARG(sp)) #define ASSERT_ARGS_dump_profile_data __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(spdata)) #define ASSERT_ARGS_findlineannotations __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(sp) \ , PARROT_ASSERT_ARG(cntp)) #define ASSERT_ARGS_finishcallchain __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(spdata)) #define ASSERT_ARGS_free_profile_data __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(spdata)) #define ASSERT_ARGS_free_subprofile __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(sp)) #define ASSERT_ARGS_get_subprofiledata __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(runcore)) #define ASSERT_ARGS_getticks __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) #define ASSERT_ARGS_Parrot_runcore_subprof_hll_init \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_runcore_subprof_ops_init \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_runcore_subprof_sub_init \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_popcallchain __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(spdata)) #define ASSERT_ARGS_printspname __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(sp)) #define ASSERT_ARGS_runops_subprof_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(runcore)) #define ASSERT_ARGS_runops_subprof_hll_core __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(runcore) \ , PARROT_ASSERT_ARG(pc)) #define ASSERT_ARGS_runops_subprof_ops_core __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(runcore) \ , PARROT_ASSERT_ARG(pc)) #define ASSERT_ARGS_runops_subprof_sub_core __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(runcore) \ , PARROT_ASSERT_ARG(pc)) #define ASSERT_ARGS_sptodebug __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(spdata) \ , PARROT_ASSERT_ARG(sp)) #define ASSERT_ARGS_str2cs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_sub2subprofile __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(spdata) \ , PARROT_ASSERT_ARG(subpmc)) #define ASSERT_ARGS_sync_callchainchange __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(spdata) \ , PARROT_ASSERT_ARG(ctx)) #define ASSERT_ARGS_sync_hll_linechange __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(spdata)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Unpacks the debug segment data into an array indexed by the opcode offset. Hashes the result in spdata->seg2debug. =cut */ PARROT_CANNOT_RETURN_NULL static INTVAL * sptodebug(PARROT_INTERP, ARGMOD(subprofiledata *spdata), ARGIN(const subprofile *sp)) { ASSERT_ARGS(sptodebug) INTVAL *xdebug; size_t di, op; opcode_t *base_pc, *debug_ops; size_t code_size, debug_size; if (!spdata->seg2debug) spdata->seg2debug = Parrot_hash_new_pointer_hash(interp); xdebug = (INTVAL *)Parrot_hash_get(interp, spdata->seg2debug, (void*)sp->subattrs->seg); if (xdebug) return xdebug; base_pc = sp->subattrs->seg->base.data; code_size = sp->subattrs->seg->base.size; debug_ops = sp->subattrs->seg->debugs->base.data; debug_size = sp->subattrs->seg->debugs->base.size; xdebug = (INTVAL *)mem_sys_allocate_zeroed(code_size * sizeof (INTVAL)); for (di = 0, op = 0; op < code_size && di < debug_size; di++) { const op_info_t * const op_info = sp->subattrs->seg->op_info_table[*base_pc]; opcode_t opsize = op_info->op_count; ADD_OP_VAR_PART(interp, sp->subattrs->seg, base_pc, opsize); base_pc += opsize; xdebug[op++] = *debug_ops >= 0 ? *debug_ops : -1; while (--opsize > 0) { xdebug[op++] = -2; } debug_ops++; } while (op < code_size) xdebug[op++] = -2; Parrot_hash_put(interp, spdata->seg2debug, (void*)sp->subattrs->seg, (void*)xdebug); return xdebug; } /* =item C Convert a STRING* to a char*, or a STRINGNULL to "STRINGNULL". =cut */ PARROT_INLINE PARROT_CANNOT_RETURN_NULL static char * str2cs(PARROT_INTERP, ARGIN_NULLOK(const STRING *s)) { ASSERT_ARGS(str2cs) if (s == STRINGNULL) return mem_sys_strdup("STRNULL"); return Parrot_str_to_cstring(interp, s); } /* =item C Return a pointer to the first line annotation of the sub and the number of line annotations for this sub. The C argument is currently unused. =cut */ PARROT_CAN_RETURN_NULL static opcode_t * findlineannotations(PARROT_INTERP, SHIM(subprofiledata *spdata), ARGIN(subprofile *sp), ARGOUT(size_t *cntp)) { ASSERT_ARGS(findlineannotations) int i; size_t j, cnt, first; PackFile_Annotations *ann = sp->subattrs->seg->annotations; PackFile_Annotations_Key *key; STRING *line_str; if (!ann) return NULL; line_str = Parrot_str_new_constant(interp, "line"); /* search for the first line annotation in our sub */ for (i = 0; i < ann->num_keys; i++) { STRING * const test_key = ann->code->const_table->str.constants[ann->keys[i].name]; if (STRING_equal(interp, test_key, line_str)) break; } if (i == ann->num_keys) return NULL; /* no annotations with this key */ cnt = 0; first = 0; key = ann->keys + i; for (j = key->start; j < key->start + key->len; j++) { if ((size_t)ann->base.data[j * 2 + ANN_ENTRY_OFF] < sp->subattrs->start_offs) continue; if ((size_t)ann->base.data[j * 2 + ANN_ENTRY_OFF] >= sp->subattrs->end_offs) break; if (!cnt++) { first = j; } } *cntp = cnt; return cnt ? ann->base.data + first * 2 : NULL; } /* =item C Create the lines array from the annotations/debug segment. Every line describes a opcode segment. Also sets sp->srcfile and sp->srcline. =cut */ static void createlines(PARROT_INTERP, ARGIN(subprofiledata *spdata), ARGIN(subprofile *sp)) { ASSERT_ARGS(createlines) if (spdata->profile_type == SUBPROF_TYPE_OPS) { int i, lasti; INTVAL *xdebug = sptodebug(interp, spdata, sp); sp->nlines = sp->subattrs->end_offs - sp->subattrs->start_offs; sp->lines = (lineinfo *) mem_sys_allocate_zeroed( ((sp->nlines ? sp->nlines : 1) + 1) * sizeof (lineinfo)); sp->lines[0].op_offs = sp->subattrs->start_offs; /* just in case */ for (i = lasti = 0; i < sp->nlines; i++) { INTVAL line = xdebug[sp->subattrs->start_offs + i]; if (line != -2) { sp->lines[i].op_offs = sp->subattrs->start_offs + i; sp->lines[lasti + 1].op_offs = sp->subattrs->start_offs + i; lasti = i; } } { STRING *filename = Parrot_sub_get_filename_from_pc(interp, sp->subpmc, sp->code_ops + sp->subattrs->start_offs); sp->lines[lasti + 1].op_offs = sp->subattrs->end_offs; sp->srcline = xdebug[sp->subattrs->start_offs]; sp->srcfile = str2cs(interp, filename); } return; } if (sp->subattrs->seg->annotations) { PackFile_Annotations *ann = sp->subattrs->seg->annotations; size_t cnt = 0; opcode_t *anndata = findlineannotations(interp, spdata, sp, &cnt); if (anndata) { PMC *srcfilepmc; size_t i, j; if (spdata->profile_type == SUBPROF_TYPE_SUB) { /* we just need the first annotation for sub profiling */ cnt = 1; } /* set srcfile and srcline */ sp->srcline = anndata[ANN_ENTRY_VAL]; /* + 1 needed because Annotations_lookup looks up the annotation _before_ the pc */ srcfilepmc = PackFile_Annotations_lookup(interp, ann, anndata[ANN_ENTRY_OFF] + 1, Parrot_str_new_constant(interp, "file")); if (PMC_IS_NULL(srcfilepmc)) sp->srcfile = mem_sys_strdup("???"); else sp->srcfile = str2cs(interp, VTABLE_get_string(interp, srcfilepmc)); sp->lines = (lineinfo *) mem_sys_allocate_zeroed((cnt + 1) * sizeof (lineinfo)); for (i = j = 0; i < cnt; i++) { if (j && sp->lines[j - 1].op_offs == (size_t)anndata[i * 2 + ANN_ENTRY_OFF]) { /* no empty segments, please */ continue; } sp->lines[j++].op_offs = anndata[i * 2 + ANN_ENTRY_OFF]; } sp->lines[0].op_offs = sp->subattrs->start_offs; /* workaround */ sp->lines[j].op_offs = sp->subattrs->end_offs; if (j > 1 && sp->lines[j - 1].op_offs == sp->subattrs->end_offs) /* no empty segments, please */ j--; sp->nlines = j; } } if (!sp->nlines) { /* no annotations, fall back to debug segment */ STRING *filename = Parrot_sub_get_filename_from_pc(interp, sp->subpmc, sp->code_ops + sp->subattrs->start_offs); sp->srcline = Parrot_sub_get_line_from_pc(interp, sp->subpmc, sp->code_ops + sp->subattrs->start_offs); sp->srcfile = str2cs(interp, filename); sp->lines = (lineinfo *) mem_sys_allocate_zeroed((1 + 1) * sizeof (lineinfo)); sp->lines[0].op_offs = sp->subattrs->start_offs; sp->lines[1].op_offs = sp->subattrs->end_offs; sp->nlines = 1; } } /* =item C ... The C argument is currently unused. =cut */ PARROT_CANNOT_RETURN_NULL static subprofile * sub2subprofile(PARROT_INTERP, ARGIN(subprofiledata *spdata), SHIM(PMC *ctx), ARGIN(PMC *subpmc)) { ASSERT_ARGS(sub2subprofile) subprofile *sp; Parrot_Sub_attributes *subattrs; PMC_get_sub(interp, subpmc, subattrs); if (!spdata->sphash) spdata->sphash = Parrot_hash_new_pointer_hash(interp); sp = (subprofile *) Parrot_hash_get(interp, spdata->sphash, (void *) (subattrs->seg->base.data + subattrs->start_offs)); if (!sp) { sp = (subprofile *) mem_sys_allocate_zeroed(sizeof (subprofile)); sp->subattrs = subattrs; sp->subpmc = subpmc; sp->code_ops = sp->subattrs->seg->base.data; createlines(interp, spdata, sp); Parrot_hash_put(interp, spdata->sphash, (void *) (subattrs->seg->base.data + subattrs->start_offs), (void *) sp); VTABLE_push_pmc(interp, spdata->markpmcs, subpmc); } return sp; } /* =item C ... =cut */ static void popcallchain(SHIM_INTERP, ARGIN(subprofiledata *spdata)) { ASSERT_ARGS(popcallchain) subprofile * const sp = spdata->cursp; subprofile * const csp = sp->caller; if (sp->callerci) { sp->callerci->ops += sp->callerops; sp->callerci->ticks += sp->callerticks; } if (csp) { csp->callerops += sp->callerops; csp->callerticks += sp->callerticks; } sp->caller = NULL; sp->callerci = NULL; sp->ctx = NULL; sp->callerops = 0; sp->callerticks = 0; spdata->cursubpmc = csp ? csp->subpmc : NULL; spdata->curctx = csp ? csp->ctx : NULL; spdata->cursp = csp; } /* =item C Propagate timing information up the call chain, clearing out old frames during the process. =cut */ static void finishcallchain(SHIM_INTERP, ARGIN(subprofiledata *spdata)) { ASSERT_ARGS(finishcallchain) subprofile *sp, *csp; /* finish all calls */ for (sp = spdata->cursp; sp; sp = csp) { csp = sp->caller; if (sp->callerci) { sp->callerci->ops += sp->callerops; sp->callerci->ticks += sp->callerticks; } if (csp) { csp->callerops += sp->callerops; csp->callerticks += sp->callerticks; } sp->caller = NULL; sp->callerci = NULL; sp->ctx = NULL; sp->callerops = 0; sp->callerticks = 0; } spdata->cursp = NULL; spdata->curctx = NULL; spdata->cursubpmc = NULL; } /* =item C ... =cut */ static void buildcallchain(PARROT_INTERP, ARGIN(subprofiledata *spdata), ARGIN_NULLOK(PMC *ctx), ARGIN_NULLOK(PMC *subpmc)) { ASSERT_ARGS(buildcallchain) PMC *cctx; subprofile *sp; lineinfo *li; cctx = Parrot_pcc_get_caller_ctx(interp, ctx); if (cctx) { PMC * const csubpmc = Parrot_pcc_get_sub(interp, cctx); if (spdata->curctx != cctx || spdata->cursubpmc != csubpmc) buildcallchain(interp, spdata, cctx, csubpmc); } if (PMC_IS_NULL(subpmc)) return; /* find the correct subprofile */ sp = sub2subprofile(interp, spdata, ctx, subpmc); while (sp->ctx) { /* recursion! */ if (!sp->rnext) { subprofile *rsp; rsp = (subprofile *)mem_sys_allocate_zeroed(sizeof (subprofile)); rsp->subattrs = sp->subattrs; rsp->subpmc = sp->subpmc; rsp->code_ops = sp->code_ops; rsp->rcnt = sp->rcnt + 1; rsp->srcline = sp->srcline; rsp->srcfile = mem_sys_strdup(sp->srcfile); sp->rnext = rsp; if (sp->nlines) { int i; rsp->lines = (lineinfo *)mem_sys_allocate_zeroed( (sp->nlines + 1) * sizeof (lineinfo)); rsp->nlines = sp->nlines; for (i = 0; i < sp->nlines + 1; i++) rsp->lines[i].op_offs = sp->lines[i].op_offs; } } sp = sp->rnext; } sp->ctx = ctx; sp->caller = spdata->cursp; if (sp->caller) { subprofile * const csp = sp->caller; /* get caller pc */ opcode_t * const cpc_op = Parrot_pcc_get_pc(interp, csp->ctx); size_t cpc = cpc_op ? cpc_op - csp->code_ops : 0; if (cpc > csp->subattrs->start_offs) cpc--; /* convert cpc into line */ if (spdata->profile_type != SUBPROF_TYPE_OPS) { int i; /* might do a binary seach instead */ for (i = 0, li = csp->lines; i < csp->nlines; i++, li++) if (cpc >= li->op_offs && cpc < li[1].op_offs) break; if (i >= csp->nlines) li = csp->lines - 1; /* just in case */ } else { li = csp->lines + (cpc - csp->subattrs->start_offs); while (li > csp->lines && (li->op_offs == 0 || li->op_offs > cpc)) li--; } } else { li = &spdata->rootline; } if (li) { /* add caller to line */ callinfo *ci; if (!li->calls) { li->calls = (callinfo *) mem_sys_allocate((1 + 8) * sizeof (*ci)); ci = li->calls; ci->callee = NULL; } else { for (ci = li->calls; ci->callee; ci++) if (ci->callee == sp) break; if (!ci->callee) { int ncalls = ci - li->calls; if ((ncalls & 7) == 0) { li->calls = (callinfo *) mem_sys_realloc( li->calls, (ncalls + (1 + 8)) * sizeof (*ci)); ci = li->calls + ncalls; } } } if (!ci->callee) { memset(ci, 0, sizeof (*ci)); ci->callee = sp; ci[1].callee = NULL; } sp->callerci = ci; } else { sp->callerci = NULL; } spdata->cursp = sp; spdata->curctx = ctx; spdata->cursubpmc = subpmc; } /* =item C Prints the name of the subprofile given in C. The C argument is currently unused. =cut */ static void printspname(PARROT_INTERP, SHIM(const subprofiledata *spdata), ARGIN(const subprofile *sp)) { ASSERT_ARGS(printspname) char * const cname = str2cs(interp, sp->subattrs->name); fprintf(stderr, "%p:%s", sp, cname); if (sp->rcnt) fprintf(stderr, "'%d", sp->rcnt); mem_sys_free(cname); } /* =item C After the program has completed, print the resulting callgrind-compatible profile to stderr. =cut */ static void dump_profile_data(PARROT_INTERP, ARGIN(subprofiledata *spdata)) { ASSERT_ARGS(dump_profile_data) unsigned int totalops = 0; UHUGEINTVAL totalticks = 0; if (!spdata->profile_type) return; finishcallchain(interp, spdata); /* just in case */ if (!spdata->sphash) spdata->sphash = Parrot_hash_create(interp, enum_type_ptr, Hash_key_type_PMC_ptr); parrot_hash_iterate(spdata->sphash, subprofile *hsp = (subprofile*)_bucket->value; subprofile *sp; for (sp = hsp; sp; sp = sp->rnext) { int j; for (j = 0; j < sp->nlines; j++) { totalops += sp->lines[j].ops; totalticks += sp->lines[j].ticks; } }); fprintf(stderr, "events: ops ticks\n"); fprintf(stderr, "summary: %d %lld\n", totalops, totalticks); parrot_hash_iterate(spdata->sphash, subprofile *hsp = (subprofile*)_bucket->value; subprofile *sp; for (sp = hsp; sp; sp = sp->rnext) { opcode_t *anndata = NULL; INTVAL *xdebug = NULL; size_t cnt = 0; int i; if (spdata->profile_type != SUBPROF_TYPE_OPS) anndata = findlineannotations(interp, spdata, sp, &cnt); else xdebug = sptodebug(interp, spdata, sp); fprintf(stderr, "\n"); fprintf(stderr, "fl=%s\n", sp->srcfile); fprintf(stderr, "fn="); printspname(interp, spdata, sp); fprintf(stderr, "\n"); for (i = 0; i < sp->nlines; i++) { lineinfo *li = sp->lines + i; callinfo *ci; INTVAL srcline = -1; if (!li->ops && !li->ticks && !li->calls) continue; if (i == 0) { /* easy for the first annotation */ srcline = sp->srcline; } else { if (spdata->profile_type == SUBPROF_TYPE_OPS) { srcline = xdebug[sp->subattrs->start_offs + i]; } else if (anndata) { while (cnt > 1 && (size_t) anndata[ANN_ENTRY_OFF + 2] <= li->op_offs) { anndata += 2; cnt--; } srcline = anndata[ANN_ENTRY_VAL]; anndata += 2; cnt--; } } if (li->ops || li->ticks) fprintf(stderr, "%d %u %llu\n", (int) srcline, (unsigned int) li->ops, (unsigned long long) li->ticks); for (ci = li->calls; ci && ci->callee; ci++) { subprofile *csp = ci->callee; fprintf(stderr, "cfl=%s\n", csp->srcfile); fprintf(stderr, "cfn="); printspname(interp, spdata, csp); fprintf(stderr, "\n"); fprintf(stderr, "calls=%u %d\n", (unsigned int) ci->count, (int) csp->srcline); fprintf(stderr, "%d %u %llu\n", (int) srcline, (unsigned int) ci->ops, (unsigned long long) ci->ticks); } } }); /* also dump profiling root if there are more than one callees */ if (spdata->rootline.calls && spdata->rootline.calls[0].callee && spdata->rootline.calls[1].callee) { lineinfo *li = &spdata->rootline; callinfo *ci; fprintf(stderr, "\n"); fprintf(stderr, "fl=\n"); fprintf(stderr, "fn=__profiling_root__\n"); for (ci = li->calls; ci && ci->callee; ci++) { subprofile *csp = ci->callee; fprintf(stderr, "cfl=%s\n", csp->srcfile); fprintf(stderr, "cfn="); printspname(interp, spdata, csp); fprintf(stderr, "\n"); fprintf(stderr, "calls=%u %d\n", (unsigned int) ci->count, (int) csp->srcline); fprintf(stderr, "%d %u %llu\n", 0, (unsigned int) ci->ops, (unsigned long long) ci->ticks); } } fprintf(stderr, "\ntotals: %d %lld\n", totalops, totalticks); } /* =item C free memory we allocated for this subprofile =cut */ static void free_subprofile(SHIM_INTERP, ARGIN(subprofile *sp)) { ASSERT_ARGS(free_subprofile) if (sp->srcfile) mem_sys_free(sp->srcfile); if (sp->lines) { int i; for (i = 0; i < sp->nlines; i++) { lineinfo *li = sp->lines + i; if (li->calls) mem_sys_free(li->calls); } mem_sys_free(sp->lines); } mem_sys_free(sp); } /* =item C Free all profile data that's been accumulated. =cut */ static void free_profile_data(PARROT_INTERP, ARGIN(subprofiledata *spdata)) { ASSERT_ARGS(free_profile_data) if (spdata->sphash) { parrot_hash_iterate(spdata->sphash, subprofile *sp = (subprofile*)_bucket->value; subprofile *rsp; for (; sp; sp = rsp) { rsp = sp->rnext; free_subprofile(interp, sp); }); Parrot_hash_destroy(interp, spdata->sphash); } Parrot_pmc_gc_unregister(interp, spdata->markpmcs); spdata->markpmcs = NULL; if (spdata->rootline.calls) mem_sys_free(spdata->rootline.calls); if (spdata->seg2debug) { parrot_hash_iterate(spdata->seg2debug, INTVAL *xdebug = (INTVAL *)_bucket->value; mem_sys_free(xdebug);); Parrot_hash_destroy(interp, spdata->seg2debug); } mem_sys_free(spdata); } /* =item C Returns a high-resolution number representing how long Parrot has been running. Inline operation. =cut */ /* =item C Returns a high-resolution number representing how long Parrot has been running. =cut */ PARROT_INLINE static UHUGEINTVAL getticks(void) { ASSERT_ARGS(getticks) #if defined(__GNUC__) && (defined(__i386) || defined(__x86_64)) unsigned lo, hi; __asm__ __volatile__("rdtsc" : "=a" (lo), "=d" (hi)); return (UHUGEINTVAL) hi << 32 | lo; #else return Parrot_hires_get_time(); #endif } /* =item C Brings the profile context chain back in sync with the context's call chain. =cut */ static void sync_callchainchange(PARROT_INTERP, ARGIN(subprofiledata *spdata), ARGIN(PMC *ctx), ARGIN_NULLOK(PMC *subpmc)) { ASSERT_ARGS(sync_callchainchange) subprofile *sp = spdata->cursp; if (sp) { /* optimize common cases */ /* did we just return? */ if (sp->caller && sp->caller->subpmc == subpmc && sp->caller->ctx == ctx) { /* a simple return */ popcallchain(interp, spdata); } else { PMC *cctx = Parrot_pcc_get_caller_ctx(interp, ctx); PMC *csubpmc = Parrot_pcc_get_sub(interp, cctx); if (spdata->curctx == cctx && spdata->cursubpmc == csubpmc) { /* a simple call */ buildcallchain(interp, spdata, ctx, subpmc); } else if (sp->caller && sp->caller->subpmc == csubpmc && sp->caller->ctx == cctx) { /* some kind of tailcall */ popcallchain(interp, spdata); buildcallchain(interp, spdata, ctx, subpmc); } } } if (subpmc != spdata->cursubpmc || ctx != spdata->curctx) { /* out of luck! redo call chain */ finishcallchain(interp, spdata); buildcallchain(interp, spdata, ctx, subpmc); } } /* =item C bring the line data in sync with the pc =cut */ PARROT_CANNOT_RETURN_NULL static lineinfo * sync_hll_linechange(SHIM_INTERP, ARGIN(subprofiledata *spdata), ARGIN_NULLOK(opcode_t *pc_op)) { ASSERT_ARGS(sync_hll_linechange) const subprofile * const sp = spdata->cursp; lineinfo *li; if (sp->nlines > 1) { const size_t pc = pc_op ? pc_op - sp->code_ops : 0; int i; for (i = 0, li = sp->lines; i < sp->nlines; i++, li++) if (pc >= li->op_offs && pc < li[1].op_offs) break; if (i == sp->nlines) li = sp->lines; /* just in case */ } else { li = sp->lines; } return li; } /* =item C Returns the subprofile data for C. The C parameter specifies the type of data to return. Accepted values are C, C, or C. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static subprofiledata * get_subprofiledata(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), int type) { ASSERT_ARGS(get_subprofiledata) Parrot_subprof_runcore_t *core = (Parrot_subprof_runcore_t *) runcore; subprofiledata *spdata = core->spdata; if (!spdata) { spdata = (subprofiledata *) mem_sys_allocate_zeroed(sizeof (subprofiledata)); spdata->profile_type = type; spdata->interp = interp; spdata->markpmcs = Parrot_pmc_new(interp, enum_class_ResizablePMCArray); Parrot_pmc_gc_register(interp, spdata->markpmcs); core->spdata = spdata; } if (spdata->profile_type != type) Parrot_ex_throw_from_c_args(interp, NULL, 1, "illegal profile type change while profiling"); if (spdata->interp != interp) Parrot_ex_throw_from_c_args(interp, NULL, 1, "illegal interpreter change while profiling"); return core->spdata; } #ifdef code_start # undef code_start #endif #ifdef code_end # undef code_end #endif #define code_start interp->code->base.data #define code_end (interp->code->base.data + interp->code->base.size) /* =item C Destroy callback. We use it to print the profile data. */ static void runops_subprof_destroy(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore)) { ASSERT_ARGS(runops_subprof_destroy) Parrot_subprof_runcore_t *core = (Parrot_subprof_runcore_t *)runcore; if (core->spdata) { dump_profile_data(interp, core->spdata); free_profile_data(interp, core->spdata); core->spdata = NULL; } } /* =item C Runs the opcodes starting at C until none remain. Runs bounds checking. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static opcode_t * runops_subprof_sub_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc)) { ASSERT_ARGS(runops_subprof_sub_core) PMC *ctx, *subpmc; subprofiledata *spdata = get_subprofiledata(interp, runcore, SUBPROF_TYPE_SUB); subprofile *sp = spdata->cursp; while (pc) { if (pc < code_start || pc >= code_end) Parrot_ex_throw_from_c_args(interp, NULL, 1, "attempt to access code outside of current code segment"); ctx = CURRENT_CONTEXT(interp); Parrot_pcc_set_pc(interp, ctx, pc); subpmc = ((Parrot_Context *) PMC_data_typed(ctx, Parrot_Context *))->current_sub; if (!PMC_IS_NULL(subpmc)) { if (subpmc != spdata->cursubpmc || ctx != spdata->curctx) { /* context changed! either called new sub or returned from sub */ /* finish old ticks */ UHUGEINTVAL tick = getticks(); if (spdata->tickadd) { UHUGEINTVAL tickdiff = tick - spdata->starttick; *spdata->tickadd += tickdiff; *spdata->tickadd2 += tickdiff; } sync_callchainchange(interp, spdata, ctx, subpmc); sp = spdata->cursp; if (pc == sp->code_ops + sp->subattrs->start_offs) { /* assume new call */ if (sp->callerci) sp->callerci->count++; } spdata->tickadd = &sp->lines->ticks; spdata->tickadd2 = &sp->callerticks; spdata->starttick = getticks(); } sp->lines->ops++; sp->callerops++; } DO_OP(pc, interp); } return pc; } /* =item C Registers the subprof_sub runcore with Parrot. =cut */ static void Parrot_runcore_subprof_sub_init(PARROT_INTERP) { ASSERT_ARGS(Parrot_runcore_subprof_sub_init) Parrot_subprof_runcore_t * const coredata = mem_gc_allocate_zeroed_typed(interp, Parrot_subprof_runcore_t); coredata->name = CONST_STRING(interp, "subprof_sub"); coredata->id = PARROT_SUBPROF_SUB_CORE; coredata->opinit = PARROT_CORE_OPLIB_INIT; coredata->runops = runops_subprof_sub_core; coredata->prepare_run = NULL; coredata->destroy = runops_subprof_destroy; coredata->flags = 0; PARROT_RUNCORE_FUNC_TABLE_SET(coredata); Parrot_runcore_register(interp, (Parrot_runcore_t *)coredata); } /* =item C Runs the Parrot operations starting at C until there are no more operations, with sub-level profiling and bounds checking enabled. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static opcode_t * runops_subprof_hll_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc)) { ASSERT_ARGS(runops_subprof_hll_core) subprofiledata *spdata = get_subprofiledata(interp, runcore, SUBPROF_TYPE_HLL); subprofile *sp = spdata->cursp; lineinfo *curline = sp ? sp->lines : NULL; opcode_t *startop = NULL; opcode_t *endop = NULL; /* triggers pc >= endop below */ while (pc) { PMC *ctx; PMC *subpmc; if (pc < code_start || pc >= code_end) Parrot_ex_throw_from_c_args(interp, NULL, 1, "attempt to access code outside of current code segment"); ctx = CURRENT_CONTEXT(interp); Parrot_pcc_set_pc(interp, ctx, pc); subpmc = ((Parrot_Context *)PMC_data_typed(ctx, Parrot_Context*))->current_sub; if (!PMC_IS_NULL(subpmc)) { if (subpmc != spdata->cursubpmc || ctx != spdata->curctx) { /* context changed! either called new sub or returned from sub */ /* finish old ticks */ UHUGEINTVAL tick = getticks(); if (spdata->tickadd) { UHUGEINTVAL tickdiff = tick - spdata->starttick; *spdata->tickadd += tickdiff; *spdata->tickadd2 += tickdiff; } sync_callchainchange(interp, spdata, ctx, subpmc); sp = spdata->cursp; if (pc == sp->code_ops + sp->subattrs->start_offs) { /* assume new call */ if (sp->callerci) sp->callerci->count++; } curline = sync_hll_linechange(interp, spdata, pc); spdata->tickadd = &curline->ticks; spdata->tickadd2 = &sp->callerticks; startop = sp->code_ops + curline->op_offs; endop = sp->code_ops + curline[1].op_offs; spdata->starttick = getticks(); } if (pc >= endop) { /* finish old ticks */ UHUGEINTVAL tick = getticks(); if (spdata->tickadd) { const UHUGEINTVAL tickdiff = tick - spdata->starttick; *spdata->tickadd += tickdiff; *spdata->tickadd2 += tickdiff; } spdata->starttick = tick; /* bring curline in sync with the pc */ while (pc >= sp->code_ops + curline[1].op_offs) { curline++; } startop = sp->code_ops + curline->op_offs; endop = sp->code_ops + curline[1].op_offs; spdata->tickadd = &curline->ticks; } else if (pc < startop) { /* finish old ticks */ const UHUGEINTVAL tick = getticks(); if (spdata->tickadd) { UHUGEINTVAL tickdiff = tick - spdata->starttick; *spdata->tickadd += tickdiff; *spdata->tickadd2 += tickdiff; } spdata->starttick = tick; /* bring curline in sync with the pc */ while (pc < sp->code_ops + curline->op_offs) { curline--; } startop = sp->code_ops + curline->op_offs; endop = sp->code_ops + curline[1].op_offs; spdata->tickadd = &curline->ticks; } curline->ops++; sp->callerops++; } DO_OP(pc, interp); } return pc; } /* =item C Registers the subprof_hll runcore with Parrot. =cut */ static void Parrot_runcore_subprof_hll_init(PARROT_INTERP) { ASSERT_ARGS(Parrot_runcore_subprof_hll_init) Parrot_subprof_runcore_t * const coredata = mem_gc_allocate_zeroed_typed(interp, Parrot_subprof_runcore_t); coredata->name = CONST_STRING(interp, "subprof_hll"); coredata->id = PARROT_SUBPROF_HLL_CORE; coredata->opinit = PARROT_CORE_OPLIB_INIT; coredata->runops = runops_subprof_hll_core; coredata->prepare_run = NULL; coredata->destroy = runops_subprof_destroy; coredata->flags = 0; PARROT_RUNCORE_FUNC_TABLE_SET(coredata); Parrot_runcore_register(interp, (Parrot_runcore_t *)coredata); } /* =item C Runs the Parrot operations starting at C until there are no more operations, with sub-level profiling and bounds checking enabled. =cut */ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static opcode_t * runops_subprof_ops_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc)) { ASSERT_ARGS(runops_subprof_ops_core) subprofiledata *spdata = get_subprofiledata(interp, runcore, SUBPROF_TYPE_OPS); subprofile *sp = spdata->cursp; opcode_t *startop = sp ? sp->code_ops + sp->subattrs->start_offs : NULL; while (pc) { PMC *ctx; PMC *subpmc; if (pc < code_start || pc >= code_end) Parrot_ex_throw_from_c_args(interp, NULL, 1, "attempt to access code outside of current code segment"); ctx = CURRENT_CONTEXT(interp); Parrot_pcc_set_pc(interp, ctx, pc); subpmc = ((Parrot_Context *)PMC_data_typed(ctx, Parrot_Context*))->current_sub; if (!PMC_IS_NULL(subpmc)) { /* finish old ticks */ const UHUGEINTVAL tick = getticks(); if (spdata->tickadd) { const UHUGEINTVAL tickdiff = tick - spdata->starttick; *spdata->tickadd += tickdiff; *spdata->tickadd2 += tickdiff; spdata->starttick = tick; } if (subpmc != spdata->cursubpmc || ctx != spdata->curctx) { /* context changed! either called new sub or returned from sub */ sync_callchainchange(interp, spdata, ctx, subpmc); sp = spdata->cursp; if (pc == sp->code_ops + sp->subattrs->start_offs) { /* assume new call */ if (sp->callerci) sp->callerci->count++; } startop = sp->code_ops + sp->subattrs->start_offs; spdata->tickadd2 = &sp->callerticks; spdata->starttick = getticks(); } sp->lines[(int)(pc - startop)].ops++; sp->callerops++; spdata->tickadd = &sp->lines[(int)(pc - startop)].ticks; } DO_OP(pc, interp); } return pc; } /* =item C Registers the subprof_ops runcore with Parrot. =cut */ static void Parrot_runcore_subprof_ops_init(PARROT_INTERP) { ASSERT_ARGS(Parrot_runcore_subprof_ops_init) Parrot_subprof_runcore_t * const coredata = mem_gc_allocate_zeroed_typed(interp, Parrot_subprof_runcore_t); coredata->name = CONST_STRING(interp, "subprof_ops"); coredata->id = PARROT_SUBPROF_OPS_CORE; coredata->opinit = PARROT_CORE_OPLIB_INIT; coredata->runops = runops_subprof_ops_core; coredata->prepare_run = NULL; coredata->destroy = runops_subprof_destroy; coredata->flags = 0; PARROT_RUNCORE_FUNC_TABLE_SET(coredata); Parrot_runcore_register(interp, (Parrot_runcore_t *) coredata); } /* =item C Register all three subprof cores =cut */ void Parrot_runcore_subprof_init(PARROT_INTERP) { ASSERT_ARGS(Parrot_runcore_subprof_init) Parrot_runcore_subprof_sub_init(interp); Parrot_runcore_subprof_hll_init(interp); Parrot_runcore_subprof_ops_init(interp); } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ LICENSE000644000765000765 53211606346657 15612 0ustar00brucebruce000000000000parrot-5.9.0/ext/winxedWinxed is Copyright 2009-2011 by Julián Albo "NotFound" It is free software; you can redistribute it and/or modify it under the terms of either: a) the GNU General Public License version 3 as published by the Free Software Foundation: http://www.gnu.org/licenses/gpl.html b) the "Artistic License": http://dev.perl.org/licenses/artistic.html mines_debug.png000644000765000765 1126711466337261 22463 0ustar00brucebruce000000000000parrot-5.9.0/examples/sdl/minesweeper‰PNG  IHDRP@Çð6~IDATxœå›}P”×½Ç?ûʾ°»°»ÁcKRÁkÇ£Ö$¦ÓfšŒÉLfÚÛk/6é4qît¦¹7ÓL«½I37™L3I3½“I¢6_F;Ec”¢¡¾!¢ ,‹˲°/°¯ÏýcÙ\ö…¨5©_çwÏ÷ …B‡L¦J¹ý¡`ˆqû8ã¶q„ €"[Ú¨ŽáKSRl…Àé„]»äìß/£¼<ÈSOyÉÏO>Ô^¿ÆûÞçËÁ/õ"K¸'ýVÎ^Éê9«™•6+!ßïwÓÓs«õ0Ng/Á ©4ŒŒBòóëÈË{…"+¥ßá¹æáʧW°´ ‹0­5QútiL¹[.à¹sbþö7{öȸpAJNŽ€×+’ èö»±ÛÉUç² k—G.Ó:ЊÓçĨ2R3»&!?Ãé´ ý-ÄbÃøzõ~¿ ¥Ò@ní…BôÑùS3¶/m¤e¦¡/×O[ö– h³‰¹tIÂÀ€¿f\ƒÒÀ¦’M¨$*Ô25ǯg¨}ˆNG'íÃíI”Ë5¬"ôODšˆîî}ŒŽšq:-ŒÛ“¶!b;m£¯¹?„R¯DÆù·\À¢¢ >êcdD„Ý.ž7K‘ÅýŠûðýhZä9¢‰?É “©ÉÉ)Àn¿ÈÈH'n·‰DάYsQ«§¢„€Ëâ¢ko±†û ØÏÙ½2—sË,(((ÐÜ,£¹ù«×386È9û9¬n+yª¬‡­ w“÷@j£g3!gf!òO@0dhlˆÆÞFšz›H§Q}O5‹u‹gTR©#3³µ:P(ˆÇÓ—´ ŒÑûY/.‹ g·“Ö\=.ün?¶6æ3c¶±)œ[‚pýŠ|…—H¾â!(¤¹¯™.}„}ÜΚ9kX?w=:¥.é³/>߉œ¹s×SP°šÎÎ9sæ:ÇÈÈetºEñŸï "„ž–¿YŽñ:¼½Aú[úIEdf Ê¹ž/Þrívèïs횈`†‡Eœ?žPŒÆº:¸|.>ëýŒ¿\ü æQ3KõK™—9—ßÅÅá‹è•z²¤!ããv¬Ö&D" éé³££]„B¤R5Riâêêq¹cè>@‡£óˆ™:>@"–0;}6ß/ú>+f¯ˆËÜ\½z ‡ãb± áõŽ —k0¿CV’qT©SbzØ͸N à¹æ!äa¨0`zØ„D*™Â‘J$d2b±Q¢þ7ò•JÈÉXº4„¢årr”Jbž1™/Ë)É*!MšóœLE&iÒ´„|•JÏܹk±Ù¾ÄíîG(Ùèõäå=€B‘™°ýbIøŠ@­WcXj@™­D»@‹,-v­,ÍËËcÑ¢E¤§§§¼˜JÃÁ{#¿¶jk 8‹HÐOÇÏ’eñýonêù˜?ÃWæO†a‘Ã"CB>W®\€ðUq·óEwÂÈÎÎæÅ_¤¾¾þÇ¿å~ Ñh¤¸¸xF¨­­eöìÙ_ þ<›b»y(”„†L£aþŠ·Î,..æÉ'ŸœÑ˜ü¬;ÎfMg'êïg€!`>;ù23‘ŽÆñívĈÆǧT&(„ôzÐjcü´o:äÁ j¿‘χ È®ÿ&ʨ¼Áï‡`x’ŒÉ¥--È?øqw7ˆÅÑ¥ChÎ|Oº»»yï½÷˜;wn\nañ>Z€á‰ûVÀL8M$0Šôt‚ ¨¬DP« iµ•ÜÍ5ò Ö¦&òkk)é%t÷Þ‹HœºgñÛßþ6ú9°aC8§«­­E¯OlG477 …X½z5[·n¥¥¥…ýèG˜ÍfÜnwBî5‘×<üä“dggsàÀÚÛÛš€ÙÀŽIœ¸Šl6¤Ÿ}†¸«‹É„¿²’P ^ihA@ªRñ7ÞÀÓß¾¢‚…?þ1š£0‚C‡qòäIrrrX·nºD é ,Z´ˆöövvî܉X,F­VãóùX³fMÂp†ð˜÷9áÈÓétÆ)“ Ø ¬#‰s™FÀÁ€¿ª Ñà "¯ik+œ<‰ÈfוE¨$ñzÒÑÞ‚ÀÀéÓ(²³ñôõÑ×ÜÌHg'Ë_}U QÐßßÏï~÷;Aà»ßý.uuuÑY?¶nÝJWWgÎœáµ×^#PZZÊÓO?V«Ë"ÜE}ß<ˆR©¤««kJ9á.y•1.Ä›“€ÈéD¶?²O>AÚÚJ º:©€¡@‰BÁÒ^ xÓ&:?úˆ#?ÿ9}G2n³¥$ ßïgçÎtvvb0ظq#™™±ëØé°wï^ºººX¹r%&“‰¦¦&Ο?ÏŽ;(..Žæ~7bþÄßÂ]¸p!¦Œ ¸øy±ƒ“FƒPP@¨¸˜à’%-‘דÚLUN!¿ŸP €H,F·x1…‚€ÇC(8Ýú8—/_fß¾}¸\.ª««©¬¬L‰ðöÛoãr¹X³f ¿þõ¯yþùçQ©Tœ>}‡Ã—— ,!<Ûƨ²U@1×#0F@±ÙŒ¤¹É_ =~I[ŒÒë ¦=ƪ*B~?Ö¦&Æ°>Œßí&cî\d)ì;{½^9}ú4‰„Ÿþô§)'øNyü~?mmm8NÒÓÓ …B(•Ê¤CÀ,`)á›<ÓÊç€Ë&®ÉˆéÂb‹ù®]ˆ¯]ƒ`‘àÕ¨ªJÚ}¾½e #f3=‡aÞ³±TŠ¦ €oýä'¤Çé>“ÑÑÑÁ;＃×ëeóæÍÜ{ï½I9“ñË_þ’;vðþûïóî»ï"‹Ñét<óÌ3Ñ¥g< éÀ¿óO>ÂÝvañznàÄø¡… ÔÔ 9w‘ÛM ²’@u5¢"H;>5¯½†åàA\½½È32È}àŒË–!‘Ë“ò=ÕÕÕ¬X±‚gŸ}6iùñÃþ“Éĉ'°ÛídddPQQÁòåËIOO)/‘Hi4ˆ231ùý˜&î¯Ö½„…›7™”™Iä¨E¬¸`,X€Àõ­pÉÄ5‘¤6;;›ÚÚÚ)ÝL½d ³—,IøCãñkkk©­­MÈMÄW©T<òÈ#<òÈ#)ñóòò(Y±ÙÈHxãfL„'‹˜¹[¡€eùfý0‹Åò•¹_þñ#oþVøi&“iÆü`0ˆÕjåü#¯¾úêåKáæý´›õý~?@üͦáv»9rä===wœ/…°Ÿ¶Y.Gzü8ž;¦þýïÏÖ­[c*™<æÅóÏŸ?ÝngÞ¼yÆèýýÄ@ €×ëÛ`‡ÃAgg'>Ÿªª*¼^/^¯7êÒÜnþ˜Ì¦1ÒãÇI{ï=Ãóæ›ÑÂ{÷î" ¦®ßÚµ°m[ô^ÄO‰D¸Ýn4 ƒƒƒœ;wŽÁÁAÔjuTÄx~b{{;ïíØÁhG‘ÝW;pOE÷WWãõzA˜~Ô¹Y¾ x½^ìv;###ø|>Äb1™™™äää––-Õ-òÁ³cŒ‘öᇈ<žÞmh@«Õò‡úzþ­¡qoï´‡ph?~§ÓɱcÇhiiÁçó‘““CYY«V­¢¢¢"®)066FÖÅ‹Ô¶µQ4qïÐc0ð'9îu³|‹Å§Ÿ~ʉ'p8Èår.\ÈC=IJeËP*l¬{Þ|‘ǃ¼¡•@ab!pßöíH€±—^Â[_ÏtkFƒËåb÷îÝœ:u*ºtºzõ*=== 1gÎœ„®ŠX4qt¶™RÅ+mmœà‹€ÿ›!ßápàt:)**" röìYššš‰Däçç3oÞ”Œ0v%ò°xPõÀ›ÀƒÀc@ìˆÆàà ÇŽãÔ©S¬]»vŠŸf³Ù8zô(¹¹¹¼òÊ+qÀ(Ð5©a}\wHRÁ~ûÛÜÛÖ@;á ˜ ???Ÿõë×£T*ñz½ìÞ½›¿þõ¯X,–i×Ò1¾ÛÐ@añ6Ž¾…„Åûo ä†11‚ .pöìYNž<‰Ãá˜ÖOâСC<üðÃ3þü)u¤§§#[º”s™™DŠ! ;…%äd>6ÕÔ̈`00 ¸\.:::ðx<Èårôz=³fÅ1Ž ¸}ûv&Æ<áÈ‹ˆ· øà!¼V­««cÛ¶m<úè£ÑŠìv;ƒƒƒø|á÷×Oóùèëë›2+Onüw~ð\.Wôžžð¤3<<S>ŸwÞ s·l™2Nž<ɾ}û¸xñ"¥¥¥ÔÕÕ‘;Í–FTÀúúzêëëÑjµ,$Üm#âm$,Þ³KJhllŒIYæÍ›‡ èõz®^½:½Ÿ&“‘——Gyyù´j4ÊËËcî÷÷÷óÅ_$ýцï}ï{Øíás€Z­»Ýž22Nœ8Acc# ,`Æ <øàƒÓþ/†˜.ü?õõ”mßó"‘ÝqVƒ•JEYYÝÝÝØl¶˜2Z­–šš £)A2ŒŽŽÒÓÓƒÕjE,3žÄ“ŒˆùÔÕÕ°eË–„~Øí‚Ýnšw ‘ç'jGŒ€?,‚d~ØíB*¿ÝHåùÓÕjµ|üñÇlÞ¼™·ß~;¡v»iô×%ãaZív{Ô[½zuB?ì_©¼Ä¸G|SõÃîvÄ0U?ìnGÜãó­­­ìÚµ‹ÖÖÖ¤§ÛïfHoÖKć[É¿ÓÞ¬Ÿ·’§!úÅ/~!|“ý¸·¦ÙZøgâÿlÃÈIEND®B`‚hamming.pir000644000765000765 323011533177634 20610 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks# Copyright (C) 2009, Parrot Foundation. =head1 NAME examples/benchmarks/hamming.pir - calculate hamming distance between two strings =head1 SYNOPSIS ./parrot examples/benchmarks/hamming.pir foobar foozibar =head1 DESCRIPTION Calculate the number of characters that are different between two strings. Strings need not be the same length. This benchmark should be useful for looking into the performance of String PMC -> string conversion and function calls. =cut .sub main .param pmc argv .local pmc s1, s2 .local int argc $S0 = shift argv # get rid of filename argc = argv s1 = new 'String' s2 = new 'String' if argc == 2 goto get_args s1 = "bbbcdebbbcdebbcdebcdbcdebbcdebebbcdebcdebbcdebbbcdebbcdebbcdebbcdebcdef" s2 = "acdbcdeabcdeaeaabcdeabbcdeadeaeabcdebcdeabcdeaabcdeabcdeabcdeabcdebcdef" goto get_distance get_args: s1 = argv[0] s2 = argv[1] get_distance: $I0 = distance(s1,s2) print $I0 print "\n" .end .sub distance .param string s1 .param string s2 .local int dist .local int min, max dist = 0 $I0 = length s1 $I1 = length s2 min = $I0 max = $I1 if $I0 < $I1 goto calc_dist min = $I1 max = $I0 calc_dist: dist = max - min .local int k k = 0 loop: $S1 = get_char(s1,k) $S2 = get_char(s2,k) $I4 = $S1 != $S2 dist += $I4 inc k if k >= min goto done goto loop done: .return (dist) .end .sub get_char .param string s .param int k $S0 = substr s, k, 1 .return ($S0) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: setup.pir000755000765000765 330211715102032 20401 0ustar00brucebruce000000000000parrot-5.9.0/examples/pir/befunge#! ../../../parrot # Copyright (C) 2009-2011, Parrot Foundation. =head1 NAME setup.pir - Python distutils style =head1 DESCRIPTION No Configure step, no Makefile generated. See F. =head1 USAGE $ parrot setup.pir $ parrot setup.pir test $ sudo parrot setup.pir install =cut .sub 'main' :main .param pmc args $S0 = shift args load_bytecode 'distutils.pbc' $P0 = new 'Hash' $P0['name'] = 'befunge' $P0['abstract'] = 'This is a Befunge interpreter written in PIR' $P0['description'] = 'This is a Befunge interpreter written in PIR' $P0['license_type'] = 'Artistic License 2.0' $P0['license_uri'] = 'http://www.perlfoundation.org/artistic_license_2_0' $P0['copyright_holder'] = 'Parrot Foundation' $P0['checkout_uri'] = 'https://github.com/parrot/parrot/tree/master/examples/pir/befunge' $P0['browser_uri'] = 'https://github.com/parrot/parrot/tree/master/examples/pir/befunge' $P0['project_uri'] = 'https://github.com/parrot/parrot/tree/master/examples/pir/befunge' # build $P1 = new 'Hash' $P2 = split "\n", <<'SOURCES' befunge.pir debug.pir flow.pir io.pir load.pir maths.pir stack.pir SOURCES $P1['befunge.pbc'] = $P2 $P0['pbc_pir'] = $P1 $P3 = new 'Hash' $P3['parrot-befunge'] = 'befunge.pbc' $P0['exe_pbc'] = $P3 $P0['installable_pbc'] = $P3 # test $P0['test_exec'] = 'perl' # dist $P4 = glob('*.bef') $P0['manifest_includes'] = $P4 $P5 = split ' ', 'Changes MAINTAINER README' $P0['doc_files'] = $P5 .tailcall setup(args :flat, $P0 :flat :named) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: hello.c000644000765000765 54412101554066 17132 0ustar00brucebruce000000000000parrot-5.9.0/config/auto/llvm/* * Copyright (C) 2009, Parrot Foundation. =head1 DESCRIPTION A test file only. =over 4 =item C A test file only. =cut */ #include int main() { printf("hello world\n"); return 0; } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ composition.t000644000765000765 2100611533177644 16153 0ustar00brucebruce000000000000parrot-5.9.0/t/oo#!./parrot # Copyright (C) 2007-2010, Parrot Foundation. =head1 NAME t/oo/composition.t - test role composition =head1 SYNOPSIS % prove t/oo/composition.t =head1 DESCRIPTION Tests role composition in the OO implementation. =cut .sub main :main .include 'except_types.pasm' .include 'test_more.pir' plan(45) role_with_no_methods() role_with_one_method_no_methods_in_class() two_roles_and_a_class_a_method_each_no_conflict() two_roles_that_conflict() role_that_conflicts_with_a_class_method() conflict_resolution_by_exclusion() conflict_resolution_by_aliasing_and_exclude() conflict_resolution_by_resolve() role_that_does_a_role() conflict_from_indirect_role() multi_composition() .end .sub badger :method :nsentry('badger') .return('Badger!') .end .sub badger2 :method :nsentry('badger2') .return('Second Badger!') .end .sub mushroom :method :nsentry('mushroom') .return('Mushroom!') .end .sub snake :method :nsentry('snake') .return('Snake!') .end .sub fire .return("You're FIRED!") .end .sub fire2 .return('BURNINATION!') .end .sub give_payrise .return('You all get a pay rise of 0.0005%.') .end .sub role_with_no_methods $P0 = new 'Role' $P1 = new 'Class' $P1.'add_role'($P0) ok(1, 'added role') $P2 = $P1.'roles'() $I0 = elements $P2 is($I0, 1, 'roles list has the role') $P2 = $P1.'new'() ok(1, 'instantiated class with composed role') .end .sub role_with_one_method_no_methods_in_class $P0 = new 'Role' $P1 = new 'Class' $P2 = get_global "badger" $P0.'add_method'("badger", $P2) ok(1, 'added method to a role') $P1.'add_role'($P0) ok(1, 'composed role into the class') $P2 = $P1.'roles'() $I0 = elements $P2 is($I0, 1, 'roles list has the role') $P2 = $P1.'new'() ok(1, 'instantiated class with composed role') $S0 = $P2.'badger'() is($S0, 'Badger!', 'called method composed from role') .end .sub two_roles_and_a_class_a_method_each_no_conflict $P0 = new 'Role' $P1 = new 'Role' $P2 = new 'Class' $P3 = get_global "snake" $P2.'add_method'("snake", $P3) ok(1, 'class has a method') $P3 = get_global "badger" $P0.'add_method'("badger", $P3) $P2.'add_role'($P0) ok(1, 'composed first role into the class') $P3 = get_global "mushroom" $P1.'add_method'("mushroom", $P3) $P2.'add_role'($P1) ok(1, 'composed second role into the class') $P3 = $P2.'new'() ok(1, 'instantiated class') $S0 = $P3.'badger'() is($S0, 'Badger!', 'called method from first role') $S1 = $P3.'mushroom'() is($S1, 'Mushroom!', 'called method from second role') $S2 = $P3.'snake'() is($S2, 'Snake!', 'called method from class') .end .sub two_roles_that_conflict .local pmc eh $P0 = new 'Role' $P1 = new 'Role' $P2 = new 'Class' $P3 = get_global "badger" $P0.'add_method'("badger", $P3) $P2.'add_role'($P0) ok(1, 'composed first role into the class') $P3 = get_global "badger2" $P1.'add_method'("badger", $P3) try: eh = new 'ExceptionHandler' eh.'handle_types'(.EXCEPTION_ROLE_COMPOSITION_METHOD_CONFLICT) set_label eh, catch push_eh eh $P2.'add_role'($P1) $I0 = 1 goto finally catch: $I0 = 0 finally: pop_eh nok($I0, 'composition failed due to conflict') .end .sub role_that_conflicts_with_a_class_method .local pmc eh $P0 = new 'Role' $P1 = new 'Class' $P2 = get_global "badger" $P1.'add_method'("badger", $P2) ok(1, 'class has a method') $P2 = get_global "badger2" $P0.'add_method'("badger", $P2) try: eh = new 'ExceptionHandler' eh.'handle_types'(.EXCEPTION_ROLE_COMPOSITION_METHOD_CONFLICT) set_label eh, catch push_eh eh $P1.'add_role'($P0) $I0 = 1 goto finally catch: $I0 = 0 finally: pop_eh nok($I0, 'composition failed due to conflict') .end .sub conflict_resolution_by_exclusion $P0 = new 'Role' $P1 = new 'Class' $P2 = get_global "badger" $P1.'add_method'("badger", $P2) ok(1, 'class has a method') $P2 = get_global "badger2" $P0.'add_method'("badger", $P2) $P2 = get_global "snake" $P0.'add_method'("snake", $P2) $P3 = new 'ResizableStringArray' push $P3, "badger" $P1.'add_role'($P0, 'exclude_method' => $P3) ok(1, 'composition worked due to exclusion') $P2 = $P1.'new'() $S0 = $P2.'badger'() is($S0, 'Badger!', 'called method from class') $S1 = $P2.'snake'() is($S1, 'Snake!', "called method from role that wasn't excluded") .end .sub conflict_resolution_by_aliasing_and_exclude $P0 = new 'Role' $P1 = new 'Class' $P2 = get_global 'badger' $P1.'add_method'('badger', $P2) ok(1, 'class has a method') $P2 = get_global 'badger2' $P0.'add_method'('badger', $P2) $P2 = get_global 'snake' $P0.'add_method'('snake', $P2) $P3 = new 'Hash' $P3['badger'] = 'role_badger' $P4 = new 'ResizableStringArray' $P4[0] = 'badger' $P1.'add_role'($P0, 'alias_method' => $P3, 'exclude_method' => $P4) ok(1, 'composition worked due to aliasing and exclude') $P2 = $P1.'new'() $S0 = $P2.'badger'() is($S0, 'Badger!', 'called method from class') $S1 = $P2.'snake'() is($S1, 'Snake!', "called method from role that wasn't aliased") $S2 = $P2.'role_badger'() is($S2, 'Second Badger!', 'called method from role that was aliased') .end .sub conflict_resolution_by_resolve $P0 = new 'Role' $P1 = new 'Class' $P3 = new 'ResizableStringArray' push $P3, 'badger' $P1.'resolve_method'($P3) ok(1, 'set resolve list') $P4 = $P1.'resolve_method'() $S0 = $P4[0] is($S0, 'badger', 'got resolve list and it matched') $P2 = get_global 'badger' $P1.'add_method'('badger', $P2) ok(1, 'class has a method') $P2 = get_global 'badger2' $P0.'add_method'('badger', $P2) $P2 = get_global 'snake' $P0.'add_method'('snake', $P2) $P1.'add_role'($P0) ok(1, 'composition worked due to resolve') $P2 = $P1.'new'() $S1 = $P2.'badger'() is($S1, 'Badger!', 'called method from class') $S2 = $P2.'snake'() is($S2, 'Snake!', "called method from role that wasn't resolved") .end .sub role_that_does_a_role .local pmc PHB, Manage, FirePeople FirePeople = new 'Role' $P0 = get_global 'fire' FirePeople.'add_method'("fire", $P0) Manage = new 'Role' $P0 = get_global 'give_payrise' Manage.'add_method'("give_payrise", $P0) Manage.'add_role'(FirePeople) ok(1, 'adding one role to another happens') PHB = new 'Class' PHB.'add_role'(Manage) ok(1, 'added one rule that does another role to the class') $P0 = PHB.'new'() $S0 = $P0.'give_payrise'() is($S0, 'You all get a pay rise of 0.0005%.', 'called method from direct role') $S1 = $P0.'fire'() is($S1, "You're FIRED!", 'called method from indirect role') .end .sub conflict_from_indirect_role .local pmc eh, BurninatorBoss, Manage, FirePeople, Burninator FirePeople = new 'Role' $P0 = get_global 'fire' FirePeople.'add_method'('fire', $P0) Manage = new 'Role' $P0 = get_global 'give_payrise' FirePeople.'add_method'('give_payrise', $P0) Manage.'add_role'(FirePeople) Burninator = new 'Role' $P0 = get_global 'fire2' Burninator.'add_method'('fire', $P0) ok(1, 'all roles created') BurninatorBoss = new 'Class' BurninatorBoss.'add_role'(Manage) ok(1, 'added first role with indirect role') try: eh = new 'ExceptionHandler' eh.'handle_types'(.EXCEPTION_ROLE_COMPOSITION_METHOD_CONFLICT) set_label eh, catch push_eh eh BurninatorBoss.'add_role'(Burninator) $I0 = 1 goto finally catch: $I0 = 0 finally: pop_eh nok($I0, 'second role conflicts with method from indirect role') .end .sub 'multi_composition' .local pmc R, C R = new 'Role' $P0 = get_global 'mctest_2' R.'add_method'("mctest", $P0) C = new 'Class' $P0 = get_global 'mctest_1' C.'add_method'("mctest", $P0) C.'add_role'(R) ok(1, 'a multi in the class prevents a role conflict') $P0 = inspect C, 'methods' $I0 = elements $P0 is($I0, 1, 'class had still one method after composition') $P0 = $P0['mctest'] $I0 = isa $P0, 'MultiSub' is($I0, 1, 'method was a multi sub') $I0 = elements $P0 is($I0, 2, 'multi holds both candidates') .end .sub 'mctest_1' :multi() .end .sub 'mctest_2' .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: packfilesegment.pmc000644000765000765 435612171255037 17734 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME src/pmc/packfilesegment.pmc - PackfileSegment PMC =head1 DESCRIPTION This class implements a PackfileSegment class, an abstract class defining a couple of methods which all Packfile segments will implement. The stub methods found here explode when called. See packfile.pmc for the toplevel Packfile interface; see PDD13 for the design spec. =head2 Methods =over 4 =cut */ /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* HEADERIZER END: static */ pmclass PackfileSegment auto_attrs { /* Directory which owns this segment. Required for correct pack/unpack Annotations. */ ATTR PMC *directory; /* =item C Initialize PackfileSegment. =cut */ VTABLE void init() { UNUSED(INTERP) Parrot_PackfileSegment_attributes * const attrs = PMC_data_typed(SELF, Parrot_PackfileSegment_attributes*); attrs->directory = PMCNULL; PObj_custom_mark_SET(SELF); } /* =item C Marks the object as live. =cut */ VTABLE void mark() { Parrot_PackfileSegment_attributes * const attrs = PARROT_PACKFILESEGMENT(SELF); Parrot_gc_mark_PMC_alive(INTERP, attrs->directory); } /* =item C Initialize PMC internals. The C argument is ignored. =cut */ VTABLE void set_pointer(void *ptr) { UNUSED(INTERP) UNUSED(SELF) UNUSED(ptr) } /* =item C Initialize PMC internals. =cut */ VTABLE void *get_pointer() { UNUSED(INTERP) UNUSED(SELF) return NULL; } /* =item C Set owning directory. =cut */ METHOD set_directory(PMC *directory) { PARROT_PACKFILESEGMENT(SELF)->directory = directory; } /* =item C Get owning directory. =cut */ METHOD get_directory() { PMC * directory = PARROT_PACKFILESEGMENT(SELF)->directory; if (!directory) directory = PMCNULL; RETURN(PMC* directory); } } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ integer.t000644000765000765 4215311533177645 15255 0ustar00brucebruce000000000000parrot-5.9.0/t/op#!./parrot # Copyright (C) 2001-2010, Parrot Foundation. =head1 NAME t/op/integer.t - Integer Registers =head1 SYNOPSIS % prove t/op/integer.t =head1 DESCRIPTION Tests the use of Parrot integer registers. =cut .const int TESTS = 153 .sub 'test' :main .include 'test_more.pir' plan(TESTS) test_set_ic() test_set() test_add_i_i_i() test_add_i_i() test_abs() test_sub() test_mul() test_div() test_fdiv() test_mod() mod_negative_zero_rest() test_eq() test_ne() test_lt() test_le() test_gt() test_ge() test_not() test_and() test_or() test_xor() test_inc() test_dec() test_sub_i_i() test_set_n() test_neg() test_negate_max_integer() test_mul_i_i() test_null() test_div_i_i_by_zero() test_div_i_ic_by_zero() test_div_i_i_i_by_zero() test_div_i_ic_i_by_zero() test_div_i_i_ic_by_zero() test_fdiv_i_i_by_zero() test_fdiv_i_ic_by_zero() test_fdiv_i_i_i_by_zero() test_fdiv_i_ic_i_by_zero() test_fdiv_i_i_ic_by_zero() test_mod_i_i_i_by_zero() test_mod_i_ic_i_by_zero() test_mod_i_i_ic_by_zero() .end .sub 'test_set_ic' $I0 = 0 $I1 = 1 $I2 = 2 $I3 = 3 $I4 = 4 $I5 = 5 $I6 = 6 $I7 = 7 $I8 = 8 $I9 = 9 $I10 = 10 $I11 = 11 $I12 = 12 $I13 = 13 $I14 = 14 $I15 = 15 $I16 = 16 $I17 = 17 $I18 = 18 $I19 = 19 $I20 = 20 $I21 = 21 $I22 = 22 $I23 = 23 $I24 = 24 $I25 = 25 $I26 = 26 $I27 = 27 $I28 = 28 $I29 = 29 $I30 = 30 $I31 = 31 $S0 = $I0 is($S0, "0", "set_i_ic with 0") $S0 = $I1 is($S0, "1", "set_i_ic with 1") $S0 = $I2 is($S0, "2", "set_i_ic with 2") $S0 = $I3 is($S0, "3", "set_i_ic with 3") $S0 = $I4 is($S0, "4", "set_i_ic with 4") $S0 = $I5 is($S0, "5", "set_i_ic with 5") $S0 = $I6 is($S0, "6", "set_i_ic with 6") $S0 = $I7 is($S0, "7", "set_i_ic with 7") $S0 = $I8 is($S0, "8", "set_i_ic with 8") $S0 = $I9 is($S0, "9", "set_i_ic with 9") $S0 = $I10 is($S0, "10", "set_i_ic with 10") $S0 = $I11 is($S0, "11", "set_i_ic with 11") $S0 = $I12 is($S0, "12", "set_i_ic with 12") $S0 = $I13 is($S0, "13", "set_i_ic with 13") $S0 = $I14 is($S0, "14", "set_i_ic with 14") $S0 = $I15 is($S0, "15", "set_i_ic with 15") $S0 = $I16 is($S0, "16", "set_i_ic with 16") $S0 = $I17 is($S0, "17", "set_i_ic with 17") $S0 = $I18 is($S0, "18", "set_i_ic with 18") $S0 = $I19 is($S0, "19", "set_i_ic with 19") $S0 = $I20 is($S0, "20", "set_i_ic with 20") $S0 = $I21 is($S0, "21", "set_i_ic with 21") $S0 = $I22 is($S0, "22", "set_i_ic with 22") $S0 = $I23 is($S0, "23", "set_i_ic with 23") $S0 = $I24 is($S0, "24", "set_i_ic with 24") $S0 = $I25 is($S0, "25", "set_i_ic with 25") $S0 = $I26 is($S0, "26", "set_i_ic with 26") $S0 = $I27 is($S0, "27", "set_i_ic with 27") $S0 = $I28 is($S0, "28", "set_i_ic with 28") $S0 = $I29 is($S0, "29", "set_i_ic with 29") $S0 = $I30 is($S0, "30", "set_i_ic with 30") $S0 = $I31 is($S0, "31", "set_i_ic with 31") .end .sub 'test_set' $I0 = 42 $I1 = $I0 $S0 = $I1 is($S0, '42', 'set_i') .end .sub 'test_add_i_i_i' $I0 = 0x11223344 $I1 = $I0 + $I0 is($I1, 574908040, 'add_i_i - first') $I2 = $I0 + $I1 is($I2, 862362060, 'add_i_i - second') $I2 = $I2 + $I2 is($I2, 1724724120, 'add_i_i - third') .end .sub 'test_add_i_i' $I0 = 0 $I1 = 2 $I2 = -2 add $I0, $I1 is($I0, 2, 'add_i_i - zero is neutral') add $I0, $I2 is($I0, 0, 'add_i_i - inverse') $I0 = 0 add $I0, 5 is($I0, 5, 'add_i_ic - zero is neutral') add $I0, -10 is($I0, -5, 'add_i_ic') .end .sub 'test_abs' $I0 = abs 1 $I1 = 1 $I1 = abs $I1 $I2 = abs -1 $I3 = -1 $I3 = abs $I3 is($I0, 1, 'abs_i_ic') is($I1, 1, 'abs_i_i') is($I2, 1, 'abs_i_nc') is($I3, 1, 'abs_i_n') .end .sub 'test_sub' $I0 = 0x12345678 $I1 = 0x01234567 $I2 = $I0 - $I1 is($I2, 286331153, 'sub_i_i_i') $I1 = 1234 $I0 = $I1 - 1230 is($I0, 4, 'sub_i_i_ic') $I0 = 1244 - $I1 is($I0, 10, 'sub_i_ic_i') $I0 = 13 - 12 is($I0, 1, 'sub_i_ic_ic') .end .sub 'test_mul' $I0 = 7 $I1 = 29 $I2 = $I0 * $I1 is($I2, 203, 'mul_i_i_i') $I2 = $I0 * 29 is($I2, 203, 'mul_i_i_ic') .end .sub 'test_div' $I0 = 0x33333333 $I1 = 0x11111111 $I2 = $I0 / $I1 is($I2, 3, 'div_i_i_i - exact') $I0 = 11 $I1 = 2 $I2 = $I0 / $I1 is($I2, 5, 'div_i_i_i - quotient with positive integers') $I0 = 9 $I1 = -4 $I2 = $I0 / $I1 is($I2, -2, 'div_i_i_i - quotient with negative divisor') $I0 = 12 $I1 = 144 / $I0 is($I1, 12, 'div_i_ic_i') $I1 = $I0 / 3 is($I1, 4, 'div_i_i_ic') $I1 = 120 / 12 is($I1, 10, 'div_i_ic_ic') .end .sub 'test_fdiv' $I0 = 9 $I1 = -4 fdiv $I0, $I1 is($I0, -3, 'fdiv_i_i with negative divisor') $I0 = 9 $I1 = -4 $I2 = fdiv $I0, $I1 is($I2, -3, 'fdiv_i_i_i with negative divisor') .end .sub 'test_mod' $I0 = 5 $I1 = 0 $I2 = mod $I0, $I1 is($I2, 5, 'mod_i_i_i by 0') $I0 = 0 $I1 = 3 $I2 = mod $I0, $I1 is($I2, 0, 'mod_i_i_i of 0') $I0 = 5 $I1 = 3 $I2 = mod $I0, $I1 is($I2, 2, 'mod_i_i_i - remainder of 5 / 3') $I0 = 5 $I1 = -3 $I2 = mod $I0, $I1 is($I2, -1, 'mod_i_i_i - remainder of 5 / -3') $I0 = -5 $I1 = 3 $I2 = mod $I0, $I1 is($I2, 1, 'mod_i_i_i - remainder of -5 / 3') $I0 = -5 $I1 = -3 $I2 = mod $I0, $I1 is($I2, -2, 'mod_i_i_i - remainder of -5 / -3') $I0 = 12 $I1 = mod $I0, 10 is($I1, 2, 'mod_i_i_ic') $I1 = mod 14, $I0 is($I1, 2, 'mod_i_ic_i') $I1 = mod 13, 11 is($I1, 2, 'mod_i_ic_ic') .end .sub 'mod_negative_zero_rest' $I1 = mod 3, 3 is($I1, 0, 'mod - negative, zero rest (#36003), 3 mod 3 = 0') $I1 = mod -3, 3 is($I1, 0, 'mod - negative, zero rest (#36003), -3 mod 3 = 0') $I1 = mod 3, -3 is($I1, 0, 'mod - negative, zero rest (#36003), 3 mod -3 = 0') $I1 = mod -3, -3 is($I1, 0, 'mod - negative, zero rest (#36003), -3 mod -3 = 0') .end .sub 'test_eq' $I0 = 0x12345678 $I1 = 0x12345678 $I2 = 0x76543210 $I3 = 1 if $I0 == $I1 goto test_eq_1 $I3 = 0 test_eq_1: ok($I3, 'eq_i_i - equal') $I3 = 1 unless $I1 == $I2 goto test_eq_2 $I3 = 0 test_eq_2: ok($I3, 'eq_i_i - different') $I0 = -42 $I3 = 0 if $I0 == 42 goto test_eq_3 $I3 = 1 test_eq_3: ok($I3, 'eq_i_ic - different') $I3 = 0 unless $I0 == -42 goto test_eq_4 $I3 = 1 test_eq_4: ok($I3, 'eq_i_ic - equal') $I0 = 12 $I3 = 0 unless $I0 == 12 goto test_eq_5 $I3 = 1 test_eq_5: ok($I3, 'eq_i_ic - 12 == 12') $I3 = 0 unless 12 == 12 goto test_eq_6 $I3 = 1 test_eq_6: ok($I3, 'eq_ic_ic - equal') $I3 = 1 unless 12 == 21 goto test_eq_7 $I3 = 0 test_eq_7: ok($I3, 'eq_ic_ic - different') .end .sub 'test_ne' $I0 = 0xa0b0c0d $I1 = 0xa0b0c0d $I2 = 0 $I3 = 0 unless $I0 != $I2 goto test_ne_1 $I3 = 1 test_ne_1: ok($I3, 'ne_i_i - different') $I3 = 0 if $I0 != $I1 goto test_ne_2 $I3 = 1 test_ne_2: ok($I3, 'ne_i_i - equal') $I0 = 427034409 $I3 = 0 if $I0 != 427034409 goto test_ne_3 $I3 = 1 test_ne_3: ok($I3, 'ne_i_ic - equal') $I3 = 0 unless $I0 != 427034408 goto test_ne_4 $I3 = 1 test_ne_4: ok($I3, 'ne_i_ic - different') .end .sub 'test_lt' $I0 = 2147483647 $I1 = -2147483648 $I2 = 0 $I3 = 0 $I4 = 0 unless $I1 < $I0 goto test_lt_1 $I4 = 1 test_lt_1: ok($I4, 'lt_i_i - true inequality') $I4 = 0 if $I0 < $I1 goto test_lt_2 $I4 = 1 test_lt_2: ok($I4, 'lt_i_i - false inequality') $I4 = 0 if $I2 < $I3 goto test_lt_3 $I4 = 1 test_lt_3: ok($I4, 'lt_i_i - irreflexivity') $I4 = 0 if $I0 < -2147483648 goto test_lt_4 $I4 = 1 test_lt_4: ok($I4, 'lt_i_ic - false inequality') $I4 = 0 unless $I1 < 2147483647 goto test_lt_5 $I4 = 1 test_lt_5: ok($I4, 'lt_i_ic - true inequality') $I4 = 0 if $I0 < 0 goto test_lt_6 $I4 = 1 test_lt_6: ok($I4, 'lt_i_ic - irreflexivity') .end .sub 'test_le' $I0 = 2147483647 $I1 = -2147483648 $I2 = 0 $I3 = 0 $I4 = 0 unless $I1 <= $I0 goto test_le_1 $I4 = 1 test_le_1: ok($I4, 'le_i_i - true inequality') $I4 = 0 if $I0 <= $I1 goto test_le_2 $I4 = 1 test_le_2: ok($I4, 'le_i_i - false inequality') $I4 = 0 unless $I2 <= $I3 goto test_le_3 $I4 = 1 test_le_3: ok($I4, 'le_i_i - reflexive') $I4 = 0 if $I0 <= -2147483648 goto test_le_4 $I4 = 1 test_le_4: ok($I4, 'le_i_ic - false inequality') $I4 = 0 unless $I1 <= 2147483647 goto test_le_5 $I4 = 1 test_le_5: ok($I4, 'le_i_ic - true inequality') $I4 = 0 unless $I2 <= 0 goto test_le_6 $I4 = 1 test_le_6: ok($I4, 'le_i_ic - reflexivity') .end .sub 'test_gt' $I0 = -2147483648 $I1 = 2147483647 $I2 = 0 $I3 = 0 $I4 = 0 unless $I1 > $I0 goto test_gt_1 $I4 = 1 test_gt_1: ok($I4, 'gt_i_i - true inequality') $I4 = 0 if $I0 > $I1 goto test_gt_2 $I4 = 1 test_gt_2: ok($I4, 'gt_i_i - false inequality') $I4 = 0 if $I2 > $I3 goto test_gt_3 $I4 = 1 test_gt_3: ok($I4, 'gt_i_i - irreflexive') $I4 = 0 if $I0 > 2147483647 goto test_gt_4 $I4 = 1 test_gt_4: ok($I4, 'gt_i_ic - false inequality') $I4 = 0 unless $I1 > -2147483648 goto test_gt_5 $I4 = 1 test_gt_5: ok($I4, 'gt_i_ic - true inequality') $I4 = 0 if $I0 > 0 goto test_gt_6 $I4 = 1 test_gt_6: ok($I4, 'gt_i_ic - another false inequality') .end .sub 'test_ge' $I0 = -2147483648 $I1 = 2147483647 $I2 = 0 $I3 = 0 $I4 = 0 unless $I1 >= $I0 goto test_ge_1 $I4 = 1 test_ge_1: ok($I4, 'ge_i_i - true inequality') $I4 = 0 if $I0 >= $I1 goto test_ge_2 $I4 = 1 test_ge_2: ok($I4, 'ge_i_i - false inequality') $I4 = 0 unless $I2 >= $I3 goto test_ge_3 $I4 = 1 test_ge_3: ok($I4, 'ge_i_i - reflexive') $I4 = 0 if $I0 >= 2147483647 goto test_ge_4 $I4 = 1 test_ge_4: ok($I4, 'ge_i_ic - false inequality') $I4 = 0 unless $I1 >= -2147483648 goto test_ge_5 $I4 = 1 test_ge_5: ok($I4, 'ge_i_ic - true inequality') $I4 = 0 unless $I2 >= 0 goto test_ge_6 $I4 = 1 test_ge_6: ok($I4, 'ge_i_ic - reflexivity') .end .sub 'test_not' $I0 = 1 $I1 = not $I0 is($I1, 0, 'not_i_i - not 1') $I2 = not $I1 is($I2, 1, 'not_i_i - not (not 1)') $I3 = 12345 $I4 = not $I3 is($I4, 0, 'not_i_i of a positive integer') $I5 = -1 $I6 = not $I5 is($I6, 0, 'not_i_i of a negative integer') $I7 = 1 $I7 = not 1 is($I7, 0, 'not_i_ic') .end .sub 'test_and' $I0 = 0 $I1 = 10 $I2 = 1 $I2 = and $I1, $I0 is($I2, 0, 'and - zero is right absorbing') $I2 = 1 $I2 = and $I0, $I1 is($I2, 0, 'and - zero is left absorbing') $I2 = 1 $I2 = and $I0, $I0 is($I2, 0, 'and - diagonal zero') $I2 = 1 $I2 = and $I2, $I1 is($I2, 10, 'and - true operands') .end .sub 'test_or' $I0 = 0 $I1 = 10 $I2 = 42 $I2 = or $I1, $I0 is($I2, 10, 'or_i_i') $I2 = 42 $I2 = or $I0, $I1 is($I2, 10, 'or_i_i - symmetric case') $I2 = or $I0, $I0 is($I2, 0, 'or_i_i - false arguments') $I2 = or $I2, $I1 is($I2, 10, 'or_i_i - reflexive') .end .sub 'test_xor' $I0 = 0 $I1 = 2 $I2 = 42 $I2 = xor $I1, $I0 is($I2, 2, 'xor - zero is right neutral') $I2 = 42 $I2 = xor $I0, $I1 is($I2, 2, 'xor - zero is left neutral') $I2 = xor $I0, $I0 is($I2, 0, 'xor - nilpotent on zero') $I2 = xor $I1, $I1 is($I2, 0, 'xor - nilpotent on 2') $I2 = xor $I2, $I2 is($I2, 0, 'xor - nilpotent on other') .end .sub 'test_inc' $I0 = 0 inc $I0 is($I0, 1, 'inc_i (first)') inc $I0 inc $I0 inc $I0 inc $I0 is($I0, 5, 'inc_i (second)') .end .sub 'test_dec' $I0 = 0 dec $I0 is($I0, -1, 'dec_i (first)') dec $I0 dec $I0 dec $I0 dec $I0 is($I0, -5, 'dec_i (second)') .end .sub 'test_sub_i_i' $I0 = 0 $I1 = 3 $I2 = -3 sub $I0, $I1 is($I0, -3, 'sub_i_i') sub $I0, $I2 is($I0, 0, 'sub_i_i - inverse') $I0 = 0 sub $I0, 5 is($I0, -5, 'sub_i_ic - first') sub $I0, -10 is($I0, 5, 'sub_i_ic - second') .end .sub 'test_set_n' $I0 = 0 $N0 = $I0 is($N0, 0.0, 'set_n_i -zero') $I1 = 2147483647 $N1 = $I1 is($N1, 2147483647.0, 'set_n_i - positive integer') $I2 = -2147483648 $N2 = $I2 is($N2, -2147483648.0, 'set_n_i - negative integer') .end .sub 'test_neg' $I0 = neg 3 $I0 = neg $I0 neg $I0 is($I0, -3, 'neg_i') .end # Test to ensure that the negative of the maximum integer is equal to the # minimum integer + 1. This should be true because we are assuming a # two's-complement machine. .include 'iglobals.pasm' .sub test_negate_max_integer .local int max, min $P0 = getinterp $P1 = $P0[.IGLOBALS_CONFIG_HASH] $I0 = $P1['intvalsize'] # XXX can't use sysinfo (from sys_ops) in coretest # build up 2's compliment min and max integers manually max = 0x7F min = 0x80 dec $I0 loop: unless $I0 goto end_loop min <<= 8 max <<= 8 max |= 0xFF dec $I0 goto loop end_loop: neg max inc min is(max, min) .end .sub 'test_mul_i_i' $I0 = 3 $I1 = 4 mul $I0, $I1 is($I0, 12, 'mul_i_i') .end .sub 'test_null' $I1 = 1000 is($I1, 1000, 'null_i - before null') null $I1 is($I1, 0, 'null_i - after null') .end .sub 'test_div_i_i_by_zero' $I0 = 0 $I1 = 10 push_eh test_div_i_i_by_zero_catch div $I1, $I0 pop_eh $I2 = 0 goto test_div_i_i_by_zero_end test_div_i_i_by_zero_catch: $I2 = 1 test_div_i_i_by_zero_end: ok($I2, 'div_i_i by zero') .end .sub 'test_div_i_ic_by_zero' $I1 = 10 push_eh test_div_i_ic_by_zero_catch div $I1, 0 pop_eh $I2 = 0 goto test_div_i_ic_by_zero_end test_div_i_ic_by_zero_catch: $I2 = 1 test_div_i_ic_by_zero_end: ok($I2, 'div_i_ic by zero') .end .sub 'test_div_i_i_i_by_zero' $I0 = 0 $I1 = 10 push_eh test_div_i_i_i_by_zero_catch $I2 = div $I1, $I0 pop_eh $I3 = 0 goto test_div_i_i_i_by_zero_end test_div_i_i_i_by_zero_catch: $I3 = 1 test_div_i_i_i_by_zero_end: ok($I3, 'div_i_i_i by zero') .end .sub 'test_div_i_ic_i_by_zero' $I0 = 0 push_eh test_div_i_ic_i_by_zero_catch $I2 = div 10, $I0 pop_eh $I3 = 0 goto test_div_i_ic_i_by_zero_end test_div_i_ic_i_by_zero_catch: $I3 = 1 test_div_i_ic_i_by_zero_end: ok($I3, 'div_i_ic_i by zero') .end .sub 'test_div_i_i_ic_by_zero' $I1 = 10 push_eh test_div_i_i_ic_by_zero_catch $I2 = div $I1, 0 pop_eh $I3 = 0 goto test_div_i_i_ic_by_zero_end test_div_i_i_ic_by_zero_catch: $I3 = 1 test_div_i_i_ic_by_zero_end: ok($I3, 'div_i_i_ic by zero') .end .sub 'test_fdiv_i_i_by_zero' $I0 = 0 $I1 = 10 push_eh test_fdiv_i_i_by_zero_catch fdiv $I1, $I0 pop_eh $I2 = 0 goto test_fdiv_i_i_by_zero_end test_fdiv_i_i_by_zero_catch: $I2 = 1 test_fdiv_i_i_by_zero_end: ok($I2, 'fdiv_i_i by zero') .end .sub 'test_fdiv_i_ic_by_zero' $I1 = 10 push_eh test_fdiv_i_ic_by_zero_catch fdiv $I1, 0 pop_eh $I2 = 0 goto test_fdiv_i_ic_by_zero_end test_fdiv_i_ic_by_zero_catch: $I2 = 1 test_fdiv_i_ic_by_zero_end: ok($I2, 'fdiv_i_ic by zero') .end .sub 'test_fdiv_i_i_i_by_zero' $I0 = 0 $I1 = 10 push_eh test_fdiv_i_i_i_by_zero_catch $I2 = fdiv $I1, $I0 pop_eh $I3 = 0 goto test_fdiv_i_i_i_by_zero_end test_fdiv_i_i_i_by_zero_catch: $I3 = 1 test_fdiv_i_i_i_by_zero_end: ok($I3, 'fdiv_i_i_i by zero') .end .sub 'test_fdiv_i_ic_i_by_zero' $I0 = 0 push_eh test_fdiv_i_ic_i_by_zero_catch $I2 = fdiv 10, $I0 pop_eh $I3 = 0 goto test_fdiv_i_ic_i_by_zero_end test_fdiv_i_ic_i_by_zero_catch: $I3 = 1 test_fdiv_i_ic_i_by_zero_end: ok($I3, 'fdiv_i_ic_i by zero') .end .sub 'test_fdiv_i_i_ic_by_zero' $I1 = 10 push_eh test_fdiv_i_i_ic_by_zero_catch $I2 = fdiv $I1, 0 pop_eh $I3 = 0 goto test_fdiv_i_i_ic_by_zero_end test_fdiv_i_i_ic_by_zero_catch: $I3 = 1 test_fdiv_i_i_ic_by_zero_end: ok($I3, 'fdiv_i_i_ic by zero') .end .sub 'test_mod_i_i_i_by_zero' $I0 = 0 $I1 = 10 $I2 = mod $I1, $I0 is($I2, 10, 'mod_i_i_i by zero') .end .sub 'test_mod_i_ic_i_by_zero' $I0 = 0 $I2 = mod 10, $I0 is($I2, 10, 'mod_i_ic_i by zero') .end .sub 'test_mod_i_i_ic_by_zero' $I1 = 10 $I2 = mod $I1, 0 is($I2, 10, 'mod_i_i_ic by zero') .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: Progress.pm000644000765000765 455511644422074 17411 0ustar00brucebruce000000000000parrot-5.9.0/lib/Pod/Simple require 5; package Pod::Simple::Progress; $VERSION = '3.19'; use strict; # Objects of this class are used for noting progress of an # operation every so often. Messages delivered more often than that # are suppressed. # # There's actually nothing in here that's specific to Pod processing; # but it's ad-hoc enough that I'm not willing to give it a name that # implies that it's generally useful, like "IO::Progress" or something. # # -- sburke # #-------------------------------------------------------------------------- sub new { my($class,$delay) = @_; my $self = bless {'quiet_until' => 1}, ref($class) || $class; $self->to(*STDOUT{IO}); $self->delay(defined($delay) ? $delay : 5); return $self; } sub copy { my $orig = shift; bless {%$orig, 'quiet_until' => 1}, ref($orig); } #-------------------------------------------------------------------------- sub reach { my($self, $point, $note) = @_; if( (my $now = time) >= $self->{'quiet_until'}) { my $goal; my $to = $self->{'to'}; print $to join('', ($self->{'quiet_until'} == 1) ? () : '... ', (defined $point) ? ( '#', ($goal = $self->{'goal'}) ? ( ' ' x (length($goal) - length($point)), $point, '/', $goal, ) : $point, $note ? ': ' : (), ) : (), $note || '', "\n" ); $self->{'quiet_until'} = $now + $self->{'delay'}; } return $self; } #-------------------------------------------------------------------------- sub done { my($self, $note) = @_; $self->{'quiet_until'} = 1; return $self->reach( undef, $note ); } #-------------------------------------------------------------------------- # Simple accessors: sub delay { return $_[0]{'delay'} if @_ == 1; $_[0]{'delay'} = $_[1]; return $_[0] } sub goal { return $_[0]{'goal' } if @_ == 1; $_[0]{'goal' } = $_[1]; return $_[0] } sub to { return $_[0]{'to' } if @_ == 1; $_[0]{'to' } = $_[1]; return $_[0] } #-------------------------------------------------------------------------- unless(caller) { # Simple self-test: my $p = __PACKAGE__->new->goal(5); $p->reach(1, "Primus!"); sleep 1; $p->reach(2, "Secundus!"); sleep 3; $p->reach(3, "Tertius!"); sleep 5; $p->reach(4); $p->reach(5, "Quintus!"); sleep 1; $p->done("All done"); } #-------------------------------------------------------------------------- 1; __END__ Compiler.pir000644000765000765 23604512101554066 21172 0ustar00brucebruce000000000000parrot-5.9.0/compilers/pct/src/PAST =head1 NAME PAST::Compiler - PAST Compiler =head1 DESCRIPTION PAST::Compiler implements a basic compiler for PAST nodes. By default PAST::Compiler transforms a PAST tree into POST. =head2 Signature Flags Throughout the compiler PAST uses a number of 1-character "flags" to indicate allowable register types and conversions. This helps the compiler generate more efficient code and know what sorts of conversions are allowed (or desired). The basic flags are: P,S,I,N PMC, string, int, or num register Q keyed PMC, next flag indicates type of key s string register or constant i int register or constant n num register or constant r any register result v void (no result) * any result type except void + PMC, int register, num register, or numeric constant ~ PMC, string register, or string constant : argument (same as '*'), possibly with :named or :flat 0-9 use the nth input operand as the output result of this operation These flags are used to describe signatures and desired return types for various operations. For example, if an opcode is specified with a signature of C, then the opcode places its result in an int register, its first child is coerced into some sort of string value, its second child is coerced into a PMC register, and the third and subsequent children can return any value type. =cut .include "cclass.pasm" .include "except_types.pasm" .include "interpinfo.pasm" .namespace [ 'PAST';'Compiler' ] # TEMPREG_BASE and UNIQUE_BASE identify the base location for # the temporary register set and unique registers .const int TEMPREG_BASE = 100 .const int UNIQUE_BASE = 1000 .sub 'onload' :anon :load :init load_bytecode 'PCT/HLLCompiler.pbc' .local pmc p6meta, cproto p6meta = new 'P6metaclass' cproto = p6meta.'new_class'('PAST::Compiler', 'parent'=>'PCT::HLLCompiler', 'attr'=>'%!symtable') cproto.'language'('PAST') $P1 = split ' ', 'post pir evalpmc' cproto.'stages'($P1) ## %piropsig is a table of common opcode signatures .local pmc piropsig piropsig = new 'Hash' piropsig['add'] = 'PP+' piropsig['band'] = 'PPP' piropsig['bxor'] = 'PPP' piropsig['bnot'] = 'PP' piropsig['bor'] = 'PPP' piropsig['can'] = 'IPs' piropsig['chr'] = 'Si' piropsig['clone'] = 'PP' piropsig['concat'] = 'PP~' piropsig['copy'] = '0PP' piropsig['defined'] = 'IP' piropsig['delete'] = 'vQ*' piropsig['die'] = 'v~' piropsig['div'] = 'PP+' piropsig['does'] = 'IPs' piropsig['downcase'] = 'Ss' piropsig['elements'] = 'IP' piropsig['exists'] = 'IQ*' piropsig['exit'] = 'vi' piropsig['fdiv'] = 'PP+' piropsig['find_codepoint'] = 'Is' piropsig['find_dynamic_lex'] = 'Ps' piropsig['find_name'] = 'Ps' piropsig['getinterp'] = 'P' piropsig['getprop'] = 'PP~' piropsig['getstderr'] = 'P' piropsig['getstdin'] = 'P' piropsig['getstdout'] = 'P' piropsig['index'] = 'Issi' piropsig['isa'] = 'IP~' piropsig['isfalse'] = 'IP' piropsig['isnull'] = 'IP' piropsig['issame'] = 'IPP' piropsig['istrue'] = 'IP' piropsig['join'] = 'SsP' piropsig['length'] = 'Is' piropsig['load_bytecode'] = 'vs' piropsig['load_language'] = 'vs' piropsig['loadlib'] = 'P~' piropsig['mod'] = 'PP+' piropsig['mul'] = 'PP+' piropsig['neg'] = 'PP' piropsig['new'] = 'P~' piropsig['newclosure'] = 'PP' piropsig['not'] = 'PP' piropsig['ord'] = 'Isi' piropsig['pop'] = 'PP' piropsig['pow'] = 'NN+' piropsig['print'] = 'v*' piropsig['printerr'] = 'v*' piropsig['push'] = '0P*' piropsig['repeat'] = 'Ssi' piropsig['replace'] = 'Ssiis' piropsig['say'] = 'v*' piropsig['set'] = 'PP' piropsig['setprop'] = '0P~P' piropsig['setattribute'] = '0P~P' piropsig['shift'] = 'PP' piropsig['shl'] = 'PP+' piropsig['shr'] = 'PP+' piropsig['sleep'] = 'v+' piropsig['splice'] = '0PPii' piropsig['split'] = 'Pss' piropsig['sub'] = 'PP+' piropsig['substr'] = 'Ssii' piropsig['titlecase'] = 'Ss' piropsig['trace'] = 'vi' piropsig['typeof'] = 'SP' piropsig['unshift'] = '0P*' piropsig['upcase'] = 'Ss' set_global '%piropsig', piropsig ## %valflags specifies when PAST::Val nodes are allowed to ## be used as a constant. The 'e' flag indicates that the ## value must be quoted+escaped in PIR code. .local pmc valflags valflags = new 'Hash' valflags['String'] = 's~*:e' valflags['Integer'] = 'i+*:' valflags['Float'] = 'n+*:' valflags['!macro_const'] = 'i+*:c' valflags['!cclass'] = 'i+*:c' valflags['!except_severity'] = 'i+*:c' valflags['!except_types'] = 'i+*:c' valflags['!iterator'] = 'i+*:c' valflags['!socket'] = 'i+*:c' set_global '%valflags', valflags ## %!controltypes holds the list of exception types for each ## type of exception handler we support .local pmc controltypes controltypes = new 'Hash' controltypes['CONTROL'] = '.CONTROL_ALL' controltypes['RETURN'] = '.CONTROL_RETURN' controltypes['OK'] = '.CONTROL_OK' controltypes['BREAK'] = '.CONTROL_BREAK' controltypes['CONTINUE'] = '.CONTROL_CONTINUE' controltypes['ERROR'] = '.CONTROL_ERROR' controltypes['GATHER'] = '.CONTROL_TAKE' controltypes['LEAVE'] = '.CONTROL_LEAVE' controltypes['EXIT'] = '.CONTROL_EXIT' controltypes['NEXT'] = '.CONTROL_NEXT' controltypes['LAST'] = '.CONTROL_LAST' controltypes['REDO'] = '.CONTROL_REDO' set_global '%!controltypes', controltypes $P0 = box UNIQUE_BASE set_global '$!serno', $P0 .return () .end =head2 Compiler methods =over 4 =item to_post(node [, 'option'=>option, ...]) Compile the abstract syntax tree given by C into POST. =cut .sub 'to_post' :method .param pmc past .param pmc options :slurpy :named .local pmc symtable symtable = new 'Hash' setattribute self, '%!symtable', symtable .local pmc blockpast blockpast = get_global '@?BLOCK' unless null blockpast goto have_blockpast blockpast = new 'ResizablePMCArray' set_global '@?BLOCK', blockpast have_blockpast: .lex '@*BLOCKPAST', blockpast null $P99 .lex '$*SUB', $P99 null $P98 .lex '%*LEXREGS', $P98 .local pmc tempregs tempregs = find_dynamic_lex '%*TEMPREGS' unless null tempregs goto have_tempregs tempregs = self.'tempreg_frame'() have_tempregs: .lex '%*TEMPREGS', tempregs $P1 = self.'as_post'(past, 'rtype'=>'v') .return ($P1) .end =item escape(str) Return C as a PIR constant string. =cut .sub 'escape' :method .param string str .local string estr estr = escape str $I0 = index estr, "\\x" if $I0 >= 0 goto unicode_prefix $I0 = index estr, "\\u" if $I0 >= 0 goto unicode_prefix estr = concat '"', estr goto done unicode_prefix: estr = concat 'unicode:"', estr done: estr = concat estr, '"' .return (estr) .end =item unique([STR fmt]) Generate a unique number that can be used as an identifier. If C is provided, then it will be used as a prefix to the unique number. =cut .sub 'unique' :method .param string fmt :optional .param int has_fmt :opt_flag if has_fmt goto unique_1 fmt = '' unique_1: $P0 = get_global '$!serno' $S0 = $P0 $S0 = concat fmt, $S0 inc $P0 .return ($S0) .end =item uniquereg(rtype) Generate a unique register based on C, where C is one of the signature flags described above. =cut .sub 'uniquereg' :method .param string rtype unless rtype goto err_nortype if rtype == 'v' goto reg_void .local string reg $I0 = index 'Ss~Nn+Ii', rtype rtype = 'P' if $I0 < 0 goto have_rtype rtype = substr 'SSSNNNII', $I0, 1 have_rtype: reg = concat '$', rtype .tailcall self.'unique'(reg) reg_void: .return ('') err_nortype: self.'panic'('rtype not set') .end =item tempreg_frame() Create a new temporary register frame, using register identifiers TEMPREG_BASE up to UNIQUE_BASE. =cut .sub 'tempreg_frame' :method .local pmc tempregs tempregs = new ['Hash'] tempregs['I'] = TEMPREG_BASE tempregs['N'] = TEMPREG_BASE tempregs['S'] = TEMPREG_BASE tempregs['P'] = TEMPREG_BASE .return (tempregs) .end =item tempreg(rtype) Generate a unique register by allocating from the temporary register pool frame in %*TEMPREGS. %*TEMPREGS is a hash that has the next register identifier to be used for I, N, S, and P registers. It also contains the names of any registers that have been "reserved" in the current frame (e.g. because they hold the return value from a PAST::Stmt node). If there are no temporary registers available, allocate and return a permanent one instead (similar to C above). =cut .sub 'tempreg' :method .param string rtype unless rtype goto err_nortype if rtype == 'v' goto reg_void .local string reg $I0 = index 'Ss~Nn+Ii', rtype rtype = 'P' if $I0 < 0 goto have_rtype rtype = substr 'SSSNNNII', $I0, 1 have_rtype: .local pmc tempregs tempregs = find_dynamic_lex '%*TEMPREGS' # if we don't have a temporary register pool, just make a unique one if null tempregs goto reg_unique unless tempregs goto reg_unique .local int rnum rnum = tempregs[rtype] make_reg: # if we've run out of temporary registers, just make a unique one if rnum >= UNIQUE_BASE goto reg_unique $S0 = rnum inc rnum tempregs[rtype] = rnum reg = concat '$', rtype reg = concat reg, $S0 $I0 = tempregs[reg] if $I0 goto make_reg .return (reg) reg_unique: # fall back to returning a globally allocated register reg = concat '$', rtype .tailcall self.'unique'(reg) reg_void: .return ('') err_nortype: self.'panic'('rtype not set') .end =item coerce(post, rtype) Return a POST tree that coerces the result of C to have a return value compatible with C. C can also be a specific register, in which case the result of C is forced into that register (with conversions as needed). =cut .sub 'coerce' :method .param pmc post .param string rtype unless rtype goto err_nortype .local string pmctype, result, rrtype null pmctype null result ## if rtype is a register, then set result and use the register ## type as rtype $S0 = substr rtype, 0, 1 unless $S0 == '$' goto have_rtype result = rtype rtype = substr result, 1, 1 have_rtype: ## these rtypes allow any return value, so no coercion needed. $I0 = index 'v*:', rtype if $I0 >= 0 goto end ## figure out what type of result we already have .local string source source = post.'result'() $S0 = substr source, 0, 1 if $S0 == '$' goto source_reg if $S0 == '"' goto source_str if $S0 == '.' goto source_int_num_or_const if $S0 == '-' goto source_int_or_num $I0 = is_cclass .CCLASS_NUMERIC, source, 0 if $I0 goto source_int_or_num $S0 = substr source, 0, 8 if $S0 == 'unicode:' goto source_str ## assume that whatever is left acts like a PMC goto source_pmc source_reg: ## source is some sort of register ## if a register is all we need, we're done if rtype == 'r' goto end $S0 = substr source, 1, 1 ## if we have the correct register type already, we're done if $S0 != rtype goto source_reg_1 unless result goto end goto coerce_reg source_reg_1: $S0 = downcase $S0 if $S0 == rtype goto end ## figure it out based on the register type if $S0 == 's' goto source_str if rtype == '+' goto end if $S0 == 'i' goto source_int if $S0 == 'n' goto source_num source_pmc: $I0 = index 'SINsin', rtype if $I0 < 0 goto end goto coerce_reg source_str: if rtype == '~' goto end if rtype == 's' goto end rrtype = 'S' pmctype = "'String'" goto coerce_reg source_int_num_or_const: $I0 = is_cclass .CCLASS_ALPHABETIC, source, 1 unless $I0 goto source_int_or_num $I0 = index 'ins+~', rtype if $I0 >= 0 goto end rrtype = 'P' goto coerce_reg source_int_or_num: if rtype == '+' goto end ## existence of an 'e' or '.' implies num $I0 = index source, '.' if $I0 >= 0 goto source_num $I0 = index source, 'E' if $I0 >= 0 goto source_num source_int: if rtype == 'i' goto end rrtype = 'I' pmctype = "'Integer'" goto coerce_reg source_num: if rtype == 'n' goto end rrtype = 'N' pmctype = "'Float'" coerce_reg: ## okay, we know we have to do a coercion. ## If we just need the value in a register (rtype == 'r'), ## then create result based on the preferred register type (rrtype). if rtype != 'r' goto coerce_reg_1 result = self.'tempreg'(rrtype) coerce_reg_1: ## if we haven't set the result target yet, then generate one ## based on rtype. (The case of rtype == 'r' was handled above.) if result goto coerce_reg_2 result = self.'tempreg'(rtype) coerce_reg_2: ## create a new ops node to hold the coercion, put C in it. $P0 = get_hll_global ['POST'], 'Ops' post = $P0.'new'(post, 'result'=>result) ## if we need a new pmc (rtype == 'P' && pmctype defined), create it if rtype != 'P' goto have_result unless pmctype goto have_result post.'push_pirop'('new', result, pmctype) have_result: ## store the value into the target register post.'push_pirop'('set', result, source) end: .return (post) err_nortype: self.'panic'('rtype not set') .end =item post_children(node [, 'signature'=>signature] ) Return the POST representation of evaluating all of C's children in sequence. The C option is a string of flags as described in "Signature Flags" above. Since we're just evaluating children nodes, the first character of C (return value type) is ignored. Thus a C of C says that the first child needs to be something in string context, the second child should be a PMC, and the third and subsequent children can be any value they wish. =cut .sub 'post_children' :method .param pmc node .param pmc options :slurpy :named .local pmc ops $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) .local string pushop pushop = 'push' $S0 = node.'childorder'() if $S0 != 'right' goto have_pushop pushop = 'unshift' have_pushop: ## get any conversion types .local string signature signature = options['signature'] if signature goto have_signature signature = '**' have_signature: .local int sigmax, sigidx sigmax = length signature dec sigmax ## if the signature contains a ':', then we're doing ## flagged arguments (:flat, :named) .local pmc posargs, namedargs posargs = new 'ResizableStringArray' null namedargs $I0 = index signature, ':' if $I0 < 0 goto nocolon namedargs = new 'ResizableStringArray' nocolon: .local pmc iter .local string rtype iter = node.'iterator'() sigidx = 1 rtype = substr signature, sigidx, 1 iter_loop: if rtype == 'Q' goto keyed_pos unless iter goto iter_end .local pmc cpast, cpost cpast = shift iter cpost = self.'as_post'(cpast, 'rtype'=>rtype) cpost = self.'coerce'(cpost, rtype) $I0 = isa cpast, ['PAST';'Node'] unless $I0 goto cpost_pos .local pmc isflat isflat = cpast.'flat'() if rtype != ':' goto iter_pos .local pmc npast, npost npast = cpast.'named'() unless npast goto iter_pos $S0 = cpost if isflat goto flat_named npost = self.'as_post'(npast, 'rtype'=>'~') cpost = ops.'new'(cpost) cpost.'push'(npost) $S1 = npost $S0 = concat $S0, ' :named(' $S0 = concat $S0, $S1 $S0 = concat $S0, ')' goto named_done flat_named: $S0 = concat $S0, ' :named :flat' named_done: ops.pushop(cpost) push namedargs, $S0 goto iter_rtype iter_pos: if isflat goto flat_pos cpost_pos: ops.pushop(cpost) push posargs, cpost goto iter_rtype flat_pos: $S0 = cpost $S0 = concat $S0, ' :flat' ops.pushop(cpost) push posargs, $S0 iter_rtype: unless sigidx < sigmax goto iter_loop inc sigidx rtype = substr signature, sigidx, 1 goto iter_loop keyed_pos: # rtype is 'Q', so construct a keyed pmc argument # first, get the base PMC unless iter goto iter_end cpast = shift iter cpost = self.'as_post'(cpast, 'rtype'=>'P') cpost = self.'coerce'(cpost, 'P') # now process the key arg unless iter goto iter_end .local pmc kpast, kpost kpast = shift iter inc sigidx rtype = substr signature, sigidx, 1 kpost = self.'as_post'(kpast, 'rtype'=>rtype) kpost = self.'coerce'(kpost, rtype) # now construct the keyed PMC $S0 = cpost $S0 = concat $S0, '[' $S1 = kpost $S0 = concat $S0, $S1 $S0 = concat $S0, ']' kpost = ops.'new'(kpost) kpost.'push'(cpost) ops.pushop(kpost) push posargs, $S0 goto iter_rtype iter_end: .return (ops, posargs, namedargs) .end =back =head2 Methods on C arguments The methods below are used to transform PAST nodes into their POST equivalents. =head3 Defaults =over 4 =item as_post(node) (General) Return a POST representation of C. Note that C is a multimethod based on the type of its first argument, this is the method that is called when no other methods match. =item as_post(Any) This is the "fallback" method for any unrecognized node types. We use this to throw a more useful exception in case any non-PAST nodes make it into the tree. =cut .sub 'as_post' :method :multi(_, _) .param pmc node .param pmc options :slurpy :named unless null node goto not_null_node self.'panic'("PAST::Compiler can't compile a null node") not_null_node: $S0 = typeof node self.'panic'("PAST::Compiler can't compile node of type ", $S0) .end =item as_post(Undef) Return an empty POST node that can be used to hold a (PMC) result. =cut .sub 'as_post' :method :multi(_, Undef) .param pmc node .param pmc options :slurpy :named .local string result $P0 = get_hll_global ['POST'], 'Ops' result = self.'tempreg'('P') .tailcall $P0.'new'('result'=>result) .end =item as_post(Integer) =item as_post(Float) =item as_post(String) Handle Integer, Float, and String nodes in the PAST tree, by generating a constant or an appropriate register setting. =cut .sub 'as_post' :method :multi(_, Integer) .param pmc node .param pmc options :slurpy :named $P0 = get_hll_global ['POST'], 'Ops' $P0 = $P0.'new'( 'result'=>node ) $S0 = options['rtype'] .tailcall self.'coerce'($P0, $S0) .end .sub 'as_post' :method :multi(_, Float) .param pmc node .param pmc options :slurpy :named $P0 = get_hll_global ['POST'], 'Ops' $P0 = $P0.'new'( 'result'=>node ) $S0 = options['rtype'] .tailcall self.'coerce'($P0, $S0) .end .sub 'as_post' :method :multi(_, String) .param pmc node .param pmc options :slurpy :named .local string value value = self.'escape'(node) $P0 = get_hll_global ['POST'], 'Ops' $P0 = $P0.'new'( 'result'=>value ) $S0 = options['rtype'] .tailcall self.'coerce'($P0, $S0) .end =item as_vivipost(String class) Generate POST to create a new object of type C. This is typically invoked by the various vivification methods below (e.g., in a PAST::Var node to default a variable to a given type). =cut .sub 'as_vivipost' :method :multi(_, String) .param pmc node .param pmc options :slurpy :named .local string result $P0 = get_hll_global ['POST'], 'Op' result = self.'tempreg'('P') $S0 = self.'escape'(node) .tailcall $P0.'new'(result, $S0, 'pirop'=>'new', 'result'=>result) .end =item as_vivipost(PAST::Node node) =cut .sub 'as_vivipost' :method :multi(_, _) .param pmc node .param pmc options :slurpy :named .tailcall self.'as_post'(node, options :flat :named) .end =item as_post(PAST::Node node) Return the POST representation of executing C's children in sequence. The result of the final child is used as the result of this node. N.B.: This method is also the one that is invoked for converting nodes of type C. =cut .sub 'as_post' :method :multi(_, ['PAST';'Node']) :subid('Node.as_post') .param pmc node .param pmc options :slurpy :named .local pmc ops .local string rtype, signature rtype = options['rtype'] signature = node.'signature'() if signature goto have_signature $P0 = node.'list'() $I0 = elements $P0 signature = repeat 'v', $I0 signature = concat signature, rtype have_signature: ops = self.'post_children'(node, 'signature'=>signature) .local pmc result result = ops[-1] $S0 = substr signature, 0, 1 $I0 = index '0123456789', $S0 if $I0 < 0 goto have_result result = ops[$I0] have_result: ops.'result'(result) unless rtype goto rtype_done ops = self.'coerce'(ops, rtype) rtype_done: .local pmc eh eh = node.'handlers'() unless eh, no_eh ops = self.'wrap_handlers'(ops, eh, 'rtype'=>rtype) no_eh: .return (ops) .end =back =head3 C =over 4 =item as_post(PAST::Stmt node) Return the POST representation of a C. This is essentially the same as for C above, but also defines the boundaries of temporary register allocations. =cut .sub 'as_post' :method :multi(_, ['PAST';'Stmt']) .param pmc node .param pmc options :slurpy :named .local pmc outerregs, tempregs null tempregs outerregs = find_dynamic_lex '%*TEMPREGS' if null outerregs goto have_tempregs tempregs = clone outerregs have_tempregs: .lex '%*TEMPREGS', tempregs .const 'Sub' node_as_post = 'Node.as_post' .local pmc post post = self.node_as_post(node, options :flat :named) if null outerregs goto reserve_done .local string rtype rtype = options['rtype'] if rtype == 'v' goto reserve_done .local string result result = post.'result'() $S0 = substr result, 0, 1 if $S0 != '$' goto reserve_done outerregs[result] = 1 reserve_done: .return (post) .end =back =head3 C =over 4 =item as_post(PAST::Control node) Return the POST representation of a C. =cut .sub 'as_post' :method :multi(_, ['PAST';'Control']) .param pmc node .param pmc options :slurpy :named # Probably not safe to use tempregs in an exception handler .local pmc tempregs null tempregs .lex '%*TEMPREGS', tempregs .local pmc ops, children, ishandled .local string handled $P0 = get_hll_global ['POST'], 'Label' $S0 = self.'unique'('handled_') ishandled = $P0.'new'('result'=>$S0) $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) .local string rtype rtype = options['rtype'] $P0 = node.'list'() $I0 = elements $P0 $S0 = repeat 'v', $I0 $S0 = concat $S0, rtype ops.'push_pirop'('.local pmc exception') ops.'push_pirop'('.get_results (exception)') children = self.'post_children'(node, 'signature'=>$S0) ops.'push'(children) handled = self.'uniquereg'('I') ops.'push_pirop'('set', handled, 'exception["handled"]') ops.'push_pirop'('eq', handled, 1, ishandled) ops.'push_pirop'('rethrow', 'exception') ops.'push'(ishandled) ops.'result'('exception') .return (ops) .end .sub 'push_exception_handler' :method .param pmc node .param pmc ops .param pmc label .local string type, extype type = node.'handle_types'() extype = node.'handle_types_except'() if type goto handler_need_exhandler if extype goto handler_need_exhandler ops.'push_pirop'('push_eh', label) .return () handler_need_exhandler: .local pmc controltypes, subpost .local string ehreg subpost = find_dynamic_lex '$*SUB' ehreg = self.'uniquereg'('P') unless type, no_handle_types controltypes = get_global '%!controltypes' type = controltypes[type] unless type, no_handle_types $P0 = split ',', type $S0 = join ';', $P0 $S0 = concat '[', $S0 $S0 = concat $S0, ']' ops.'push_pirop'('new', ehreg, "'ExceptionHandler'", $S0) subpost.'add_directive'('.include "except_types.pasm"') goto handle_types_done no_handle_types: ops.'push_pirop'('new', ehreg, "'ExceptionHandler'") handle_types_done: ops.'push_pirop'('set_label', ehreg, label) unless extype, handle_types_except_done controltypes = get_global '%!controltypes' extype = controltypes[extype] unless extype, handle_types_except_done $P0 = split ',', extype ops.'push_pirop'('callmethod', '"handle_types_except"', ehreg, $P0 :flat) subpost.'add_directive'('.include "except_types.pasm"') handle_types_except_done: ops.'push_pirop'('push_eh', ehreg) .return () .end .sub 'wrap_handlers' :method .param pmc child .param pmc ehs .param pmc options :slurpy :named .local string rtype, result .local int addreturn rtype = options['rtype'] addreturn = options['addreturn'] if addreturn goto wrap_no_result result = self.'tempreg'(rtype) wrap_no_result: # Probably not safe to use tempregs in an exception handler .local pmc tempregs null tempregs .lex '%*TEMPREGS', tempregs .local pmc it, node, ops, tail, skip .local int depth $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) $P0 = get_hll_global ['POST'], 'Ops' tail = $P0.'new'('node'=>node) $P0 = get_hll_global ['POST'], 'Label' $S0 = self.'unique'('skip_handler_') skip = $P0.'new'('result'=>$S0) ops.'result'(result) unless result goto wrap_child_no_result child = self.'coerce'(child, result) wrap_child_no_result: it = iter ehs depth = 0 handler_loop: unless it, handler_loop_done node = shift it .local pmc ehpir, label .local string exceptreg $P0 = get_hll_global ['POST'], 'Label' $S0 = self.'unique'('control_') label = $P0.'new'('result'=>$S0) self.'push_exception_handler'(node, ops, label) inc depth # Push the handler itself tail.'push'(label) exceptreg = self.'uniquereg'('P') tail.'push_pirop'('peek_exception', exceptreg) ehpir = self.'as_post'(node, 'rtype'=>rtype) unless result goto handler_loop_no_result ehpir = self.'coerce'(ehpir, result) handler_loop_no_result: tail.'push'(ehpir) tail.'push_pirop'('finalize', exceptreg) unless addreturn goto handler_loop_no_return .local pmc retval retval = ehpir.'result'() tail.'push_pirop'('return', retval) goto handler_loop handler_loop_no_return: tail.'push_pirop'('pop_upto_eh', exceptreg) $I0 = depth pops_loop_handler: tail.'push_pirop'('pop_eh') dec $I0 if $I0 goto pops_loop_handler unless it, handler_loop_done tail.'push_pirop'('goto', skip) goto handler_loop handler_loop_done: ops.'push'(child) $I0 = depth unless $I0 goto pops_done pops_loop: ops.'push_pirop'('pop_eh') dec $I0 if $I0 goto pops_loop pops_done: ops.'push_pirop'('goto', skip) ops.'push'(tail) ops.'push'(skip) .return (ops) .end =back =head3 C =over 4 =item as_post(PAST::Block node) Return the POST representation of a C. =cut .sub 'as_post' :method :multi(_, ['PAST';'Block']) .param pmc node .param pmc options :slurpy :named ## add current block node to @*BLOCKPAST .local pmc blockpast blockpast = find_dynamic_lex '@*BLOCKPAST' unshift blockpast, node .local string name, pirflags, blocktype .local pmc nsentry, subid, ns, hll, multi, loadlibs name = node.'name'() pirflags = node.'pirflags'() blocktype = node.'blocktype'() nsentry = node.'nsentry'() subid = node.'subid'() ns = node.'namespace'() hll = node.'hll'() multi = node.'multi'() loadlibs = node.'loadlibs'() ## handle nsentry attribute $I0 = defined nsentry unless $I0 goto nsentry_done unless nsentry goto nsentry_anon $S0 = self.'escape'(nsentry) pirflags = concat pirflags, ' :nsentry(' pirflags = concat pirflags, $S0 pirflags = concat pirflags, ')' goto nsentry_done nsentry_anon: pirflags = concat pirflags, ' :anon' nsentry_done: ## handle anonymous blocks if name goto have_name name = self.'unique'('_block') if ns goto have_name if nsentry goto have_name pirflags = concat pirflags, ' :anon' have_name: ## create a POST::Sub node for this block .local pmc bpost $P0 = get_hll_global ['POST'], 'Sub' bpost = $P0.'new'('node'=>node, 'name'=>name, 'blocktype'=>blocktype, 'namespace'=>ns, 'hll'=>hll, 'subid'=>subid, 'multi'=>multi, 'loadlibs'=>loadlibs) unless pirflags goto pirflags_done bpost.'pirflags'(pirflags) pirflags_done: ## pir-encode name and namespace .local string blockreg, blockref blockreg = self.'uniquereg'('P') blockref = concat ".const 'Sub' ", blockreg blockref = concat blockref, ' = ' $P0 = bpost.'subid'() $S0 = self.'escape'($P0) blockref = concat blockref, $S0 ## determine the outer POST::Sub for the new one .local pmc outerpost outerpost = find_dynamic_lex '$*SUB' .lex '$*SUB', bpost .local int islexical islexical = node.'lexical'() unless islexical goto outer_done bpost.'outer'(outerpost) ## add block setup code (cpost) to outer block if needed if null outerpost goto outer_done .local pmc cpost $P0 = get_hll_global ['POST'], 'Ops' cpost = $P0.'new'( 'result'=>blockreg ) cpost.'push_pirop'(blockref) cpost.'push_pirop'('capture_lex', blockreg) outerpost.'unshift'(cpost) outer_done: ## merge the node's symtable with the master .local pmc outersym, symtable outersym = getattribute self, '%!symtable' symtable = outersym ## if the Block doesn't have a symtable, re-use the existing one $P0 = node.'symtable'() unless $P0 goto have_symtable ## if the Block has a default ('') entry, use the Block's symtable as-is symtable = $P0 $I0 = defined symtable[''] if $I0 goto have_symtable ## merge the Block's symtable with outersym symtable = 'shallow_clone_hash'(symtable) symtable_merge: .local pmc it it = iter outersym symtable_merge_loop: unless it goto have_symtable $S0 = shift it $I0 = exists symtable[$S0] if $I0 goto symtable_merge_loop $P0 = it[$S0] symtable[$S0] = $P0 goto symtable_merge_loop have_symtable: setattribute self, '%!symtable', symtable .local pmc compiler compiler = node.'compiler'() if compiler goto children_compiler # if tempregs flag is set, then create a new bank of temporary registers .local pmc tempregs, outerregs outerregs = find_dynamic_lex '%*TEMPREGS' tempregs = outerregs $I0 = node.'tempregs'() unless $I0 goto have_tempregs tempregs = self.'tempreg_frame'() have_tempregs: .lex '%*TEMPREGS', tempregs .local pmc lexregs, outerlexregs outerlexregs = find_dynamic_lex '%*LEXREGS' null lexregs .lex '%*LEXREGS', lexregs ## control exception handler .local pmc ctrlpast, ctrllabel ctrlpast = node.'control'() unless ctrlpast goto children_past $P0 = get_hll_global ['POST'], 'Label' $S0 = self.'unique'('control_') ctrllabel = $P0.'new'('result'=>$S0) $S0 = self.'uniquereg'('P') bpost.'push_pirop'('new', $S0, "'ExceptionHandler'", '[.CONTROL_RETURN]') bpost.'push_pirop'('set_label', $S0, ctrllabel) bpost.'push_pirop'('push_eh', $S0) bpost.'add_directive'('.include "except_types.pasm"') children_past: ## all children but last are void context, last returns anything $P0 = node.'list'() $I0 = elements $P0 $S0 = repeat 'v', $I0 $S0 = concat $S0, '*' ## convert children to post .local pmc ops, retval ops = self.'post_children'(node, 'signature'=>$S0) ## result of last child is return from block retval = ops[-1] ops.'result'(retval) ## wrap the child with appropriate exception handlers, if any .local pmc eh eh = node.'handlers'() unless eh, no_eh ops = self.'wrap_handlers'(ops, eh, 'rtype'=>'*', 'addreturn'=>1) no_eh: bpost.'push'(ops) bpost.'push_pirop'('return', retval) unless ctrlpast goto sub_done bpost.'push'(ctrllabel) bpost.'push_pirop'('.local pmc exception') bpost.'push_pirop'('.get_results (exception)') $I0 = isa ctrlpast, ['PAST';'Node'] if $I0 goto control_past if ctrlpast == 'return_pir' goto control_return self.'panic'("Unrecognized control handler '", ctrlpast, "'") control_return: ## handle 'return' exceptions $S0 = self.'tempreg'('P') bpost.'push_pirop'('getattribute', $S0, 'exception', '"payload"') bpost.'push_pirop'('return', $S0) goto sub_done control_past: $P0 = self.'as_post'(ctrlpast, 'rtype'=>'*') bpost.'push'($P0) goto sub_done children_compiler: ## set the compiler to use for the POST::Sub node, pass on ## and compiler arguments and add this block's child to it. bpost.'compiler'(compiler) $P0 = node.'compiler_args'() bpost.'compiler_args'($P0) $P0 = node[0] bpost.'push'($P0) sub_done: ## generate any loadinit code for the sub $I0 = exists node['loadinit'] unless $I0 goto loadinit_done .local pmc lisub $P0 = get_hll_global ['POST'], 'Sub' lisub = $P0.'new'('outer'=>bpost, 'pirflags'=>':load :init') lisub.'push_pirop'(blockref) lisub.'push_pirop'('.local pmc', 'block') lisub.'push_pirop'('set', 'block', blockreg) .local pmc lipast, lipost lipast = node.'loadinit'() lipost = self.'as_post'(lipast, 'rtype'=>'v') lisub.'push'(lipost) bpost['loadinit'] = lisub loadinit_done: ## restore the outer temporary register bank store_lex '%*TEMPREGS', outerregs ## restore the outer lexical register hash store_lex '%*LEXREGS', outerlexregs ## restore previous outer scope and symtable setattribute self, '%!symtable', outersym ## return block or block result .local string rtype, result rtype = options['rtype'] if blocktype == 'immediate' goto block_immediate if rtype == 'v' goto block_done $P0 = get_hll_global ['POST'], 'Ops' bpost = $P0.'new'( bpost, 'node'=>node, 'result'=>blockreg) bpost.'push_pirop'( blockref, 'result'=>blockreg ) unless islexical goto block_done $I0 = node.'closure'() if $I0 goto block_closure bpost.'push_pirop'('capture_lex', blockreg) goto block_done block_closure: ## return a reference to a clone of the block with captured outer context result = self.'uniquereg'('P') bpost.'push_pirop'('newclosure', result, blockreg) bpost.'result'(result) goto block_done block_immediate: .local pmc arglist arglist = options['arglist'] unless null arglist goto have_arglist arglist = new 'ResizablePMCArray' have_arglist: result = self.'tempreg'(rtype) $P0 = get_hll_global ['POST'], 'Ops' bpost = $P0.'new'(bpost, 'node'=>node, 'result'=>result) bpost.'push_pirop'(blockref) unless islexical goto block_immediate_capture_skip bpost.'push_pirop'('capture_lex', blockreg) block_immediate_capture_skip: bpost.'push_pirop'('call', blockreg, arglist :flat, 'result'=>result) block_done: ## remove current block from @*BLOCKPAST $P99 = shift blockpast .return (bpost) .end .sub 'shallow_clone_hash' .param pmc to_clone $P0 = new ['Hash'] $P1 = iter to_clone it_loop: unless $P1 goto it_loop_end $S0 = shift $P1 $P2 = to_clone[$S0] $P0[$S0] = $P2 goto it_loop it_loop_end: .return ($P0) .end =back =head3 C =over 4 =item as_post(PAST::Op node) Return the POST representation of a C node. Normally this is handled by redispatching to a method corresponding to the node's "pasttype" attribute. =cut .sub 'as_post' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named ## see if we set first child's lvalue $I0 = node.'lvalue'() unless $I0 goto have_lvalue $P0 = node[0] if null $P0 goto have_lvalue $I1 = exists $P0['lvalue'] if $I1 goto have_lvalue $P0.'lvalue'($I0) have_lvalue: .local string pasttype pasttype = node.'pasttype'() unless pasttype goto post_pirop $P0 = find_method self, pasttype .tailcall self.$P0(node, options :flat :named) post_pirop: .local pmc pirop pirop = node.'pirop'() unless pirop goto post_inline .tailcall self.'pirop'(node, options :flat :named) post_inline: .local pmc inline inline = node.'inline'() unless inline goto post_call .tailcall self.'inline'(node, options :flat :named) post_call: .tailcall self.'call'(node, options :flat :named) .end =item pirop(PAST::Op node) Return the POST representation of a C node with a 'pasttype' of 'pirop'. =cut .sub 'pirop' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .local string pirop, signature pirop = node.'pirop'() ## see if pirop is of form "pirop signature" $I0 = index pirop, ' ' if $I0 < 0 goto pirop_0 $I1 = $I0 + 1 signature = substr pirop, $I1 pirop = substr pirop, 0, $I0 goto have_signature pirop_0: ## see if pirop is of form "pirop__signature" $I0 = index pirop, '__' if $I0 < 0 goto pirop_1 $I1 = $I0 + 2 signature = substr pirop, $I1 pirop = substr pirop, 0, $I0 goto have_signature pirop_1: $P0 = get_global '%piropsig' signature = $P0[pirop] if signature goto have_signature signature = 'vP' have_signature: .local pmc ops, posargs (ops, posargs) = self.'post_children'(node, 'signature'=>signature) .local pmc arglist arglist = ops.'list'() $S0 = substr signature, 0, 1 if $S0 == 'v' goto pirop_void $I0 = index '0123456789', $S0 if $I0 < 0 goto pirop_reg $S0 = arglist[$I0] ops.'result'($S0) goto pirop_void pirop_reg: .local string result result = self.'tempreg'($S0) ops.'result'(result) ops.'push_pirop'(pirop, result, posargs :flat) .return (ops) pirop_void: ops.'push_pirop'(pirop, posargs :flat) .return (ops) .end =item call(PAST::Op node) Return the POST representation of a C node for calling a sub. =cut .sub 'call' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .local string pasttype pasttype = node.'pasttype'() if pasttype goto have_pasttype pasttype = 'call' have_pasttype: .local string signature signature = 'v:' ## for callmethod, the invocant (child) must be a PMC if pasttype != 'callmethod' goto have_signature signature = 'vP:' have_signature: .local pmc name, ops, posargs, namedargs name = node.'name'() if name goto call_by_name ## our first child is the thing to be invoked, so make sure it's a PMC signature = replace signature, 1, 0, 'P' (ops, posargs, namedargs) = self.'post_children'(node, 'signature'=>signature) goto children_done call_by_name: (ops, posargs, namedargs) = self.'post_children'(node, 'signature'=>signature) $I0 = isa name, ['PAST';'Node'] if $I0 goto call_by_name_past $S0 = self.'escape'(name) unshift posargs, $S0 goto children_done call_by_name_past: .local pmc name_post name_post = self.'as_post'(name, 'rtype'=>'s') name_post = self.'coerce'(name_post, 's') ops.'push'(name_post) unshift posargs, name_post children_done: ## generate the call itself .local string result, rtype rtype = options['rtype'] result = self.'tempreg'(rtype) ops.'push_pirop'(pasttype, posargs :flat, namedargs :flat, 'result'=>result) ops.'result'(result) .return (ops) .end =item callmethod(PAST::Op node) Return the POST representation of a C node to invoke a method on a PMC. =cut .sub 'callmethod' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .tailcall self.'call'(node, options :flat :named) .end =item if(PAST::Op node) =item unless(PAST::Op node) Return the POST representation of C nodes with a 'pasttype' of if/unless. =cut .sub 'if' :method :multi(_,['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .local pmc opsclass, ops opsclass = get_hll_global ['POST'], 'Ops' ops = opsclass.'new'('node'=>node) .local string rtype, result rtype = options['rtype'] result = self.'tempreg'(rtype) ops.'result'(result) .local string pasttype pasttype = node.'pasttype'() .local pmc exprpast, thenpast, elsepast, childpast .local pmc exprpost, thenpost, elsepost, childpost exprpast = node[0] thenpast = node[1] elsepast = node[2] .local pmc thenlabel, endlabel $P0 = get_hll_global ['POST'], 'Label' $S0 = concat pasttype, '_' $S0 = self.'unique'($S0) thenlabel = $P0.'new'('result'=>$S0) $S0 = concat $S0, '_end' endlabel = $P0.'new'('result'=>$S0) .local string exprrtype, childrtype exprrtype = 'r' if rtype != 'v' goto have_exprrtype exprrtype = '*' have_exprrtype: childrtype = rtype $I0 = index '*:', rtype if $I0 < 0 goto have_childrtype childrtype = 'P' have_childrtype: exprpost = self.'as_post'(exprpast, 'rtype'=>exprrtype) .local pmc jmpstack jmpstack = new 'ResizableIntegerArray' childpast = thenpast local_branch jmpstack, make_childpost thenpost = childpost childpast = elsepast local_branch jmpstack, make_childpost elsepost = childpost if null elsepost goto no_elsepost ops.'push'(exprpost) ops.'push_pirop'(pasttype, exprpost, thenlabel) if null elsepost goto else_done ops.'push'(elsepost) else_done: ops.'push_pirop'('goto', endlabel) ops.'push'(thenlabel) if null thenpost goto then_done ops.'push'(thenpost) then_done: ops.'push'(endlabel) .return (ops) no_elsepost: $S0 = 'if' unless pasttype == $S0 goto no_elsepost_1 $S0 = 'unless' no_elsepost_1: ops.'push'(exprpost) ops.'push_pirop'($S0, exprpost, endlabel) if null thenpost goto no_elsepost_2 ops.'push'(thenpost) no_elsepost_2: ops.'push'(endlabel) .return (ops) make_childpost: null childpost $I0 = defined childpast unless $I0 goto no_childpast .local pmc arglist arglist = new 'ResizablePMCArray' $I0 = childpast.'arity'() unless $I0 > 0 goto have_arglist push arglist, exprpost have_arglist: childpost = self.'as_post'(childpast, 'rtype'=>childrtype, 'arglist'=>arglist) goto childpost_coerce no_childpast: if rtype == 'v' goto ret_childpost childpost = opsclass.'new'('result'=>exprpost) childpost_coerce: unless result goto ret_childpost childpost = self.'coerce'(childpost, result) ret_childpost: local_return jmpstack .end .sub 'unless' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .tailcall self.'if'(node, options :flat :named) .end =item loop_gen(...) Generate a standard loop with NEXT/LAST/REDO exception handling. =cut .sub 'loop_gen' :method .param pmc options :slurpy :named .local pmc testlabel, prelabel, redolabel, nextlabel, donelabel, handlabel $P0 = get_hll_global ['POST'], 'Label' .local string loopname loopname = self.'unique'('loop') $S0 = concat loopname, '_test' testlabel = $P0.'new'('result'=>$S0) $S0 = concat loopname, '_redo' redolabel = $P0.'new'('result'=>$S0) $S0 = concat loopname, '_next' nextlabel = $P0.'new'('result'=>$S0) $S0 = concat loopname, '_done' donelabel = $P0.'new'('result'=>$S0) $S0 = concat loopname, '_handler' handlabel = $P0.'new'('result'=>$S0) .local pmc testpost, prepost, bodypost, nextpost .local string testop .local int bodyfirst testop = options['testop'] testpost = options['test'] prepost = options['pre'] bodypost = options['body'] nextpost = options['next'] bodyfirst = options['bodyfirst'] if testop goto have_testop testop = 'unless' have_testop: .local pmc ops $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'() $P0 = find_dynamic_lex '$*SUB' $P0.'add_directive'('.include "except_types.pasm"') .local string handreg handreg = self.'tempreg'('P') ops.'push_pirop'('new', handreg, "'ExceptionHandler'", "[.CONTROL_LOOP_NEXT;.CONTROL_LOOP_REDO;.CONTROL_LOOP_LAST]") ops.'push_pirop'('set_label', handreg, handlabel) ops.'push_pirop'('push_eh', handreg) unless bodyfirst goto bodyfirst_done ops.'push_pirop'('goto', redolabel) bodyfirst_done: ops.'push'(testlabel) if null testpost goto test_done ops.'push'(testpost) ops.'push_pirop'(testop, testpost, donelabel) test_done: if null prepost goto pre_done ops.'push'(prepost) pre_done: ops.'push'(redolabel) if null bodypost goto body_done ops.'push'(bodypost) body_done: ops.'push'(nextlabel) if null nextpost goto next_done ops.'push'(nextpost) next_done: ops.'push_pirop'('goto', testlabel) ops.'push'(handlabel) ops.'push_pirop'('.local pmc exception') ops.'push_pirop'('.get_results (exception)') # should probably also finalize the exception ops.'push_pirop'('pop_upto_eh', 'exception') $S0 = self.'tempreg'('P') ops.'push_pirop'('getattribute', $S0, 'exception', "'type'") ops.'push_pirop'('eq', $S0, '.CONTROL_LOOP_NEXT', nextlabel) ops.'push_pirop'('eq', $S0, '.CONTROL_LOOP_REDO', redolabel) ops.'push'(donelabel) ops.'push_pirop'('pop_eh') .return (ops) .end =item while(PAST::Op node) =item until(PAST::Op node) =item repeat_while(PAST::Op node) =item repeat_until(PAST::Op node) Return the POST representation of a C or C loop. =cut .sub 'while' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .local pmc exprpast, bodypast, nextpast exprpast = node[0] bodypast = node[1] nextpast = node[2] .local pmc exprpost, bodypost, nextpost exprpost = self.'as_post'(exprpast, 'rtype'=>'r') .local pmc arglist arglist = new 'ResizablePMCArray' $I0 = bodypast.'arity'() if $I0 < 1 goto have_arglist push arglist, exprpost have_arglist: bodypost = self.'as_post'(bodypast, 'rtype'=>'v', 'arglist'=>arglist) null nextpost if null nextpast goto have_nextpost nextpost = self.'as_post'(nextpast, 'rtype'=>'v') have_nextpost: .local string testop testop = options['testop'] .local int bodyfirst bodyfirst = options['bodyfirst'] .local pmc ops ops = self.'loop_gen'('testop'=>testop, 'test'=>exprpost, 'body'=>bodypost, 'bodyfirst'=>bodyfirst, 'next'=>nextpost) ops.'result'(exprpost) ops.'node'(node) .return (ops) .end .sub 'until' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .tailcall self.'while'(node, options :flat :named, 'testop'=>'if') .end .sub 'repeat_while' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .tailcall self.'while'(node, options :flat :named, 'bodyfirst'=>1) .end .sub 'repeat_until' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .tailcall self.'while'(node, options :flat :named, 'testop'=>'if', 'bodyfirst'=>1) .end =item for(PAST::Op node) Return the POST representation of the C loop given by C. =cut .sub 'for' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .local pmc ops, prepost, testpost $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) prepost = $P0.'new'() $S0 = self.'tempreg'('P') testpost = $P0.'new'('result'=>$S0) .local pmc collpast, bodypast collpast = node[0] bodypast = node[1] .local pmc collpost collpost = self.'as_post'(collpast, 'rtype'=>'P') ops.'push'(collpost) ## don't try to iterate undefined values .local pmc undeflabel $P0 = get_hll_global ['POST'], 'Label' undeflabel = $P0.'new'('name'=>'for_undef_') $S0 = self.'tempreg'('I') ops.'push_pirop'('defined', $S0, collpost) ops.'push_pirop'('unless', $S0, undeflabel) ops.'push_pirop'('iter', testpost, collpost) ## determine the arity of the loop. We check arity of the 'for' ## node itself, and if not set we use the arity of the body. .local int arity arity = 1 $P0 = node.'arity'() $I0 = defined $P0 unless $I0 goto arity_child arity = $P0 goto have_arity arity_child: $P0 = bodypast.'arity'() $I0 = defined $P0 unless $I0 goto have_arity arity = $P0 have_arity: ## build the argument list to pass to the body .local pmc arglist arglist = new 'ResizablePMCArray' arity_loop: .local string nextarg nextarg = self.'tempreg'('P') prepost.'push_pirop'('shift', nextarg, testpost) if arity < 1 goto arity_end push arglist, nextarg dec arity if arity > 0 goto arity_loop arity_end: ## now build the body itself .local pmc bodypost bodypost = self.'as_post'(bodypast, 'rtype'=>'v', 'arglist'=>arglist) ## generate the loop and return $P0 = self.'loop_gen'('test'=>testpost, 'pre'=>prepost, 'body'=>bodypost) ops.'push'($P0) ops.'push'(undeflabel) ops.'result'(testpost) .return (ops) .end =item list(PAST::Op node) Build a list from the children. The type of list constructed is determined by the C attribute, which defaults to C if not set. =cut .sub 'list' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .local pmc ops, posargs (ops, posargs) = self.'post_children'(node, 'signature'=>'v*') .local pmc returns returns = node.'returns'() if returns goto have_returns returns = box 'ResizablePMCArray' have_returns: .local pmc listpost, it listpost = self.'as_vivipost'(returns, 'rtype'=>'P') ops.'result'(listpost) ops.'push'(listpost) it = iter posargs iter_loop: unless it goto iter_end $S0 = shift it ops.'push_pirop'('push', listpost, $S0) goto iter_loop iter_end: .return (ops) .end =item stmts(PAST::Op node) Treat the node like a PAST::Stmts node -- i.e., invoke all the children and return the value of the last one. =cut .sub 'stmts' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .const 'Sub' $P0 = 'Node.as_post' .tailcall self.$P0(node, options :flat :named) .end =item null(PAST::Op node) A "no-op" node -- none of the children are processed, and no statements are generated. =cut .sub 'null' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named $P0 = get_hll_global ['POST'], 'Ops' .tailcall $P0.'new'('node'=>node) .end =item return(PAST::Op node) Generate a return exception, using the first child (if any) as a return value. =cut .sub 'return' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .local pmc ops $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) .local string exreg, extype exreg = self.'tempreg'('P') extype = concat exreg, "['type']" ops.'push_pirop'('new', exreg, '"Exception"') ops.'push_pirop'('set', extype, '.CONTROL_RETURN') $P0 = find_dynamic_lex '$*SUB' $P0.'add_directive'('.include "except_types.pasm"') .local pmc cpast, cpost cpast = node[0] unless cpast goto cpast_done cpost = self.'as_post'(cpast, 'rtype'=>'P') cpost = self.'coerce'(cpost, 'P') ops.'push'(cpost) ops.'push_pirop'('setattribute', exreg, "'payload'", cpost) cpast_done: ops.'push_pirop'('throw', exreg) .return (ops) .end =item try(PAST::Op node) Return the POST representation of a C node with a 'pasttype' of try. The first child is the code to be surrounded by an exception handler, the second child (if any) is the code to process the handler. =cut .sub 'try' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .local pmc ops $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) .local pmc catchlabel, endlabel $P0 = get_hll_global ['POST'], 'Label' $S0 = self.'unique'('catch_') catchlabel = $P0.'new'('result'=>$S0) $S0 = concat $S0, '_end' endlabel = $P0.'new'('result'=>$S0) .local string rtype, result rtype = options['rtype'] result = self.'tempreg'(rtype) ops.'result'(result) .local pmc trypast, trypost trypast = node[0] trypost = self.'as_post'(trypast, 'rtype'=>rtype) unless result goto trypost_no_result trypost = self.'coerce'(trypost, result) trypost_no_result: self.'push_exception_handler'(node, ops, catchlabel) ops.'push'(trypost) ops.'push_pirop'('pop_eh') .local pmc elsepast, elsepost elsepast = node[2] if null elsepast goto else_done elsepost = self.'as_post'(elsepast, 'rtype'=>'v') ops.'push'(elsepost) else_done: ops.'push_pirop'('goto', endlabel) ops.'push'(catchlabel) .local string exceptreg exceptreg = self.'uniquereg'('P') ops.'push_pirop'('peek_exception', exceptreg) .local pmc catchpast, catchpost catchpast = node[1] if null catchpast goto catchpost_done catchpost = self.'as_post'(catchpast, 'rtype'=>rtype) unless result goto catchpost_no_result catchpost = self.'coerce'(catchpost, result) catchpost_no_result: ops.'push'(catchpost) catchpost_done: ops.'push_pirop'('finalize', exceptreg) ops.'push_pirop'('pop_upto_eh', exceptreg) ops.'push_pirop'('pop_eh') catch_done: ops.'push'(endlabel) .return (ops) .end =item chain(PAST::Op node) A short-circuiting chain of operations. In a sequence of nodes with pasttype 'chain', the right operand of a node serves as the left operand of its parent. Each node is evaluated only once, and the first false result short-circuits the chain. In other words, C<< $x < $y < $z >> is true only if $x < $y and $y < $z, but $y only gets evaluated once. =cut .sub 'chain' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .local pmc clist, cpast ## first, we build up the list of nodes in the chain clist = new 'ResizablePMCArray' cpast = node chain_loop: $I0 = isa cpast, ['PAST';'Op'] if $I0 == 0 goto chain_end .local string pasttype pasttype = cpast.'pasttype'() if pasttype != 'chain' goto chain_end push clist, cpast cpast = cpast[0] goto chain_loop chain_end: .local pmc ops, endlabel $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) $S0 = self.'unique'('$P') ops.'result'($S0) $P0 = get_hll_global ['POST'], 'Label' endlabel = $P0.'new'('name'=>'chain_end_') .local pmc apast, apost cpast = pop clist apast = cpast[0] apost = self.'as_post'(apast, 'rtype'=>'P') ops.'push'(apost) clist_loop: .local pmc bpast, bpost bpast = cpast[1] bpost = self.'as_post'(bpast, 'rtype'=>'P') ops.'push'(bpost) .local string name name = cpast.'name'() name = self.'escape'(name) ops.'push_pirop'('call', name, apost, bpost, 'result'=>ops) unless clist goto clist_end ops.'push_pirop'('unless', ops, endlabel) cpast = pop clist apost = bpost goto clist_loop clist_end: ops.'push'(endlabel) .return (ops) .end =item def_or(PAST::Op node) The short-circuiting default operator (e.g., Perl 6's C<< infix: >>). Returns its first child if its defined, otherwise it evaluates and returns the second child. (N.B.: This particular pasttype is a candidate for being refactored out using thunks of some sort.) =cut .sub 'def_or' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .local pmc ops $P0 = get_hll_global ['POST'], 'Ops' $S0 = self.'unique'('$P') ops = $P0.'new'('node'=>node, 'result'=>$S0) .local pmc lpast, lpost lpast = node[0] lpost = self.'as_post'(lpast, 'rtype'=>'P') ops.'push'(lpost) ops.'push_pirop'('set', ops, lpost) .local pmc endlabel $P0 = get_hll_global ['POST'], 'Label' $S0 = self.'unique'('default_') endlabel = $P0.'new'('result'=>$S0) $S0 = self.'unique'('$I') ops.'push_pirop'('defined', $S0, ops) ops.'push_pirop'('if', $S0, endlabel) .local pmc rpast, rpost rpast = node[1] rpost = self.'as_post'(rpast, 'rtype'=>'P') ops.'push'(rpost) ops.'push_pirop'('set', ops, rpost) ops.'push'(endlabel) .return (ops) .end =item xor(PAST::Op node) A short-circuiting exclusive-or operation. Each child is evaluated, if exactly one child evaluates to true then its value is returned, otherwise return Undef. Short-circuits with Undef as soon as a second child is found that evaluates as true. =cut .sub 'xor' :method :multi(_,['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .local pmc ops $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) $S0 = self.'unique'('$P') ops.'result'($S0) .local pmc labelproto, endlabel, falselabel labelproto = get_hll_global ['POST'], 'Label' falselabel = labelproto.'new'('name'=>'xor_false') endlabel = labelproto.'new'('name'=>'xor_end') .local pmc iter, apast, apost, i, t, u i = self.'unique'('$I') t = self.'unique'('$I') u = self.'unique'('$I') iter = node.'iterator'() apast = shift iter apost = self.'as_post'(apast, 'rtype'=>'P') ops.'push'(apost) ops.'push_pirop'('set', ops, apost) ops.'push_pirop'('istrue', t, apost) middle_child: .local pmc bpast, bpost bpast = shift iter bpost = self.'as_post'(bpast, 'rtype'=>'P') ops.'push'(bpost) ops.'push_pirop'('istrue', u, bpost) ops.'push_pirop'('and', i, t, u) ops.'push_pirop'('if', i, falselabel) unless iter goto last_child .local pmc truelabel truelabel = labelproto.'new'('name'=>'xor_true') ops.'push_pirop'('if', t, truelabel) ops.'push_pirop'('set', ops, bpost) ops.'push_pirop'('set', t, u) ops.'push'(truelabel) goto middle_child last_child: ops.'push_pirop'('if', t, endlabel) ops.'push_pirop'('set', ops, bpost) ops.'push_pirop'('goto', endlabel) ops.'push'(falselabel) ops.'push_pirop'('new', ops, '"Undef"') ops.'push'(endlabel) .return (ops) .end =item bind(PAST::Op node) Return the POST representation of a C node with a 'pasttype' of bind. =cut .sub 'bind' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .local pmc ops, lpast, rpast, lpost, rpost lpast = node[0] rpast = node[1] $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) rpost = self.'as_post'(rpast, 'rtype'=>'P') rpost = self.'coerce'(rpost, 'P') ops.'push'(rpost) lpast.'lvalue'(1) lpost = self.'as_post'(lpast, 'bindpost'=>rpost) ops.'push'(lpost) ops.'result'(lpost) .return (ops) .end =item copy(PAST::Op node) Implement a 'copy' assignment (at least until we get the 'copy' opcode). =cut .sub 'copy' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .local pmc rpast, rpost, lpast, lpost rpast = node[1] lpast = node[0] rpost = self.'as_post'(rpast, 'rtype'=>'P') lpost = self.'as_post'(lpast, 'rtype'=>'P') .local pmc ops, alabel $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'(rpost, lpost, 'node'=>node, 'result'=>lpost) ops.'push_pirop'('copy', lpost, rpost) .return (ops) .end =item inline(PAST::Op node) Return the POST representation of a C node with a 'pasttype' of inline. =cut .sub 'inline' :method :multi(_, ['PAST';'Op']) .param pmc node .param pmc options :slurpy :named .local pmc ops ops = self.'post_children'(node, 'signature'=>'vP') .local pmc inline_pmc .local string inline inline_pmc = node.'inline'() $I0 = does inline_pmc, 'array' if $I0 goto inline_array inline = inline_pmc goto have_inline inline_array: inline = join "\n", inline_pmc have_inline: .local string result result = '' $I0 = index inline, '%t' if $I0 >= 0 goto result_new $I0 = index inline, '%r' unless $I0 >= 0 goto have_result result = self.'unique'('$P') ops.'result'(result) goto have_result result_new: result = self.'unique'('$P') ops.'push_pirop'('new', result, "'Undef'") ops.'result'(result) have_result: .local pmc arglist arglist = ops.'list'() ops.'push_pirop'('inline', arglist :flat, 'inline'=>inline, 'result'=>result) $S0 = options['rtype'] .return (ops) .end =back =head3 C =over 4 =item as_post(PAST::Var node) Return the POST representation of a C. Generally we redispatch to an appropriate handler based on the node's 'scope' attribute. =cut .sub 'as_post' :method :multi(_, ['PAST';'Var']) .param pmc node .param pmc options :slurpy :named ## set 'bindpost' .local pmc bindpost bindpost = options['bindpost'] unless null bindpost goto have_bindpost bindpost = new 'Undef' have_bindpost: ## determine the node's scope. First, check the node itself .local string scope scope = node.'scope'() if scope goto have_scope ## otherwise, check the current symbol table under the variable's name .local string name name = node.'name'() .local pmc symtable symtable = getattribute self, '%!symtable' $P0 = symtable[name] if null $P0 goto default_scope scope = $P0['scope'] if scope goto have_scope default_scope: ## see if an outer block has set a default scope $P0 = symtable[''] if null $P0 goto scope_error scope = $P0['scope'] unless scope goto scope_error have_scope: push_eh scope_error_ex $P0 = find_method self, scope .tailcall self.$P0(node, bindpost) scope_error_ex: pop_eh scope_error: unless scope goto scope_error_1 scope = concat " in '", scope scope = concat scope, "' scope" scope_error_1: # Find the nearest named block .local string blockname blockname = '' .local pmc it $P0 = find_dynamic_lex '@*BLOCKPAST' it = iter $P0 scope_error_block_loop: unless it goto scope_error_2 $P0 = shift it blockname = $P0.'name'() unless blockname goto scope_error_block_loop scope_error_2: if blockname goto have_blockname blockname = '' have_blockname: # Find the source location, if available .local string sourceline .local pmc source, pos, files sourceline = '' source = node['source'] pos = node['pos'] if null source goto scope_error_3 files = find_caller_lex '$?FILES' if null files goto scope_error_3 $S0 = files sourceline = concat ' (', $S0 sourceline = concat sourceline, ':' $I0 = self.'lineof'(source, pos) inc $I0 $S0 = $I0 sourceline = concat sourceline, $S0 sourceline = concat sourceline, ')' scope_error_3: .tailcall self.'panic'("Symbol '", name, "' not predeclared", scope, " in ", blockname, sourceline) .end .sub 'vivify' :method .param pmc node .param pmc ops .param pmc fetchop .param pmc storeop .local pmc viviself, vivipost, vivilabel viviself = node.'viviself'() vivipost = self.'as_vivipost'(viviself, 'rtype'=>'P') .local string result result = vivipost.'result'() unless result == '' goto have_result result = self.'tempreg'('P') have_result: ops.'result'(result) ops.'push'(fetchop) unless viviself goto vivipost_done $P0 = get_hll_global ['POST'], 'Label' vivilabel = $P0.'new'('name'=>'vivify_') ops.'push_pirop'('unless_null', ops, vivilabel) ops.'push'(vivipost) $I0 = node.'lvalue'() unless $I0 goto vivipost_stored ops.'push'(storeop) vivipost_stored: ops.'push'(vivilabel) vivipost_done: .return (ops) .end .sub 'parameter' :method :multi(_, ['PAST';'Var']) .param pmc node .param pmc bindpost ## get the current sub .local pmc subpost subpost = find_dynamic_lex '$*SUB' ## determine lexical, register, and parameter names .local string named, pname, has_pname .local pmc name name = node.'name'() named = node.'named'() pname = self.'unique'('param_') has_pname = concat 'has_', pname ## returned post node .local pmc ops $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node, 'result'=>pname) ## handle optional params .local pmc viviself, vivipost, vivilabel viviself = node.'viviself'() unless viviself goto param_required vivipost = self.'as_vivipost'(viviself, 'rtype'=>'P') $P0 = get_hll_global ['POST'], 'Label' vivilabel = $P0.'new'('name'=>'optparam_') subpost.'add_param'(pname, 'named'=>named, 'optional'=>1) ops.'push_pirop'('if', has_pname, vivilabel) ops.'push'(vivipost) ops.'push_pirop'('set', ops, vivipost) ops.'push'(vivilabel) goto param_done param_required: .local int call_sig, slurpy call_sig = node.'call_sig'() slurpy = node.'slurpy'() subpost.'add_param'(pname, 'named'=>named, 'slurpy'=>slurpy, 'call_sig'=>call_sig) param_done: $I0 = defined name unless $I0 goto param_lex_done name = self.'escape'(name) ops.'push_pirop'('.lex', name, ops) .local int directaccess directaccess = node.'directaccess'() unless directaccess goto param_lex_done .local pmc lexregs lexregs = find_dynamic_lex '%*LEXREGS' unless null lexregs goto have_lexregs lexregs = new 'Hash' store_dynamic_lex '%*LEXREGS', lexregs have_lexregs: lexregs[name] = pname param_lex_done: .return (ops) .end .sub 'package' :method :multi(_, ['PAST';'Var']) .param pmc node .param pmc bindpost .local pmc ops, fetchop, storeop $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) .local string name name = node.'name'() name = self.'escape'(name) $P0 = get_hll_global ['POST'], 'Op' .local pmc ns ns = node.'namespace'() $I0 = defined ns if $I0 goto package_hll if bindpost goto package_bind fetchop = $P0.'new'(ops, name, 'pirop'=>'get_global') storeop = $P0.'new'(name, ops, 'pirop'=>'set_global') .tailcall self.'vivify'(node, ops, fetchop, storeop) package_bind: .tailcall $P0.'new'(name, bindpost, 'pirop'=>'set_global', 'result'=>bindpost) package_hll: if ns goto package_ns if bindpost goto package_hll_bind fetchop = $P0.'new'(ops, name, 'pirop'=>'get_hll_global') storeop = $P0.'new'(name, ops, 'pirop'=>'set_hll_global') .tailcall self.'vivify'(node, ops, fetchop, storeop) package_hll_bind: .tailcall $P0.'new'(name, bindpost, 'pirop'=>'set_hll_global', 'result'=>bindpost) package_ns: $P1 = get_hll_global ['POST'], 'Compiler' ns = $P1.'key_pir'(ns) if bindpost goto package_ns_bind fetchop = $P0.'new'(ops, ns, name, 'pirop'=>'get_hll_global') storeop = $P0.'new'(ns, name, ops, 'pirop'=>'set_hll_global') .tailcall self.'vivify'(node, ops, fetchop, storeop) package_ns_bind: .tailcall $P0.'new'(ns, name, bindpost, 'pirop'=>'set_hll_global', 'result'=>bindpost) .end .sub 'lexical' :method :multi(_, ['PAST';'Var']) .param pmc node .param pmc bindpost .local string name name = node.'name'() name = self.'escape'(name) .local pmc lexregs lexregs = find_dynamic_lex '%*LEXREGS' .local int isdecl isdecl = node.'isdecl'() lexical_post: if isdecl goto lexical_decl if bindpost goto lexical_bind .local pmc ops, fetchop, storeop $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) $P0 = get_hll_global ['POST'], 'Op' if null lexregs goto no_lexregs .local string lexreg lexreg = lexregs[name] unless lexreg goto no_lexregs fetchop = $P0.'new'(ops, lexreg, 'pirop'=>'set') storeop = $P0.'new'(lexreg, ops, 'pirop'=>'set') .tailcall self.'vivify'(node, ops, fetchop, storeop) no_lexregs: fetchop = $P0.'new'(ops, name, 'pirop'=>'find_lex') storeop = $P0.'new'(name, ops, 'pirop'=>'store_lex') .tailcall self.'vivify'(node, ops, fetchop, storeop) lexical_decl: .local string lexreg # lexical registers cannot be temporaries lexreg = self.'uniquereg'('P') $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) if bindpost goto have_bindpost .local pmc viviself viviself = node.'viviself'() unless viviself goto have_lexreg bindpost = self.'as_vivipost'(viviself, 'rtype'=>'P') ops.'push'(bindpost) have_bindpost: ops.'push_pirop'('set', lexreg, bindpost) have_lexreg: ops.'push_pirop'('.lex', name, lexreg) ops.'result'(lexreg) .local int directaccess directaccess = node.'directaccess'() unless directaccess goto no_directaccess unless null lexregs goto have_lexregs lexregs = new 'Hash' store_dynamic_lex '%*LEXREGS', lexregs have_lexregs: lexregs[name] = lexreg no_directaccess: .return (ops) lexical_bind: $P0 = get_hll_global ['POST'], 'Op' if null lexregs goto no_lexregs_bind .local string lexreg lexreg = lexregs[name] unless lexreg goto no_lexregs_bind .tailcall $P0.'new'(lexreg, bindpost, 'pirop'=>'set', 'result'=>bindpost) no_lexregs_bind: .tailcall $P0.'new'(name, bindpost, 'pirop'=>'store_lex', 'result'=>bindpost) .end .sub 'contextual' :method :multi(_, ['PAST';'Var']) .param pmc node .param pmc bindpost # If we've requested a contextual in a block that # explicitly declares the variable as a different type, # treat it as that type. .local string name name = node.'name'() $P0 = find_dynamic_lex '@*BLOCKPAST' $P0 = $P0[0] $P0 = $P0.'symtable'() unless $P0 goto contextual $P0 = $P0[name] if null $P0 goto contextual $S0 = $P0['scope'] unless $S0 goto contextual if $S0 == 'contextual' goto contextual .tailcall self.$S0(node, bindpost) contextual: # If this is a declaration, treat it like a normal lexical .local int isdecl isdecl = node.'isdecl'() if isdecl goto contextual_lex name = self.'escape'(name) if bindpost goto contextual_bind contextual_post: .local pmc ops, fetchop, storeop $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) $P0 = get_hll_global ['POST'], 'Op' fetchop = $P0.'new'(ops, name, 'pirop'=>'find_dynamic_lex') storeop = $P0.'new'(name, ops, 'pirop'=>'store_dynamic_lex') .tailcall self.'vivify'(node, ops, fetchop, storeop) contextual_bind: $P0 = get_hll_global ['POST'], 'Op' .tailcall $P0.'new'(name, bindpost, 'pirop'=>'store_dynamic_lex', 'result'=>bindpost) contextual_lex: .tailcall self.'lexical'(node, bindpost) .end .sub 'keyed' :method :multi(_, ['PAST';'Var']) .param pmc node .param pmc bindpost .param string keyrtype :optional .param int has_keyrtype :opt_flag .local pmc ops $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) if has_keyrtype goto have_keyrtype keyrtype = '*' have_keyrtype: .local pmc keypast, keypost keypast = node[1] keypost = self.'as_post'(keypast, 'rtype'=>keyrtype) keypost = self.'coerce'(keypost, keyrtype) ops.'push'(keypost) .local pmc basepast, basepost basepast = node[0] $P0 = node.'vivibase'() unless $P0 goto have_vivibase $I0 = can basepast, 'viviself' unless $I0 goto have_vivibase $P1 = basepast.'viviself'() unless $P1 goto vivibase_1 if $P1 != 'Undef' goto have_vivibase vivibase_1: basepast.'viviself'($P0) have_vivibase: # if the keyed node is an lvalue, its base is an lvalue also $I0 = node.'lvalue'() unless $I0 goto have_lvalue basepast.'lvalue'($I0) have_lvalue: basepost = self.'as_post'(basepast, 'rtype'=>'P') ops.'push'(basepost) .local string name $S0 = basepost.'result'() name = concat $S0, '[' $S0 = keypost.'result'() name = concat name, $S0 name = concat name, ']' .local pmc fetchop, storeop $P0 = get_hll_global ['POST'], 'Op' if bindpost goto keyed_bind fetchop = $P0.'new'(ops, name, 'pirop'=>'set') storeop = $P0.'new'(name, ops, 'pirop'=>'set') .tailcall self.'vivify'(node, ops, fetchop, storeop) keyed_bind: ops.'result'(bindpost) ops.'push_pirop'('set', name, ops) .return (ops) .end .sub 'keyed_int' :method :multi(_, ['PAST';'Var']) .param pmc node .param pmc bindpost .tailcall self.'keyed'(node, bindpost, 'i') .end .sub 'attribute' :method :multi(_, ['PAST';'Var']) .param pmc node .param pmc bindpost .local pmc ops $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) .local string name name = node.'name'() name = self.'escape'(name) # We have three cases here. # 0 children = use self # 1 child = object to look up on # 2 children = object to look up on + class handle # In the last case, we need to generate a different form of the op that # has the extra argument. .local pmc call_on $I0 = elements node if $I0 == 0 goto use_self call_on = node[0] call_on = self.'as_post'(call_on, 'rtype'=>'P') ops.'push'(call_on) if $I0 == 2 goto have_class_handle goto invocant_done use_self: call_on = box 'self' invocant_done: if bindpost goto attribute_bind attribute_post: .local pmc fetchop, storeop $P0 = get_hll_global ['POST'], 'Op' fetchop = $P0.'new'(ops, call_on, name, 'pirop'=>'getattribute') storeop = $P0.'new'(call_on, name, ops, 'pirop'=>'setattribute') .tailcall self.'vivify'(node, ops, fetchop, storeop) attribute_bind: ops.'push_pirop'('setattribute', call_on, name, bindpost) ops.'result'(bindpost) .return (ops) have_class_handle: .local pmc handle handle = node[1] handle = self.'as_post'(handle, 'rtype'=>'P') ops.'push'(handle) if bindpost goto attribute_bind_handle .local pmc fetchop, storeop $P0 = get_hll_global ['POST'], 'Op' fetchop = $P0.'new'(ops, call_on, handle, name, 'pirop'=>'getattribute') storeop = $P0.'new'(call_on, handle, name, ops, 'pirop'=>'setattribute') .tailcall self.'vivify'(node, ops, fetchop, storeop) attribute_bind_handle: ops.'push_pirop'('setattribute', call_on, handle, name, bindpost) ops.'result'(bindpost) .return (ops) .end .sub 'register' :method :multi(_, ['PAST';'Var']) .param pmc node .param pmc bindpost .local string name name = node.'name'() if name goto have_name name = self.'uniquereg'('P') node.'name'(name) have_name: .local pmc ops $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('result'=>name, 'node'=>node) .local int isdecl isdecl = node.'isdecl'() unless isdecl goto decl_done ops.'push_pirop'('.local pmc', ops) decl_done: if bindpost goto register_bind .local pmc viviself, vivipost viviself = node.'viviself'() unless viviself goto end vivipost = self.'as_vivipost'(viviself, 'rtype'=>'P') ops.'push'(vivipost) ops.'push_pirop'('set', ops, vivipost) goto end register_bind: ops.'push_pirop'('set', ops, bindpost) end: .return (ops) .end =back =head3 C =over 4 =item as_post(PAST::Val node [, 'rtype'=>rtype]) Return the POST representation of the constant value given by C. The C parameter advises the method whether the value may be returned directly as a PIR constant or needs to have a PMC generated containing the constant value. =cut .sub 'as_post' :method :multi(_, ['PAST';'Val']) .param pmc node .param pmc options :slurpy :named .local pmc ops $P0 = get_hll_global ['POST'], 'Ops' ops = $P0.'new'('node'=>node) .local pmc value, returns value = node['value'] if null value goto err_novalue $I0 = isa value, ['PAST';'Block'] if $I0 goto value_block returns = node.'returns'() if returns goto have_returns $S0 = typeof value returns = $S0 have_returns: .local string valflags $P0 = get_global '%valflags' valflags = $P0[returns] $I0 = index valflags, 'e' if $I0 < 0 goto escape_done value = self.'escape'(value) escape_done: # See if this is a pasm constant type $I0 = index valflags, 'c' if $I0 < 0 goto const_done # Add the directive for the appropriate .include statement. $S0 = returns if $S0 == '!macro_const' goto include_done $S0 = replace $S0, 0, 1, '.include "' $S0 = concat $S0, '.pasm"' $P0 = find_dynamic_lex '$*SUB' $P0.'add_directive'($S0) include_done: # Add a leading dot to the value if one isn't already there. $S0 = substr value, 0, 1 if $S0 == '.' goto const_done $P0 = box '.' value = concat $P0, value const_done: .local string rtype rtype = options['rtype'] $I0 = index valflags, rtype if $I0 < 0 goto result_convert ops.'result'(value) .return (ops) result_convert: # handle int-to-num conversion here if rtype != 'n' goto result_pmc $I0 = index valflags, 'i' if $I0 < 0 goto result_pmc value = concat value, '.0' ops.'result'(value) .return (ops) result_pmc: .local string result result = self.'tempreg'('P') returns = self.'escape'(returns) ops.'push_pirop'('new', result, returns) ops.'push_pirop'('assign', result, value) ops.'result'(result) .return (ops) value_block: .local string blockreg, blockref blockreg = self.'uniquereg'('P') returns = node.'returns'() if null returns goto value_block_no_returns $S0 = returns blockref = concat ".const '", $S0 blockref = concat blockref, "' " blockref = concat blockref, blockreg goto value_block_blockref_set value_block_no_returns: blockref = concat ".const 'Sub' ", blockreg value_block_blockref_set: blockref = concat blockref, ' = ' $P0 = value.'subid'() $S0 = self.'escape'($P0) blockref = concat blockref, $S0 ops.'push_pirop'(blockref) ops.'result'(blockreg) .return (ops) err_novalue: self.'panic'('PAST::Val node missing :value attribute') .end =back =head1 AUTHOR Patrick Michaud is the author and maintainer. Please send patches and suggestions to the Parrot porters or Perl 6 compilers mailing lists. =head1 HISTORY 2006-11-20 Patrick Michaud added first draft of POD documentation. 2006-11-27 Significant refactor into separate modules. =head1 COPYRIGHT Copyright (C) 2006-2008, Parrot Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: obscure.ops000644000765000765 742111567202624 17501 0ustar00brucebruce000000000000parrot-5.9.0/src/dynoplibs/* ** obscure.ops */ BEGIN_OPS_PREAMBLE #include END_OPS_PREAMBLE =head1 NAME obscure.ops - Obscure Mathematical Opcodes =cut =head1 DESCRIPTION Parrot's library of obscure mathematical ops. These turn common trig expressions into a single op. To use this library of ops, add this directive to your PIR: .loadlib 'obscure_ops' =cut ############################################################################### =head2 Obscure trigonometric operations Reference: Abramowitz, M. and Stegum, C. A. (Eds.). Handbook of Mathematical Functions with Formulas, Graphs, and Mathematical Tables, 9th printing. New York: Dover, p. 78, 1972. =over 4 =cut ######################################## =item B(out NUM, in NUM) Set $1 to the coversine (in radians) of $2. =cut inline op covers(out NUM, in NUM) :advanced_math { $1 = 1.0 - sin($2); } ######################################## =item B(out NUM, in NUM) Set $1 to the exsecant of $2 (given in radians). =cut inline op exsec(out NUM, in NUM) :advanced_math { $1 = (1.0 / cos($2)) - 1.0; } ######################################## =item B(out NUM, in NUM) Set $1 to the haversine (in radians) of $2. =cut inline op hav(out NUM, in NUM) { $1 = 0.5 * (1.0 - cos($2)); } ######################################## =item B(out NUM, in NUM) Set $1 to the versine (in radians) of $2. =cut inline op vers(out NUM, in NUM) :advanced_math { $1 = 1.0 - cos($2); } ######################################## =item B(out INT, in INT, in INT) Greatest Common divisor of $2 and $3. =cut inline op gcd(out INT, in INT, in INT) :advanced_math { INTVAL p = 0; INTVAL a = $2 < 0 ? -$2 : $2; INTVAL b = $3 < 0 ? -$3 : $3; if (a==0) { $1=b; goto NEXT(); } if (b==0) { $1=a; goto NEXT(); } while (!((a | b) & 1)) { a>>=1; b>>=1; p++; } while (a>0) { if (!(a & 1)) a>>=1; else if (!(b & 1)) b>>=1; else if (a>1; else a = (a-b)>>1; } $1 = b<(out INT, in INT, in INT) Least Common Multiple of $2 and $3 =cut inline op lcm(out INT, in INT, in INT) :advanced_math { INTVAL gcd = 0; INTVAL p = 0; INTVAL a = $2 < 0 ? -$2 : $2; INTVAL b = $3 < 0 ? -$3 : $3; INTVAL saved_var1 = a, saved_var2 = b; if (a==0 || b==0) { $1=0; goto NEXT(); } while (!((a | b) & 1)) { a>>=1; b>>=1; p++; } while (a>0) { if (!(a & 1)) a>>=1; else if (!(b & 1)) b>>=1; else if (a>1; else a = (a-b)>>1; } gcd = b<(out INT, in INT) =item B(out NUM, in INT) Factorial, n!. Calculates the product of 1 to N. =cut inline op fact(out INT, in INT) :advanced_math { /* Coercing a negative to a UINT can get pretty ugly * in this situation. */ INTVAL i = $2; UINTVAL q = 1; while (i>0) { q = q*i; i--; } $1 = q; } inline op fact(out NUM, in INT) :advanced_math { /* Coercing a negative to a UINT can get pretty ugly * in this situation. */ INTVAL i = $2; FLOATVAL q = 1; while (i>0) { q = q*i; i--; } $1 = q; } =back =cut ############################################################################### =head1 COPYRIGHT Copyright (C) 2001-2009, Parrot Foundation. =head1 LICENSE This program is free software. It is subject to the same license as the Parrot interpreter itself. =cut /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ .travis.yml000644000765000765 515612224663742 14641 0ustar00brucebruce000000000000parrot-5.9.0language: "perl" perl: # - "5.10" - "5.14" install: "echo" before_script: - sudo apt-get install libffi-dev libicu-dev libgmp3-dev clang llvm-dev zlib1g-dev gcc-multilib # No, we are not going to run the tests for all these dependencies on every commit - cpanm -n LWP::UserAgent TAP::Harness::Archive TAP::Harness::ReportByDescription Test::Perl::Critic - gcc --version - g++ --version - clang --version # This stuff used to be required, but was rolled into the Travis CI perl support. # - curl -L http://cpanmin.us | sudo perl - --self-upgrade # - export CI_USER=$USER # - mkdir ~/perl5 && perl -Mlocal::lib >> /tmp/local_lib_junk.sh && source /tmp/local_lib_junk.sh # - sudo chown -R $CI_USER ~/.cpanm # - sudo chown -R $CI_USER ~/perl5 # Don't run Configure.pl tests, for now #script: "perl Configure.pl --test=build $PARROT_CONFIG_ARGS $PARROT_OPTIMIZE --cc=\"$CC\" --link=\"$CC\" --ld=\"$CC\" --ccflags='-g' ; make $PARROT_TEST" script: "perl Configure.pl $PARROT_CONFIG_ARGS $PARROT_OPTIMIZE --cc=\"$CC\" --link=\"$CC\" --ld=\"$CC\" --ccflags='-g' ; make $PARROT_TEST" branches: only: - master - /smoke-me/ notifications: recipients: - parrot-ci@lists.parrot.org email: on_success: change on_failure: always irc: "irc.parrot.org#parrot" env: - PARROT_CONFIG_ARGS="" PARROT_OPTIMIZE="" PARROT_TEST="smoke" CC="clang" - PARROT_CONFIG_ARGS="--without-gettext --without-gmp --without-libffi --without-extra-nci-thunks --without-opengl --without-readline --without-pcre --without-zlib --without-threads --without-icu" PARROT_OPTIMIZE="" PARROT_TEST="smoke" CC="clang" - PARROT_CONFIG_ARGS="" PARROT_OPTIMIZE="--optimize" PARROT_TEST="smoke" CC="gcc" - PARROT_CONFIG_ARGS="--without-gettext --without-gmp --without-libffi --without-extra-nci-thunks --without-opengl --without-readline --without-pcre --without-zlib --without-threads --without-icu" PARROT_OPTIMIZE="" PARROT_TEST="smoke" CC="gcc" - PARROT_CONFIG_ARGS="" PARROT_OPTIMIZE="" PARROT_TEST="smoke" CC="g++" # Use clang to run our coding standard and manifest tests, because it is the fastest # These will cause Travis to report a build failure when somebody breaks the manifest # tests by forgetting to add files to our manifest, or when they break our coding standards. # The reason we do not use smolder_fulltest is because it will intermittently trigger # the Travis CI time-out of 15 minutes. - PARROT_CONFIG_ARGS="" PARROT_OPTIMIZE="" PARROT_TEST="codingstd_tests" CC="clang" - PARROT_CONFIG_ARGS="" PARROT_OPTIMIZE="" PARROT_TEST="manifest_tests" CC="clang" const.t000644000765000765 2525612101554067 20043 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/imcc/syn#!perl # Copyright (C) 2001-2008, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use vars qw($TODO); use Test::More; use Parrot::Config; use Parrot::Test tests => 39; pir_output_is( <<'CODE', <<'OUT', "globalconst 1" ); .sub 'main' :main .globalconst int N = 5 _main() .end .sub '_sub1' print N print "\n" .end .sub '_main' _sub1() .end CODE 5 OUT pir_output_is( <<'CODE', <<'OUT', "globalconst 2" ); .sub 'test' :main .globalconst int N = 5 _main() .end .sub '_sub1' .local int x x = 10 + N print x print "\n" .end .sub '_main' _sub1() .end CODE 15 OUT pir_output_is( <<'CODE', <<'OUT', "globalconst 3" ); .sub 'call_sub1' 'sub1'() .end .sub 'test' :main .globalconst int N = 5 'call_sub1'() .end .sub 'sub1' print N print "\n" .end CODE 5 OUT pir_output_is( <<'CODE', <<'OUT', "array/hash consts" ); .sub 'main' :main .local pmc ar .local pmc ha .local string key1 .const string key2 = "key2" .local int idx1 .const int idx2 = 2 ar = new 'ResizablePMCArray' ar = 3 ha = new 'Hash' key1 = "key1" idx1 = 1 ha[key1] = idx1 ha[key2] = idx2 $I0 = ha[key1] $I1 = ha[key2] ar[idx1] = $I0 ar[idx2] = $I1 $I2 = ar[idx1] $I3 = ar[idx2] print $I2 print $I3 print "\n" .end CODE 12 OUT pir_output_is( <<'CODE', <<'OUT', "escaped" ); .sub 'main' :main $S0 = "\"" print $S0 print "\\" $S0 = "\"\\\"\n" print $S0 .end CODE "\"\" OUT # fix editor highlighting " pir_output_is( <<'CODE', <<'OUT', "PMC const 1 - Sub" ); .sub 'main' :main .const 'Sub' $P0 = "foo" print "ok 1\n" $P0() print "ok 3\n" .end .sub foo print "ok 2\n" .end CODE ok 1 ok 2 ok 3 OUT pir_output_is( <<'CODE', <<'OUT', "PMC const 2 - Sub ident" ); .sub 'main' :main .const 'Sub' func = "foo" print "ok 1\n" func() print "ok 3\n" .end .sub foo print "ok 2\n" .end CODE ok 1 ok 2 ok 3 OUT pasm_output_is( <<'CODE', <<'OUT', "const I/N mismatch" ); .pcc_sub :main main: set I0, 2.0 print I0 print "\n" set N0, 2 print N0 print "\nok\n" end CODE 2 2 ok OUT pir_output_is( <<'CODE', <<'OUT', "const I/N mismatch 2" ); .sub 'main' :main .const int i = 2.0 print i print "\n" .const num n = 2 print n print "\nok\n" .const string s = ascii:"ok 2\n" print s .end CODE 2 2 ok ok 2 OUT pir_output_is( <<'CODE', <<'OUT', 'PIR heredocs: accepts double quoted terminator' ); .sub 'main' :main $S0 = <<"quotage" I want an elephant Oh, I want an elephat! Oh, woo, elephants, yeah :-O quotage print $S0 .end CODE I want an elephant Oh, I want an elephat! Oh, woo, elephants, yeah :-O OUT pir_output_is( <<'CODE', <<'OUT', 'PIR heredocs: accepts inline with concat' ); .sub 'main' :main $S0 = "" $I0 = 0 LOOP: $S0 = concat $S0, <<"end" ending end inc $I0 if $I0 < 5 goto LOOP print $S0 .end CODE ending ending ending ending ending OUT pir_output_is( <<'CODE', <<'OUT', "PIR heredoc: accepts terminator with any word chars" ); .sub 'main' :main $S0 = <<"AnY_w0Rd_ch4rS" so much depends upon a red wheel barrow glazed with rain water beside the white chickens AnY_w0Rd_ch4rS print $S0 .end CODE so much depends upon a red wheel barrow glazed with rain water beside the white chickens OUT pir_output_is( <<'CODE', <<'OUT', 'PIR heredoc: single quoted terminator' ); .sub 'main' :main $S0 = <<'Jabberwocky' `Twas brillig, and the slithy toves Did gyre and gimble in the wabe; All mimsy were the borogoves, And the mome raths outgrabe. Jabberwocky print $S0 .end CODE `Twas brillig, and the slithy toves Did gyre and gimble in the wabe; All mimsy were the borogoves, And the mome raths outgrabe. OUT pir_output_is( <<'CODE', <<'OUT', 'PIR heredoc: single quoted - backslash' ); .sub 'main' :main $S0 = <<'SQ' abc\tdef SQ print $S0 .end CODE abc\tdef OUT pir_error_output_like( <<'CODE', <<'OUT', 'PIR heredoc: rejects unquoted terminator' ); .sub 'main' :main $S0 = < PMC. Checks size, sets various elements, including out-of-bounds test. Checks INT and PMC keys. =cut .sub 'main' :main .include 'test_more.pir' plan(50) test_set_size() test_reset_size() test_set_first() test_set_second() test_out_of_bounds() test_set_via_pmc() test_get_via_pmc() test_interface_done() test_clone() test_clone_unitialized() test_truth() test_get_iter() test_freez_thaw() test_get_string() test_equality() test_gc() test_number() test_new_style_init() test_invalid_init_tt1509() .end .sub 'test_set_size' $P0 = new ['FixedStringArray'] $I0 = $P0 is($I0, 0, "Fresh array has 0 elements") $P0 = 42 $I0 = $P0 is($I0, 42, "Size was set correctly") .end .sub 'test_reset_size' $P0 = new ['FixedStringArray'] $I0 = 1 $P0 = 1 push_eh handled $P0 = 2 $I0 = 0 handled: pop_eh ok($I0, "Can't resize") .end .sub 'test_set_first' $P0 = new ['FixedStringArray'] $P0 = 1 $P0[0] = -7 $I0 = $P0[0] is($I0, -7, "First element set to integer properly") $P0[0] = 3.7 $N0 = $P0[0] is($N0, 3.7, "First element set to number properly") $P0[0] = "muwhahaha" $S0 = $P0[0] is($S0, "muwhahaha", "First element set to string properly") .end .sub 'test_set_second' $P0 = new ['FixedStringArray'] $P0 = 2 $P0[1] = -7 $I0 = $P0[1] is($I0, -7, "Second element set to integer properly") $P0[1] = 3.7 $I0 = $P0[1] is($I0, 3, "Second element set to number properly") $P0[1] = "purple" $S0 = $P0[1] is($S0, "purple", "Second element set to string properly") .end .sub 'test_out_of_bounds' $P0 = new ['FixedStringArray'] $P0 = 1 $I0 = 1 push_eh handle_set $P0[2] = 7 $I0 = 0 handle_set: ok($I0, "Can't set out-of-bounds element") pop_eh $I0 = 1 push_eh handle_set_negative $P0[-42] = 7 $I0 = 0 handle_set_negative: ok($I0, "Can't set element on negative index") pop_eh $I0 = 1 push_eh handle_get $I1 = $P0[2] $I0 = 0 handle_get: ok($I0, "Can't get out-of-bounds element") pop_eh $I0 = 1 push_eh handle_get_negative $I1 = $P0[-1] $I0 = 0 handle_get_negative: ok($I0, "Can't get element with negative index") pop_eh .end # Set via PMC keys, access via INTs .sub 'test_set_via_pmc' $P0 = new ['FixedStringArray'] $P0 = 3 $P1 = new ['Key'] $P1 = 0 $P0[$P1] = 25 $S0 = $P0[0] is($S0, "25", "Set INTVAL via PMC Key works") $P1 = 1 $P0[$P1] = 2.5 $S0 = $P0[1] is($S0, "2.5", "Set FLOATVAL via PMC Key works") $P1 = 2 $P0[$P1] = "bleep" $S0 = $P0[2] is($S0, "bleep", "Set STRING via PMC Key works") .end # Set via INTs, access via PMC Keys .sub 'test_get_via_pmc' $P0 = new ['FixedStringArray'] $P0 = 1024 $P0[25] = 125 $P0[128] = 10.2 $P0[513] = "blah" $P1 = new ['Integer'] $P1 = 123456 $P0[1023] = $P1 $P2 = new ['Key'] $P2 = 25 $I0 = $P0[$P2] is($I0, 125, "Get INTVAL via Key works") $P2 = 128 $N0 = $P0[$P2] is($N0, 10.2, "Get FLOATVAL via Key works") $P2 = 513 $S0 = $P0[$P2] is($S0, "blah", "Get STRING via Key works") $P2 = 1023 $I0 = $P0[$P2] is($I0, 123456, "Get INTVAL for stored PMC via Key works") .end .sub 'test_interface_done' .local pmc pmc1 pmc1 = new ['FixedStringArray'] .local int bool1 does bool1, pmc1, "scalar" nok(bool1, "Does not scalar") does bool1, pmc1, "array" ok(bool1, "Does array") does bool1, pmc1, "no_interface" nok(bool1, "Does not no_interface") .end .sub 'test_clone' new $P0, ['FixedStringArray'] set $P0, 3 set $P0[0], "abcde" set $P0[1], "fghi" set $P0[2], "jkl" clone $P1, $P0 set $P0[0], "" set $P0[1], "" set $P0[2], "" set $S0, $P1[0] is($S0, "abcde", "First element cloned") set $S0, $P1[1] is($S0, "fghi", "Second element cloned") set $S0, $P1[2] is($S0, "jkl", "Third element cloned") .end .sub 'test_clone_unitialized' $P0 = new ['FixedStringArray'] $P1 = clone $P0 $I0 = 0 push_eh clone_1 $P0 = 10 $P1 = 20 $I0 = 1 clone_1: pop_eh ok($I0, "Resize of uninitialized clone successful") $I1 = 1 push_eh clone_2 $P2 = clone $P0 $P2 = 30 $I0 = 0 clone_2: ok($I0, "Resize of initialization not successful") pop_eh .end .sub 'test_truth' $P0 = new ['FixedStringArray'] nok($P0, "Empty array is false") $P0 = 10 ok($P0, "Non-empty array is true") .end .sub 'test_gc' $P0 = new ['FixedStringArray'] $P0 = 8192 $I0 = 0 loop: $P0[$I0] = $I0 inc $I0 sweep 1 if $I0 < 8192 goto loop $S0 = $P0[1000] is($S0, "1000", "1000th element survived") $S0 = $P0[2000] is($S0, "2000", "2000th element survived") $S0 = $P0[4000] is($S0, "4000", "4000th element survived") $S0 = $P0[8000] is($S0, "8000", "8000th element survived") .end .sub 'test_get_iter' $P0 = new ['FixedStringArray'] $P0 = 3 $P0[0] = "foo" $P0[1] = "bar" $P0[2] = "baz" $S0 = "" $P1 = iter $P0 loop: unless $P1 goto loop_end $S2 = shift $P1 $S0 = concat $S0, $S2 goto loop loop_end: is($S0, "foobarbaz", "Iteration works") .end .sub 'test_freez_thaw' .local pmc fsa, it .local string s new fsa, ['FixedStringArray'] fsa = 5 fsa[0] = 42 fsa[1] = 43 fsa[2] = 44 fsa[3] = 99 fsa[4] = 101 s = freeze fsa fsa = thaw s it = iter fsa $S0 = "" loop: unless it goto loop_end s = shift it $S0 = concat $S0, s goto loop loop_end: is($S0, "42434499101", "get_iter works") .end .sub 'test_get_string' $P0 = new ['FixedStringArray'] $P0 = 2 $P0[0] = "foo" is($P0, '[ "foo", "" ]', "Array stringified properly") .end .sub 'test_equality' .local pmc a1, a2, other .local int i .local string s a1 = new ['FixedStringArray'] a2 = new ['FixedStringArray'] other = new ['Integer'] is(a1, a2, "Empty arrays are equal") i = iseq a1, other is(i, 0, "Not equal to other type") a1 = 3 isnt(a1, a2, "Different size arrays aren't equal") a2 = 3 a1[0] = "foo" a2[0] = "foo" is(a1, a2, "Equal with first element set") a1[1] = "bar" a2[1] = "BAR" isnt(a1, a2, "Not equal when second element differ") a2[1] = "bar" is(a1, a2, "Equal when second element same") null s a2[1] = s isnt(a1, a2, "Not equal when second element is null") .end .sub 'test_number' .local pmc fsa fsa = new ['FixedStringArray'] fsa = 3 $I0 = fsa is($I0, 3, "get_integer returns correct size") $N0 = fsa is($N0, 3.0, "get_number returns correct size") .end .sub 'test_new_style_init' $P0 = new 'FixedStringArray', 10 $I0 = $P0 is($I0, 10, "New style init creates the correct # of elements") $P0 = new ['FixedStringArray'], 10 $I0 = $P0 is($I0, 10, "New style init creates the correct # of elements for a key constant") .end .sub test_invalid_init_tt1509 throws_substring(<<'CODE', 'FixedStringArray: Cannot set array size to a negative number (-10)', 'New style init does not dump core for negative array lengths') .sub main :main $P0 = new ['FixedStringArray'], -10 .end CODE throws_substring(<<'CODE', 'FixedStringArray: Cannot set array size to a negative number (-10)', 'New style init (key constant) does not dump core for negative array lengths') .sub main :main $P0 = new 'FixedStringArray', -10 .end CODE .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: inheritance.t000644000765000765 443511533177644 16070 0ustar00brucebruce000000000000parrot-5.9.0/t/oo#!./parrot # Copyright (C) 2008-2010, Parrot Foundation. =head1 NAME t/oo/removeparent.t - Test OO inheritance =head1 SYNOPSIS % prove t/oo/removeparent.t =head1 DESCRIPTION Tests OO features related to the removeparent opcode. =cut .sub main :main .include 'test_more.pir' plan(4) remove_1() remove_2() remove_Y() remove_diamond() .end .sub remove_1 $P1 = newclass "Foo" $P2 = newclass "Bar" $I1 = isa $P2, $P1 if $I1, fail addparent $P2, $P1 $I1 = isa $P2, $P1 unless $I1, fail removeparent $P2, $P1 $I1 = isa $P2, $P1 if $I1, fail $I1 = 1 ok( $I1, 'simple') fail: .end .sub remove_2 $P1 = newclass "Foo2_1" $P2 = newclass "Foo2_2" $P3 = newclass "Bar2" $I1 = isa $P3, $P1 if $I1, fail $I1 = isa $P3, $P2 if $I1, fail addparent $P3, $P1 $I1 = isa $P3, $P1 unless $I1, fail $I1 = isa $P3, $P2 if $I1, fail addparent $P3, $P2 $I1 = isa $P3, $P2 unless $I1, fail removeparent $P3, $P1 $I1 = isa $P3, $P1 if $I1, fail $I1 = isa $P3, $P2 unless $I1, fail removeparent $P3, $P2 $I1 = isa $P3, $P1 if $I1, fail $I1 = isa $P3, $P2 if $I1, fail $I1 = 1 ok( $I1, 'multiple') fail: .end .sub remove_Y $P1 = newclass "FooY_1" $P2 = newclass "FooY_2" $P3 = newclass "BarY_1" $P4 = newclass "BarY_2" addparent $P3, $P1 addparent $P3, $P2 $I1 = isa $P4, $P1 if $I1, fail $I1 = isa $P4, $P2 if $I1, fail addparent $P4, $P3 $I1 = isa $P4, $P1 unless $I1, fail $I1 = isa $P4, $P2 unless $I1, fail removeparent $P4, $P3 $I1 = isa $P4, $P1 if $I1, fail $I1 = isa $P4, $P2 if $I1, fail $I1 = 1 ok( $I1, 'Y') fail: .end .sub remove_diamond $P1 = newclass "FooD1" $P2 = newclass "FooD2" $P3 = newclass "FooD3" $P4 = newclass "BarD1" addparent $P2, $P1 addparent $P3, $P1 addparent $P4, $P2 addparent $P4, $P3 $I1 = isa $P4, $P1 unless $I1, fail removeparent $P4, $P2 $I1 = isa $P4, $P1 unless $I1, fail removeparent $P4, $P3 $I1 = isa $P4, $P1 if $I1, fail $I1 = 1 ok( $I1, 'diamond') fail: .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: Compiler.pir000644000765000765 2463011606346657 21201 0ustar00brucebruce000000000000parrot-5.9.0/compilers/pct/src/POST =head1 NAME POST::Compiler - Compiler for POST trees =head1 DESCRIPTION POST::Compiler defines a compiler that converts a POST tree into PIR or an Eval PMC (bytecode). =head1 METHODS =over =cut .namespace [ 'POST';'Compiler' ] .sub '__onload' :load :init .local pmc p6meta, cproto p6meta = new 'P6metaclass' cproto = p6meta.'new_class'('POST::Compiler', 'parent'=>'PCT::HLLCompiler') cproto.'language'('POST') $P1 = split ' ', 'pir evalpmc' cproto.'stages'($P1) $P0 = new 'String' set_global '$?HLL', $P0 null $P0 set_global '$?NAMESPACE', $P0 .return () .end =item C Returns an escaped value of C suitable for including in PIR. If the string contains any non-ASCII characters, then it's prefixed with 'unicode:'. (This method just delegates to PAST::Compiler.escape, which does the same thing.) =cut .sub 'escape' :method .param string str $P0 = get_hll_global ['PAST'], 'Compiler' .tailcall $P0.'escape'(str) .end =item C Constructs a PIR key using the strings passed as arguments. For example, C returns C<["Foo";"Bar"]>. =cut .sub 'key_pir' :method .param pmc args :slurpy .local string out, sep out = '[' sep = '' args_loop: unless args goto args_done $P0 = shift args if null $P0 goto args_loop $I0 = does $P0, 'array' if $I0 goto args_array args_string: $S0 = self.'escape'($P0) out = concat out, sep out = concat out, $S0 sep = ';' goto args_loop args_array: splice args, $P0, 0, 0 goto args_loop args_done: out = concat out, ']' .return (out) .end .sub 'to_pir' :method .param pmc post .param pmc adverbs :slurpy :named .local pmc newself newself = new ['POST';'Compiler'] .local pmc innerpir, line innerpir = new 'StringBuilder' .lex '$CODE', innerpir line = box 0 .lex '$LINE', line ## if the root node isn't a Sub, wrap it $I0 = isa post, ['POST';'Sub'] if $I0 goto have_sub $P0 = get_hll_global ['POST'], 'Sub' post = $P0.'new'(post, 'name'=>'anon') have_sub: ## now generate the pir newself.'pir'(post) ## and return whatever code was generated .return (innerpir) .end =item pir_children(node) Return generated PIR for C and all of its children. =cut .sub 'pir_children' :method .param pmc node .local pmc line line = find_caller_lex '$LINE' .lex '$LINE', line .local pmc iter iter = node.'iterator'() iter_loop: unless iter goto iter_end .local pmc cpost, pos, source cpost = shift iter pos = cpost['pos'] if null pos goto done_subline source = cpost['source'] if null source goto done_subline line = self.'lineof'(source, pos, 'cache'=>1) inc line done_subline: self.'pir'(cpost) goto iter_loop iter_end: .end =item pir(Any node) Return generated pir for any POST::Node. Returns the generated pir of C's children. =cut .sub 'pir' :method :multi(_,_) .param pmc node self.'pir_children'(node) .end =item pir(POST::Op node) Return pir for an operation node. =cut .sub 'pir' :method :multi(_,['POST';'Op']) .param pmc node ## determine the type of operation .local string pirop pirop = node.'pirop'() ## determine if we're storing result .local string result result = node.'result'() unless result goto have_result result = concat result, ' = ' have_result: ## get list of arguments to operation .local pmc arglist arglist = node.'list'() ## get format and arguments based on pirop .local string fmt, name, invocant if pirop == 'call' goto pirop_call if pirop == 'callmethod' goto pirop_callmethod if pirop == 'return' goto pirop_return if pirop == 'yield' goto pirop_yield if pirop == 'tailcall' goto pirop_tailcall if pirop == 'inline' goto pirop_inline pirop_opcode: fmt = " %n %,\n" name = pirop goto pirop_emit pirop_call: fmt = " %r%n(%,)\n" name = shift arglist goto pirop_emit pirop_callmethod: fmt = " %r%i.%n(%,)\n" name = shift arglist invocant = shift arglist goto pirop_emit pirop_return: fmt = " .return (%,)\n" goto pirop_emit pirop_yield: fmt = " .yield (%,)\n" goto pirop_emit pirop_tailcall: name = shift arglist fmt = " .tailcall %n(%,)\n" goto pirop_emit pirop_inline: fmt = node.'inline'() fmt = concat fmt, "\n" result = node.'result'() goto pirop_emit pirop_emit: .local pmc subpir, subline, line subpir = find_caller_lex '$SUBPIR' subline = find_caller_lex '$SUBLINE' line = find_caller_lex '$LINE' if subline == line goto done_line subpir.'append_format'(".annotate 'line', %0\n", line) assign subline, line done_line: subpir.'append_format'(fmt, arglist :flat, 'r'=>result, 'n'=>name, 'i'=>invocant, 't'=>result) .end =item pir(POST::Label node) Generate a label. =cut .sub 'pir' :method :multi(_, ['POST';'Label']) .param pmc node .local pmc subpir, value value = node.'result'() subpir = find_caller_lex '$SUBPIR' subpir.'append_format'(" %0:\n", value) .end =item pir(POST::Sub node) Generate PIR for C, storing the result into the compiler's C<$!code> attribute and returning any code needed to look up the sub. =cut .sub 'pir' :method :multi(_, ['POST';'Sub']) .param pmc node .local pmc subpir, subline, innerpir subpir = new 'StringBuilder' .lex '$SUBPIR', subpir subline = box -1 .lex '$SUBLINE', subline innerpir = new 'StringBuilder' .lex '$CODE', innerpir .local string name, pirflags name = node.'name'() pirflags = node.'pirflags'() pirflags_subid: $I0 = index pirflags, ':subid(' if $I0 >= 0 goto pirflags_subid_done .local string subid subid = node.'subid'() pirflags = concat pirflags, ' :subid("' pirflags .= subid pirflags .= '")' pirflags_subid_done: pirflags_method: $I0 = index pirflags, ':method' if $I0 >= 0 goto pirflags_method_done $S0 = node.'blocktype'() if $S0 != 'method' goto pirflags_method_done pirflags = concat pirflags, ' :method' pirflags_method_done: .local pmc outerpost, outername outername = new 'Undef' outerpost = node.'outer'() if null outerpost goto pirflags_done unless outerpost goto pirflags_done outername = outerpost.'subid'() $S0 = self.'escape'(outername) pirflags = concat pirflags, ' :outer(' pirflags = concat pirflags, $S0 pirflags = concat pirflags, ')' pirflags_done: .local pmc outerhll, hll outerhll = get_global '$?HLL' hll = node.'hll'() if hll goto have_hll hll = outerhll have_hll: set_global '$?HLL', hll .local pmc outerns, ns, nskey outerns = get_global '$?NAMESPACE' ns = outerns $P0 = node.'namespace'() unless $P0 goto have_ns ns = $P0 have_ns: set_global '$?NAMESPACE', ns nskey = self.'key_pir'(ns) .local pmc multi multi = node.'multi'() unless multi goto no_multi .local pmc parts, m_iter parts = new ['ResizableStringArray'] m_iter = iter multi multi_iter: unless m_iter goto multi_iter_done $P0 = shift m_iter $S0 = $P0 if $S0 == "_" goto push_part $S0 = self.'key_pir'($P0) push_part: push parts, $S0 goto multi_iter multi_iter_done: pirflags = concat pirflags, ' :multi(' $S0 = join ',', parts pirflags = concat pirflags, $S0 pirflags = concat pirflags, ')' no_multi: subpir_start: $P0 = node['loadinit'] if null $P0 goto loadinit_done self.'pir'($P0) loadinit_done: $P0 = node.'compiler'() unless $P0 goto subpir_post subpir_compiler: $P0 = node.'compiler_args'() if $P0 goto have_compiler_args $P0 = new 'Hash' have_compiler_args: $P0 = self.'hll_pir'(node, 'name'=>name, 'namespace'=>ns, 'pirflags'=>pirflags, $P0 :named :flat) subpir .= $P0 goto subpir_done subpir_post: unless hll goto subpir_loadlibs $P0 = self.'escape'(hll) subpir.'append_format'("\n.HLL %0\n", $P0) subpir_loadlibs: $P0 = node.'loadlibs'() if null $P0 goto subpir_ns unless $P0 goto subpir_ns $P1 = iter $P0 subpir_loadlibs_loop: unless $P1 goto subpir_ns $P2 = shift $P1 $P2 = self.'escape'($P2) subpir.'append_format'("\n.loadlib %0\n", $P2) goto subpir_loadlibs_loop subpir_ns: subpir.'append_format'("\n.namespace %0\n", nskey) subpir_directives: $S0 = node['directives'] unless $S0 goto subpir_decl subpir.'append_format'("%0", $S0) subpir_decl: $S0 = self.'escape'(name) subpir.'append_format'(".sub %0 %1\n", $S0, pirflags) .local pmc paramlist paramlist = node['paramlist'] if null paramlist goto paramlist_done .local pmc it it = iter paramlist param_loop: unless it goto paramlist_done $P0 = shift it if null $P0 goto param_loop subpir .= $P0 goto param_loop paramlist_done: ## Add a file annotation .local pmc files files = find_caller_lex '$?FILES' if null files goto no_files unless files goto no_files $S0 = self.'escape'(files) subpir.'append_format'(".annotate 'file', %0\n", $S0) no_files: self.'pir_children'(node) subpir.'append_format'(".end\n\n") subpir_done: .local pmc outerpir outerpir = find_caller_lex '$CODE' outerpir .= subpir outerpir .= innerpir set_global '$?NAMESPACE', outerns set_global '$?HLL', outerhll .end .sub 'hll_pir' :method .param pmc node .param pmc options :slurpy :named options['target'] = 'pir' $P0 = node.'subid'() options['subid'] = $P0 .local pmc source, compiler, pir source = node[0] $S0 = node.'compiler'() compiler = compreg $S0 $I0 = isa compiler, 'Sub' if $I0 goto compiler_sub .tailcall compiler.'compile'(source, options :flat :named) compiler_sub: .tailcall compiler(source, options :flat :named) .end =back =head1 AUTHOR Patrick Michaud is the author and maintainer. Please send patches and suggestions to the Parrot porters or Perl 6 compilers mailing lists. =head1 HISTORY 2007-11-21 Significant refactor as part of Parrot Compiler Toolkit =head1 COPYRIGHT Copyright (C) 2006-2008, Parrot Foundation. =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: main.c000644000765000765 1576512101554067 20576 0ustar00brucebruce000000000000parrot-5.9.0/frontend/pbc_disassemble/* Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME pbc_disassemble - parrot bytecode disassembler =head1 SYNOPSIS pbc_disassemble [-bh?] [--bare|--header-only] [-o outfile] [file.pbc] =head1 DESCRIPTION C translates Parrot bytecode (C) into Parrot assembly language (C). C is the bytecode file to disassemble. If a file is not specified, the bytecode will be read from C. Additionally, if the C<-o> switch is not given, the output is displayed to C. =head1 OPTIONS =over 4 =item B<-?>, B<--help> Displays usage and help information. =item B<-b>, B<--bare> Displays bare PASM without the header and left column. =item B<-h>, B<--header-only> Displays only the constants table header. =item B<-o> filename, B<--output> filename Writes output to C. =back =head1 STATIC FUNCTIONS =over 4 =cut */ #include #include #include "parrot/parrot.h" #include "parrot/api.h" #include "parrot/longopt.h" #define PFOPT_UTILS 1 /* NOTE: * C uses the C function from F, * which in turn uses the C function from F. */ /* Longopts option table */ static struct longopt_opt_decl options[] = { { '?', '?', OPTION_optional_FLAG, { "--help" } }, { 'b', 'b', OPTION_optional_FLAG, { "--bare" } }, { 'h', 'h', OPTION_optional_FLAG, { "--header-only" } }, { 'o', 'o', OPTION_required_FLAG, { "--output" } }, { 0 , 0, OPTION_optional_FLAG, { NULL } } }; /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void help(void); static void show_last_error_and_exit(Parrot_PMC interp); #define ASSERT_ARGS_help __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) #define ASSERT_ARGS_show_last_error_and_exit __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Execution entry point. Starts up an interpreter, loads the bytecode from the command-line, and disassembles it. =cut */ int main(int argc, const char *argv[]) { const char *outfile = NULL; int option = 0, status = 0, debug = PFOPT_UTILS; struct longopt_opt_info opt = LONGOPT_OPT_INFO_INIT; Parrot_PMC interp = NULL, pbc = NULL; Parrot_String filename = NULL; Parrot_Init_Args *initargs = NULL; /* Parse command-line arguments */ while ((status = longopt_get(argc, argv, options, &opt)) > 0) { switch (opt.opt_id) { case 'h': option += enum_DIS_HEADER; break; case 'b': option += enum_DIS_BARE; break; case 'o': outfile = opt.opt_arg; break; case '?': /* Fall through */ default: help(); break; } } /* Check for parse errors */ if (argc == 1 || status == -1) { help(); } /* Set initialization parameters */ GET_INIT_STRUCT(initargs); /* Create new interpreter and set executable name */ if (!(Parrot_api_make_interpreter(NULL, 0, initargs, &interp) && Parrot_api_set_executable_name(interp, argv[0]))) { fprintf(stderr, "PARROT VM: Could not initialize new interpreter\n"); show_last_error_and_exit(interp); } argc -= opt.opt_index; argv += opt.opt_index; /* What to do about this debug flag? */ /* pf = Parrot_pbc_read(interp, argc ? *argv : "-", debug); */ /* Convert native char * to Parrot_String */ if (!Parrot_api_string_import(interp, argc ? *argv : "-", &filename)) { fprintf(stderr, "String transformation failed\n"); show_last_error_and_exit(interp); } /* Disassemble bytecode and destroy interpreter */ if (!(Parrot_api_load_bytecode_file(interp, filename, &pbc) && Parrot_api_disassemble_bytecode(interp, pbc, outfile, option) && Parrot_api_destroy_interpreter(interp))) { fprintf(stderr, "Error during disassembly\n"); show_last_error_and_exit(interp); } return 0; } /* =item C Prints out the user help information and exits. =cut */ static void help(void) { puts("pbc_disassemble - parrot bytecode disassembler\n"); puts("Usage:"); puts("pbc_disassemble [-bh] [file.pbc]"); puts("pbc_disassemble -o file.pasm file.pbc\n"); puts(" -?, --help Displays help information"); puts(" -b, --bare Displays bare PASM without header and left column"); puts(" -h, --header-only Dumps only the constants table header"); puts(" -o, --output \"filename\" Writes output to \"filename\""); exit(EXIT_SUCCESS); } /* =item C Prints out the C's last error and exits. =cut */ static void show_last_error_and_exit(Parrot_PMC interp) { Parrot_Int is_error, exit_code; Parrot_String errmsg, backtrace; Parrot_PMC exception; /* Get result of last API function call and exception backtrace */ if (!(Parrot_api_get_result(interp, &is_error, &exception, &exit_code, &errmsg) && Parrot_api_get_exception_backtrace(interp, exception, &backtrace))) { fprintf(stderr, "PARROT VM: Cannot recover\n"); exit(EXIT_FAILURE); } /* Check for unhandled exceptions */ if (is_error) { char *msg; /* Display error message */ Parrot_api_string_export_ascii(interp, errmsg, &msg); fprintf(stderr, "%s\n", msg); Parrot_api_string_free_exported_ascii(interp, msg); /* Display exception backtrace */ Parrot_api_string_export_ascii(interp, backtrace, &msg); fprintf(stderr, "%s\n", msg); Parrot_api_string_free_exported_ascii(interp, msg); } exit(exit_code); } /* =back =head1 SEE ALSO F and F. =head1 HISTORY Initial version by Daniel Grunblatt on 2002.5.26. Florian Ragwitz: Moved POD documentation that's not necessary to know how to actually run the disassembler to normal C comments (Wed, 16 Nov 2005). Reini Urban: Renamed from disassemble to pbc_disassemble (2008-07-03). Add options: help, -h, -o, --debug, --bare (2009-01-29) Force option 1 for passing version check (2009-03-07) Kevin Polulak (soh_cah_toa): Updated to use embedding API, moved source file to frontend/pbc_disassemble, and cleaned up source code and perldoc. (2011-06-19) =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ packfilebytecodesegment.pmc000644000765000765 1314211716253437 21472 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME src/pmc/packfilebytecodesegment.pmc - PackfileBytecodeSegment PMC =head1 DESCRIPTION This class implements a PackfileBytecode class, providing a PMC-based interface for bytecode creation and manipulation. See packfile.pmc for the toplevel Packfile interface; see PDD13 for the design spec. =head2 Methods =over 4 =cut */ /* HEADERIZER HFILE: none */ /* HEADERIZER BEGIN: static */ /* HEADERIZER END: static */ #include "pmc/pmc_packfileopmap.h" pmclass PackfileBytecodeSegment auto_attrs extends PackfileRawSegment { ATTR PMC *op_map; /* OpMap PMC */ ATTR INTVAL main_sub; /* Index of :main sub */ /* =item C Initialize PackfileBytecodeSegment. =cut */ VTABLE void init() { Parrot_PackfileBytecodeSegment_attributes * const attrs = PARROT_PACKFILEBYTECODESEGMENT(SELF); PObj_custom_mark_SET(SELF); attrs->op_map = Parrot_pmc_new(INTERP, enum_class_PackfileOpMap); SUPER(); } /* =item C Marks the object as live. =cut */ VTABLE void mark() { PMC *tmp; GET_ATTR_op_map(INTERP, SELF, tmp); Parrot_gc_mark_PMC_alive(INTERP, tmp); SUPER(); } /* =item C Return a pointer to a PackFile_ByteCode* built from this PMC's data. =cut */ VTABLE void *get_pointer() { INTVAL op_count; size_t i; PMC *ops, *op_map; PackFile_ByteCode_OpMapping * mapping; /* ByteCode to return */ PackFile_ByteCode * const bc = mem_gc_allocate_zeroed_typed(interp, PackFile_ByteCode); bc->base.type = PF_BYTEC_SEG; /* Create proper ByteCode structure from internal PMCs */ GET_ATTR_main_sub(INTERP, SELF, bc->main_sub); /* Copy ops into ByteCode */ GET_ATTR_opcodes(INTERP, SELF, ops); bc->base.size = VTABLE_get_integer(INTERP, ops); bc->base.data = mem_gc_allocate_n_typed(INTERP, bc->base.size, opcode_t); /* Not very efficient... */ for (i = 0; i < bc->base.size; ++i) { bc->base.data[i] = VTABLE_get_integer_keyed_int(INTERP, ops, i); } /* Create various dynop mapping related structures */ GET_ATTR_op_map(INTERP, SELF, op_map); op_count = VTABLE_get_integer(INTERP, op_map); bc->op_count = op_count; bc->op_func_table = mem_gc_allocate_n_zeroed_typed(interp, op_count, op_func_t); /* TODO Fill it */ bc->op_info_table = mem_gc_allocate_n_zeroed_typed(interp, op_count, op_info_t*); /* TODO Fill it */ /* Construct mappings */ mapping = (PackFile_ByteCode_OpMapping *)VTABLE_get_pointer(INTERP, op_map); memcpy(&bc->op_mapping, mapping, sizeof (PackFile_ByteCode_OpMapping)); /* Don't free "mapping". Caller will do it */ return bc; } /* =item C Initialize PackfileBytecodeSegment from PackFile_Bytecode* =cut */ VTABLE void set_pointer(void *pointer) { const PackFile_ByteCode * const pfseg = (const PackFile_ByteCode *)pointer; opcode_t i, j; PMC *op_map; GET_ATTR_op_map(INTERP, SELF, op_map); /* Recreate OpMapping */ for (i = 0; i < pfseg->op_mapping.n_libs; i++) { PackFile_ByteCode_OpMappingEntry entry = pfseg->op_mapping.libs[i]; for (j = 0; j < entry.n_ops; j++) { opcode_t lib_op = entry.lib_ops[j]; VTABLE_get_integer_keyed_str(INTERP, op_map, Parrot_str_from_platform_cstring(INTERP, entry.lib->op_info_table[lib_op].full_name)); } } /* TODO. Figure out how to generate OpLibs and where to store them */ SUPER(pointer); } /* =item C Add an op and its arguments to this bytecode. The PMC should be a ResizablePMCArray with the first PMC being a String containing the full name of an op and the remaining PMCs being Integers. =cut */ VTABLE void push_pmc(PMC *p) { const Parrot_PackfileBytecodeSegment_attributes * const attrs = PMC_data_typed(SELF, Parrot_PackfileBytecodeSegment_attributes*); INTVAL i, op_num, arr_size; if (!VTABLE_does(INTERP, p, CONST_STRING(INTERP, "array"))) { Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "PMC passed to push_pmc is not array-like"); } op_num = VTABLE_get_integer_keyed_str(INTERP, attrs->op_map, VTABLE_get_string_keyed_int(INTERP, p, 0)); /* add the things to attrs->ops */ VTABLE_push_integer(INTERP, attrs->opcodes, op_num); arr_size = VTABLE_elements(INTERP, p); for (i = 1; i < arr_size; i++){ VTABLE_push_integer(INTERP, attrs->opcodes, VTABLE_get_integer_keyed_int(INTERP, p, i)); } } /* =item C Return :main Sub for this segment. =cut */ METHOD main_sub(INTVAL main_sub :optional, INTVAL got_main :opt_flag) { if (got_main) { SET_ATTR_main_sub(INTERP, SELF, main_sub); } GET_ATTR_main_sub(INTERP, SELF, main_sub); RETURN(INTVAL main_sub); } /* =item C Return PackfileOpMap for this BytecodeSegment. =cut */ METHOD PMC* opmap() { PMC *op_map; GET_ATTR_op_map(INTERP, SELF, op_map); RETURN(PMC* op_map); } /* =back =cut */ } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ 01-parse.t000644000765000765 521711656271051 17443 0ustar00brucebruce000000000000parrot-5.9.0/t/compilers/opsc#! ./parrot # Copyright (C) 2010, Parrot Foundation. .include 't/compilers/opsc/common.pir' .sub 'main' :main .include 'test_more.pir' load_bytecode 'opsc.pbc' plan(12) test_parse_basic_op() test_parse_many_ops() test_parse_header() test_parse_params() test_parse_flags() .end .sub "test_parse_basic_op" .local string buf .local pmc res buf = <<"END" inline op noop() { } END "_parse_buffer"(buf) is(1, 1, "Simple noop parsed") buf = <<"END" inline op noop() { foo } END "_parse_buffer"(buf) is(1, 1, "noop body parsed") buf = <<"END" inline op noop() { foo { bar{}; } } END "_parse_buffer"(buf) is(1, 1, "noop nested body parsed") .end .sub "test_parse_many_ops" .local string buf .local pmc res buf = <<"END" =item noop asdfs =cut inline op noop() { } =item halt asdsad =cut inline op halt() { } =head2 ads =cut inline op rule_the_world() { } END res = "_parse_buffer"(buf) is(1, 1, "Multiple ops parsed") $I0 = res['body';'op'] is($I0, 3, "...and we have 3 ops") .end # test parsing ops file header. .sub "test_parse_header" .local string buf .local pmc res buf = <<"END" /* ** core.ops */ BEGIN_OPS_PREAMBLE #include "parrot/dynext.h" #include "parrot/parrot.h" #include "parrot/runcore_api.h" #include "../pmc/pmc_continuation.h" #include "../pmc/pmc_parrotlibrary.h" END_OPS_PREAMBLE =head1 NAME core.ops - Core Opcodes =cut =head1 DESCRIPTION Parrot's core library of ops. Core operations are primarily flow control and interpreter introspection. =cut inline op noop() { } END res = "_parse_buffer"(buf) is(1, 1, "Header parsed") $I0 = res['body';'op'] is($I0, 1, "...and we have our op") .end .sub "test_parse_params" .local string buf .local pmc res buf = <<"END" inline op reserved(inconst INT) { /* reserve 1 entries */ } END "_parse_buffer"(buf) is(1, 1, "Op with single param parsed") buf = <<"END" inline op add(out INT, inconst INT, inconst INT) { } END "_parse_buffer"(buf) is(1, 1, "Op with multiple param parsed") .end .sub "test_parse_flags" .local string buf .local pmc res buf = <<"END" inline op hcf() :flow :deprecated { } END res = "_parse_buffer"(buf) is(1, 1, "Op with flags parsed") .local pmc op op = res['body';'op';0;'op_flag'] $S0 = op[0] is($S0, ":flow ", "First flag parsed") $S0 = op[1] is($S0, ":deprecated ", "Second flag parsed") .end # Don't forget to update plan! # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: os2.pm000644000765000765 143511533177634 17124 0ustar00brucebruce000000000000parrot-5.9.0/config/init/hints# Copyright (C) 2005, Parrot Foundation. package init::hints::os2; use strict; use warnings; sub runstep { my ( $self, $conf ) = @_; # This hints file is very specific to a particular os/2 configuration. # A more general one would be appreciated, should anyone actually be # using OS/2 $conf->data->set( libs => "-lm -lsocket -lcExt -lbsd", iv => "long", nv => "double", opcode_t => "long", ccflags => "-I. -fno-strict-aliasing -mieee-fp -I./include", ldflags => "-Zexe", perl => "perl" # avoids case-mangling in make ); } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: parrot_shell.pl000755000765000765 766011606346603 17503 0ustar00brucebruce000000000000parrot-5.9.0/tools/dev#! perl # Copyright (C) 2009, Parrot Foundation. use 5.008; use strict; use warnings; use FindBin qw($Bin); use lib "$Bin/../lib"; # install location use lib "$Bin/../../lib"; # build location use IO::File (); use File::Spec; use Parrot::Config; use File::Temp qw/ tempfile /; use Benchmark qw/timeit timestr :hireswallclock/; =head1 NAME tools/dev/parrot_shell.pl - The Parrot Shell =head1 SYNOPSIS % perl tools/dev/parrot_shell.pl =head1 DESCRIPTION The Parrot Shell allows you to rapidly prototype Parrot code. It wraps your code in a ".sub main" and ".end", so you don't have to, unless your code begins with ".sub". It reads code from STDIN until it sees a line containing a single ".", which is how you tell parrot_shell to run the code you are giving to it: Example: parrot_shell 0> $I0 = 42 $N1 = sqrt $I0 say $N1 . Output: 6.48074069840786 parrot_shell 1> quit Thanks for visiting the Parrot Shell, come back soon! Each numbered Parrot Shell session is run in its own interpreter, so no registers or variables are shared/leaked between them. =cut my $parrot; my $session_no = 0; BEGIN { $parrot = File::Spec->catfile( ".", "parrot"); unless (-e $parrot) { warn "$parrot not found, attempting to use an installed parrot"; $parrot = 'parrot'; } my $exefile = $parrot . $PConfig{exe}; } show_welcome(); while(1) { my $code; show_prompt($session_no); while( my $line = ) { exit_shell() if $line =~ m/^q(uit)?$/; if ($line =~ m/^h(elp)?$/) { show_help(); show_prompt($session_no) if !defined $code; next; } if ($line =~ m/^\s*\.\s*$/) { # Run it, baby! print eval_snippet($code); last; } else { $code .= $line; } } $session_no++; } sub show_welcome { print < "; } sub exit_shell { print "Thanks for visiting the Parrot Shell, come back soon!\n"; exit 0; } sub show_help { print <<'EX'; The Parrot Shell allows you to rapidly prototype Parrot code. It wraps your code in a ".sub main" and ".end", so you don't have to, unless your code begins with ".sub". It reads code from STDIN until it sees a line containing a single ".", which is how you tell parrot_shell to run the code you are giving to it: Example: parrot_shell> $I0 = 42 $N1 = sqrt $I0 say $N1 . Output: 6.48074069840786 EX } sub eval_snippet { my ($snippet) = @_; my $codefn = get_tempfile(); my $stdoutfn = get_tempfile(); my $f = IO::File->new(">$codefn"); $f->print(normalize_snippet($snippet || '')); $f->close(); my $time = timestr(timeit(1, sub { system("$parrot $codefn >$stdoutfn 2>&1") } )); $time =~ s/\(.*//g; handle_errors($?) if $?; $f = IO::File->new($stdoutfn); my $output = join( '', <$f> ); return "Time: $time\nOutput:\n$output"; } sub handle_errors { my ($exit_code) = @_; if ($exit_code == -1) { print "Error: failed to execute: $!\n"; } elsif ($exit_code & 127) { printf "Error: child died with signal %d, %s coredump\n", ($exit_code & 127), ($exit_code & 128) ? 'with' : 'without'; } else { printf "Error: child exited with value %d\n", $? >> 8; } } sub get_tempfile { my (undef, $name) = tempfile( CLEANUP => 1); return $name; } sub normalize_snippet { my ($snippet) = @_; if ($snippet =~ m/^\.sub/) { # don't wrap snippet return $snippet; } else { return < argument says where to populate the directory, if not given then the lowercase version of the language name is used. For a language 'Xyz', this script will create the following files and directories in C: README Configure.pl build/Makefile.in build/gen_parrot.pl src/Xyz.pir src/Xyz/Grammar.pm src/Xyz/Actions.pm src/Xyz/Compiler.pm src/Xyz/Runtime.pm src/gen/.gitignore t/harness t/00-sanity.t Any files that already exist are skipped, so this script can be used to repopulate a language directory with omitted files. If all goes well, after creating the language shell one can simply change to the language directory and type $ perl Configure.pl [--gen-parrot] $ make $ make test to verify that the new language compiles and configures properly. =cut use strict; use warnings; use lib 'lib'; use File::Path; use File::Spec; unless (@ARGV) { die "usage: $0 language [path]\n"; } if ($ARGV[0] eq '--help') { print <) { print $_; last if /^__DATA__/; } while (<$fh0>) { last if /^__DATA__$/; if (/^__(.*?)__$/) { print; $_ = $1; s{\@lang\@} {$lang}g; s{\@lclang\@} {$lclang}ig; s{\@UCLANG\@} {$uclang}ig; open my $fh, '<', "$path/$_" or die "Unable to read $path/$_"; while (<$fh>) { s{$lang} {\@lang\@}g; s{$lclang} {\@lclang\@}g; s{$uclang} {\@UCLANG\@}g; s{$script} {\@script\@}g; print; } close $fh; } } print; while (<$fh0>) { print; } close $fh0; exit 0; } ## now loop through the file information (see below), substituting ## any instances of @lang@, @lclang@, @UCLANG@, and @Id@ with ## the language name or the svn id tag. If the line has the form ## __filepath__, then start a new file. my $fh; while () { last if /^__DATA__$/; s{\@lang\@} {$lang}g; s{\@lclang\@} {$lclang}ig; s{\@UCLANG\@} {$uclang}ig; s{\@script\@} {$script}ig; if (/^__(.*)__$/) { start_new_file("$path/$1"); } elsif ($fh) { print $fh $_; } } ## generate build/PARROT_REVISION start_new_file("$path/build/PARROT_REVISION"); my $rev = '$Revision$'; $rev =~ s/^\D*(\d+)\D*$/$1/; print $fh "$rev\n"; close($fh) if $fh; print <<"END"; Your new language has been created in the $path directory. To do an initial build and test of the language: cd $path perl Configure.pl [--gen-parrot] make make test END ## we're done 1; ## this function closes any previous opened file, and determines ## if we're creating a new file. It also calls C to ## create any needed parent subdirectories. sub start_new_file { my ($filepath) = @_; if ($fh) { close $fh; undef $fh; } if (-e $filepath) { print "skipping $filepath\n"; return; } my ($volume, $dir, $base) = File::Spec->splitpath($filepath); my $filedir = File::Spec->catpath($volume, $dir); unless (-d $filedir) { print "creating $filedir\n"; mkpath( [ $filedir ], 0, 0777 ); } print "creating $filepath\n"; open $fh, '>', $filepath; } ### The section below contains the text of the files to be created. ### The name of the file to be created is given as C<__filepath__>, ### and all subsequent lines up to the next C<__filepath__> are ### placed in the file (performing substitutions on @lang@, @lclang@, ### @UCLANG@, and @Id@ as appropriate). __DATA__ __README__ =head1 @lang@ This is @lang@, a compiler for the Parrot virtual machine. =head2 Build requirements (installing from source) For building @lang@ you need at least a C compiler, a C utility, and Perl 5.8 or newer. To automatically obtain and build Parrot you also need a git client. =head2 Building and invoking @lang@ We generally recommend downloading @lang@ directly from [XXX: fill in this information for @lang@]. Once you have a copy of @lang@, build it as follows: $ cd @lclang@ $ perl Configure.pl --gen-parrot $ make This will create a "@lclang@" or "@lclang@.exe" executable in the current directory. Programs can then be run from the build directory using a command like: $ ./@lclang@ The C<--gen-parrot> option above tells Configure.pl to automatically download and build the most appropriate version of Parrot into a local "parrot/" subdirectory, install that Parrot into the "parrot_install/" subdirectory, and use that for building @lang@. It's okay to use the C<--gen-parrot> option on later invocations of Configure.pl; the configure system will re-build Parrot only if a newer version is needed for whatever version of @lang@ you're working with. You can use C<--parrot-config=/path/to/parrot_config> instead of C<--gen-parrot> to use an already installed Parrot for building @lang@. This installed Parrot must include its development environment; typically this is done via Parrot's C target or by installing prebuilt C and/or C packages. The version of the already installed Parrot must satisfy a minimum specified by @lang@ -- Configure.pl will verify this for you. Once built, @lang@'s C target will install @lang@ and its libraries into the Parrot installation that was used to create it. Until this step is performed, the "@lclang@" executable created by C above can only be reliably run from the root of @lang@'s build directory. After C is performed, the installed executable can be run from any directory (as long as the Parrot installation that was used to create it remains intact). If the @lang@ compiler is invoked without an explicit script to run, it enters a small interactive mode that allows statements to be executed from the command line. Each line entered is treated as a separate compilation unit, however (which means that subroutines are preserved after they are defined, but variables are not). =head2 Running the test suite Entering C will run a test suite that comes bundled with @lang@. This is a simple suite of tests, designed to make sure that the compiler is basically working and that it's capable of running a simple test harness. If you want to run the tests in parallel, you need to install a fairly recent version of the Perl 5 module L (3.16 works for sure). =head2 Where to get help or answers to questions =head2 Reporting bugs =head2 Submitting patches =head2 How the compiler works See F. =head1 AUTHOR =cut ## vim: expandtab sw=4 ft=pod tw=70: __Configure.pl__ #! perl # Copyright (C) 2009 The Perl Foundation use 5.008; use strict; use warnings; use Getopt::Long; use Cwd; MAIN: { my %options; GetOptions(\%options, 'help!', 'parrot-config=s', 'gen-parrot!', 'gen-parrot-prefix=s', 'gen-parrot-option=s@'); # Print help if it's requested if ($options{'help'}) { print_help(); exit(0); } # Determine the revision of Parrot we require open my $REQ, "build/PARROT_REVISION" || die "cannot open build/PARROT_REVISION\n"; my ($reqsvn, $reqpar) = split(' ', <$REQ>); $reqsvn += 0; close $REQ; # Update/generate parrot build if needed if ($options{'gen-parrot'}) { my @opts = @{ $options{'gen-parrot-option'} || [] }; my $prefix = $options{'gen-parrot-prefix'} || cwd()."/parrot_install"; # parrot's Configure.pl mishandles win32 backslashes in --prefix $prefix =~ s{\\}{/}g; my @command = ($^X, "build/gen_parrot.pl", "--prefix=$prefix", ($^O !~ /win32/i ? "--optimize" : ()), @opts); print "Generating Parrot ...\n"; print "@command\n\n"; system @command; } # Get a list of parrot-configs to invoke. my @parrot_config_exe = qw( parrot_install/bin/parrot_config ../../parrot_config parrot_config ); if (exists $options{'gen-parrot-prefix'}) { unshift @parrot_config_exe, $options{'gen-parrot-prefix'} . '/bin/parrot_config'; } if ($options{'parrot-config'} && $options{'parrot-config'} ne '1') { @parrot_config_exe = ($options{'parrot-config'}); } # Get configuration information from parrot_config my %config = read_parrot_config(@parrot_config_exe); my $parrot_errors = ''; if (!%config) { $parrot_errors .= "Unable to locate parrot_config\n"; } elsif ($reqsvn > $config{'revision'} && ($reqpar eq '' || version_int($reqpar) > version_int($config{'VERSION'}))) { $parrot_errors .= "Parrot revision r$reqsvn required (currently r$config{'revision'})\n"; } if ($parrot_errors) { die <<"END"; ===SORRY!=== $parrot_errors To automatically checkout (svn) and build a copy of parrot r$reqsvn, try re-running Configure.pl with the '--gen-parrot' option. Or, use the '--parrot-config' option to explicitly specify the location of parrot_config to be used to build @lang@. END } # Verify the Parrot installation is sufficient for building @lang@ verify_parrot(%config); # Create the Makefile using the information we just got create_makefile(%config); my $make = $config{'make'}; { no warnings; print "Cleaning up ...\n"; if (open my $CLEAN, '-|', "$make clean") { my @slurp = <$CLEAN>; close $CLEAN; } } print <<"END"; You can now use '$make' to build @lang@. After that, you can use '$make test' to run some local tests. END exit 0; } sub read_parrot_config { my @parrot_config_exe = @_; my %config = (); for my $exe (@parrot_config_exe) { no warnings; if (open my $PARROT_CONFIG, '-|', "$exe --dump") { print "\nReading configuration information from $exe ...\n"; while (<$PARROT_CONFIG>) { if (/(\w+) => '(.*)'/) { $config{$1} = $2 } } close $PARROT_CONFIG or die $!; last if %config; } } return %config; } sub verify_parrot { print "Verifying Parrot installation...\n"; my %config = @_; my $PARROT_VERSION = $config{'versiondir'}; my $PARROT_BIN_DIR = $config{'bindir'}; my $PARROT_LIB_DIR = $config{'libdir'}.$PARROT_VERSION; my $PARROT_SRC_DIR = $config{'srcdir'}.$PARROT_VERSION; my $PARROT_INCLUDE_DIR = $config{'includedir'}.$PARROT_VERSION; my $PARROT_TOOLS_DIR = "$PARROT_LIB_DIR/tools"; my @required_files = ( "$PARROT_BIN_DIR/parrot-nqp" ); my @missing; for my $reqfile (@required_files) { push @missing, " $reqfile" unless -e $reqfile; } if (@missing) { my $missing = join("\n", @missing); die <<"END"; ===SORRY!=== I'm missing some needed files from the Parrot installation: $missing (Perhaps you need to use Parrot's "make install" or install the "parrot-devel" package for your system?) END } } # Generate a Makefile from a configuration sub create_makefile { my %config = @_; my $maketext = slurp( 'build/Makefile.in' ); $config{'win32_libparrot_copy'} = $^O eq 'MSWin32' ? 'copy $(PARROT_BIN_DIR)\libparrot.dll .' : ''; $maketext =~ s/@(\w+)@/$config{$1}/g; if ($^O eq 'MSWin32') { $maketext =~ s{/}{\\}g; $maketext =~ s{\\\*}{\\\\*}g; $maketext =~ s{http:\S+}{ do {my $t = $&; $t =~ s'\\'/'g; $t} }eg; } my $outfile = 'Makefile'; print "\nCreating $outfile ...\n"; open(my $MAKEOUT, '>', $outfile) || die "Unable to write $outfile\n"; print {$MAKEOUT} $maketext; close $MAKEOUT or die $!; return; } sub slurp { my $filename = shift; open my $fh, '<', $filename or die "Unable to read $filename\n"; local $/ = undef; my $maketext = <$fh>; close $fh or die $!; return $maketext; } sub version_int { sprintf('%d%03d%03d', split(/\./, $_[0])) } # Print some help text. sub print_help { print <<'END'; Configure.pl - @lang@ Configure General Options: --help Show this text --gen-parrot Download and build a copy of Parrot to use --gen-parrot-option='--option=value' Set parrot config option when using --gen-parrot --parrot-config=(config) Use configuration information from config END return; } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: __build/Makefile.in__ # Copyright (C) 2006-2009, The Perl Foundation. PARROT_ARGS = # values from parrot_config PARROT_BIN_DIR = @bindir@ PARROT_VERSION = @versiondir@ PARROT_INCLUDE_DIR = @includedir@$(PARROT_VERSION) PARROT_LIB_DIR = @libdir@$(PARROT_VERSION) PARROT_SRC_DIR = @srcdir@$(PARROT_VERSION) PARROT_LIBRARY_DIR = $(PARROT_LIB_DIR)/library HAS_ICU = @has_icu@ CC = @cc@ CFLAGS = @ccflags@ @cc_shared@ @cc_debug@ @ccwarn@ @cg_flag@ EXE = @exe@ LD = @ld@ LDFLAGS = @ldflags@ @ld_debug@ LD_LOAD_FLAGS = @ld_load_flags@ LIBPARROT = @inst_libparrot_ldflags@ O = @o@ LOAD_EXT = @load_ext@ PERL = @perl@ CP = @cp@ MV = @mv@ RM_F = @rm_f@ MKPATH = $(PERL) -MExtUtils::Command -e mkpath CHMOD = $(PERL) -MExtUtils::Command -e chmod # locations of parrot resources PARROT = $(PARROT_BIN_DIR)/parrot$(EXE) PARROT_NQP = $(PARROT_BIN_DIR)/parrot-nqp$(EXE) PBC_TO_EXE = $(PARROT_BIN_DIR)/pbc_to_exe$(EXE) PARROT_TOOLS_DIR = $(PARROT_LIB_DIR)/tools PARROT_PERL_LIB = $(PARROT_TOOLS_DIR)/lib @UCLANG@_LANG_DIR = $(PARROT_LIB_DIR)/languages/@lclang@ @UCLANG@_EXE = @lclang@$(EXE) @UCLANG@_PBC = @lclang@.pbc @UCLANG@_G_PIR = src/gen/@lclang@-grammar.pir @UCLANG@_A_PIR = src/gen/@lclang@-actions.pir @UCLANG@_C_PIR = src/gen/@lclang@-compiler.pir @UCLANG@_R_PIR = src/gen/@lclang@-runtime.pir @UCLANG@_SOURCES = \ src/@lang@.pir \ $(@UCLANG@_G_PIR) \ $(@UCLANG@_A_PIR) \ $(@UCLANG@_C_PIR) \ $(@UCLANG@_R_PIR) \ CLEANUPS = \ *.manifest \ *.pdb \ *.c\ *.o\ $(@UCLANG@_EXE) \ $(@UCLANG@_PBC) \ src/gen/*.pir \ default: $(@UCLANG@_EXE) all: $(@UCLANG@_EXE) $(@UCLANG@_EXE) : $(@UCLANG@_SOURCES) $(PARROT) -o $(@UCLANG@_PBC) src/@lang@.pir $(PBC_TO_EXE) $(@UCLANG@_PBC) $(@UCLANG@_G_PIR): src/@lang@/Grammar.pm $(PARROT_NQP) --target=pir -o $(@UCLANG@_G_PIR) src/@lang@/Grammar.pm $(@UCLANG@_A_PIR): src/@lang@/Actions.pm $(PARROT_NQP) --target=pir -o $(@UCLANG@_A_PIR) src/@lang@/Actions.pm $(@UCLANG@_C_PIR): src/@lang@/Compiler.pm $(PARROT_NQP) --target=pir -o $(@UCLANG@_C_PIR) src/@lang@/Compiler.pm $(@UCLANG@_R_PIR): src/@lang@/Runtime.pm $(PARROT_NQP) --target=pir -o $(@UCLANG@_R_PIR) src/@lang@/Runtime.pm ## testing test: $(@UCLANG@_EXE) $(PERL) t/harness t ## installation install: all $(MKPATH) $(DESTDIR)$(@UCLANG@_LANG_DIR) $(CP) $(@UCLANG@_PBC) $(DESTDIR)$(@UCLANG@_LANG_DIR) $(CP) $(@UCLANG@_EXE) $(DESTDIR)$(PARROT_BIN_DIR) $(CHMOD) 755 $(DESTDIR)$(PARROT_BIN_DIR)/$(@UCLANG@_EXE) ## cleaning clean: $(RM_F) $(CLEANUPS) distclean: realclean realclean: clean $(RM_F) Makefile testclean: ## miscellaneous targets # a listing of all targets meant to be called by users help: @echo "" @echo "Following targets are available for the user:" @echo "" @echo " all: $(@UCLANG@_EXE)" @echo " This is the default." @echo " $(@UCLANG@_EXE): The @lang@ compiler." @echo " install: Install compiler into Parrot." @echo "" @echo "Testing:" @echo " test: Run tests." @echo "" @echo "Cleaning:" @echo " clean: Basic cleaning up." @echo " distclean: Removes also anything built, in theory." @echo " realclean: Removes also files generated by 'Configure.pl'." @echo " testclean: Clean up test results." @echo "" @echo "Misc:" @echo " help: Print this help message." @echo "" __build/gen_parrot.pl__ #! perl # Copyright (C) 2009 The Perl Foundation =head1 TITLE gen_parrot.pl - script to obtain and build Parrot for Rakudo =head2 SYNOPSIS perl gen_parrot.pl [--parrot --configure=options] =head2 DESCRIPTION Maintains an appropriate copy of Parrot in the parrot/ subdirectory. The revision of Parrot to be used in the build is given by the build/PARROT_REVISION file. =cut use strict; use warnings; use 5.008; # Work out slash character to use. my $slash = $^O eq 'MSWin32' ? '\\' : '/'; ## determine what revision of Parrot we require open my $REQ, "build/PARROT_REVISION" || die "cannot open build/PARROT_REVISION\n"; my ($reqsvn, $reqpar) = split(' ', <$REQ>); $reqsvn += 0; close $REQ; { no warnings; if (open my $REV, '-|', "parrot_install${slash}bin${slash}parrot_config revision") { my $revision = 0+<$REV>; close $REV; if ($revision >= $reqsvn) { print "Parrot r$revision already available (r$reqsvn required)\n"; exit(0); } } } print "Cloning the Parrot git repo...\n"; system(qw(git clone), qw(http://github.com/parrot/parrot.git)); chdir('parrot') or die "Can't chdir to parrot: $!"; system("git checkout $reqsvn"); # TODO: error checking ## If we have a Makefile from a previous build, do a 'make realclean' if (-f 'Makefile') { my %config = read_parrot_config(); my $make = $config{'make'}; if ($make) { print "\nPerforming '$make realclean' ...\n"; system($make, "realclean"); } } print "\nConfiguring Parrot ...\n"; my @config_command = ($^X, 'Configure.pl', @ARGV); print "@config_command\n"; system @config_command; print "\nBuilding Parrot ...\n"; my %config = read_parrot_config(); my $make = $config{'make'} or exit(1); my @make_opts; if ($ENV{GNU_MAKE_JOBS}) { push @make_opts, '-j', $ENV{GNU_MAKE_JOBS} } system($make, 'install-dev', @make_opts); sub read_parrot_config { my %config = (); if (open my $CFG, "config_lib.pasm") { while (<$CFG>) { if (/P0\["(.*?)"], "(.*?)"/) { $config{$1} = $2 } } close $CFG; } %config; } __src/@lang@.pir__ .HLL '@lclang@' .namespace [] .sub '' :anon :load :init load_bytecode 'HLL.pbc' .local pmc hllns, parrotns, imports hllns = get_hll_namespace parrotns = get_root_namespace ['parrot'] imports = split ' ', 'PAST PCT HLL Regex Hash' parrotns.'export_to'(hllns, imports) .end .include 'src/gen/@lclang@-grammar.pir' .include 'src/gen/@lclang@-actions.pir' .include 'src/gen/@lclang@-compiler.pir' .include 'src/gen/@lclang@-runtime.pir' .namespace [] .sub 'main' :main .param pmc args $P0 = compreg '@lang@' # Cannot tailcall here. (TT #1029) $P1 = $P0.'command_line'(args) .return ($P1) .end __src/@lang@/Grammar.pm__ =begin overview This is the grammar for @lang@ in Perl 6 rules. =end overview grammar @lang@::Grammar is HLL::Grammar; token TOP { [ $ || <.panic: "Syntax error"> ] } ## Lexer items # This rule treats # as "comment to eol". token ws { [ '#' \N* \n? | \s+ ]* } ## Statements rule statementlist { [ | ] ** ';' } rule statement { | | } proto token statement_control { <...> } rule statement_control:sym { [ ] ** ',' } rule statement_control:sym { [ ] ** ',' } ## Terms token term:sym { } token term:sym { } proto token quote { <...> } token quote:sym<'> { } token quote:sym<"> { } ## Operators INIT { @lang@::Grammar.O(':prec, :assoc', '%multiplicative'); @lang@::Grammar.O(':prec, :assoc', '%additive'); } token circumfix:sym<( )> { '(' <.ws> ')' } token infix:sym<*> { ')> } token infix:sym { ')> } token infix:sym<+> { ')> } token infix:sym<-> { ')> } __src/@lang@/Actions.pm__ class @lang@::Actions is HLL::Actions; method TOP($/) { make PAST::Block.new( $.ast , :hll<@lclang@>, :node($/) ); } method statementlist($/) { my $past := PAST::Stmts.new( :node($/) ); for $ { $past.push( $_.ast ); } make $past; } method statement($/) { make $ ?? $.ast !! $.ast; } method statement_control:sym($/) { my $past := PAST::Op.new( :name, :pasttype, :node($/) ); for $ { $past.push( $_.ast ); } make $past; } method statement_control:sym($/) { my $past := PAST::Op.new( :name, :pasttype, :node($/) ); for $ { $past.push( $_.ast ); } make $past; } method term:sym($/) { make $.ast; } method term:sym($/) { make $.ast; } method quote:sym<'>($/) { make $.ast; } method quote:sym<">($/) { make $.ast; } method circumfix:sym<( )>($/) { make $.ast; } __src/@lang@/Compiler.pm__ class @lang@::Compiler is HLL::Compiler; INIT { @lang@::Compiler.language('@lang@'); @lang@::Compiler.parsegrammar(@lang@::Grammar); @lang@::Compiler.parseactions(@lang@::Actions); } __src/@lang@/Runtime.pm__ # language-specific runtime functions go here sub print(*@args) { pir::print(pir::join('', @args)); 1; } sub say(*@args) { pir::say(pir::join('', @args)); 1; } __src/gen/.gitignore__ * __t/harness__ #! perl use strict; use warnings; use FindBin; use File::Spec; use Getopt::Long qw(:config pass_through); $ENV{'HARNESS_PERL'} = './@lclang@'; use Test::Harness; $Test::Harness::switches = ''; GetOptions( 'tests-from-file=s' => \my $list_file, 'verbosity=i' => \$Test::Harness::verbose, 'jobs:3' => \my $jobs, 'icu:1' => \my $do_icu, ); my @pass_through_options = grep m/^--?[^-]/, @ARGV; my @files = grep m/^[^-]/, @ARGV; my $slash = $^O eq 'MSWin32' ? '\\' : '/'; if ($list_file) { open(my $f, '<', $list_file) or die "Can't open file '$list_file' for reading: $!"; while (<$f>) { next if m/^\s*#/; next unless m/\S/; chomp; my ($fn, $flags) = split /\s+#\s*/; next if ($flags && ($flags =~ m/icu/) && !$do_icu); $fn = "t/spec/$fn" unless $fn =~ m/^t\Q$slash\Espec\Q$slash\E/; $fn =~ s{/}{$slash}g; if ( -r $fn ) { push @files, $fn; } else { warn "Missing test file: $fn\n"; } } close $f or die $!; } my @tfiles = map { all_in($_) } sort @files; if (eval { require TAP::Harness; 1 }) { my %harness_options = ( exec => ['./@lclang@'], verbosity => 0+$Test::Harness::verbose, jobs => $jobs || 1, ); TAP::Harness->new( \%harness_options )->runtests(@tfiles); } else { runtests(@tfiles); } # adapted to return only files ending in '.t' sub all_in { my $start = shift; return $start unless -d $start; my @skip = ( File::Spec->updir, File::Spec->curdir, qw( .svn CVS .git ) ); my %skip = map {($_,1)} @skip; my @hits = (); if ( opendir( my $dh, $start ) ) { my @files = sort readdir $dh; closedir $dh or die $!; for my $file ( @files ) { next if $skip{$file}; my $currfile = File::Spec->catfile( $start, $file ); if ( -d $currfile ) { push( @hits, all_in( $currfile ) ); } else { push( @hits, $currfile ) if $currfile =~ /\.t$/; } } } else { warn "$start: $!\n"; } return @hits; } __t/00-sanity.t__ # This just checks that the basic parsing and call to builtin say() works. say '1..4'; say 'ok 1'; say 'ok ', 2; say 'ok ', 2 + 1; say 'ok', ' ', 4; __DATA__ # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: filenames.t000644000765000765 704012101554067 17064 0ustar00brucebruce000000000000parrot-5.9.0/t/codingstd#! perl # Copyright (C) 2006-2012, Parrot Foundation. use strict; use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; use ExtUtils::Manifest qw(maniread); use Parrot::Distribution; use File::Spec; # set up how many tests to run plan tests => 3; =head1 NAME t/codingstd/filenames.t - checks that filenames conform to standards =head1 SYNOPSIS # test all files % prove t/codingstd/filenames.t # test specific files % perl t/codingstd/filenames.t src/foo.c include/parrot/bar.h =head1 DESCRIPTION Checks that the filenames used for files within the Parrot distribution conform to a set of highly portable standards. =over 4 =item No multiple dots within filenames Files with more than one dot ( '.' ) in their filename are problematic on some platforms (e.g. VMS) hence avoid these in Parrot. Even generated files have to obey this. =item No strange characters in filenames Filenames are restricted to the characters C =item Filenames length restriction Filenames are restricted to 32 characters. =back =head1 SEE ALSO L =head1 AUTHOR Paul Cochrane =cut my $DIST = Parrot::Distribution->new; my @files; if (@ARGV){ @files = <@ARGV>; } else { my $manifest = maniread('MANIFEST'); if (-e 'MANIFEST.generated') { my $mani2 = maniread('MANIFEST.generated'); for (keys %$mani2) { $manifest->{$_} = $mani2->{$_} unless /(lib|cyg)parrot/; } } # Give ports a little more leeway @files = grep {! /^ports/} sort keys %$manifest; } my ( @multi_dots, @strange_chars, @too_long ); foreach my $file ( @files ) { # check for multiple dots in filenames my $num_dots = grep(m/\./g, split( m//, $file)); if ( $num_dots > 1 ) { # this file is not used to build Parrot, so VMS can just deal with it push @multi_dots, $file . "\n" unless $file eq '.travis.yml'; } # check the characters used in filenames push @strange_chars, $file . "\n" if $file =~ m/[^\w\/.\-]/g; # check for filenames that are too long my ($volume, $directory, $filename) = File::Spec->splitpath( $file ); my @filename_chars = split m//, $filename; my $filename_len = scalar @filename_chars; push @too_long, $file . ":$filename_len chars\n" if $filename_len > 32; } ok( !@multi_dots, 'No multi-dot filenames' ) or diag( "Multi-dot filename found in " . @multi_dots . " files:\n@multi_dots" ); ok( !@strange_chars, 'Portable characters in filenames' ) or diag( "Filename with non-portable character found in " . @strange_chars . " files:\n@strange_chars" ); if (@too_long == 1 and $too_long[0] eq "installable_parrot_nci_thunk_gen.exe:36 chars\n") { # Only on Windows and Windows allows filename lengths > 36 ok( @too_long == 1, "Filenames length - installable_parrot_nci_thunk_gen.exe:36 okay on Windows" ); } elsif (@too_long == 1 and $too_long[0] eq "runtime/parrot/include/packfile_annotation_key_type.pasm:33 chars\n") { TODO: { local $TODO = 'GH #895 deprecate 1 overlong filename'; ok( !@too_long, "Filenames length" ) or diag( "Filename with more than 32 chars found in " . @too_long . " files:\n@too_long" ); }; } else { ok( !@too_long, 'Filenames length' ) or diag( "Filename with more than 32 chars found in " . @too_long . " files:\n@too_long" ); } # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: buffer.c000644000765000765 6716512101554067 15364 0ustar00brucebruce000000000000parrot-5.9.0/src/io/* Copyright (C) 2001-2011, Parrot Foundation. =head1 NAME src/io/buffer.c - I/O buffering =head1 DESCRIPTION This file implements buffering logic for the IO subsystem. A buffer is a chunk of memory that can be used to store data so fewer OS-level transactions need to be performed. =head2 Functions =over 4 =cut */ #include "parrot/parrot.h" #include "io_private.h" #include "pmc/pmc_handle.h" /* HEADERIZER HFILE: include/parrot/io.h */ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ static void io_buffer_add_bytes(PARROT_INTERP, ARGMOD(IO_BUFFER *buffer), ARGIN(char *s), size_t length) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) FUNC_MODIFIES(*buffer); static void io_buffer_normalize(PARROT_INTERP, ARGMOD_NULLOK(IO_BUFFER *buffer)) __attribute__nonnull__(1) FUNC_MODIFIES(*buffer); static INTVAL io_buffer_requires_flush(PARROT_INTERP, ARGIN(IO_BUFFER *buffer), ARGIN(char * s), size_t length) __attribute__nonnull__(2) __attribute__nonnull__(3); static size_t io_buffer_transfer_to_mem(PARROT_INTERP, ARGMOD_NULLOK(IO_BUFFER *buffer), ARGOUT(char * s), size_t length) __attribute__nonnull__(1) __attribute__nonnull__(3) FUNC_MODIFIES(*buffer) FUNC_MODIFIES(* s); #define ASSERT_ARGS_io_buffer_add_bytes __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(buffer) \ , PARROT_ASSERT_ARG(s)) #define ASSERT_ARGS_io_buffer_normalize __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_io_buffer_requires_flush __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(buffer) \ , PARROT_ASSERT_ARG(s)) #define ASSERT_ARGS_io_buffer_transfer_to_mem __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(s)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ /* =item C Allocate a new buffer for PMC C with the given flags and settings. =item C Free the C memory. =cut */ PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT IO_BUFFER * Parrot_io_buffer_allocate(PARROT_INTERP, ARGMOD(PMC *owner), INTVAL flags, ARGIN_NULLOK(const STR_VTABLE *encoding), size_t init_size) { ASSERT_ARGS(Parrot_io_buffer_allocate) IO_BUFFER * const buffer = (IO_BUFFER *)Parrot_gc_allocate_fixed_size_storage(interp, sizeof (IO_BUFFER)); buffer->encoding = encoding; if (init_size == BUFFER_SIZE_ANY) { if (flags & PIO_BF_LINEBUF) init_size = PIO_BUFFER_LINEBUF_SIZE; else init_size = PIO_BUFFER_MIN_SIZE; } buffer->buffer_size = init_size; if (init_size) { buffer->buffer_ptr = (char *)mem_sys_allocate(init_size); flags |= PIO_BF_MALLOC; } else flags &= ~PIO_BF_MALLOC; buffer->buffer_start = buffer->buffer_ptr; buffer->buffer_end = buffer->buffer_ptr; PARROT_ASSERT(BUFFER_IS_EMPTY(buffer)); buffer->raw_reads = 0; buffer->flags = flags; return buffer; } void Parrot_io_buffer_free(PARROT_INTERP, ARGFREE(IO_BUFFER *buffer)) { ASSERT_ARGS(Parrot_io_buffer_free) if (buffer->buffer_size) { if (buffer->flags & PIO_BF_MALLOC) { mem_sys_free(buffer->buffer_start); } else if (buffer->flags & PIO_BF_MMAP) { /* TODO */ } } Parrot_gc_free_fixed_size_storage(interp, sizeof (IO_BUFFER), buffer); } /* =item C Allocate a new C and attach it to PMC C at position C. Valid positions are C and C. If the buffer already exists, resize it to match the specifications. =item C Remove the buffer from C at position C. Valid positions are C and C. =cut */ void Parrot_io_buffer_add_to_handle(PARROT_INTERP, ARGMOD(PMC *handle), INTVAL idx, size_t length, INTVAL flags) { ASSERT_ARGS(Parrot_io_buffer_add_to_handle) if (idx != IO_PTR_IDX_READ_BUFFER && idx != IO_PTR_IDX_WRITE_BUFFER) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Unknown buffer number %d", idx); { IO_BUFFER * buffer = (IO_BUFFER *)VTABLE_get_pointer_keyed_int(interp, handle, idx); if (buffer) { Parrot_io_buffer_resize(interp, buffer, length); PARROT_ASSERT(length == BUFFER_SIZE_ANY || buffer->buffer_size >= length); } else { buffer = Parrot_io_buffer_allocate(interp, handle, flags, NULL, length); PARROT_ASSERT(buffer); VTABLE_set_pointer_keyed_int(interp, handle, idx, buffer); } if (flags != BUFFER_FLAGS_ANY) buffer->flags = flags; } } void Parrot_io_buffer_remove_from_handle(PARROT_INTERP, ARGMOD(PMC *handle), INTVAL idx) { ASSERT_ARGS(Parrot_io_buffer_remove_from_handle) if (idx != IO_PTR_IDX_READ_BUFFER && idx != IO_PTR_IDX_WRITE_BUFFER) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR, "Unknown buffer number %d", idx); { IO_BUFFER * const buffer = (IO_BUFFER *)VTABLE_get_pointer_keyed_int(interp, handle, idx); if (!buffer) return; /* TODO: Decrease reference count, only free it if the refcount is zero */ Parrot_io_buffer_free(interp, buffer); VTABLE_set_pointer_keyed_int(interp, handle, idx, NULL); } } /* =item C Resize the C to be able to accomodate the C. The buffer may grow but probably will not shrink to avoid data loss. Return the new size of the buffer. =cut */ size_t Parrot_io_buffer_resize(PARROT_INTERP, ARGMOD(IO_BUFFER *buffer), size_t new_size) { ASSERT_ARGS(Parrot_io_buffer_resize) if (new_size == BUFFER_SIZE_ANY) return buffer->buffer_size; if (new_size < PIO_BUFFER_MIN_SIZE) new_size = PIO_BUFFER_MIN_SIZE; if (buffer->buffer_size >= new_size) return new_size; buffer->buffer_ptr = (char *)mem_sys_realloc(buffer->buffer_ptr, new_size); buffer->buffer_size = new_size; return new_size; } /* =item C Mark any GCable data attached to the buffer, if any. =cut */ void Parrot_io_buffer_mark(SHIM_INTERP, ARGMOD_NULLOK(IO_BUFFER *buffer)) { ASSERT_ARGS(Parrot_io_buffer_mark) if (!buffer) return; /*if (!PMC_IS_NULL(buffer->owner_pmc)) Parrot_gc_mark_PMC_alive(interp, buffer->owner_pmc);*/ } /* =item C Clear the buffer, erasing all data and normalizing all pointers. =cut */ void Parrot_io_buffer_clear(PARROT_INTERP, ARGMOD_NULLOK(IO_BUFFER *buffer)) { ASSERT_ARGS(Parrot_io_buffer_clear) if (!buffer) return; buffer->buffer_start = buffer->buffer_ptr; buffer->buffer_end = buffer->buffer_ptr; BUFFER_ASSERT_SANITY(buffer); } /* =item C Attempt to read C bytes from C, possibly using C. If C is null, read from C directly. Otherwise, attempt to read data out of the buffer and fill it up again. Data is read into the chunk of memory pointed to by C. The number of bytes actually read is returned. =cut */ size_t Parrot_io_buffer_read_b(PARROT_INTERP, ARGMOD_NULLOK(IO_BUFFER *buffer), ARGIN(PMC *handle), ARGIN(const IO_VTABLE *vtable), ARGOUT(char *s), size_t length) { ASSERT_ARGS(Parrot_io_buffer_read_b) if (!buffer) return vtable->read_b(interp, handle, s, length); { size_t bytes_read = io_buffer_transfer_to_mem(interp, buffer, s, length); PARROT_ASSERT(bytes_read <= length); PARROT_ASSERT(length >= bytes_read); length = length - bytes_read; /* If we still need more data than the buffer can hold, just read it directly. */ if (length > buffer->buffer_size) { bytes_read += vtable->read_b(interp, handle, s + bytes_read, length); buffer->raw_reads++; } /* Else, if we need to read an amount that the buffer can handle, fill the buffer. */ else if (length) { Parrot_io_buffer_fill(interp, buffer, handle, vtable); bytes_read += io_buffer_transfer_to_mem(interp, buffer, s + bytes_read, length); } return bytes_read; } } /* =item C Transfer C bytes from the C to the memory chunk pointed to by C, removing those bytes from the buffer. Return the number of bytes actually copied. =cut */ static size_t io_buffer_transfer_to_mem(PARROT_INTERP, ARGMOD_NULLOK(IO_BUFFER *buffer), ARGOUT(char * s), size_t length) { ASSERT_ARGS(io_buffer_transfer_to_mem) if (!buffer || BUFFER_IS_EMPTY(buffer)) return 0; PARROT_ASSERT(length > 0); { const size_t length_left = length == PIO_READ_SIZE_ANY ? BUFFER_USED_SIZE(buffer) : length; const size_t used_length = BUFFER_USED_SIZE(buffer); const size_t copy_length = used_length <= length ? used_length : length; PARROT_ASSERT(copy_length <= length); memcpy(s, buffer->buffer_start, copy_length); buffer->buffer_start += copy_length; io_buffer_normalize(interp, buffer); return copy_length; } } /* =item C Attempt to normalize the buffer. If we can, move data to the front of the buffer so we have the maximum amount of contiguous free space =cut */ static void io_buffer_normalize(PARROT_INTERP, ARGMOD_NULLOK(IO_BUFFER *buffer)) { ASSERT_ARGS(io_buffer_normalize) /* BUFFER_DBG_PRINT(buffer); */ BUFFER_ASSERT_SANITY(buffer); if (!buffer) return; if (BUFFER_IS_EMPTY(buffer)) { Parrot_io_buffer_clear(interp, buffer); return; } if (BUFFER_CAN_BE_NORMALIZED(buffer)) { const size_t used_size = BUFFER_USED_SIZE(buffer); /* Make sure that we need to normalize, and that the memory regions are non-overlapping. */ PARROT_ASSERT(used_size > 0); PARROT_ASSERT(buffer->buffer_start >= (buffer->buffer_ptr + used_size)); /* Copy the data */ memmove(buffer->buffer_ptr, buffer->buffer_start, used_size); buffer->buffer_start = buffer->buffer_ptr; buffer->buffer_end = buffer->buffer_start + used_size; BUFFER_ASSERT_SANITY(buffer); /* Assert that we have the same amount of data in the buffer */ PARROT_ASSERT(used_size == BUFFER_USED_SIZE(buffer)); } } /* =item C HACK. Determine if the buffer needs a special flush. This is only required if the buffer is marked as C and if the input sequence contains a literal newline '\n'. This is for backwards compatibility with the old system and will probably be deleted soon. Return C<1> if the buffer needs to be flushed, C<0> otherwise. =cut */ static INTVAL io_buffer_requires_flush(SHIM_INTERP, ARGIN(IO_BUFFER *buffer), ARGIN(char * s), size_t length) { ASSERT_ARGS(io_buffer_requires_flush) /* Something of an ugly hack borrowed from the old system. If we're in line buffered mode we need to flush more often. Flush when we see a newline character. */ if (buffer->flags & PIO_BF_LINEBUF) { size_t i; for (i = 0; i < length; i++) { if (s[i] == '\n') return 1; } } return 0; } /* =item C Write C bytes from C into the C. If the buffer fills or needs to be flushed, the data will be written through to C. If C is null, data is written directly to C. Return the number of bytes added, probably C. =cut */ size_t Parrot_io_buffer_write_b(PARROT_INTERP, ARGMOD_NULLOK(IO_BUFFER *buffer), ARGMOD(PMC * handle), ARGIN(const IO_VTABLE *vtable), ARGIN(char *s), size_t length) { ASSERT_ARGS(Parrot_io_buffer_write_b) if (!buffer) return vtable->write_b(interp, handle, s, length); if (!length) return 0; else { size_t written = 0; const size_t total_size = buffer->buffer_size; const size_t used_size = BUFFER_USED_SIZE(buffer); const size_t avail_size = BUFFER_FREE_END_SPACE(buffer); const INTVAL needs_flush = io_buffer_requires_flush(interp, buffer, s, length); /* If the data fits in the buffer, copy it there and move on. */ if (length <= avail_size) { io_buffer_add_bytes(interp, buffer, s, length); if (needs_flush) Parrot_io_buffer_flush(interp, buffer, handle, vtable); return length; } /* If the total data to write is larger than the buffer, flush and write directly through to the handle */ if (length > total_size) { Parrot_io_buffer_flush(interp, buffer, handle, vtable); PARROT_ASSERT(BUFFER_IS_EMPTY(buffer)); return vtable->write_b(interp, handle, s, length); } /* Else, we have more data than available space, but the buffer should be able to cover any overflow. Flush then add the data to the newly empty buffer. */ Parrot_io_buffer_flush(interp, buffer, handle, vtable); io_buffer_add_bytes(interp, buffer, s, length); PARROT_ASSERT(BUFFER_USED_SIZE(buffer) == length); if (needs_flush) Parrot_io_buffer_flush(interp, buffer, handle, vtable); return length; } } /* =item C Add C bytes from C to the C. Assume that the number of bytes to add is less than or equal to the amount of available space for writing. =cut */ static void io_buffer_add_bytes(PARROT_INTERP, ARGMOD(IO_BUFFER *buffer), ARGIN(char *s), size_t length) { ASSERT_ARGS(io_buffer_add_bytes) BUFFER_ASSERT_SANITY(buffer); /* Assert that we aren't going to over-fill the buffer, and then fill it. */ PARROT_ASSERT(BUFFER_USED_SIZE(buffer) + length <= buffer->buffer_size); memcpy(buffer->buffer_end, s, length); buffer->buffer_end += length; PARROT_ASSERT(BUFFER_USED_SIZE(buffer) <= buffer->buffer_size); BUFFER_ASSERT_SANITY(buffer); } /* =item C Flush the buffer, writing all data out to C. If the buffer is null or empty, do nothing. Return the number of bytes written through to the handle. =cut */ size_t Parrot_io_buffer_flush(PARROT_INTERP, ARGMOD_NULLOK(IO_BUFFER *buffer), ARGMOD(PMC * handle), ARGIN(const IO_VTABLE *vtable)) { ASSERT_ARGS(Parrot_io_buffer_flush) size_t bytes_written = 0; if (buffer && !BUFFER_IS_EMPTY(buffer)) { size_t used_length = BUFFER_USED_SIZE(buffer); bytes_written += vtable->write_b(interp, handle, (char *)buffer->buffer_start, BUFFER_USED_SIZE(buffer)); Parrot_io_buffer_clear(interp, buffer); } return bytes_written; } /* =item C Peek the next byte from the buffer. Notice that this is the next byte, not the next codepoint. This is to preserve backwards compatibility with the old system. An updated peek operation will try to read the first codepoint instead. =cut */ UINTVAL Parrot_io_buffer_peek(PARROT_INTERP, ARGMOD(IO_BUFFER *buffer), ARGMOD(PMC * handle), ARGIN(const IO_VTABLE *vtable)) { ASSERT_ARGS(Parrot_io_buffer_peek) /* Current behavior only returns the first byte, not the first codepoint. Returning codepoint would make a lot more sense, but that's a change for later. */ if (BUFFER_IS_EMPTY(buffer)) { const size_t size = Parrot_io_buffer_fill(interp, buffer, handle, vtable); if (size == 0) return -1; } PARROT_ASSERT(!BUFFER_IS_EMPTY(buffer)); return (UINTVAL)buffer->buffer_start[0]; } /* =item C Reads data into the buffer, trying to fill if possible. Returns the total number of bytes in the buffer. =cut */ size_t Parrot_io_buffer_fill(PARROT_INTERP, ARGMOD_NULLOK(IO_BUFFER *buffer), ARGMOD(PMC * handle), ARGIN(const IO_VTABLE *vtable)) { ASSERT_ARGS(Parrot_io_buffer_fill) if (!buffer) return 0; /* Normalize to make sure we have a maximum amount of free space */ io_buffer_normalize(interp, buffer); { const size_t available_size = BUFFER_FREE_END_SPACE(buffer); size_t read_bytes; if (available_size == 0) return BUFFER_USED_SIZE(buffer); read_bytes = vtable->read_b(interp, handle, buffer->buffer_end, available_size); buffer->raw_reads++; buffer->buffer_end += read_bytes; BUFFER_ASSERT_SANITY(buffer); return BUFFER_USED_SIZE(buffer); } } /* =item C Return the number of bytes contained in C. =item C Advance the buffer content pointer by C bytes. This is required in certain cases, such as a "rw" handle. When we write bytes to the handle, we need to advance the read buffer pointer by the same number of bytes. If the Buffer is null or empty, do nothing. If the buffer has less data than the number of bytes to advance, clear and reset the buffer. =cut */ PARROT_WARN_UNUSED_RESULT size_t Parrot_io_buffer_content_size(SHIM_INTERP, ARGIN(IO_BUFFER *buffer)) { ASSERT_ARGS(Parrot_io_buffer_content_size) return BUFFER_USED_SIZE(buffer); } void Parrot_io_buffer_advance_position(PARROT_INTERP, ARGMOD_NULLOK(IO_BUFFER *buffer), size_t len) { ASSERT_ARGS(Parrot_io_buffer_advance_position) if (!buffer || BUFFER_IS_EMPTY(buffer)) return; if (BUFFER_USED_SIZE(buffer) <= len) { Parrot_io_buffer_clear(interp, buffer); return; } buffer->buffer_start += len; io_buffer_normalize(interp, buffer); } /* =item C Search the buffer for the given delimiter substr or end-of-buffer, whichever comes first. Return a count of the number of bytes to be read, in addition to scan information in *bounds. Does not return an amount of bytes to read which would create an incomplete codepoint. The return value is the number of bytes to read for the string contents. The pointer C<*chars_total> returns the total number of bytes to remove from the buffer =cut */ PARROT_WARN_UNUSED_RESULT size_t io_buffer_find_string_marker(PARROT_INTERP, ARGMOD(IO_BUFFER *buffer), ARGMOD(PMC *handle), ARGIN(const IO_VTABLE *vtable), ARGIN(const STR_VTABLE *encoding), ARGMOD(Parrot_String_Bounds *bounds), ARGIN(STRING * delim), ARGOUT(INTVAL *have_delim)) { ASSERT_ARGS(io_buffer_find_string_marker) INTVAL bytes_needed = 0; const size_t delim_bytelen = STRING_byte_length(delim); const size_t bytes_available = BUFFER_USED_SIZE(buffer); *have_delim = 0; if (bytes_available == 0) return 0; bounds->bytes = bytes_available; bounds->chars = -1; bounds->delim = -1; /* Partial scan the buffer to get information about bounds. */ bytes_needed = encoding->partial_scan(interp, buffer->buffer_start, bounds); if (bounds->bytes > 0) { /* Wrap the buffer up into a temporary STRING header. Use this to do string search to try and find the delimiter. If we do not find it, we might have part of the delimiter at the end of the buffer, so we can only safely read out part of it. */ INTVAL delim_idx; STRING str; str._bufstart = buffer->buffer_start; str.strstart = buffer->buffer_start; str._buflen = bounds->bytes; str.bufused = bounds->bytes; str.strlen = bounds->chars; str.hashval = 0; str.encoding = encoding; /* If we've found the delimiter, return the number of bytes up to and including it. */ delim_idx = STRING_index(interp, &str, delim, 0); if (delim_idx >= 0) { bounds->chars = delim_idx; bounds->delim = -1; encoding->partial_scan(interp, buffer->buffer_start, bounds); *have_delim = 1; return bounds->bytes + delim_bytelen; } /* If we haven't found the delimiter, we MIGHT have part of it. First, check a few simplifying cases before we do anything else. If the delimiter is exactly one byte, we know we don't have it so we can just return everything. This is a small optimization for the common case where the delimiter is "\n" */ if (delim_bytelen == 1) return bounds->bytes; /* If the buffer did not fill completely, we can assume there's nothing left for us to read because we tried to fill before we started this loop. If so, just return all the bytes in the buffer. If we've hit EOF and don't have the terminator, we'll never have it, so just return everything also. */ if (BUFFER_FREE_END_SPACE(buffer) > 0 || vtable->is_eof(interp, handle)) return bounds->bytes; /* If the delimiter is multiple bytes, we might have part of it. We need to leave that many bytes in the buffer at the end so that a subsequent fill+search will get the whole delimiter. Because we've required that the delimiter can be, at most, less than half the size of the buffer (which is obnoxiously large considering most delimiters will be either "\n" or "\r\n") we know that the buffer will be normalized and the remainder of the terminator will be found with the next fill. If the delimiter is multiple bytes, and we don't have enough bytes in the buffer to guarantee we can return bytes without eating into a partial delimiter, we return 0. */ if (bytes_available > delim_bytelen) { const size_t max_readable_bytes = (bytes_available / 2) - delim_bytelen; bounds->bytes = max_readable_bytes; bounds->chars = -1; bounds->delim = -1; encoding->partial_scan(interp, buffer->buffer_start, bounds); return bounds->bytes; } } /* For whatever reason, we have nothing to return. This may be because there is no text in the buffer, or because we have a multi-byte delimiter but we don't have enough bytes in the buffer to match it. */ return 0; } /* =item C Attempt to read from the buffer the given number of characters in the given encoding. Returns the number of bytes to be read from the buffer to either get this number from the buffer or else get the entire contents of the buffer and continue on a later read. =cut */ PARROT_WARN_UNUSED_RESULT size_t io_buffer_find_num_characters(PARROT_INTERP, ARGMOD(IO_BUFFER *buffer), ARGMOD(PMC *handle), ARGIN(const IO_VTABLE *vtable), ARGIN(const STR_VTABLE *encoding), ARGMOD(Parrot_String_Bounds *bounds), size_t num_chars) { ASSERT_ARGS(io_buffer_find_num_characters) INTVAL bytes_needed = 0; if (BUFFER_IS_EMPTY(buffer)) { const size_t bytes_available = Parrot_io_buffer_fill(interp, buffer, handle, vtable); if (bytes_available == 0) return 0; } bounds->bytes = BUFFER_USED_SIZE(buffer); bounds->chars = num_chars; bounds->delim = -1; bytes_needed = encoding->partial_scan(interp, buffer->buffer_start, bounds); return bounds->bytes; } /* =item C Perform a seek in the buffer. C must be C, currently. This must be a read buffer. If the buffer contains enough data to satisfy the seek, adjust the pointer accordingly and continue. Otherwise, clear the buffer and perform a seek on the underlying handle. =cut */ PIOOFF_T Parrot_io_buffer_seek(PARROT_INTERP, ARGMOD(IO_BUFFER *buffer), ARGMOD(PMC *handle), ARGIN(const IO_VTABLE *vtable), PIOOFF_T offset, INTVAL w) { ASSERT_ARGS(Parrot_io_buffer_seek) PIOOFF_T cur_pos = vtable->get_position(interp, handle); PIOOFF_T pos_diff; PARROT_ASSERT(w == SEEK_SET); if (cur_pos == offset) return offset; if (offset < cur_pos) { /* write buffers are flushed before seeking, so this is a read buffer. if we're not seeking to a position inside the buffer just clear it. */ Parrot_io_buffer_clear(interp, buffer); return vtable->seek(interp, handle, offset, w); } pos_diff = offset - cur_pos; PARROT_ASSERT(pos_diff > 0); if ((size_t)pos_diff > BUFFER_USED_SIZE(buffer)) { Parrot_io_buffer_clear(interp, buffer); return vtable->seek(interp, handle, offset, w); } /* If we're here, we can seek inside this buffer */ buffer->buffer_start += (size_t)pos_diff; io_buffer_normalize(interp, buffer); return offset; } /* =item C Find the current position of the file, taking into account the read-ahead data in the read buffer. If the handle has a write buffer, it is assumed that the write buffer has been flushed prior to calling this routine. =cut */ PARROT_WARN_UNUSED_RESULT PIOOFF_T Parrot_io_buffer_tell(PARROT_INTERP, ARGIN_NULLOK(IO_BUFFER *buffer), ARGMOD(PMC *handle), ARGIN(const IO_VTABLE * vtable)) { ASSERT_ARGS(Parrot_io_buffer_tell) if (!buffer || BUFFER_IS_EMPTY(buffer)) return vtable->tell(interp, handle); { const size_t used_size = BUFFER_USED_SIZE(buffer); return vtable->tell(interp, handle) - used_size; } } /* =back =cut */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ test_builder_done_testing.t000644000765000765 246211533177644 22053 0ustar00brucebruce000000000000parrot-5.9.0/t/library#!./parrot # Copyright (C) 2005-2008, Parrot Foundation. .sub _main :main load_bytecode 'Test/Builder/Tester.pbc' .local pmc tb_args tb_args = new 'Hash' .local pmc test test = new [ 'Test'; 'Builder' ], tb_args .local pmc plan .local pmc test_pass .local pmc test_fail .local pmc test_out .local pmc test_diag .local pmc test_test plan = get_global [ 'Test'; 'Builder'; 'Tester' ], 'plan' test_pass = get_global [ 'Test'; 'Builder'; 'Tester' ], 'test_pass' test_fail = get_global [ 'Test'; 'Builder'; 'Tester' ], 'test_fail' test_out = get_global [ 'Test'; 'Builder'; 'Tester' ], 'test_out' test_diag = get_global [ 'Test'; 'Builder'; 'Tester' ], 'test_diag' test_test = get_global [ 'Test'; 'Builder'; 'Tester' ], 'test_test' plan( 4 ) test_out( 'ok 1 - hi' ) test.'ok'( 1, 'hi' ) test_test( 'passing test') test_out( 'not ok 2 - bye' ) test.'ok'( 0, 'bye' ) test_test( 'failing test') test_out( "\n1..2" ) test.'done_testing'() test_test( 'Simple done_testing works' ) test_out( "1..3" ) test_out( "Expected 3 but ran 2" ) test.'done_testing'(3) test_test( 'done_testing with bad plan works' ) test.'finish'() .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: test_c.in000644000765000765 122312110742227 17766 0ustar00brucebruce000000000000parrot-5.9.0/config/auto/libffi/* Copyright (C) 2008-2010, Parrot Foundation. seeing if libffi is installed */ #include #include int main() { ffi_cif cif; ffi_type *args[1]; void *values[1]; char *s; int rc; /* Initialize the argument info vectors */ args[0] = &ffi_type_pointer; values[0] = &s; /* Initialize the cif */ if (ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 1, &ffi_type_uint, args) == FFI_OK) { s = "libffi worked"; ffi_call(&cif, FFI_FN(puts), &rc, values); } return 0; } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ stress_strings1.pir000644000765000765 173012101554066 22336 0ustar00brucebruce000000000000parrot-5.9.0/examples/benchmarks# Copyright (C) 2010-2012, Parrot Foundation. =head1 NAME examples/benchmarks/stress_strings1.pir - comparison with stress_stringsu.pir =head1 SYNOPSIS % time ./parrot examples/benchmarks/stress_strings1.pir % time ./parrot examples/benchmarks/stress_stringsu.pir =head1 DESCRIPTION Create non-encoded strings, running through the imcc optimizer. Some of the strings are long-lived, most of them are short lived. =cut .sub 'main' :main .local pmc rsa # array of long lived strings. .local pmc args .local int i rsa = new ['ResizableStringArray'] args = new ['ResizablePMCArray'] i = 0 push args, i loop: $S0 = "c" args[0] = i sprintf $S1, "%d", args $S2 = concat $S0, $S1 $I0 = i % 10 # every 10th string is longlived if $I0 goto inc_i push rsa, $S2 inc_i: inc i if i < 10000000 goto loop .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: OPTable.pir000644000765000765 4702312101554066 17724 0ustar00brucebruce000000000000parrot-5.9.0/compilers/pge/PGE# Copyright (C) 2005-2009, Parrot Foundation. =head1 DESCRIPTION PGE::OPTable - PGE operator precedence table and parser =head1 Methods =over 4 =cut .namespace [ 'PGE';'OPTable' ] .const int PGE_OPTABLE_EXPECT_TERM = 0x01 .const int PGE_OPTABLE_EXPECT_OPER = 0x02 .const int PGE_OPTABLE_EXPECT_START = 0x05 .const int PGE_OPTABLE_EMPTY = 0x00 .const int PGE_OPTABLE_TERM = 0x10 .const int PGE_OPTABLE_POSTFIX = 0x20 .const int PGE_OPTABLE_CLOSE = 0x30 .const int PGE_OPTABLE_PREFIX = 0x40 .const int PGE_OPTABLE_PRELIST = 0x50 .const int PGE_OPTABLE_INFIX = 0x60 .const int PGE_OPTABLE_TERNARY = 0x70 .const int PGE_OPTABLE_POSTCIRCUMFIX = 0x80 .const int PGE_OPTABLE_CIRCUMFIX = 0x90 .const int PGE_OPTABLE_STOP_SUB = -1 .include "cclass.pasm" .sub '__onload' :load .local pmc p6meta p6meta = new 'P6metaclass' p6meta.'new_class'('PGE::OPTable', 'parent'=>'Hash', 'attr'=>'%!key %!klen &!ws') .local pmc sctable sctable = new 'Hash' set_global '%!sctable', sctable 'sctable'('term:', 'syncat'=>PGE_OPTABLE_TERM, 'expect'=>0x0201) 'sctable'('postfix:', 'syncat'=>PGE_OPTABLE_POSTFIX, 'expect'=>0x0202, 'arity'=>1) 'sctable'('close:', 'syncat'=>PGE_OPTABLE_CLOSE, 'expect'=>0x0202) 'sctable'('prefix:', 'syncat'=>PGE_OPTABLE_PREFIX, 'expect'=>0x0101, 'arity'=>1) 'sctable'('infix:', 'syncat'=>PGE_OPTABLE_INFIX, 'expect'=>0x0102, 'arity'=>2) 'sctable'('ternary:', 'syncat'=>PGE_OPTABLE_TERNARY, 'expect'=>0x0102, 'expectclose'=>0x0102, 'arity'=>3) 'sctable'('postcircumfix:', 'syncat'=>PGE_OPTABLE_POSTCIRCUMFIX, 'expect'=>0x0102, 'arity'=>2) 'sctable'('circumfix:', 'syncat'=>PGE_OPTABLE_CIRCUMFIX, 'expect'=>0x0101, 'arity'=>1) .return () .end =item C Adds (or replaces) a syntactic category's defaults. =cut .sub 'sctable' .param string name .param pmc adverbs :slurpy :named .local pmc sctable sctable = get_global '%!sctable' unless null adverbs goto with_adverbs adverbs = new 'Hash' with_adverbs: sctable[name] = adverbs .return (adverbs) .end .sub "init" :vtable :method .local pmc tokentable, keytable, klentable tokentable = self keytable = new 'Hash' klentable = new 'Hash' setattribute self, '%!key', keytable setattribute self, '%!klen', klentable .end .sub 'newtok' :method .param string name .param pmc args :slurpy :named .local string syncat, key $I0 = index name, ':' inc $I0 syncat = substr name, 0, $I0 key = substr name, $I0 .local pmc sctable, token sctable = get_hll_global ['PGE';'OPTable'], '%!sctable' $I0 = exists sctable[syncat] if $I0 == 0 goto token_hash token = sctable[syncat] token = clone token goto with_token token_hash: token = new 'Hash' with_token: token['name'] = name # we don't replace existing tokens .local pmc tokentable tokentable = self $I0 = exists tokentable[name] if $I0 goto end tokentable[name] = token $P0 = iter args args_loop: unless $P0 goto args_end $S1 = shift $P0 $P2 = $P0[$S1] token[$S1] = $P2 goto args_loop args_end: ## handle token word boundaries unless key goto with_wb $I0 = exists token['wb'] if $I0 goto with_wb $I0 = length key $I1 = find_not_cclass .CCLASS_WORD, key, 0, $I0 if $I1 < $I0 goto with_wb token['wb'] = 1 with_wb: ## handle key scanning unless key goto with_skipkey $I0 = exists token['skipkey'] if $I0 goto with_skipkey $P0 = token['parsed'] if null $P0 goto with_skipkey token['skipkey'] = 1 with_skipkey: $S0 = token['match'] if $S0 > '' goto with_match token['match'] = 'PGE::Match' with_match: $S0 = token['equiv'] unless $S0 goto with_equiv $S1 = tokentable[$S0;'precedence'] token['precedence'] = $S1 $S1 = tokentable[$S0;'assoc'] token['assoc'] = $S1 with_equiv: $S0 = token['looser'] unless $S0 goto with_looser $S0 = tokentable[$S0;'precedence'] $S0 = clone $S0 $S0 = replace $S0, -1, 0, '<' token['precedence'] = $S0 with_looser: $S0 = token['tighter'] unless $S0 goto with_tighter $S0 = tokentable[$S0;'precedence'] $S0 = clone $S0 $S0 = replace $S0, -1, 0, '>' token['precedence'] = $S0 with_tighter: $I0 = exists token['precclose'] if $I0 goto with_precclose $P0 = token['precedence'] token['precclose'] = $P0 with_precclose: .local string keyclose $I0 = index key, ' ' if $I0 < 0 goto with_close $I1 = $I0 + 1 keyclose = substr key, $I1 key = substr key, 0, $I0 token['keyclose'] = keyclose $S0 = concat 'close:', keyclose $I0 = token['expectclose'] if $I0 goto with_expectclose $I0 = 0x0202 with_expectclose: $I1 = token['nows'] self.'newtok'($S0, 'equiv' => name, 'expect'=>$I0, 'nows'=>$I1) with_close: add_key: .local pmc keytable, klentable keytable = getattribute self, '%!key' klentable = getattribute self, '%!klen' $I1 = length key $S0 = substr key, 0, 1 $I0 = klentable[$S0] if $I0 >= $I1 goto add_key_1 klentable[$S0] = $I1 add_key_1: $I0 = exists keytable[key] if $I0 goto add_key_array keytable[key] = token goto add_key_end add_key_array: $P0 = keytable[key] $I0 = does $P0, 'array' if $I0 goto add_key_array_2 $P1 = new 'ResizablePMCArray' push $P1, $P0 push $P1, token keytable[key] = $P1 goto add_key_end add_key_array_2: push $P0, token add_key_end: .local string assoc assoc = token['assoc'] if assoc > '' goto with_assoc token['assoc'] = 'left' with_assoc: end: .return (token) .end .sub 'parse' :method .param pmc mob .param pmc adverbs :slurpy :named .local pmc tokentable, keytable, klentable .local pmc tokenstack, operstack, termstack .local string target .local pmc mfrom, mpos .local int pos, lastpos, wspos .local int expect, nows .local pmc ws .local string key .local pmc token, top, oper .local pmc it .local int tokencat, topcat .local int circumnest .local pmc cstack cstack = new 'ResizableIntegerArray' tokentable = self keytable = getattribute self, '%!key' klentable = getattribute self, '%!klen' unless null adverbs goto with_adverbs adverbs = new 'Hash' with_adverbs: .local pmc action .local string rulename action = adverbs['action'] if null action goto no_rulename rulename = adverbs['rulename'] unless rulename goto have_rulename $I0 = can action, rulename if $I0 goto have_rulename no_rulename: rulename = '' have_rulename: ## see if we have a 'stop' adverb. If so, then it is either ## a string to be matched directly or a sub(rule) to be called ## to check for a match. .local int has_stop, has_stop_nows .local string stop_str .local pmc stop has_stop = 0 $I0 = exists adverbs['stop'] if $I0 == 0 goto with_stop stop = adverbs['stop'] has_stop = PGE_OPTABLE_STOP_SUB $I0 = isa stop, 'Sub' if $I0 goto with_stop stop_str = stop $S0 = substr stop_str, 0, 1 if $S0 != ' ' goto stop_str_nows stop_str = substr stop_str, 1 has_stop = length stop_str has_stop_nows = 0 goto with_stop stop_str_nows: has_stop = length stop_str has_stop_nows = 1 with_stop: ## if we have a 'tighter' adverb, set ## tighter to the precedence of the op specified .local string tighter tighter = adverbs['tighter'] $I0 = exists tokentable[tighter] if $I0 == 0 goto with_tighter token = tokentable[tighter] tighter = token['precedence'] with_tighter: ws = getattribute self, '&!ws' unless null ws goto have_ws $I0 = can mob, 'ws' unless $I0 goto have_ws ws = find_method mob, 'ws' have_ws: tokenstack = new 'ResizablePMCArray' operstack = new 'ResizablePMCArray' termstack = new 'ResizablePMCArray' $P0 = get_hll_global ['PGE'], 'Match' (mob, pos, target, mfrom, mpos) = $P0.'new'(mob, adverbs :flat :named) lastpos = length target circumnest = 0 expect = PGE_OPTABLE_EXPECT_START token_next: ## figure out what we're looking for ## if we're at the end of the string, end match wspos = pos if pos >= lastpos goto oper_not_found ## check for leading whitespace -- it may limit token candidates if null ws goto token_next_ws mpos = pos $P0 = ws(mob) unless $P0 goto token_next_1 pos = $P0.'to'() goto token_next_1 token_next_ws: pos = find_not_cclass .CCLASS_WHITESPACE, target, pos, lastpos token_next_1: ## "nows" tokens are eligible if we don't have leading ws nows = isne pos, wspos check_stop: ## Check for a stop pattern or string. But don't check ## if we're in a circumfix. if circumnest > 0 goto key_search if has_stop == 0 goto key_search if has_stop == PGE_OPTABLE_STOP_SUB goto check_stop_sub $I0 = has_stop_nows & nows if $I0 goto key_search $S0 = substr target, pos, has_stop if $S0 == stop_str goto oper_not_found goto key_search check_stop_sub: mpos = wspos $P0 = stop(mob) if $P0 goto oper_not_found ## look through eligible tokens to find longest match key_search: ## use the next character of input stream to limit search key = substr target, pos, 1 $I0 = klentable[key] key = substr target, pos, $I0 key_loop: $I0 = exists keytable[key] if $I0 == 0 goto key_next token = keytable[key] $I0 = does token, "array" if $I0 goto key_array local_branch cstack, token_match if_null oper, key_next if oper goto oper_found goto key_next key_array: it = iter token key_array_1: unless it goto key_next token = shift it local_branch cstack, token_match if_null oper, key_array_1 if oper goto oper_found goto key_array_1 key_next: if key == '' goto token_nows key = chopn key, 1 goto key_loop token_nows: if pos == wspos goto oper_not_found ## try again, with the whitespace operators this time pos = wspos nows = 0 goto check_stop oper_not_found: ## we were unable to find a valid token for the current expect state ## if we're not expecting a term, then end the match here $I0 = expect & PGE_OPTABLE_EXPECT_TERM if $I0 == 0 goto end ## otherwise, let's add a "dummy" term to the stack for reduction oper = mob.'new'(mob) push termstack, oper ## if the current operator doesn't allow nullterm, end match unless tokenstack goto end top = tokenstack[-1] $I0 = top['nullterm'] if $I0 == 0 goto end ## it's a nullterm operator, so we can continue parsing oper.'to'(pos) expect = PGE_OPTABLE_EXPECT_OPER goto token_next oper_found: ## tighter: if we have an insufficiently tight token, ## treat it as not found. if circumnest > 0 goto oper_found_1 $S0 = token['precedence'] if $S0 <= tighter goto oper_not_found oper_found_1: tokencat = token['syncat'] ## this section processes according to the ## table at the end of this function if tokencat == PGE_OPTABLE_TERM goto term_shift if tokencat == PGE_OPTABLE_PREFIX goto oper_shift # (S1) if tokencat == PGE_OPTABLE_CIRCUMFIX goto oper_shift # (S2) $I0 = elements termstack if $I0 > 0 goto shift_reduce if tokencat != PGE_OPTABLE_PRELIST goto end ## The shift/reduce loop shift_reduce: $I0 = elements tokenstack if $I0 > 0 goto shift_reduce_1 if tokencat == PGE_OPTABLE_CLOSE goto end # (E3) topcat = PGE_OPTABLE_EMPTY goto oper_shift # (S3) shift_reduce_1: top = tokenstack[-1] topcat = top['syncat'] if topcat == PGE_OPTABLE_POSTFIX goto oper_reduce # (R4) if tokencat == PGE_OPTABLE_CLOSE goto oper_close # (R5, C5) if topcat >= PGE_OPTABLE_POSTCIRCUMFIX goto oper_shift # (S6) $P0 = token['precedence'] $P1 = top['precclose'] if $P0 > $P1 goto oper_shift # (P) if topcat != PGE_OPTABLE_TERNARY goto shift_reduce_2 if tokencat != PGE_OPTABLE_TERNARY goto err_ternary # (P/E) goto oper_shift shift_reduce_2: if $P0 < $P1 goto oper_reduce $P2 = top['assoc'] if $P2 == 'right' goto oper_shift # (P/A) oper_reduce: local_branch cstack, reduce goto shift_reduce oper_close: ## if the top operator isn't a circumfix, reduce it ## if the close token doesn't match circumfix close, end here ## else shift (fall-through) if topcat < PGE_OPTABLE_TERNARY goto oper_reduce # (R5) $S0 = top['keyclose'] if key != $S0 goto end dec circumnest oper_shift: ## shift operator onto the operator stack push tokenstack, token push operstack, oper pos = oper.'to'() ## for circumfix ops, increase the circumfix nesting level $I0 = isgt tokencat, PGE_OPTABLE_POSTCIRCUMFIX circumnest += $I0 expect = token['expect'] expect = shr expect, 8 goto token_next term_shift: push termstack, oper pos = oper.'to'() expect = token['expect'] expect = shr expect, 8 goto token_next ## reduce top operation on stack reduce: top = pop tokenstack $P1 = pop operstack topcat = top['syncat'] if topcat == PGE_OPTABLE_CLOSE goto reduce_close if topcat < PGE_OPTABLE_POSTCIRCUMFIX goto reduce_normal ## we have an unbalanced open, so error. remove the ## incomplete circumfixed term, and for circumfix: opers ## put a failed nullterm onto the termstack wspos = -1 $P0 = pop termstack if topcat != PGE_OPTABLE_CIRCUMFIX goto reduce_end oper = mob.'new'(mob) push termstack, oper goto reduce_end reduce_close: top = pop tokenstack $P1 = pop operstack reduce_normal: .local int arity arity = top['arity'] reduce_args: if arity < 1 goto reduce_list $P2 = pop termstack dec arity unless $P2 goto reduce_backtrack $P1[arity] = $P2 goto reduce_args reduce_backtrack: wspos = -1 if arity > 0 goto end push termstack, $P2 goto reduce_end reduce_list: ## combine matching list associative operations $S0 = top['assoc'] if $S0 != 'list' goto reduce_saveterm $S1 = $P1['type'] $S2 = $P2['type'] if $S1 != $S2 goto reduce_saveterm $P0 = $P2.'list'() $P1 = $P1[1] push $P0, $P1 $P1 = $P2 reduce_saveterm: unless rulename goto reduce_saveterm_1 ($P0 :optional, $I0 :opt_flag) = action.rulename($P1, 'reduce') unless $I0 goto reduce_saveterm_1 $P1.'!make'($P0) reduce_saveterm_1: push termstack, $P1 reduce_end: local_return cstack token_match: mpos = pos null oper $I0 = token['expect'] $I0 = $I0 & expect if $I0 == 0 goto token_match_end $I0 = token['nows'] $I0 = $I0 & nows if $I0 goto token_match_end $I0 = exists token['parsed'] if $I0 goto token_match_sub $I0 = length key $I0 += pos $I1 = token['wb'] unless $I1 goto token_match_key $I1 = is_cclass .CCLASS_WORD, target, $I0 if $I1 goto token_match_end token_match_key: $S0 = token['match'] oper = mob.'new'(mob, 'grammar'=>$S0) oper.'to'($I0) goto token_match_success token_match_sub: $P0 = token['parsed'] mob['KEY'] = key mpos = pos $I0 = token['skipkey'] unless $I0 goto token_match_sub_1 $I0 = length key mpos += $I0 token_match_sub_1: oper = $P0(mob, 'action'=>action) delete mob['KEY'] $P0 = oper.'from'() $P0 = pos token_match_success: $P0 = token["name"] $P0 = clone $P0 oper['type'] = $P0 oper['top'] = token token_match_end: local_return cstack ## At end, reduce any remaining tokens and return result term end: $I0 = elements tokenstack if $I0 < 1 goto end_1 local_branch cstack, reduce goto end end_1: mpos = -1 ## if the termstack is empty, fail the match ## if the term is an invalid term, fail the match $I0 = elements termstack if $I0 < 1 goto end_all $P0 = pop termstack unless $P0 goto end_all mob["expr"] = $P0 mpos = wspos if wspos > 0 goto end_2 ## somewhere we encountered an error that caused us to backtrack ## find the "real" ending position here end_1a: $I0 = $P0.'to'() if $I0 <= wspos goto end_1b wspos = $I0 mpos = $I0 end_1b: $P0 = $P0[-1] if null $P0 goto end_2 $I0 = isa $P0, ['PGE';'Match'] if $I0 goto end_1a end_2: unless rulename goto end_all ($P0 :optional, $I0 :opt_flag) = action.rulename(mob, 'end') unless $I0 goto end_all mob.'!make'($P0) end_all: .return (mob) err_ternary: $S1 = pos $S0 = concat 'Ternary error at offset ', $S1 $S0 .= ", found '" $S1 = substr target, pos, 1 $S0 .= $S1 $S0 .= "'" die $S0 .end ### Miscellaneous Notes # # Here's the shift-reduce table used by the C method. # The digits in the table map each state to the corresponding # statement in the C method above. # # stack Current token # ------- ----------------------------------------------------------------- # postfix close prefix prelist infix ternary postcir circfix # empty S3 E3 S1 S3 S3 S3 S3 S2 # postfix R4 R4 X R4 R4 R4 R4 X # close P R5 S1 P P P P P2 # prefix P R5 S1 P P P P S2 # prelist R5 S1 S2 # infix P R5 S1 P P/A P P S2 # ternary P/E C5 S1 P/E P/E P/A P/E S2 # postcir S6 C5 S1 S6 S6 S6 S6 S2 # circfix S6 C5 S1 S6 S6 S6 S6 S2 # # Legend: # S# = shift -- push operator onto token stack # R# = reduce -- pop operator from token stack, and fill it with # the appropriate number of arguments (arity) from the term stack. # Then put the operator token onto the term stack. Reducing a # close token requires popping two operators from the token # stack. Reducing a lone ternary operator is a parse error # (its close token must be present). # P = precedence -- compare the relative precedence of the top # token in the token stack with the current token. # If current is tighter than top, shift. # If current is looser than top, reduce. # P/A = precedence with associativity -- for tokens with equal # precedence, use the associativity of the top token in the # token stack, shift if it's right associative, reduce otherwise. # P/E = higher precedence only -- shift if the current token has # higher precedence than the top token on the stack, otherwise # it's a parse error. # C = close -- If the current token is an appropriate closing # token for the top operator on the token stack, then shift. # Otherwise, it's an unbalanced closing token. # X = unreachable combination # E = either the end of the parse, or a parse error (probably # to be determined by the caller) # =back =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: NQP-s0.pir000644000765000765 322223411606346657 20310 0ustar00brucebruce000000000000parrot-5.9.0/ext/nqp-rx/src/stage0# Copyright (C) 2009, The Perl Foundation. =head1 NAME NQP::Compiler - NQP compiler =head1 DESCRIPTION =cut .sub '' :anon :load :init load_bytecode 'P6Regex.pbc' .end ### .include 'gen/nqp-grammar.pir' .namespace [] .sub "_block1000" :anon :subid("10_1309998847.42912") .annotate 'line', 0 .const 'Sub' $P1003 = "11_1309998847.42912" capture_lex $P1003 .annotate 'line', 1 $P0 = find_dynamic_lex "$*CTXSAVE" if null $P0 goto ctxsave_done $I0 = can $P0, "ctxsave" unless $I0 goto ctxsave_done $P0."ctxsave"() ctxsave_done: .annotate 'line', 4 .const 'Sub' $P1003 = "11_1309998847.42912" capture_lex $P1003 $P102 = $P1003() .annotate 'line', 1 .return ($P102) .const 'Sub' $P1968 = "377_1309998847.42912" .return ($P1968) .end .namespace [] .sub "" :load :init :subid("post378") :outer("10_1309998847.42912") .annotate 'line', 0 .const 'Sub' $P1001 = "10_1309998847.42912" .local pmc block set block, $P1001 $P1970 = get_root_global ["parrot"], "P6metaclass" $P1970."new_class"("NQP::Grammar", "HLL::Grammar" :named("parent")) .end .namespace ["NQP";"Grammar"] .sub "_block1002" :subid("11_1309998847.42912") :outer("10_1309998847.42912") .annotate 'line', 4 .const 'Sub' $P1911 = "355_1309998847.42912" capture_lex $P1911 .const 'Sub' $P1901 = "354_1309998847.42912" capture_lex $P1901 .const 'Sub' $P1896 = "352_1309998847.42912" capture_lex $P1896 .const 'Sub' $P1891 = "350_1309998847.42912" capture_lex $P1891 .const 'Sub' $P1886 = "348_1309998847.42912" capture_lex $P1886 .const 'Sub' $P1881 = "346_1309998847.42912" capture_lex $P1881 .const 'Sub' $P1876 = "344_1309998847.42912" capture_lex $P1876 .const 'Sub' $P1871 = "342_1309998847.42912" capture_lex $P1871 .const 'Sub' $P1866 = "340_1309998847.42912" capture_lex $P1866 .const 'Sub' $P1861 = "338_1309998847.42912" capture_lex $P1861 .const 'Sub' $P1856 = "336_1309998847.42912" capture_lex $P1856 .const 'Sub' $P1852 = "334_1309998847.42912" capture_lex $P1852 .const 'Sub' $P1847 = "332_1309998847.42912" capture_lex $P1847 .const 'Sub' $P1842 = "330_1309998847.42912" capture_lex $P1842 .const 'Sub' $P1837 = "328_1309998847.42912" capture_lex $P1837 .const 'Sub' $P1832 = "326_1309998847.42912" capture_lex $P1832 .const 'Sub' $P1827 = "324_1309998847.42912" capture_lex $P1827 .const 'Sub' $P1822 = "322_1309998847.42912" capture_lex $P1822 .const 'Sub' $P1817 = "320_1309998847.42912" capture_lex $P1817 .const 'Sub' $P1812 = "318_1309998847.42912" capture_lex $P1812 .const 'Sub' $P1807 = "316_1309998847.42912" capture_lex $P1807 .const 'Sub' $P1802 = "314_1309998847.42912" capture_lex $P1802 .const 'Sub' $P1797 = "312_1309998847.42912" capture_lex $P1797 .const 'Sub' $P1792 = "310_1309998847.42912" capture_lex $P1792 .const 'Sub' $P1787 = "308_1309998847.42912" capture_lex $P1787 .const 'Sub' $P1782 = "306_1309998847.42912" capture_lex $P1782 .const 'Sub' $P1777 = "304_1309998847.42912" capture_lex $P1777 .const 'Sub' $P1772 = "302_1309998847.42912" capture_lex $P1772 .const 'Sub' $P1767 = "300_1309998847.42912" capture_lex $P1767 .const 'Sub' $P1762 = "298_1309998847.42912" capture_lex $P1762 .const 'Sub' $P1757 = "296_1309998847.42912" capture_lex $P1757 .const 'Sub' $P1752 = "294_1309998847.42912" capture_lex $P1752 .const 'Sub' $P1747 = "292_1309998847.42912" capture_lex $P1747 .const 'Sub' $P1742 = "290_1309998847.42912" capture_lex $P1742 .const 'Sub' $P1737 = "288_1309998847.42912" capture_lex $P1737 .const 'Sub' $P1732 = "286_1309998847.42912" capture_lex $P1732 .const 'Sub' $P1727 = "284_1309998847.42912" capture_lex $P1727 .const 'Sub' $P1722 = "282_1309998847.42912" capture_lex $P1722 .const 'Sub' $P1717 = "280_1309998847.42912" capture_lex $P1717 .const 'Sub' $P1712 = "278_1309998847.42912" capture_lex $P1712 .const 'Sub' $P1707 = "276_1309998847.42912" capture_lex $P1707 .const 'Sub' $P1702 = "274_1309998847.42912" capture_lex $P1702 .const 'Sub' $P1697 = "272_1309998847.42912" capture_lex $P1697 .const 'Sub' $P1692 = "270_1309998847.42912" capture_lex $P1692 .const 'Sub' $P1687 = "268_1309998847.42912" capture_lex $P1687 .const 'Sub' $P1682 = "266_1309998847.42912" capture_lex $P1682 .const 'Sub' $P1677 = "264_1309998847.42912" capture_lex $P1677 .const 'Sub' $P1672 = "262_1309998847.42912" capture_lex $P1672 .const 'Sub' $P1667 = "260_1309998847.42912" capture_lex $P1667 .const 'Sub' $P1663 = "258_1309998847.42912" capture_lex $P1663 .const 'Sub' $P1659 = "256_1309998847.42912" capture_lex $P1659 .const 'Sub' $P1655 = "254_1309998847.42912" capture_lex $P1655 .const 'Sub' $P1651 = "252_1309998847.42912" capture_lex $P1651 .const 'Sub' $P1647 = "250_1309998847.42912" capture_lex $P1647 .const 'Sub' $P1643 = "248_1309998847.42912" capture_lex $P1643 .const 'Sub' $P1639 = "246_1309998847.42912" capture_lex $P1639 .const 'Sub' $P1635 = "244_1309998847.42912" capture_lex $P1635 .const 'Sub' $P1629 = "242_1309998847.42912" capture_lex $P1629 .const 'Sub' $P1625 = "240_1309998847.42912" capture_lex $P1625 .const 'Sub' $P1621 = "238_1309998847.42912" capture_lex $P1621 .const 'Sub' $P1617 = "236_1309998847.42912" capture_lex $P1617 .const 'Sub' $P1611 = "234_1309998847.42912" capture_lex $P1611 .const 'Sub' $P1605 = "232_1309998847.42912" capture_lex $P1605 .const 'Sub' $P1601 = "230_1309998847.42912" capture_lex $P1601 .const 'Sub' $P1597 = "228_1309998847.42912" capture_lex $P1597 .const 'Sub' $P1593 = "226_1309998847.42912" capture_lex $P1593 .const 'Sub' $P1589 = "224_1309998847.42912" capture_lex $P1589 .const 'Sub' $P1585 = "222_1309998847.42912" capture_lex $P1585 .const 'Sub' $P1581 = "220_1309998847.42912" capture_lex $P1581 .const 'Sub' $P1577 = "218_1309998847.42912" capture_lex $P1577 .const 'Sub' $P1573 = "216_1309998847.42912" capture_lex $P1573 .const 'Sub' $P1569 = "214_1309998847.42912" capture_lex $P1569 .const 'Sub' $P1565 = "212_1309998847.42912" capture_lex $P1565 .const 'Sub' $P1556 = "208_1309998847.42912" capture_lex $P1556 .const 'Sub' $P1551 = "206_1309998847.42912" capture_lex $P1551 .const 'Sub' $P1547 = "204_1309998847.42912" capture_lex $P1547 .const 'Sub' $P1542 = "202_1309998847.42912" capture_lex $P1542 .const 'Sub' $P1538 = "200_1309998847.42912" capture_lex $P1538 .const 'Sub' $P1531 = "198_1309998847.42912" capture_lex $P1531 .const 'Sub' $P1525 = "196_1309998847.42912" capture_lex $P1525 .const 'Sub' $P1521 = "194_1309998847.42912" capture_lex $P1521 .const 'Sub' $P1516 = "192_1309998847.42912" capture_lex $P1516 .const 'Sub' $P1506 = "188_1309998847.42912" capture_lex $P1506 .const 'Sub' $P1495 = "186_1309998847.42912" capture_lex $P1495 .const 'Sub' $P1488 = "184_1309998847.42912" capture_lex $P1488 .const 'Sub' $P1482 = "180_1309998847.42912" capture_lex $P1482 .const 'Sub' $P1478 = "178_1309998847.42912" capture_lex $P1478 .const 'Sub' $P1474 = "176_1309998847.42912" capture_lex $P1474 .const 'Sub' $P1466 = "174_1309998847.42912" capture_lex $P1466 .const 'Sub' $P1454 = "172_1309998847.42912" capture_lex $P1454 .const 'Sub' $P1448 = "170_1309998847.42912" capture_lex $P1448 .const 'Sub' $P1443 = "168_1309998847.42912" capture_lex $P1443 .const 'Sub' $P1436 = "166_1309998847.42912" capture_lex $P1436 .const 'Sub' $P1425 = "162_1309998847.42912" capture_lex $P1425 .const 'Sub' $P1415 = "160_1309998847.42912" capture_lex $P1415 .const 'Sub' $P1410 = "158_1309998847.42912" capture_lex $P1410 .const 'Sub' $P1405 = "156_1309998847.42912" capture_lex $P1405 .const 'Sub' $P1399 = "152_1309998847.42912" capture_lex $P1399 .const 'Sub' $P1394 = "150_1309998847.42912" capture_lex $P1394 .const 'Sub' $P1390 = "148_1309998847.42912" capture_lex $P1390 .const 'Sub' $P1384 = "146_1309998847.42912" capture_lex $P1384 .const 'Sub' $P1379 = "144_1309998847.42912" capture_lex $P1379 .const 'Sub' $P1374 = "142_1309998847.42912" capture_lex $P1374 .const 'Sub' $P1369 = "140_1309998847.42912" capture_lex $P1369 .const 'Sub' $P1361 = "136_1309998847.42912" capture_lex $P1361 .const 'Sub' $P1355 = "134_1309998847.42912" capture_lex $P1355 .const 'Sub' $P1350 = "132_1309998847.42912" capture_lex $P1350 .const 'Sub' $P1344 = "128_1309998847.42912" capture_lex $P1344 .const 'Sub' $P1340 = "126_1309998847.42912" capture_lex $P1340 .const 'Sub' $P1331 = "124_1309998847.42912" capture_lex $P1331 .const 'Sub' $P1323 = "122_1309998847.42912" capture_lex $P1323 .const 'Sub' $P1318 = "120_1309998847.42912" capture_lex $P1318 .const 'Sub' $P1314 = "118_1309998847.42912" capture_lex $P1314 .const 'Sub' $P1310 = "116_1309998847.42912" capture_lex $P1310 .const 'Sub' $P1306 = "114_1309998847.42912" capture_lex $P1306 .const 'Sub' $P1297 = "111_1309998847.42912" capture_lex $P1297 .const 'Sub' $P1293 = "109_1309998847.42912" capture_lex $P1293 .const 'Sub' $P1289 = "107_1309998847.42912" capture_lex $P1289 .const 'Sub' $P1285 = "105_1309998847.42912" capture_lex $P1285 .const 'Sub' $P1281 = "103_1309998847.42912" capture_lex $P1281 .const 'Sub' $P1277 = "101_1309998847.42912" capture_lex $P1277 .const 'Sub' $P1273 = "99_1309998847.42912" capture_lex $P1273 .const 'Sub' $P1268 = "97_1309998847.42912" capture_lex $P1268 .const 'Sub' $P1263 = "95_1309998847.42912" capture_lex $P1263 .const 'Sub' $P1258 = "93_1309998847.42912" capture_lex $P1258 .const 'Sub' $P1251 = "89_1309998847.42912" capture_lex $P1251 .const 'Sub' $P1246 = "87_1309998847.42912" capture_lex $P1246 .const 'Sub' $P1239 = "83_1309998847.42912" capture_lex $P1239 .const 'Sub' $P1234 = "81_1309998847.42912" capture_lex $P1234 .const 'Sub' $P1229 = "79_1309998847.42912" capture_lex $P1229 .const 'Sub' $P1222 = "75_1309998847.42912" capture_lex $P1222 .const 'Sub' $P1217 = "73_1309998847.42912" capture_lex $P1217 .const 'Sub' $P1212 = "71_1309998847.42912" capture_lex $P1212 .const 'Sub' $P1202 = "69_1309998847.42912" capture_lex $P1202 .const 'Sub' $P1196 = "67_1309998847.42912" capture_lex $P1196 .const 'Sub' $P1186 = "64_1309998847.42912" capture_lex $P1186 .const 'Sub' $P1179 = "62_1309998847.42912" capture_lex $P1179 .const 'Sub' $P1173 = "58_1309998847.42912" capture_lex $P1173 .const 'Sub' $P1169 = "56_1309998847.42912" capture_lex $P1169 .const 'Sub' $P1163 = "52_1309998847.42912" capture_lex $P1163 .const 'Sub' $P1159 = "50_1309998847.42912" capture_lex $P1159 .const 'Sub' $P1155 = "48_1309998847.42912" capture_lex $P1155 .const 'Sub' $P1149 = "46_1309998847.42912" capture_lex $P1149 .const 'Sub' $P1144 = "44_1309998847.42912" capture_lex $P1144 .const 'Sub' $P1139 = "42_1309998847.42912" capture_lex $P1139 .const 'Sub' $P1134 = "40_1309998847.42912" capture_lex $P1134 .const 'Sub' $P1130 = "38_1309998847.42912" capture_lex $P1130 .const 'Sub' $P1125 = "36_1309998847.42912" capture_lex $P1125 .const 'Sub' $P1111 = "33_1309998847.42912" capture_lex $P1111 .const 'Sub' $P1105 = "31_1309998847.42912" capture_lex $P1105 .const 'Sub' $P1100 = "29_1309998847.42912" capture_lex $P1100 .const 'Sub' $P1063 = "26_1309998847.42912" capture_lex $P1063 .const 'Sub' $P1049 = "23_1309998847.42912" capture_lex $P1049 .const 'Sub' $P1039 = "21_1309998847.42912" capture_lex $P1039 .const 'Sub' $P1028 = "19_1309998847.42912" capture_lex $P1028 .const 'Sub' $P1022 = "17_1309998847.42912" capture_lex $P1022 .const 'Sub' $P1016 = "15_1309998847.42912" capture_lex $P1016 .const 'Sub' $P1011 = "13_1309998847.42912" capture_lex $P1011 .const 'Sub' $P1004 = "12_1309998847.42912" capture_lex $P1004 $P0 = find_dynamic_lex "$*CTXSAVE" if null $P0 goto ctxsave_done $I0 = can $P0, "ctxsave" unless $I0 goto ctxsave_done $P0."ctxsave"() ctxsave_done: .annotate 'line', 575 .const 'Sub' $P1911 = "355_1309998847.42912" capture_lex $P1911 $P100 = $P1911() .annotate 'line', 4 .return ($P100) .const 'Sub' $P1964 = "376_1309998847.42912" .return ($P1964) .end .namespace ["NQP";"Grammar"] .sub "" :load :init :subid("post379") :outer("11_1309998847.42912") .annotate 'line', 4 .const 'Sub' $P1003 = "11_1309998847.42912" .local pmc block set block, $P1003 .annotate 'line', 456 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc", "%methodop") .annotate 'line', 457 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc", "%autoincrement") .annotate 'line', 458 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc", "%exponentiation") .annotate 'line', 459 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc", "%symbolic_unary") .annotate 'line', 460 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc", "%multiplicative") .annotate 'line', 461 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc", "%additive") .annotate 'line', 462 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc", "%concatenation") .annotate 'line', 463 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc", "%relational") .annotate 'line', 464 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc", "%tight_and") .annotate 'line', 465 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc", "%tight_or") .annotate 'line', 466 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc", "%conditional") .annotate 'line', 467 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc", "%assignment") .annotate 'line', 468 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc, :nextterm", "%comma") .annotate 'line', 469 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc", "%list_infix") .annotate 'line', 470 get_hll_global $P102, ["NQP"], "Grammar" $P102."O"(":prec, :assoc", "%list_prefix") .annotate 'line', 455 $P1966 = get_root_global ["parrot"], "P6metaclass" $P1966."new_class"("NQP::Regex", "Regex::P6Regex::Grammar" :named("parent")) .end .namespace ["NQP";"Grammar"] .include "except_types.pasm" .sub "TOP" :subid("12_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 new $P1006, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1006, control_1005 push_eh $P1006 .lex "self", self .annotate 'line', 5 $P1008 = root_new ['parrot';'Hash'] set $P1007, $P1008 .lex "%*LANG", $P1007 .annotate 'line', 10 new $P100, "Undef" set $P1009, $P100 .lex "$*SCOPE", $P1009 .annotate 'line', 11 new $P101, "Undef" set $P1010, $P101 .lex "$*MULTINESS", $P1010 .annotate 'line', 4 find_lex $P102, "%*LANG" unless_null $P102, vivify_380 get_hll_global $P102, "%LANG" unless_null $P102, vivify_381 die "Contextual %*LANG not found" vivify_381: vivify_380: .annotate 'line', 6 get_hll_global $P102, ["NQP"], "Regex" find_lex $P103, "%*LANG" unless_null $P103, vivify_382 get_hll_global $P103, "%LANG" unless_null $P103, vivify_383 die "Contextual %*LANG not found" vivify_383: store_lex "%*LANG", $P103 vivify_382: set $P103["Regex"], $P102 .annotate 'line', 7 get_hll_global $P102, ["NQP"], "RegexActions" find_lex $P103, "%*LANG" unless_null $P103, vivify_384 get_hll_global $P103, "%LANG" unless_null $P103, vivify_385 die "Contextual %*LANG not found" vivify_385: store_lex "%*LANG", $P103 vivify_384: set $P103["Regex-actions"], $P102 .annotate 'line', 8 get_hll_global $P102, ["NQP"], "Grammar" find_lex $P103, "%*LANG" unless_null $P103, vivify_386 get_hll_global $P103, "%LANG" unless_null $P103, vivify_387 die "Contextual %*LANG not found" vivify_387: store_lex "%*LANG", $P103 vivify_386: set $P103["MAIN"], $P102 .annotate 'line', 9 get_hll_global $P102, ["NQP"], "Actions" find_lex $P103, "%*LANG" unless_null $P103, vivify_388 get_hll_global $P103, "%LANG" unless_null $P103, vivify_389 die "Contextual %*LANG not found" vivify_389: store_lex "%*LANG", $P103 vivify_388: set $P103["MAIN-actions"], $P102 .annotate 'line', 10 new $P102, "String" assign $P102, "" store_lex "$*SCOPE", $P102 .annotate 'line', 11 new $P102, "String" assign $P102, "" store_lex "$*MULTINESS", $P102 .annotate 'line', 12 find_lex $P102, "self" $P103 = $P102."comp_unit"() .annotate 'line', 4 .return ($P103) control_1005: .local pmc exception .get_results (exception) getattribute $P102, exception, "payload" .return ($P102) .end .namespace ["NQP";"Grammar"] .sub "identifier" :subid("13_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1012_tgt .local int rx1012_pos .local int rx1012_off .local int rx1012_eos .local int rx1012_rep .local pmc rx1012_cur .local pmc rx1012_debug (rx1012_cur, rx1012_pos, rx1012_tgt, $I10) = self."!cursor_start"() getattribute rx1012_debug, rx1012_cur, "$!debug" .lex unicode:"$\x{a2}", rx1012_cur .local pmc match .lex "$/", match length rx1012_eos, rx1012_tgt gt rx1012_pos, rx1012_eos, rx1012_done set rx1012_off, 0 lt rx1012_pos, 2, rx1012_start sub rx1012_off, rx1012_pos, 1 substr rx1012_tgt, rx1012_tgt, rx1012_off rx1012_start: eq $I10, 1, rx1012_restart if_null rx1012_debug, debug_390 rx1012_cur."!cursor_debug"("START", "identifier") debug_390: $I10 = self.'from'() ne $I10, -1, rxscan1014_done goto rxscan1014_scan rxscan1014_loop: ($P10) = rx1012_cur."from"() inc $P10 set rx1012_pos, $P10 ge rx1012_pos, rx1012_eos, rxscan1014_done rxscan1014_scan: set_addr $I10, rxscan1014_loop rx1012_cur."!mark_push"(0, rx1012_pos, $I10) rxscan1014_done: .annotate 'line', 17 # rx subrule "ident" subtype=method negate= rx1012_cur."!cursor_pos"(rx1012_pos) $P10 = rx1012_cur."ident"() unless $P10, rx1012_fail rx1012_pos = $P10."pos"() # rx rxquantr1015 ** 0..* set_addr $I10, rxquantr1015_done rx1012_cur."!mark_push"(0, rx1012_pos, $I10) rxquantr1015_loop: # rx enumcharlist negate=0 ge rx1012_pos, rx1012_eos, rx1012_fail sub $I10, rx1012_pos, rx1012_off substr $S10, rx1012_tgt, $I10, 1 index $I11, "-'", $S10 lt $I11, 0, rx1012_fail inc rx1012_pos # rx subrule "ident" subtype=method negate= rx1012_cur."!cursor_pos"(rx1012_pos) $P10 = rx1012_cur."ident"() unless $P10, rx1012_fail rx1012_pos = $P10."pos"() set_addr $I10, rxquantr1015_done (rx1012_rep) = rx1012_cur."!mark_commit"($I10) set_addr $I10, rxquantr1015_done rx1012_cur."!mark_push"(rx1012_rep, rx1012_pos, $I10) goto rxquantr1015_loop rxquantr1015_done: # rx pass rx1012_cur."!cursor_pass"(rx1012_pos, "identifier") if_null rx1012_debug, debug_391 rx1012_cur."!cursor_debug"("PASS", "identifier", " at pos=", rx1012_pos) debug_391: .return (rx1012_cur) rx1012_restart: .annotate 'line', 4 if_null rx1012_debug, debug_392 rx1012_cur."!cursor_debug"("NEXT", "identifier") debug_392: rx1012_fail: (rx1012_rep, rx1012_pos, $I10, $P10) = rx1012_cur."!mark_fail"(0) lt rx1012_pos, -1, rx1012_done eq rx1012_pos, -1, rx1012_fail jump $I10 rx1012_done: rx1012_cur."!cursor_fail"() if_null rx1012_debug, debug_393 rx1012_cur."!cursor_debug"("FAIL", "identifier") debug_393: .return (rx1012_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__identifier" :subid("14_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ident", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "name" :subid("15_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1017_tgt .local int rx1017_pos .local int rx1017_off .local int rx1017_eos .local int rx1017_rep .local pmc rx1017_cur .local pmc rx1017_debug (rx1017_cur, rx1017_pos, rx1017_tgt, $I10) = self."!cursor_start"() rx1017_cur."!cursor_caparray"("identifier") getattribute rx1017_debug, rx1017_cur, "$!debug" .lex unicode:"$\x{a2}", rx1017_cur .local pmc match .lex "$/", match length rx1017_eos, rx1017_tgt gt rx1017_pos, rx1017_eos, rx1017_done set rx1017_off, 0 lt rx1017_pos, 2, rx1017_start sub rx1017_off, rx1017_pos, 1 substr rx1017_tgt, rx1017_tgt, rx1017_off rx1017_start: eq $I10, 1, rx1017_restart if_null rx1017_debug, debug_394 rx1017_cur."!cursor_debug"("START", "name") debug_394: $I10 = self.'from'() ne $I10, -1, rxscan1019_done goto rxscan1019_scan rxscan1019_loop: ($P10) = rx1017_cur."from"() inc $P10 set rx1017_pos, $P10 ge rx1017_pos, rx1017_eos, rxscan1019_done rxscan1019_scan: set_addr $I10, rxscan1019_loop rx1017_cur."!mark_push"(0, rx1017_pos, $I10) rxscan1019_done: .annotate 'line', 19 # rx rxquantr1020 ** 1..* set_addr $I10, rxquantr1020_done rx1017_cur."!mark_push"(0, -1, $I10) rxquantr1020_loop: # rx subrule "identifier" subtype=capture negate= rx1017_cur."!cursor_pos"(rx1017_pos) $P10 = rx1017_cur."identifier"() unless $P10, rx1017_fail goto rxsubrule1021_pass rxsubrule1021_back: $P10 = $P10."!cursor_next"() unless $P10, rx1017_fail rxsubrule1021_pass: set_addr $I10, rxsubrule1021_back rx1017_cur."!mark_push"(0, rx1017_pos, $I10, $P10) $P10."!cursor_names"("identifier") rx1017_pos = $P10."pos"() set_addr $I10, rxquantr1020_done (rx1017_rep) = rx1017_cur."!mark_commit"($I10) set_addr $I10, rxquantr1020_done rx1017_cur."!mark_push"(rx1017_rep, rx1017_pos, $I10) # rx literal "::" add $I11, rx1017_pos, 2 gt $I11, rx1017_eos, rx1017_fail sub $I11, rx1017_pos, rx1017_off substr $S10, rx1017_tgt, $I11, 2 ne $S10, "::", rx1017_fail add rx1017_pos, 2 goto rxquantr1020_loop rxquantr1020_done: # rx pass rx1017_cur."!cursor_pass"(rx1017_pos, "name") if_null rx1017_debug, debug_395 rx1017_cur."!cursor_debug"("PASS", "name", " at pos=", rx1017_pos) debug_395: .return (rx1017_cur) rx1017_restart: .annotate 'line', 4 if_null rx1017_debug, debug_396 rx1017_cur."!cursor_debug"("NEXT", "name") debug_396: rx1017_fail: (rx1017_rep, rx1017_pos, $I10, $P10) = rx1017_cur."!mark_fail"(0) lt rx1017_pos, -1, rx1017_done eq rx1017_pos, -1, rx1017_fail jump $I10 rx1017_done: rx1017_cur."!cursor_fail"() if_null rx1017_debug, debug_397 rx1017_cur."!cursor_debug"("FAIL", "name") debug_397: .return (rx1017_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__name" :subid("16_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "deflongname" :subid("17_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1023_tgt .local int rx1023_pos .local int rx1023_off .local int rx1023_eos .local int rx1023_rep .local pmc rx1023_cur .local pmc rx1023_debug (rx1023_cur, rx1023_pos, rx1023_tgt, $I10) = self."!cursor_start"() rx1023_cur."!cursor_caparray"("colonpair") getattribute rx1023_debug, rx1023_cur, "$!debug" .lex unicode:"$\x{a2}", rx1023_cur .local pmc match .lex "$/", match length rx1023_eos, rx1023_tgt gt rx1023_pos, rx1023_eos, rx1023_done set rx1023_off, 0 lt rx1023_pos, 2, rx1023_start sub rx1023_off, rx1023_pos, 1 substr rx1023_tgt, rx1023_tgt, rx1023_off rx1023_start: eq $I10, 1, rx1023_restart if_null rx1023_debug, debug_398 rx1023_cur."!cursor_debug"("START", "deflongname") debug_398: $I10 = self.'from'() ne $I10, -1, rxscan1025_done goto rxscan1025_scan rxscan1025_loop: ($P10) = rx1023_cur."from"() inc $P10 set rx1023_pos, $P10 ge rx1023_pos, rx1023_eos, rxscan1025_done rxscan1025_scan: set_addr $I10, rxscan1025_loop rx1023_cur."!mark_push"(0, rx1023_pos, $I10) rxscan1025_done: .annotate 'line', 22 # rx subrule "identifier" subtype=capture negate= rx1023_cur."!cursor_pos"(rx1023_pos) $P10 = rx1023_cur."identifier"() unless $P10, rx1023_fail rx1023_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("identifier") rx1023_pos = $P10."pos"() # rx rxquantr1026 ** 0..1 set_addr $I10, rxquantr1026_done rx1023_cur."!mark_push"(0, rx1023_pos, $I10) rxquantr1026_loop: # rx subrule "colonpair" subtype=capture negate= rx1023_cur."!cursor_pos"(rx1023_pos) $P10 = rx1023_cur."colonpair"() unless $P10, rx1023_fail goto rxsubrule1027_pass rxsubrule1027_back: $P10 = $P10."!cursor_next"() unless $P10, rx1023_fail rxsubrule1027_pass: set_addr $I10, rxsubrule1027_back rx1023_cur."!mark_push"(0, rx1023_pos, $I10, $P10) $P10."!cursor_names"("colonpair") rx1023_pos = $P10."pos"() set_addr $I10, rxquantr1026_done (rx1023_rep) = rx1023_cur."!mark_commit"($I10) rxquantr1026_done: .annotate 'line', 21 # rx pass rx1023_cur."!cursor_pass"(rx1023_pos, "deflongname") if_null rx1023_debug, debug_399 rx1023_cur."!cursor_debug"("PASS", "deflongname", " at pos=", rx1023_pos) debug_399: .return (rx1023_cur) rx1023_restart: .annotate 'line', 4 if_null rx1023_debug, debug_400 rx1023_cur."!cursor_debug"("NEXT", "deflongname") debug_400: rx1023_fail: (rx1023_rep, rx1023_pos, $I10, $P10) = rx1023_cur."!mark_fail"(0) lt rx1023_pos, -1, rx1023_done eq rx1023_pos, -1, rx1023_fail jump $I10 rx1023_done: rx1023_cur."!cursor_fail"() if_null rx1023_debug, debug_401 rx1023_cur."!cursor_debug"("FAIL", "deflongname") debug_401: .return (rx1023_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__deflongname" :subid("18_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("identifier", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "ENDSTMT" :subid("19_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1029_tgt .local int rx1029_pos .local int rx1029_off .local int rx1029_eos .local int rx1029_rep .local pmc rx1029_cur .local pmc rx1029_debug (rx1029_cur, rx1029_pos, rx1029_tgt, $I10) = self."!cursor_start"() getattribute rx1029_debug, rx1029_cur, "$!debug" .lex unicode:"$\x{a2}", rx1029_cur .local pmc match .lex "$/", match length rx1029_eos, rx1029_tgt gt rx1029_pos, rx1029_eos, rx1029_done set rx1029_off, 0 lt rx1029_pos, 2, rx1029_start sub rx1029_off, rx1029_pos, 1 substr rx1029_tgt, rx1029_tgt, rx1029_off rx1029_start: eq $I10, 1, rx1029_restart if_null rx1029_debug, debug_402 rx1029_cur."!cursor_debug"("START", "ENDSTMT") debug_402: $I10 = self.'from'() ne $I10, -1, rxscan1031_done goto rxscan1031_scan rxscan1031_loop: ($P10) = rx1029_cur."from"() inc $P10 set rx1029_pos, $P10 ge rx1029_pos, rx1029_eos, rxscan1031_done rxscan1031_scan: set_addr $I10, rxscan1031_loop rx1029_cur."!mark_push"(0, rx1029_pos, $I10) rxscan1031_done: .annotate 'line', 29 # rx rxquantr1032 ** 0..1 set_addr $I10, rxquantr1032_done rx1029_cur."!mark_push"(0, rx1029_pos, $I10) rxquantr1032_loop: alt1033_0: .annotate 'line', 26 set_addr $I10, alt1033_1 rx1029_cur."!mark_push"(0, rx1029_pos, $I10) .annotate 'line', 27 # rx enumcharlist_q negate=0 r 0..-1 sub $I10, rx1029_pos, rx1029_off set rx1029_rep, 0 sub $I12, rx1029_eos, rx1029_pos rxenumcharlistq1034_loop: le $I12, 0, rxenumcharlistq1034_done substr $S10, rx1029_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1034_done inc rx1029_rep inc $I10 dec $I12 goto rxenumcharlistq1034_loop rxenumcharlistq1034_done: add rx1029_pos, rx1029_pos, rx1029_rep # rxanchor eol sub $I10, rx1029_pos, rx1029_off is_cclass $I11, 4096, rx1029_tgt, $I10 if $I11, rxanchor1035_done ne rx1029_pos, rx1029_eos, rx1029_fail eq rx1029_pos, 0, rxanchor1035_done dec $I10 is_cclass $I11, 4096, rx1029_tgt, $I10 if $I11, rx1029_fail rxanchor1035_done: # rx subrule "ws" subtype=method negate= rx1029_cur."!cursor_pos"(rx1029_pos) $P10 = rx1029_cur."ws"() unless $P10, rx1029_fail rx1029_pos = $P10."pos"() # rx subrule "MARKER" subtype=zerowidth negate= rx1029_cur."!cursor_pos"(rx1029_pos) $P10 = rx1029_cur."MARKER"("endstmt") unless $P10, rx1029_fail goto alt1033_end alt1033_1: .annotate 'line', 28 # rx rxquantr1036 ** 0..1 set_addr $I10, rxquantr1036_done rx1029_cur."!mark_push"(0, rx1029_pos, $I10) rxquantr1036_loop: # rx subrule "unv" subtype=method negate= rx1029_cur."!cursor_pos"(rx1029_pos) $P10 = rx1029_cur."unv"() unless $P10, rx1029_fail goto rxsubrule1037_pass rxsubrule1037_back: $P10 = $P10."!cursor_next"() unless $P10, rx1029_fail rxsubrule1037_pass: set_addr $I10, rxsubrule1037_back rx1029_cur."!mark_push"(0, rx1029_pos, $I10, $P10) rx1029_pos = $P10."pos"() set_addr $I10, rxquantr1036_done (rx1029_rep) = rx1029_cur."!mark_commit"($I10) rxquantr1036_done: # rxanchor eol sub $I10, rx1029_pos, rx1029_off is_cclass $I11, 4096, rx1029_tgt, $I10 if $I11, rxanchor1038_done ne rx1029_pos, rx1029_eos, rx1029_fail eq rx1029_pos, 0, rxanchor1038_done dec $I10 is_cclass $I11, 4096, rx1029_tgt, $I10 if $I11, rx1029_fail rxanchor1038_done: # rx subrule "ws" subtype=method negate= rx1029_cur."!cursor_pos"(rx1029_pos) $P10 = rx1029_cur."ws"() unless $P10, rx1029_fail rx1029_pos = $P10."pos"() # rx subrule "MARKER" subtype=zerowidth negate= rx1029_cur."!cursor_pos"(rx1029_pos) $P10 = rx1029_cur."MARKER"("endstmt") unless $P10, rx1029_fail alt1033_end: .annotate 'line', 29 set_addr $I10, rxquantr1032_done (rx1029_rep) = rx1029_cur."!mark_commit"($I10) rxquantr1032_done: .annotate 'line', 25 # rx pass rx1029_cur."!cursor_pass"(rx1029_pos, "ENDSTMT") if_null rx1029_debug, debug_403 rx1029_cur."!cursor_debug"("PASS", "ENDSTMT", " at pos=", rx1029_pos) debug_403: .return (rx1029_cur) rx1029_restart: .annotate 'line', 4 if_null rx1029_debug, debug_404 rx1029_cur."!cursor_debug"("NEXT", "ENDSTMT") debug_404: rx1029_fail: (rx1029_rep, rx1029_pos, $I10, $P10) = rx1029_cur."!mark_fail"(0) lt rx1029_pos, -1, rx1029_done eq rx1029_pos, -1, rx1029_fail jump $I10 rx1029_done: rx1029_cur."!cursor_fail"() if_null rx1029_debug, debug_405 rx1029_cur."!cursor_debug"("FAIL", "ENDSTMT") debug_405: .return (rx1029_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__ENDSTMT" :subid("20_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "ws" :subid("21_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1040_tgt .local int rx1040_pos .local int rx1040_off .local int rx1040_eos .local int rx1040_rep .local pmc rx1040_cur .local pmc rx1040_debug (rx1040_cur, rx1040_pos, rx1040_tgt, $I10) = self."!cursor_start"() getattribute rx1040_debug, rx1040_cur, "$!debug" .lex unicode:"$\x{a2}", rx1040_cur .local pmc match .lex "$/", match length rx1040_eos, rx1040_tgt gt rx1040_pos, rx1040_eos, rx1040_done set rx1040_off, 0 lt rx1040_pos, 2, rx1040_start sub rx1040_off, rx1040_pos, 1 substr rx1040_tgt, rx1040_tgt, rx1040_off rx1040_start: eq $I10, 1, rx1040_restart if_null rx1040_debug, debug_406 rx1040_cur."!cursor_debug"("START", "ws") debug_406: $I10 = self.'from'() ne $I10, -1, rxscan1042_done goto rxscan1042_scan rxscan1042_loop: ($P10) = rx1040_cur."from"() inc $P10 set rx1040_pos, $P10 ge rx1040_pos, rx1040_eos, rxscan1042_done rxscan1042_scan: set_addr $I10, rxscan1042_loop rx1040_cur."!mark_push"(0, rx1040_pos, $I10) rxscan1042_done: alt1043_0: .annotate 'line', 32 set_addr $I10, alt1043_1 rx1040_cur."!mark_push"(0, rx1040_pos, $I10) .annotate 'line', 33 # rx subrule "MARKED" subtype=zerowidth negate= rx1040_cur."!cursor_pos"(rx1040_pos) $P10 = rx1040_cur."MARKED"("ws") unless $P10, rx1040_fail goto alt1043_end alt1043_1: .annotate 'line', 34 # rx subrule "ww" subtype=zerowidth negate=1 rx1040_cur."!cursor_pos"(rx1040_pos) $P10 = rx1040_cur."ww"() if $P10, rx1040_fail .annotate 'line', 39 # rx rxquantr1044 ** 0..* set_addr $I10, rxquantr1044_done rx1040_cur."!mark_push"(0, rx1040_pos, $I10) rxquantr1044_loop: alt1045_0: .annotate 'line', 35 set_addr $I10, alt1045_1 rx1040_cur."!mark_push"(0, rx1040_pos, $I10) # rx enumcharlist_q negate=0 r 1..-1 sub $I10, rx1040_pos, rx1040_off set rx1040_rep, 0 sub $I12, rx1040_eos, rx1040_pos rxenumcharlistq1046_loop: le $I12, 0, rxenumcharlistq1046_done substr $S10, rx1040_tgt, $I10, 1 index $I11, unicode:"\n\x{b}\f\r\x{85}\u2028\u2029", $S10 lt $I11, 0, rxenumcharlistq1046_done inc rx1040_rep inc $I10 dec $I12 goto rxenumcharlistq1046_loop rxenumcharlistq1046_done: lt rx1040_rep, 1, rx1040_fail add rx1040_pos, rx1040_pos, rx1040_rep goto alt1045_end alt1045_1: set_addr $I10, alt1045_2 rx1040_cur."!mark_push"(0, rx1040_pos, $I10) .annotate 'line', 36 # rx literal "#" add $I11, rx1040_pos, 1 gt $I11, rx1040_eos, rx1040_fail sub $I11, rx1040_pos, rx1040_off ord $I11, rx1040_tgt, $I11 ne $I11, 35, rx1040_fail add rx1040_pos, 1 # rx charclass_q N r 0..-1 sub $I10, rx1040_pos, rx1040_off find_cclass $I11, 4096, rx1040_tgt, $I10, rx1040_eos add rx1040_pos, rx1040_off, $I11 goto alt1045_end alt1045_2: set_addr $I10, alt1045_3 rx1040_cur."!mark_push"(0, rx1040_pos, $I10) .annotate 'line', 37 # rxanchor bol eq rx1040_pos, 0, rxanchor1047_done ge rx1040_pos, rx1040_eos, rx1040_fail sub $I10, rx1040_pos, rx1040_off dec $I10 is_cclass $I11, 4096, rx1040_tgt, $I10 unless $I11, rx1040_fail rxanchor1047_done: # rx subrule "pod_comment" subtype=method negate= rx1040_cur."!cursor_pos"(rx1040_pos) $P10 = rx1040_cur."pod_comment"() unless $P10, rx1040_fail rx1040_pos = $P10."pos"() goto alt1045_end alt1045_3: .annotate 'line', 38 # rx enumcharlist_q negate=0 r 1..-1 sub $I10, rx1040_pos, rx1040_off set rx1040_rep, 0 sub $I12, rx1040_eos, rx1040_pos rxenumcharlistq1048_loop: le $I12, 0, rxenumcharlistq1048_done substr $S10, rx1040_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1048_done inc rx1040_rep inc $I10 dec $I12 goto rxenumcharlistq1048_loop rxenumcharlistq1048_done: lt rx1040_rep, 1, rx1040_fail add rx1040_pos, rx1040_pos, rx1040_rep alt1045_end: .annotate 'line', 39 set_addr $I10, rxquantr1044_done (rx1040_rep) = rx1040_cur."!mark_commit"($I10) set_addr $I10, rxquantr1044_done rx1040_cur."!mark_push"(rx1040_rep, rx1040_pos, $I10) goto rxquantr1044_loop rxquantr1044_done: .annotate 'line', 40 # rx subrule "MARKER" subtype=zerowidth negate= rx1040_cur."!cursor_pos"(rx1040_pos) $P10 = rx1040_cur."MARKER"("ws") unless $P10, rx1040_fail alt1043_end: .annotate 'line', 32 # rx pass rx1040_cur."!cursor_pass"(rx1040_pos, "ws") if_null rx1040_debug, debug_407 rx1040_cur."!cursor_debug"("PASS", "ws", " at pos=", rx1040_pos) debug_407: .return (rx1040_cur) rx1040_restart: .annotate 'line', 4 if_null rx1040_debug, debug_408 rx1040_cur."!cursor_debug"("NEXT", "ws") debug_408: rx1040_fail: (rx1040_rep, rx1040_pos, $I10, $P10) = rx1040_cur."!mark_fail"(0) lt rx1040_pos, -1, rx1040_done eq rx1040_pos, -1, rx1040_fail jump $I10 rx1040_done: rx1040_cur."!cursor_fail"() if_null rx1040_debug, debug_409 rx1040_cur."!cursor_debug"("FAIL", "ws") debug_409: .return (rx1040_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__ws" :subid("22_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "unv" :subid("23_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .const 'Sub' $P1056 = "25_1309998847.42912" capture_lex $P1056 .local string rx1050_tgt .local int rx1050_pos .local int rx1050_off .local int rx1050_eos .local int rx1050_rep .local pmc rx1050_cur .local pmc rx1050_debug (rx1050_cur, rx1050_pos, rx1050_tgt, $I10) = self."!cursor_start"() getattribute rx1050_debug, rx1050_cur, "$!debug" .lex unicode:"$\x{a2}", rx1050_cur .local pmc match .lex "$/", match length rx1050_eos, rx1050_tgt gt rx1050_pos, rx1050_eos, rx1050_done set rx1050_off, 0 lt rx1050_pos, 2, rx1050_start sub rx1050_off, rx1050_pos, 1 substr rx1050_tgt, rx1050_tgt, rx1050_off rx1050_start: eq $I10, 1, rx1050_restart if_null rx1050_debug, debug_410 rx1050_cur."!cursor_debug"("START", "unv") debug_410: $I10 = self.'from'() ne $I10, -1, rxscan1052_done goto rxscan1052_scan rxscan1052_loop: ($P10) = rx1050_cur."from"() inc $P10 set rx1050_pos, $P10 ge rx1050_pos, rx1050_eos, rxscan1052_done rxscan1052_scan: set_addr $I10, rxscan1052_loop rx1050_cur."!mark_push"(0, rx1050_pos, $I10) rxscan1052_done: alt1053_0: .annotate 'line', 45 set_addr $I10, alt1053_1 rx1050_cur."!mark_push"(0, rx1050_pos, $I10) .annotate 'line', 46 # rxanchor bol eq rx1050_pos, 0, rxanchor1054_done ge rx1050_pos, rx1050_eos, rx1050_fail sub $I10, rx1050_pos, rx1050_off dec $I10 is_cclass $I11, 4096, rx1050_tgt, $I10 unless $I11, rx1050_fail rxanchor1054_done: # rx subrule "before" subtype=zerowidth negate= rx1050_cur."!cursor_pos"(rx1050_pos) .const 'Sub' $P1056 = "25_1309998847.42912" capture_lex $P1056 $P10 = rx1050_cur."before"($P1056) unless $P10, rx1050_fail # rx subrule "pod_comment" subtype=method negate= rx1050_cur."!cursor_pos"(rx1050_pos) $P10 = rx1050_cur."pod_comment"() unless $P10, rx1050_fail rx1050_pos = $P10."pos"() goto alt1053_end alt1053_1: set_addr $I10, alt1053_2 rx1050_cur."!mark_push"(0, rx1050_pos, $I10) .annotate 'line', 47 # rx enumcharlist_q negate=0 r 0..-1 sub $I10, rx1050_pos, rx1050_off set rx1050_rep, 0 sub $I12, rx1050_eos, rx1050_pos rxenumcharlistq1061_loop: le $I12, 0, rxenumcharlistq1061_done substr $S10, rx1050_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1061_done inc rx1050_rep inc $I10 dec $I12 goto rxenumcharlistq1061_loop rxenumcharlistq1061_done: add rx1050_pos, rx1050_pos, rx1050_rep # rx literal "#" add $I11, rx1050_pos, 1 gt $I11, rx1050_eos, rx1050_fail sub $I11, rx1050_pos, rx1050_off ord $I11, rx1050_tgt, $I11 ne $I11, 35, rx1050_fail add rx1050_pos, 1 # rx charclass_q N r 0..-1 sub $I10, rx1050_pos, rx1050_off find_cclass $I11, 4096, rx1050_tgt, $I10, rx1050_eos add rx1050_pos, rx1050_off, $I11 goto alt1053_end alt1053_2: .annotate 'line', 48 # rx enumcharlist_q negate=0 r 1..-1 sub $I10, rx1050_pos, rx1050_off set rx1050_rep, 0 sub $I12, rx1050_eos, rx1050_pos rxenumcharlistq1062_loop: le $I12, 0, rxenumcharlistq1062_done substr $S10, rx1050_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1062_done inc rx1050_rep inc $I10 dec $I12 goto rxenumcharlistq1062_loop rxenumcharlistq1062_done: lt rx1050_rep, 1, rx1050_fail add rx1050_pos, rx1050_pos, rx1050_rep alt1053_end: .annotate 'line', 43 # rx pass rx1050_cur."!cursor_pass"(rx1050_pos, "unv") if_null rx1050_debug, debug_415 rx1050_cur."!cursor_debug"("PASS", "unv", " at pos=", rx1050_pos) debug_415: .return (rx1050_cur) rx1050_restart: .annotate 'line', 4 if_null rx1050_debug, debug_416 rx1050_cur."!cursor_debug"("NEXT", "unv") debug_416: rx1050_fail: (rx1050_rep, rx1050_pos, $I10, $P10) = rx1050_cur."!mark_fail"(0) lt rx1050_pos, -1, rx1050_done eq rx1050_pos, -1, rx1050_fail jump $I10 rx1050_done: rx1050_cur."!cursor_fail"() if_null rx1050_debug, debug_417 rx1050_cur."!cursor_debug"("FAIL", "unv") debug_417: .return (rx1050_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__unv" :subid("24_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" push $P100, "" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "_block1055" :anon :subid("25_1309998847.42912") :method :outer("23_1309998847.42912") .annotate 'line', 46 .local string rx1057_tgt .local int rx1057_pos .local int rx1057_off .local int rx1057_eos .local int rx1057_rep .local pmc rx1057_cur .local pmc rx1057_debug (rx1057_cur, rx1057_pos, rx1057_tgt, $I10) = self."!cursor_start"() getattribute rx1057_debug, rx1057_cur, "$!debug" .lex unicode:"$\x{a2}", rx1057_cur .local pmc match .lex "$/", match length rx1057_eos, rx1057_tgt gt rx1057_pos, rx1057_eos, rx1057_done set rx1057_off, 0 lt rx1057_pos, 2, rx1057_start sub rx1057_off, rx1057_pos, 1 substr rx1057_tgt, rx1057_tgt, rx1057_off rx1057_start: eq $I10, 1, rx1057_restart if_null rx1057_debug, debug_411 rx1057_cur."!cursor_debug"("START", "") debug_411: $I10 = self.'from'() ne $I10, -1, rxscan1058_done goto rxscan1058_scan rxscan1058_loop: ($P10) = rx1057_cur."from"() inc $P10 set rx1057_pos, $P10 ge rx1057_pos, rx1057_eos, rxscan1058_done rxscan1058_scan: set_addr $I10, rxscan1058_loop rx1057_cur."!mark_push"(0, rx1057_pos, $I10) rxscan1058_done: # rx enumcharlist_q negate=0 r 0..-1 sub $I10, rx1057_pos, rx1057_off set rx1057_rep, 0 sub $I12, rx1057_eos, rx1057_pos rxenumcharlistq1059_loop: le $I12, 0, rxenumcharlistq1059_done substr $S10, rx1057_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1059_done inc rx1057_rep inc $I10 dec $I12 goto rxenumcharlistq1059_loop rxenumcharlistq1059_done: add rx1057_pos, rx1057_pos, rx1057_rep # rx literal "=" add $I11, rx1057_pos, 1 gt $I11, rx1057_eos, rx1057_fail sub $I11, rx1057_pos, rx1057_off ord $I11, rx1057_tgt, $I11 ne $I11, 61, rx1057_fail add rx1057_pos, 1 alt1060_0: set_addr $I10, alt1060_1 rx1057_cur."!mark_push"(0, rx1057_pos, $I10) # rx charclass w ge rx1057_pos, rx1057_eos, rx1057_fail sub $I10, rx1057_pos, rx1057_off is_cclass $I11, 8192, rx1057_tgt, $I10 unless $I11, rx1057_fail inc rx1057_pos goto alt1060_end alt1060_1: # rx literal "\\" add $I11, rx1057_pos, 1 gt $I11, rx1057_eos, rx1057_fail sub $I11, rx1057_pos, rx1057_off ord $I11, rx1057_tgt, $I11 ne $I11, 92, rx1057_fail add rx1057_pos, 1 alt1060_end: # rx pass rx1057_cur."!cursor_pass"(rx1057_pos, "") if_null rx1057_debug, debug_412 rx1057_cur."!cursor_debug"("PASS", "", " at pos=", rx1057_pos) debug_412: .return (rx1057_cur) rx1057_restart: if_null rx1057_debug, debug_413 rx1057_cur."!cursor_debug"("NEXT", "") debug_413: rx1057_fail: (rx1057_rep, rx1057_pos, $I10, $P10) = rx1057_cur."!mark_fail"(0) lt rx1057_pos, -1, rx1057_done eq rx1057_pos, -1, rx1057_fail jump $I10 rx1057_done: rx1057_cur."!cursor_fail"() if_null rx1057_debug, debug_414 rx1057_cur."!cursor_debug"("FAIL", "") debug_414: .return (rx1057_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "pod_comment" :subid("26_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .const 'Sub' $P1093 = "28_1309998847.42912" capture_lex $P1093 .local string rx1064_tgt .local int rx1064_pos .local int rx1064_off .local int rx1064_eos .local int rx1064_rep .local pmc rx1064_cur .local pmc rx1064_debug (rx1064_cur, rx1064_pos, rx1064_tgt, $I10) = self."!cursor_start"() getattribute rx1064_debug, rx1064_cur, "$!debug" .lex unicode:"$\x{a2}", rx1064_cur .local pmc match .lex "$/", match length rx1064_eos, rx1064_tgt gt rx1064_pos, rx1064_eos, rx1064_done set rx1064_off, 0 lt rx1064_pos, 2, rx1064_start sub rx1064_off, rx1064_pos, 1 substr rx1064_tgt, rx1064_tgt, rx1064_off rx1064_start: eq $I10, 1, rx1064_restart if_null rx1064_debug, debug_418 rx1064_cur."!cursor_debug"("START", "pod_comment") debug_418: $I10 = self.'from'() ne $I10, -1, rxscan1066_done goto rxscan1066_scan rxscan1066_loop: ($P10) = rx1064_cur."from"() inc $P10 set rx1064_pos, $P10 ge rx1064_pos, rx1064_eos, rxscan1066_done rxscan1066_scan: set_addr $I10, rxscan1066_loop rx1064_cur."!mark_push"(0, rx1064_pos, $I10) rxscan1066_done: .annotate 'line', 53 # rxanchor bol eq rx1064_pos, 0, rxanchor1067_done ge rx1064_pos, rx1064_eos, rx1064_fail sub $I10, rx1064_pos, rx1064_off dec $I10 is_cclass $I11, 4096, rx1064_tgt, $I10 unless $I11, rx1064_fail rxanchor1067_done: # rx enumcharlist_q negate=0 r 0..-1 sub $I10, rx1064_pos, rx1064_off set rx1064_rep, 0 sub $I12, rx1064_eos, rx1064_pos rxenumcharlistq1068_loop: le $I12, 0, rxenumcharlistq1068_done substr $S10, rx1064_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1068_done inc rx1064_rep inc $I10 dec $I12 goto rxenumcharlistq1068_loop rxenumcharlistq1068_done: add rx1064_pos, rx1064_pos, rx1064_rep # rx literal "=" add $I11, rx1064_pos, 1 gt $I11, rx1064_eos, rx1064_fail sub $I11, rx1064_pos, rx1064_off ord $I11, rx1064_tgt, $I11 ne $I11, 61, rx1064_fail add rx1064_pos, 1 alt1069_0: .annotate 'line', 54 set_addr $I10, alt1069_1 rx1064_cur."!mark_push"(0, rx1064_pos, $I10) .annotate 'line', 55 # rx literal "begin" add $I11, rx1064_pos, 5 gt $I11, rx1064_eos, rx1064_fail sub $I11, rx1064_pos, rx1064_off substr $S10, rx1064_tgt, $I11, 5 ne $S10, "begin", rx1064_fail add rx1064_pos, 5 # rx enumcharlist_q negate=0 r 1..-1 sub $I10, rx1064_pos, rx1064_off set rx1064_rep, 0 sub $I12, rx1064_eos, rx1064_pos rxenumcharlistq1070_loop: le $I12, 0, rxenumcharlistq1070_done substr $S10, rx1064_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1070_done inc rx1064_rep inc $I10 dec $I12 goto rxenumcharlistq1070_loop rxenumcharlistq1070_done: lt rx1064_rep, 1, rx1064_fail add rx1064_pos, rx1064_pos, rx1064_rep # rx literal "END" add $I11, rx1064_pos, 3 gt $I11, rx1064_eos, rx1064_fail sub $I11, rx1064_pos, rx1064_off substr $S10, rx1064_tgt, $I11, 3 ne $S10, "END", rx1064_fail add rx1064_pos, 3 # rxanchor rwb le rx1064_pos, 0, rx1064_fail sub $I10, rx1064_pos, rx1064_off is_cclass $I11, 8192, rx1064_tgt, $I10 if $I11, rx1064_fail dec $I10 is_cclass $I11, 8192, rx1064_tgt, $I10 unless $I11, rx1064_fail alt1071_0: .annotate 'line', 56 set_addr $I10, alt1071_1 rx1064_cur."!mark_push"(0, rx1064_pos, $I10) # rx rxquantf1072 ** 0..* set_addr $I10, rxquantf1072_loop rx1064_cur."!mark_push"(0, rx1064_pos, $I10) goto rxquantf1072_done rxquantf1072_loop: # rx charclass . ge rx1064_pos, rx1064_eos, rx1064_fail inc rx1064_pos set_addr $I10, rxquantf1072_loop rx1064_cur."!mark_push"(rx1064_rep, rx1064_pos, $I10) rxquantf1072_done: # rx charclass nl ge rx1064_pos, rx1064_eos, rx1064_fail sub $I10, rx1064_pos, rx1064_off is_cclass $I11, 4096, rx1064_tgt, $I10 unless $I11, rx1064_fail substr $S10, rx1064_tgt, $I10, 2 iseq $I11, $S10, "\r\n" add rx1064_pos, $I11 inc rx1064_pos # rx enumcharlist_q negate=0 r 0..-1 sub $I10, rx1064_pos, rx1064_off set rx1064_rep, 0 sub $I12, rx1064_eos, rx1064_pos rxenumcharlistq1074_loop: le $I12, 0, rxenumcharlistq1074_done substr $S10, rx1064_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1074_done inc rx1064_rep inc $I10 dec $I12 goto rxenumcharlistq1074_loop rxenumcharlistq1074_done: add rx1064_pos, rx1064_pos, rx1064_rep # rx literal "=end" add $I11, rx1064_pos, 4 gt $I11, rx1064_eos, rx1064_fail sub $I11, rx1064_pos, rx1064_off substr $S10, rx1064_tgt, $I11, 4 ne $S10, "=end", rx1064_fail add rx1064_pos, 4 # rx enumcharlist_q negate=0 r 1..-1 sub $I10, rx1064_pos, rx1064_off set rx1064_rep, 0 sub $I12, rx1064_eos, rx1064_pos rxenumcharlistq1075_loop: le $I12, 0, rxenumcharlistq1075_done substr $S10, rx1064_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1075_done inc rx1064_rep inc $I10 dec $I12 goto rxenumcharlistq1075_loop rxenumcharlistq1075_done: lt rx1064_rep, 1, rx1064_fail add rx1064_pos, rx1064_pos, rx1064_rep # rx literal "END" add $I11, rx1064_pos, 3 gt $I11, rx1064_eos, rx1064_fail sub $I11, rx1064_pos, rx1064_off substr $S10, rx1064_tgt, $I11, 3 ne $S10, "END", rx1064_fail add rx1064_pos, 3 # rxanchor rwb le rx1064_pos, 0, rx1064_fail sub $I10, rx1064_pos, rx1064_off is_cclass $I11, 8192, rx1064_tgt, $I10 if $I11, rx1064_fail dec $I10 is_cclass $I11, 8192, rx1064_tgt, $I10 unless $I11, rx1064_fail # rx charclass_q N r 0..-1 sub $I10, rx1064_pos, rx1064_off find_cclass $I11, 4096, rx1064_tgt, $I10, rx1064_eos add rx1064_pos, rx1064_off, $I11 goto alt1071_end alt1071_1: # rx charclass_q . r 0..-1 sub $I10, rx1064_pos, rx1064_off find_not_cclass $I11, 65535, rx1064_tgt, $I10, rx1064_eos add rx1064_pos, rx1064_off, $I11 alt1071_end: .annotate 'line', 55 goto alt1069_end alt1069_1: set_addr $I10, alt1069_2 rx1064_cur."!mark_push"(0, rx1064_pos, $I10) .annotate 'line', 57 # rx literal "begin" add $I11, rx1064_pos, 5 gt $I11, rx1064_eos, rx1064_fail sub $I11, rx1064_pos, rx1064_off substr $S10, rx1064_tgt, $I11, 5 ne $S10, "begin", rx1064_fail add rx1064_pos, 5 # rx enumcharlist_q negate=0 r 1..-1 sub $I10, rx1064_pos, rx1064_off set rx1064_rep, 0 sub $I12, rx1064_eos, rx1064_pos rxenumcharlistq1076_loop: le $I12, 0, rxenumcharlistq1076_done substr $S10, rx1064_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1076_done inc rx1064_rep inc $I10 dec $I12 goto rxenumcharlistq1076_loop rxenumcharlistq1076_done: lt rx1064_rep, 1, rx1064_fail add rx1064_pos, rx1064_pos, rx1064_rep # rx subrule "identifier" subtype=capture negate= rx1064_cur."!cursor_pos"(rx1064_pos) $P10 = rx1064_cur."identifier"() unless $P10, rx1064_fail rx1064_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("identifier") rx1064_pos = $P10."pos"() alt1077_0: .annotate 'line', 58 set_addr $I10, alt1077_1 rx1064_cur."!mark_push"(0, rx1064_pos, $I10) .annotate 'line', 59 # rx rxquantf1078 ** 0..* set_addr $I10, rxquantf1078_loop rx1064_cur."!mark_push"(0, rx1064_pos, $I10) goto rxquantf1078_done rxquantf1078_loop: # rx charclass . ge rx1064_pos, rx1064_eos, rx1064_fail inc rx1064_pos set_addr $I10, rxquantf1078_loop rx1064_cur."!mark_push"(rx1064_rep, rx1064_pos, $I10) rxquantf1078_done: # rx charclass nl ge rx1064_pos, rx1064_eos, rx1064_fail sub $I10, rx1064_pos, rx1064_off is_cclass $I11, 4096, rx1064_tgt, $I10 unless $I11, rx1064_fail substr $S10, rx1064_tgt, $I10, 2 iseq $I11, $S10, "\r\n" add rx1064_pos, $I11 inc rx1064_pos # rx enumcharlist_q negate=0 r 0..-1 sub $I10, rx1064_pos, rx1064_off set rx1064_rep, 0 sub $I12, rx1064_eos, rx1064_pos rxenumcharlistq1080_loop: le $I12, 0, rxenumcharlistq1080_done substr $S10, rx1064_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1080_done inc rx1064_rep inc $I10 dec $I12 goto rxenumcharlistq1080_loop rxenumcharlistq1080_done: add rx1064_pos, rx1064_pos, rx1064_rep # rx literal "=end" add $I11, rx1064_pos, 4 gt $I11, rx1064_eos, rx1064_fail sub $I11, rx1064_pos, rx1064_off substr $S10, rx1064_tgt, $I11, 4 ne $S10, "=end", rx1064_fail add rx1064_pos, 4 # rx enumcharlist_q negate=0 r 1..-1 sub $I10, rx1064_pos, rx1064_off set rx1064_rep, 0 sub $I12, rx1064_eos, rx1064_pos rxenumcharlistq1081_loop: le $I12, 0, rxenumcharlistq1081_done substr $S10, rx1064_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1081_done inc rx1064_rep inc $I10 dec $I12 goto rxenumcharlistq1081_loop rxenumcharlistq1081_done: lt rx1064_rep, 1, rx1064_fail add rx1064_pos, rx1064_pos, rx1064_rep # rx subrule "!BACKREF" subtype=method negate= rx1064_cur."!cursor_pos"(rx1064_pos) $P10 = rx1064_cur."!BACKREF"("identifier") unless $P10, rx1064_fail rx1064_pos = $P10."pos"() # rxanchor rwb le rx1064_pos, 0, rx1064_fail sub $I10, rx1064_pos, rx1064_off is_cclass $I11, 8192, rx1064_tgt, $I10 if $I11, rx1064_fail dec $I10 is_cclass $I11, 8192, rx1064_tgt, $I10 unless $I11, rx1064_fail # rx charclass_q N r 0..-1 sub $I10, rx1064_pos, rx1064_off find_cclass $I11, 4096, rx1064_tgt, $I10, rx1064_eos add rx1064_pos, rx1064_off, $I11 goto alt1077_end alt1077_1: .annotate 'line', 60 # rx subrule "panic" subtype=method negate= rx1064_cur."!cursor_pos"(rx1064_pos) $P10 = rx1064_cur."panic"("=begin without matching =end") unless $P10, rx1064_fail rx1064_pos = $P10."pos"() alt1077_end: .annotate 'line', 57 goto alt1069_end alt1069_2: set_addr $I10, alt1069_3 rx1064_cur."!mark_push"(0, rx1064_pos, $I10) .annotate 'line', 62 # rx literal "begin" add $I11, rx1064_pos, 5 gt $I11, rx1064_eos, rx1064_fail sub $I11, rx1064_pos, rx1064_off substr $S10, rx1064_tgt, $I11, 5 ne $S10, "begin", rx1064_fail add rx1064_pos, 5 # rxanchor rwb le rx1064_pos, 0, rx1064_fail sub $I10, rx1064_pos, rx1064_off is_cclass $I11, 8192, rx1064_tgt, $I10 if $I11, rx1064_fail dec $I10 is_cclass $I11, 8192, rx1064_tgt, $I10 unless $I11, rx1064_fail # rx enumcharlist_q negate=0 r 0..-1 sub $I10, rx1064_pos, rx1064_off set rx1064_rep, 0 sub $I12, rx1064_eos, rx1064_pos rxenumcharlistq1082_loop: le $I12, 0, rxenumcharlistq1082_done substr $S10, rx1064_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1082_done inc rx1064_rep inc $I10 dec $I12 goto rxenumcharlistq1082_loop rxenumcharlistq1082_done: add rx1064_pos, rx1064_pos, rx1064_rep alt1083_0: .annotate 'line', 63 set_addr $I10, alt1083_1 rx1064_cur."!mark_push"(0, rx1064_pos, $I10) # rxanchor eol sub $I10, rx1064_pos, rx1064_off is_cclass $I11, 4096, rx1064_tgt, $I10 if $I11, rxanchor1084_done ne rx1064_pos, rx1064_eos, rx1064_fail eq rx1064_pos, 0, rxanchor1084_done dec $I10 is_cclass $I11, 4096, rx1064_tgt, $I10 if $I11, rx1064_fail rxanchor1084_done: goto alt1083_end alt1083_1: set_addr $I10, alt1083_2 rx1064_cur."!mark_push"(0, rx1064_pos, $I10) # rx literal "#" add $I11, rx1064_pos, 1 gt $I11, rx1064_eos, rx1064_fail sub $I11, rx1064_pos, rx1064_off ord $I11, rx1064_tgt, $I11 ne $I11, 35, rx1064_fail add rx1064_pos, 1 goto alt1083_end alt1083_2: # rx subrule "panic" subtype=method negate= rx1064_cur."!cursor_pos"(rx1064_pos) $P10 = rx1064_cur."panic"("Unrecognized token after =begin") unless $P10, rx1064_fail rx1064_pos = $P10."pos"() alt1083_end: alt1085_0: .annotate 'line', 64 set_addr $I10, alt1085_1 rx1064_cur."!mark_push"(0, rx1064_pos, $I10) .annotate 'line', 65 # rx rxquantf1086 ** 0..* set_addr $I10, rxquantf1086_loop rx1064_cur."!mark_push"(0, rx1064_pos, $I10) goto rxquantf1086_done rxquantf1086_loop: # rx charclass . ge rx1064_pos, rx1064_eos, rx1064_fail inc rx1064_pos set_addr $I10, rxquantf1086_loop rx1064_cur."!mark_push"(rx1064_rep, rx1064_pos, $I10) rxquantf1086_done: # rx charclass nl ge rx1064_pos, rx1064_eos, rx1064_fail sub $I10, rx1064_pos, rx1064_off is_cclass $I11, 4096, rx1064_tgt, $I10 unless $I11, rx1064_fail substr $S10, rx1064_tgt, $I10, 2 iseq $I11, $S10, "\r\n" add rx1064_pos, $I11 inc rx1064_pos # rx enumcharlist_q negate=0 r 0..-1 sub $I10, rx1064_pos, rx1064_off set rx1064_rep, 0 sub $I12, rx1064_eos, rx1064_pos rxenumcharlistq1088_loop: le $I12, 0, rxenumcharlistq1088_done substr $S10, rx1064_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1088_done inc rx1064_rep inc $I10 dec $I12 goto rxenumcharlistq1088_loop rxenumcharlistq1088_done: add rx1064_pos, rx1064_pos, rx1064_rep # rx literal "=end" add $I11, rx1064_pos, 4 gt $I11, rx1064_eos, rx1064_fail sub $I11, rx1064_pos, rx1064_off substr $S10, rx1064_tgt, $I11, 4 ne $S10, "=end", rx1064_fail add rx1064_pos, 4 # rxanchor rwb le rx1064_pos, 0, rx1064_fail sub $I10, rx1064_pos, rx1064_off is_cclass $I11, 8192, rx1064_tgt, $I10 if $I11, rx1064_fail dec $I10 is_cclass $I11, 8192, rx1064_tgt, $I10 unless $I11, rx1064_fail # rx charclass_q N r 0..-1 sub $I10, rx1064_pos, rx1064_off find_cclass $I11, 4096, rx1064_tgt, $I10, rx1064_eos add rx1064_pos, rx1064_off, $I11 goto alt1085_end alt1085_1: .annotate 'line', 66 # rx subrule "panic" subtype=method negate= rx1064_cur."!cursor_pos"(rx1064_pos) $P10 = rx1064_cur."panic"("=begin without matching =end") unless $P10, rx1064_fail rx1064_pos = $P10."pos"() alt1085_end: .annotate 'line', 62 goto alt1069_end alt1069_3: set_addr $I10, alt1069_4 rx1064_cur."!mark_push"(0, rx1064_pos, $I10) .annotate 'line', 68 # rx subrule "identifier" subtype=capture negate= rx1064_cur."!cursor_pos"(rx1064_pos) $P10 = rx1064_cur."identifier"() unless $P10, rx1064_fail rx1064_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("identifier") rx1064_pos = $P10."pos"() .annotate 'line', 69 # rx rxquantf1089 ** 0..* set_addr $I10, rxquantf1089_loop rx1064_cur."!mark_push"(0, rx1064_pos, $I10) goto rxquantf1089_done rxquantf1089_loop: # rx charclass . ge rx1064_pos, rx1064_eos, rx1064_fail inc rx1064_pos set_addr $I10, rxquantf1089_loop rx1064_cur."!mark_push"(rx1064_rep, rx1064_pos, $I10) rxquantf1089_done: # rxanchor bol eq rx1064_pos, 0, rxanchor1091_done ge rx1064_pos, rx1064_eos, rx1064_fail sub $I10, rx1064_pos, rx1064_off dec $I10 is_cclass $I11, 4096, rx1064_tgt, $I10 unless $I11, rx1064_fail rxanchor1091_done: # rx subrule "before" subtype=zerowidth negate= rx1064_cur."!cursor_pos"(rx1064_pos) .const 'Sub' $P1093 = "28_1309998847.42912" capture_lex $P1093 $P10 = rx1064_cur."before"($P1093) unless $P10, rx1064_fail .annotate 'line', 68 goto alt1069_end alt1069_4: alt1099_0: .annotate 'line', 75 set_addr $I10, alt1099_1 rx1064_cur."!mark_push"(0, rx1064_pos, $I10) # rx charclass s ge rx1064_pos, rx1064_eos, rx1064_fail sub $I10, rx1064_pos, rx1064_off is_cclass $I11, 32, rx1064_tgt, $I10 unless $I11, rx1064_fail inc rx1064_pos goto alt1099_end alt1099_1: # rx subrule "panic" subtype=method negate= rx1064_cur."!cursor_pos"(rx1064_pos) $P10 = rx1064_cur."panic"("Illegal pod directive") unless $P10, rx1064_fail rx1064_pos = $P10."pos"() alt1099_end: .annotate 'line', 76 # rx charclass_q N r 0..-1 sub $I10, rx1064_pos, rx1064_off find_cclass $I11, 4096, rx1064_tgt, $I10, rx1064_eos add rx1064_pos, rx1064_off, $I11 alt1069_end: .annotate 'line', 52 # rx pass rx1064_cur."!cursor_pass"(rx1064_pos, "pod_comment") if_null rx1064_debug, debug_423 rx1064_cur."!cursor_debug"("PASS", "pod_comment", " at pos=", rx1064_pos) debug_423: .return (rx1064_cur) rx1064_restart: .annotate 'line', 4 if_null rx1064_debug, debug_424 rx1064_cur."!cursor_debug"("NEXT", "pod_comment") debug_424: rx1064_fail: (rx1064_rep, rx1064_pos, $I10, $P10) = rx1064_cur."!mark_fail"(0) lt rx1064_pos, -1, rx1064_done eq rx1064_pos, -1, rx1064_fail jump $I10 rx1064_done: rx1064_cur."!cursor_fail"() if_null rx1064_debug, debug_425 rx1064_cur."!cursor_debug"("FAIL", "pod_comment") debug_425: .return (rx1064_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__pod_comment" :subid("27_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "_block1092" :anon :subid("28_1309998847.42912") :method :outer("26_1309998847.42912") .annotate 'line', 69 .local string rx1094_tgt .local int rx1094_pos .local int rx1094_off .local int rx1094_eos .local int rx1094_rep .local pmc rx1094_cur .local pmc rx1094_debug (rx1094_cur, rx1094_pos, rx1094_tgt, $I10) = self."!cursor_start"() getattribute rx1094_debug, rx1094_cur, "$!debug" .lex unicode:"$\x{a2}", rx1094_cur .local pmc match .lex "$/", match length rx1094_eos, rx1094_tgt gt rx1094_pos, rx1094_eos, rx1094_done set rx1094_off, 0 lt rx1094_pos, 2, rx1094_start sub rx1094_off, rx1094_pos, 1 substr rx1094_tgt, rx1094_tgt, rx1094_off rx1094_start: eq $I10, 1, rx1094_restart if_null rx1094_debug, debug_419 rx1094_cur."!cursor_debug"("START", "") debug_419: $I10 = self.'from'() ne $I10, -1, rxscan1095_done goto rxscan1095_scan rxscan1095_loop: ($P10) = rx1094_cur."from"() inc $P10 set rx1094_pos, $P10 ge rx1094_pos, rx1094_eos, rxscan1095_done rxscan1095_scan: set_addr $I10, rxscan1095_loop rx1094_cur."!mark_push"(0, rx1094_pos, $I10) rxscan1095_done: # rx enumcharlist_q negate=0 r 0..-1 sub $I10, rx1094_pos, rx1094_off set rx1094_rep, 0 sub $I12, rx1094_eos, rx1094_pos rxenumcharlistq1096_loop: le $I12, 0, rxenumcharlistq1096_done substr $S10, rx1094_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1096_done inc rx1094_rep inc $I10 dec $I12 goto rxenumcharlistq1096_loop rxenumcharlistq1096_done: add rx1094_pos, rx1094_pos, rx1094_rep alt1097_0: set_addr $I10, alt1097_1 rx1094_cur."!mark_push"(0, rx1094_pos, $I10) .annotate 'line', 70 # rx literal "=" add $I11, rx1094_pos, 1 gt $I11, rx1094_eos, rx1094_fail sub $I11, rx1094_pos, rx1094_off ord $I11, rx1094_tgt, $I11 ne $I11, 61, rx1094_fail add rx1094_pos, 1 .annotate 'line', 72 # rx rxquantr1098 ** 0..1 set_addr $I10, rxquantr1098_done rx1094_cur."!mark_push"(0, rx1094_pos, $I10) rxquantr1098_loop: .annotate 'line', 71 # rx literal "cut" add $I11, rx1094_pos, 3 gt $I11, rx1094_eos, rx1094_fail sub $I11, rx1094_pos, rx1094_off substr $S10, rx1094_tgt, $I11, 3 ne $S10, "cut", rx1094_fail add rx1094_pos, 3 # rxanchor rwb le rx1094_pos, 0, rx1094_fail sub $I10, rx1094_pos, rx1094_off is_cclass $I11, 8192, rx1094_tgt, $I10 if $I11, rx1094_fail dec $I10 is_cclass $I11, 8192, rx1094_tgt, $I10 unless $I11, rx1094_fail .annotate 'line', 72 # rx subrule "panic" subtype=method negate= rx1094_cur."!cursor_pos"(rx1094_pos) $P10 = rx1094_cur."panic"("Obsolete pod format, please use =begin/=end instead") unless $P10, rx1094_fail rx1094_pos = $P10."pos"() set_addr $I10, rxquantr1098_done (rx1094_rep) = rx1094_cur."!mark_commit"($I10) rxquantr1098_done: .annotate 'line', 69 goto alt1097_end alt1097_1: .annotate 'line', 73 # rx charclass nl ge rx1094_pos, rx1094_eos, rx1094_fail sub $I10, rx1094_pos, rx1094_off is_cclass $I11, 4096, rx1094_tgt, $I10 unless $I11, rx1094_fail substr $S10, rx1094_tgt, $I10, 2 iseq $I11, $S10, "\r\n" add rx1094_pos, $I11 inc rx1094_pos alt1097_end: .annotate 'line', 69 # rx pass rx1094_cur."!cursor_pass"(rx1094_pos, "") if_null rx1094_debug, debug_420 rx1094_cur."!cursor_debug"("PASS", "", " at pos=", rx1094_pos) debug_420: .return (rx1094_cur) rx1094_restart: if_null rx1094_debug, debug_421 rx1094_cur."!cursor_debug"("NEXT", "") debug_421: rx1094_fail: (rx1094_rep, rx1094_pos, $I10, $P10) = rx1094_cur."!mark_fail"(0) lt rx1094_pos, -1, rx1094_done eq rx1094_pos, -1, rx1094_fail jump $I10 rx1094_done: rx1094_cur."!cursor_fail"() if_null rx1094_debug, debug_422 rx1094_cur."!cursor_debug"("FAIL", "") debug_422: .return (rx1094_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "comp_unit" :subid("29_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1101_tgt .local int rx1101_pos .local int rx1101_off .local int rx1101_eos .local int rx1101_rep .local pmc rx1101_cur .local pmc rx1101_debug (rx1101_cur, rx1101_pos, rx1101_tgt, $I10) = self."!cursor_start"() getattribute rx1101_debug, rx1101_cur, "$!debug" .lex unicode:"$\x{a2}", rx1101_cur .local pmc match .lex "$/", match length rx1101_eos, rx1101_tgt gt rx1101_pos, rx1101_eos, rx1101_done set rx1101_off, 0 lt rx1101_pos, 2, rx1101_start sub rx1101_off, rx1101_pos, 1 substr rx1101_tgt, rx1101_tgt, rx1101_off rx1101_start: eq $I10, 1, rx1101_restart if_null rx1101_debug, debug_426 rx1101_cur."!cursor_debug"("START", "comp_unit") debug_426: $I10 = self.'from'() ne $I10, -1, rxscan1103_done goto rxscan1103_scan rxscan1103_loop: ($P10) = rx1101_cur."from"() inc $P10 set rx1101_pos, $P10 ge rx1101_pos, rx1101_eos, rxscan1103_done rxscan1103_scan: set_addr $I10, rxscan1103_loop rx1101_cur."!mark_push"(0, rx1101_pos, $I10) rxscan1103_done: .annotate 'line', 84 # rx subrule "newpad" subtype=method negate= rx1101_cur."!cursor_pos"(rx1101_pos) $P10 = rx1101_cur."newpad"() unless $P10, rx1101_fail rx1101_pos = $P10."pos"() .annotate 'line', 85 # rx subrule "outerctx" subtype=method negate= rx1101_cur."!cursor_pos"(rx1101_pos) $P10 = rx1101_cur."outerctx"() unless $P10, rx1101_fail rx1101_pos = $P10."pos"() .annotate 'line', 86 # rx subrule "statementlist" subtype=capture negate= rx1101_cur."!cursor_pos"(rx1101_pos) $P10 = rx1101_cur."statementlist"() unless $P10, rx1101_fail rx1101_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("statementlist") rx1101_pos = $P10."pos"() alt1104_0: .annotate 'line', 87 set_addr $I10, alt1104_1 rx1101_cur."!mark_push"(0, rx1101_pos, $I10) # rxanchor eos ne rx1101_pos, rx1101_eos, rx1101_fail goto alt1104_end alt1104_1: # rx subrule "panic" subtype=method negate= rx1101_cur."!cursor_pos"(rx1101_pos) $P10 = rx1101_cur."panic"("Confused") unless $P10, rx1101_fail rx1101_pos = $P10."pos"() alt1104_end: .annotate 'line', 83 # rx pass rx1101_cur."!cursor_pass"(rx1101_pos, "comp_unit") if_null rx1101_debug, debug_427 rx1101_cur."!cursor_debug"("PASS", "comp_unit", " at pos=", rx1101_pos) debug_427: .return (rx1101_cur) rx1101_restart: .annotate 'line', 4 if_null rx1101_debug, debug_428 rx1101_cur."!cursor_debug"("NEXT", "comp_unit") debug_428: rx1101_fail: (rx1101_rep, rx1101_pos, $I10, $P10) = rx1101_cur."!mark_fail"(0) lt rx1101_pos, -1, rx1101_done eq rx1101_pos, -1, rx1101_fail jump $I10 rx1101_done: rx1101_cur."!cursor_fail"() if_null rx1101_debug, debug_429 rx1101_cur."!cursor_debug"("FAIL", "comp_unit") debug_429: .return (rx1101_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__comp_unit" :subid("30_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("newpad", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "statementlist" :subid("31_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1106_tgt .local int rx1106_pos .local int rx1106_off .local int rx1106_eos .local int rx1106_rep .local pmc rx1106_cur .local pmc rx1106_debug (rx1106_cur, rx1106_pos, rx1106_tgt, $I10) = self."!cursor_start"() rx1106_cur."!cursor_caparray"("statement") getattribute rx1106_debug, rx1106_cur, "$!debug" .lex unicode:"$\x{a2}", rx1106_cur .local pmc match .lex "$/", match length rx1106_eos, rx1106_tgt gt rx1106_pos, rx1106_eos, rx1106_done set rx1106_off, 0 lt rx1106_pos, 2, rx1106_start sub rx1106_off, rx1106_pos, 1 substr rx1106_tgt, rx1106_tgt, rx1106_off rx1106_start: eq $I10, 1, rx1106_restart if_null rx1106_debug, debug_430 rx1106_cur."!cursor_debug"("START", "statementlist") debug_430: $I10 = self.'from'() ne $I10, -1, rxscan1108_done goto rxscan1108_scan rxscan1108_loop: ($P10) = rx1106_cur."from"() inc $P10 set rx1106_pos, $P10 ge rx1106_pos, rx1106_eos, rxscan1108_done rxscan1108_scan: set_addr $I10, rxscan1108_loop rx1106_cur."!mark_push"(0, rx1106_pos, $I10) rxscan1108_done: alt1109_0: .annotate 'line', 90 set_addr $I10, alt1109_1 rx1106_cur."!mark_push"(0, rx1106_pos, $I10) .annotate 'line', 91 # rx subrule "ws" subtype=method negate= rx1106_cur."!cursor_pos"(rx1106_pos) $P10 = rx1106_cur."ws"() unless $P10, rx1106_fail rx1106_pos = $P10."pos"() # rxanchor eos ne rx1106_pos, rx1106_eos, rx1106_fail # rx subrule "ws" subtype=method negate= rx1106_cur."!cursor_pos"(rx1106_pos) $P10 = rx1106_cur."ws"() unless $P10, rx1106_fail rx1106_pos = $P10."pos"() goto alt1109_end alt1109_1: .annotate 'line', 92 # rx subrule "ws" subtype=method negate= rx1106_cur."!cursor_pos"(rx1106_pos) $P10 = rx1106_cur."ws"() unless $P10, rx1106_fail rx1106_pos = $P10."pos"() # rx rxquantr1110 ** 0..* set_addr $I10, rxquantr1110_done rx1106_cur."!mark_push"(0, rx1106_pos, $I10) rxquantr1110_loop: # rx subrule "statement" subtype=capture negate= rx1106_cur."!cursor_pos"(rx1106_pos) $P10 = rx1106_cur."statement"() unless $P10, rx1106_fail rx1106_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("statement") rx1106_pos = $P10."pos"() # rx subrule "eat_terminator" subtype=method negate= rx1106_cur."!cursor_pos"(rx1106_pos) $P10 = rx1106_cur."eat_terminator"() unless $P10, rx1106_fail rx1106_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1106_cur."!cursor_pos"(rx1106_pos) $P10 = rx1106_cur."ws"() unless $P10, rx1106_fail rx1106_pos = $P10."pos"() set_addr $I10, rxquantr1110_done (rx1106_rep) = rx1106_cur."!mark_commit"($I10) set_addr $I10, rxquantr1110_done rx1106_cur."!mark_push"(rx1106_rep, rx1106_pos, $I10) goto rxquantr1110_loop rxquantr1110_done: # rx subrule "ws" subtype=method negate= rx1106_cur."!cursor_pos"(rx1106_pos) $P10 = rx1106_cur."ws"() unless $P10, rx1106_fail rx1106_pos = $P10."pos"() alt1109_end: .annotate 'line', 90 # rx pass rx1106_cur."!cursor_pass"(rx1106_pos, "statementlist") if_null rx1106_debug, debug_431 rx1106_cur."!cursor_debug"("PASS", "statementlist", " at pos=", rx1106_pos) debug_431: .return (rx1106_cur) rx1106_restart: .annotate 'line', 4 if_null rx1106_debug, debug_432 rx1106_cur."!cursor_debug"("NEXT", "statementlist") debug_432: rx1106_fail: (rx1106_rep, rx1106_pos, $I10, $P10) = rx1106_cur."!mark_fail"(0) lt rx1106_pos, -1, rx1106_done eq rx1106_pos, -1, rx1106_fail jump $I10 rx1106_done: rx1106_cur."!cursor_fail"() if_null rx1106_debug, debug_433 rx1106_cur."!cursor_debug"("FAIL", "statementlist") debug_433: .return (rx1106_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statementlist" :subid("32_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "") $P101 = self."!PREFIX__!subrule"("ws", "") new $P102, "ResizablePMCArray" push $P102, $P100 push $P102, $P101 .return ($P102) .end .namespace ["NQP";"Grammar"] .sub "statement" :subid("33_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .const 'Sub' $P1116 = "35_1309998847.42912" capture_lex $P1116 .local string rx1112_tgt .local int rx1112_pos .local int rx1112_off .local int rx1112_eos .local int rx1112_rep .local pmc rx1112_cur .local pmc rx1112_debug (rx1112_cur, rx1112_pos, rx1112_tgt, $I10) = self."!cursor_start"() rx1112_cur."!cursor_caparray"("statement_mod_cond", "statement_mod_loop") getattribute rx1112_debug, rx1112_cur, "$!debug" .lex unicode:"$\x{a2}", rx1112_cur .local pmc match .lex "$/", match length rx1112_eos, rx1112_tgt gt rx1112_pos, rx1112_eos, rx1112_done set rx1112_off, 0 lt rx1112_pos, 2, rx1112_start sub rx1112_off, rx1112_pos, 1 substr rx1112_tgt, rx1112_tgt, rx1112_off rx1112_start: eq $I10, 1, rx1112_restart if_null rx1112_debug, debug_434 rx1112_cur."!cursor_debug"("START", "statement") debug_434: $I10 = self.'from'() ne $I10, -1, rxscan1114_done goto rxscan1114_scan rxscan1114_loop: ($P10) = rx1112_cur."from"() inc $P10 set rx1112_pos, $P10 ge rx1112_pos, rx1112_eos, rxscan1114_done rxscan1114_scan: set_addr $I10, rxscan1114_loop rx1112_cur."!mark_push"(0, rx1112_pos, $I10) rxscan1114_done: .annotate 'line', 96 # rx subrule "before" subtype=zerowidth negate=1 rx1112_cur."!cursor_pos"(rx1112_pos) .const 'Sub' $P1116 = "35_1309998847.42912" capture_lex $P1116 $P10 = rx1112_cur."before"($P1116) if $P10, rx1112_fail alt1120_0: .annotate 'line', 97 set_addr $I10, alt1120_1 rx1112_cur."!mark_push"(0, rx1112_pos, $I10) .annotate 'line', 98 # rx subrule "statement_control" subtype=capture negate= rx1112_cur."!cursor_pos"(rx1112_pos) $P10 = rx1112_cur."statement_control"() unless $P10, rx1112_fail rx1112_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("statement_control") rx1112_pos = $P10."pos"() goto alt1120_end alt1120_1: .annotate 'line', 99 # rx subrule "EXPR" subtype=capture negate= rx1112_cur."!cursor_pos"(rx1112_pos) $P10 = rx1112_cur."EXPR"() unless $P10, rx1112_fail rx1112_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("EXPR") rx1112_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1112_cur."!cursor_pos"(rx1112_pos) $P10 = rx1112_cur."ws"() unless $P10, rx1112_fail rx1112_pos = $P10."pos"() .annotate 'line', 104 # rx rxquantr1121 ** 0..1 set_addr $I10, rxquantr1121_done rx1112_cur."!mark_push"(0, rx1112_pos, $I10) rxquantr1121_loop: alt1122_0: .annotate 'line', 100 set_addr $I10, alt1122_1 rx1112_cur."!mark_push"(0, rx1112_pos, $I10) .annotate 'line', 101 # rx subrule "MARKED" subtype=zerowidth negate= rx1112_cur."!cursor_pos"(rx1112_pos) $P10 = rx1112_cur."MARKED"("endstmt") unless $P10, rx1112_fail goto alt1122_end alt1122_1: set_addr $I10, alt1122_2 rx1112_cur."!mark_push"(0, rx1112_pos, $I10) .annotate 'line', 102 # rx subrule "statement_mod_cond" subtype=capture negate= rx1112_cur."!cursor_pos"(rx1112_pos) $P10 = rx1112_cur."statement_mod_cond"() unless $P10, rx1112_fail rx1112_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("statement_mod_cond") rx1112_pos = $P10."pos"() # rx rxquantr1123 ** 0..1 set_addr $I10, rxquantr1123_done rx1112_cur."!mark_push"(0, rx1112_pos, $I10) rxquantr1123_loop: # rx subrule "statement_mod_loop" subtype=capture negate= rx1112_cur."!cursor_pos"(rx1112_pos) $P10 = rx1112_cur."statement_mod_loop"() unless $P10, rx1112_fail goto rxsubrule1124_pass rxsubrule1124_back: $P10 = $P10."!cursor_next"() unless $P10, rx1112_fail rxsubrule1124_pass: set_addr $I10, rxsubrule1124_back rx1112_cur."!mark_push"(0, rx1112_pos, $I10, $P10) $P10."!cursor_names"("statement_mod_loop") rx1112_pos = $P10."pos"() set_addr $I10, rxquantr1123_done (rx1112_rep) = rx1112_cur."!mark_commit"($I10) rxquantr1123_done: goto alt1122_end alt1122_2: .annotate 'line', 103 # rx subrule "statement_mod_loop" subtype=capture negate= rx1112_cur."!cursor_pos"(rx1112_pos) $P10 = rx1112_cur."statement_mod_loop"() unless $P10, rx1112_fail rx1112_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("statement_mod_loop") rx1112_pos = $P10."pos"() alt1122_end: .annotate 'line', 104 set_addr $I10, rxquantr1121_done (rx1112_rep) = rx1112_cur."!mark_commit"($I10) rxquantr1121_done: alt1120_end: .annotate 'line', 95 # rx pass rx1112_cur."!cursor_pass"(rx1112_pos, "statement") if_null rx1112_debug, debug_439 rx1112_cur."!cursor_debug"("PASS", "statement", " at pos=", rx1112_pos) debug_439: .return (rx1112_cur) rx1112_restart: .annotate 'line', 4 if_null rx1112_debug, debug_440 rx1112_cur."!cursor_debug"("NEXT", "statement") debug_440: rx1112_fail: (rx1112_rep, rx1112_pos, $I10, $P10) = rx1112_cur."!mark_fail"(0) lt rx1112_pos, -1, rx1112_done eq rx1112_pos, -1, rx1112_fail jump $I10 rx1112_done: rx1112_cur."!cursor_fail"() if_null rx1112_debug, debug_441 rx1112_cur."!cursor_debug"("FAIL", "statement") debug_441: .return (rx1112_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement" :subid("34_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "_block1115" :anon :subid("35_1309998847.42912") :method :outer("33_1309998847.42912") .annotate 'line', 96 .local string rx1117_tgt .local int rx1117_pos .local int rx1117_off .local int rx1117_eos .local int rx1117_rep .local pmc rx1117_cur .local pmc rx1117_debug (rx1117_cur, rx1117_pos, rx1117_tgt, $I10) = self."!cursor_start"() getattribute rx1117_debug, rx1117_cur, "$!debug" .lex unicode:"$\x{a2}", rx1117_cur .local pmc match .lex "$/", match length rx1117_eos, rx1117_tgt gt rx1117_pos, rx1117_eos, rx1117_done set rx1117_off, 0 lt rx1117_pos, 2, rx1117_start sub rx1117_off, rx1117_pos, 1 substr rx1117_tgt, rx1117_tgt, rx1117_off rx1117_start: eq $I10, 1, rx1117_restart if_null rx1117_debug, debug_435 rx1117_cur."!cursor_debug"("START", "") debug_435: $I10 = self.'from'() ne $I10, -1, rxscan1118_done goto rxscan1118_scan rxscan1118_loop: ($P10) = rx1117_cur."from"() inc $P10 set rx1117_pos, $P10 ge rx1117_pos, rx1117_eos, rxscan1118_done rxscan1118_scan: set_addr $I10, rxscan1118_loop rx1117_cur."!mark_push"(0, rx1117_pos, $I10) rxscan1118_done: alt1119_0: set_addr $I10, alt1119_1 rx1117_cur."!mark_push"(0, rx1117_pos, $I10) # rx enumcharlist negate=0 ge rx1117_pos, rx1117_eos, rx1117_fail sub $I10, rx1117_pos, rx1117_off substr $S10, rx1117_tgt, $I10, 1 index $I11, "])}", $S10 lt $I11, 0, rx1117_fail inc rx1117_pos goto alt1119_end alt1119_1: # rxanchor eos ne rx1117_pos, rx1117_eos, rx1117_fail alt1119_end: # rx pass rx1117_cur."!cursor_pass"(rx1117_pos, "") if_null rx1117_debug, debug_436 rx1117_cur."!cursor_debug"("PASS", "", " at pos=", rx1117_pos) debug_436: .return (rx1117_cur) rx1117_restart: if_null rx1117_debug, debug_437 rx1117_cur."!cursor_debug"("NEXT", "") debug_437: rx1117_fail: (rx1117_rep, rx1117_pos, $I10, $P10) = rx1117_cur."!mark_fail"(0) lt rx1117_pos, -1, rx1117_done eq rx1117_pos, -1, rx1117_fail jump $I10 rx1117_done: rx1117_cur."!cursor_fail"() if_null rx1117_debug, debug_438 rx1117_cur."!cursor_debug"("FAIL", "") debug_438: .return (rx1117_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "eat_terminator" :subid("36_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1126_tgt .local int rx1126_pos .local int rx1126_off .local int rx1126_eos .local int rx1126_rep .local pmc rx1126_cur .local pmc rx1126_debug (rx1126_cur, rx1126_pos, rx1126_tgt, $I10) = self."!cursor_start"() getattribute rx1126_debug, rx1126_cur, "$!debug" .lex unicode:"$\x{a2}", rx1126_cur .local pmc match .lex "$/", match length rx1126_eos, rx1126_tgt gt rx1126_pos, rx1126_eos, rx1126_done set rx1126_off, 0 lt rx1126_pos, 2, rx1126_start sub rx1126_off, rx1126_pos, 1 substr rx1126_tgt, rx1126_tgt, rx1126_off rx1126_start: eq $I10, 1, rx1126_restart if_null rx1126_debug, debug_442 rx1126_cur."!cursor_debug"("START", "eat_terminator") debug_442: $I10 = self.'from'() ne $I10, -1, rxscan1128_done goto rxscan1128_scan rxscan1128_loop: ($P10) = rx1126_cur."from"() inc $P10 set rx1126_pos, $P10 ge rx1126_pos, rx1126_eos, rxscan1128_done rxscan1128_scan: set_addr $I10, rxscan1128_loop rx1126_cur."!mark_push"(0, rx1126_pos, $I10) rxscan1128_done: alt1129_0: .annotate 'line', 108 set_addr $I10, alt1129_1 rx1126_cur."!mark_push"(0, rx1126_pos, $I10) .annotate 'line', 109 # rx literal ";" add $I11, rx1126_pos, 1 gt $I11, rx1126_eos, rx1126_fail sub $I11, rx1126_pos, rx1126_off ord $I11, rx1126_tgt, $I11 ne $I11, 59, rx1126_fail add rx1126_pos, 1 goto alt1129_end alt1129_1: set_addr $I10, alt1129_2 rx1126_cur."!mark_push"(0, rx1126_pos, $I10) .annotate 'line', 110 # rx subrule "MARKED" subtype=zerowidth negate= rx1126_cur."!cursor_pos"(rx1126_pos) $P10 = rx1126_cur."MARKED"("endstmt") unless $P10, rx1126_fail goto alt1129_end alt1129_2: set_addr $I10, alt1129_3 rx1126_cur."!mark_push"(0, rx1126_pos, $I10) .annotate 'line', 111 # rx subrule "terminator" subtype=zerowidth negate= rx1126_cur."!cursor_pos"(rx1126_pos) $P10 = rx1126_cur."terminator"() unless $P10, rx1126_fail goto alt1129_end alt1129_3: .annotate 'line', 112 # rxanchor eos ne rx1126_pos, rx1126_eos, rx1126_fail alt1129_end: .annotate 'line', 108 # rx pass rx1126_cur."!cursor_pass"(rx1126_pos, "eat_terminator") if_null rx1126_debug, debug_443 rx1126_cur."!cursor_debug"("PASS", "eat_terminator", " at pos=", rx1126_pos) debug_443: .return (rx1126_cur) rx1126_restart: .annotate 'line', 4 if_null rx1126_debug, debug_444 rx1126_cur."!cursor_debug"("NEXT", "eat_terminator") debug_444: rx1126_fail: (rx1126_rep, rx1126_pos, $I10, $P10) = rx1126_cur."!mark_fail"(0) lt rx1126_pos, -1, rx1126_done eq rx1126_pos, -1, rx1126_fail jump $I10 rx1126_done: rx1126_cur."!cursor_fail"() if_null rx1126_debug, debug_445 rx1126_cur."!cursor_debug"("FAIL", "eat_terminator") debug_445: .return (rx1126_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__eat_terminator" :subid("37_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" push $P100, "" push $P100, "" push $P100, ";" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "xblock" :subid("38_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1131_tgt .local int rx1131_pos .local int rx1131_off .local int rx1131_eos .local int rx1131_rep .local pmc rx1131_cur .local pmc rx1131_debug (rx1131_cur, rx1131_pos, rx1131_tgt, $I10) = self."!cursor_start"() getattribute rx1131_debug, rx1131_cur, "$!debug" .lex unicode:"$\x{a2}", rx1131_cur .local pmc match .lex "$/", match length rx1131_eos, rx1131_tgt gt rx1131_pos, rx1131_eos, rx1131_done set rx1131_off, 0 lt rx1131_pos, 2, rx1131_start sub rx1131_off, rx1131_pos, 1 substr rx1131_tgt, rx1131_tgt, rx1131_off rx1131_start: eq $I10, 1, rx1131_restart if_null rx1131_debug, debug_446 rx1131_cur."!cursor_debug"("START", "xblock") debug_446: $I10 = self.'from'() ne $I10, -1, rxscan1133_done goto rxscan1133_scan rxscan1133_loop: ($P10) = rx1131_cur."from"() inc $P10 set rx1131_pos, $P10 ge rx1131_pos, rx1131_eos, rxscan1133_done rxscan1133_scan: set_addr $I10, rxscan1133_loop rx1131_cur."!mark_push"(0, rx1131_pos, $I10) rxscan1133_done: .annotate 'line', 116 # rx subrule "EXPR" subtype=capture negate= rx1131_cur."!cursor_pos"(rx1131_pos) $P10 = rx1131_cur."EXPR"() unless $P10, rx1131_fail rx1131_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("EXPR") rx1131_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1131_cur."!cursor_pos"(rx1131_pos) $P10 = rx1131_cur."ws"() unless $P10, rx1131_fail rx1131_pos = $P10."pos"() # rx subrule "pblock" subtype=capture negate= rx1131_cur."!cursor_pos"(rx1131_pos) $P10 = rx1131_cur."pblock"() unless $P10, rx1131_fail rx1131_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("pblock") rx1131_pos = $P10."pos"() .annotate 'line', 115 # rx pass rx1131_cur."!cursor_pass"(rx1131_pos, "xblock") if_null rx1131_debug, debug_447 rx1131_cur."!cursor_debug"("PASS", "xblock", " at pos=", rx1131_pos) debug_447: .return (rx1131_cur) rx1131_restart: .annotate 'line', 4 if_null rx1131_debug, debug_448 rx1131_cur."!cursor_debug"("NEXT", "xblock") debug_448: rx1131_fail: (rx1131_rep, rx1131_pos, $I10, $P10) = rx1131_cur."!mark_fail"(0) lt rx1131_pos, -1, rx1131_done eq rx1131_pos, -1, rx1131_fail jump $I10 rx1131_done: rx1131_cur."!cursor_fail"() if_null rx1131_debug, debug_449 rx1131_cur."!cursor_debug"("FAIL", "xblock") debug_449: .return (rx1131_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__xblock" :subid("39_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("EXPR", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "pblock" :subid("40_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1135_tgt .local int rx1135_pos .local int rx1135_off .local int rx1135_eos .local int rx1135_rep .local pmc rx1135_cur .local pmc rx1135_debug (rx1135_cur, rx1135_pos, rx1135_tgt, $I10) = self."!cursor_start"() getattribute rx1135_debug, rx1135_cur, "$!debug" .lex unicode:"$\x{a2}", rx1135_cur .local pmc match .lex "$/", match length rx1135_eos, rx1135_tgt gt rx1135_pos, rx1135_eos, rx1135_done set rx1135_off, 0 lt rx1135_pos, 2, rx1135_start sub rx1135_off, rx1135_pos, 1 substr rx1135_tgt, rx1135_tgt, rx1135_off rx1135_start: eq $I10, 1, rx1135_restart if_null rx1135_debug, debug_450 rx1135_cur."!cursor_debug"("START", "pblock") debug_450: $I10 = self.'from'() ne $I10, -1, rxscan1137_done goto rxscan1137_scan rxscan1137_loop: ($P10) = rx1135_cur."from"() inc $P10 set rx1135_pos, $P10 ge rx1135_pos, rx1135_eos, rxscan1137_done rxscan1137_scan: set_addr $I10, rxscan1137_loop rx1135_cur."!mark_push"(0, rx1135_pos, $I10) rxscan1137_done: alt1138_0: .annotate 'line', 119 set_addr $I10, alt1138_1 rx1135_cur."!mark_push"(0, rx1135_pos, $I10) .annotate 'line', 120 # rx subrule "lambda" subtype=method negate= rx1135_cur."!cursor_pos"(rx1135_pos) $P10 = rx1135_cur."lambda"() unless $P10, rx1135_fail rx1135_pos = $P10."pos"() .annotate 'line', 121 # rx subrule "newpad" subtype=method negate= rx1135_cur."!cursor_pos"(rx1135_pos) $P10 = rx1135_cur."newpad"() unless $P10, rx1135_fail rx1135_pos = $P10."pos"() .annotate 'line', 122 # rx subrule "signature" subtype=capture negate= rx1135_cur."!cursor_pos"(rx1135_pos) $P10 = rx1135_cur."signature"() unless $P10, rx1135_fail rx1135_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("signature") rx1135_pos = $P10."pos"() .annotate 'line', 123 # rx subrule "blockoid" subtype=capture negate= rx1135_cur."!cursor_pos"(rx1135_pos) $P10 = rx1135_cur."blockoid"() unless $P10, rx1135_fail rx1135_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("blockoid") rx1135_pos = $P10."pos"() .annotate 'line', 120 goto alt1138_end alt1138_1: set_addr $I10, alt1138_2 rx1135_cur."!mark_push"(0, rx1135_pos, $I10) .annotate 'line', 124 # rx enumcharlist negate=0 zerowidth sub $I10, rx1135_pos, rx1135_off substr $S10, rx1135_tgt, $I10, 1 index $I11, "{", $S10 lt $I11, 0, rx1135_fail .annotate 'line', 125 # rx subrule "newpad" subtype=method negate= rx1135_cur."!cursor_pos"(rx1135_pos) $P10 = rx1135_cur."newpad"() unless $P10, rx1135_fail rx1135_pos = $P10."pos"() .annotate 'line', 126 # rx subrule "blockoid" subtype=capture negate= rx1135_cur."!cursor_pos"(rx1135_pos) $P10 = rx1135_cur."blockoid"() unless $P10, rx1135_fail rx1135_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("blockoid") rx1135_pos = $P10."pos"() .annotate 'line', 124 goto alt1138_end alt1138_2: .annotate 'line', 127 # rx subrule "panic" subtype=method negate= rx1135_cur."!cursor_pos"(rx1135_pos) $P10 = rx1135_cur."panic"("Missing block") unless $P10, rx1135_fail rx1135_pos = $P10."pos"() alt1138_end: .annotate 'line', 119 # rx pass rx1135_cur."!cursor_pass"(rx1135_pos, "pblock") if_null rx1135_debug, debug_451 rx1135_cur."!cursor_debug"("PASS", "pblock", " at pos=", rx1135_pos) debug_451: .return (rx1135_cur) rx1135_restart: .annotate 'line', 4 if_null rx1135_debug, debug_452 rx1135_cur."!cursor_debug"("NEXT", "pblock") debug_452: rx1135_fail: (rx1135_rep, rx1135_pos, $I10, $P10) = rx1135_cur."!mark_fail"(0) lt rx1135_pos, -1, rx1135_done eq rx1135_pos, -1, rx1135_fail jump $I10 rx1135_done: rx1135_cur."!cursor_fail"() if_null rx1135_debug, debug_453 rx1135_cur."!cursor_debug"("FAIL", "pblock") debug_453: .return (rx1135_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__pblock" :subid("41_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("panic", "") $P101 = self."!PREFIX__!subrule"("lambda", "") new $P102, "ResizablePMCArray" push $P102, $P100 push $P102, "{" push $P102, $P101 .return ($P102) .end .namespace ["NQP";"Grammar"] .sub "lambda" :subid("42_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1140_tgt .local int rx1140_pos .local int rx1140_off .local int rx1140_eos .local int rx1140_rep .local pmc rx1140_cur .local pmc rx1140_debug (rx1140_cur, rx1140_pos, rx1140_tgt, $I10) = self."!cursor_start"() getattribute rx1140_debug, rx1140_cur, "$!debug" .lex unicode:"$\x{a2}", rx1140_cur .local pmc match .lex "$/", match length rx1140_eos, rx1140_tgt gt rx1140_pos, rx1140_eos, rx1140_done set rx1140_off, 0 lt rx1140_pos, 2, rx1140_start sub rx1140_off, rx1140_pos, 1 substr rx1140_tgt, rx1140_tgt, rx1140_off rx1140_start: eq $I10, 1, rx1140_restart if_null rx1140_debug, debug_454 rx1140_cur."!cursor_debug"("START", "lambda") debug_454: $I10 = self.'from'() ne $I10, -1, rxscan1142_done goto rxscan1142_scan rxscan1142_loop: ($P10) = rx1140_cur."from"() inc $P10 set rx1140_pos, $P10 ge rx1140_pos, rx1140_eos, rxscan1142_done rxscan1142_scan: set_addr $I10, rxscan1142_loop rx1140_cur."!mark_push"(0, rx1140_pos, $I10) rxscan1142_done: alt1143_0: .annotate 'line', 130 set_addr $I10, alt1143_1 rx1140_cur."!mark_push"(0, rx1140_pos, $I10) # rx literal "->" add $I11, rx1140_pos, 2 gt $I11, rx1140_eos, rx1140_fail sub $I11, rx1140_pos, rx1140_off substr $S10, rx1140_tgt, $I11, 2 ne $S10, "->", rx1140_fail add rx1140_pos, 2 goto alt1143_end alt1143_1: # rx literal "<->" add $I11, rx1140_pos, 3 gt $I11, rx1140_eos, rx1140_fail sub $I11, rx1140_pos, rx1140_off substr $S10, rx1140_tgt, $I11, 3 ne $S10, "<->", rx1140_fail add rx1140_pos, 3 alt1143_end: # rx pass rx1140_cur."!cursor_pass"(rx1140_pos, "lambda") if_null rx1140_debug, debug_455 rx1140_cur."!cursor_debug"("PASS", "lambda", " at pos=", rx1140_pos) debug_455: .return (rx1140_cur) rx1140_restart: .annotate 'line', 4 if_null rx1140_debug, debug_456 rx1140_cur."!cursor_debug"("NEXT", "lambda") debug_456: rx1140_fail: (rx1140_rep, rx1140_pos, $I10, $P10) = rx1140_cur."!mark_fail"(0) lt rx1140_pos, -1, rx1140_done eq rx1140_pos, -1, rx1140_fail jump $I10 rx1140_done: rx1140_cur."!cursor_fail"() if_null rx1140_debug, debug_457 rx1140_cur."!cursor_debug"("FAIL", "lambda") debug_457: .return (rx1140_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__lambda" :subid("43_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "<->" push $P100, "->" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "block" :subid("44_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1145_tgt .local int rx1145_pos .local int rx1145_off .local int rx1145_eos .local int rx1145_rep .local pmc rx1145_cur .local pmc rx1145_debug (rx1145_cur, rx1145_pos, rx1145_tgt, $I10) = self."!cursor_start"() getattribute rx1145_debug, rx1145_cur, "$!debug" .lex unicode:"$\x{a2}", rx1145_cur .local pmc match .lex "$/", match length rx1145_eos, rx1145_tgt gt rx1145_pos, rx1145_eos, rx1145_done set rx1145_off, 0 lt rx1145_pos, 2, rx1145_start sub rx1145_off, rx1145_pos, 1 substr rx1145_tgt, rx1145_tgt, rx1145_off rx1145_start: eq $I10, 1, rx1145_restart if_null rx1145_debug, debug_458 rx1145_cur."!cursor_debug"("START", "block") debug_458: $I10 = self.'from'() ne $I10, -1, rxscan1147_done goto rxscan1147_scan rxscan1147_loop: ($P10) = rx1145_cur."from"() inc $P10 set rx1145_pos, $P10 ge rx1145_pos, rx1145_eos, rxscan1147_done rxscan1147_scan: set_addr $I10, rxscan1147_loop rx1145_cur."!mark_push"(0, rx1145_pos, $I10) rxscan1147_done: alt1148_0: .annotate 'line', 133 set_addr $I10, alt1148_1 rx1145_cur."!mark_push"(0, rx1145_pos, $I10) # rx enumcharlist negate=0 zerowidth sub $I10, rx1145_pos, rx1145_off substr $S10, rx1145_tgt, $I10, 1 index $I11, "{", $S10 lt $I11, 0, rx1145_fail goto alt1148_end alt1148_1: # rx subrule "panic" subtype=method negate= rx1145_cur."!cursor_pos"(rx1145_pos) $P10 = rx1145_cur."panic"("Missing block") unless $P10, rx1145_fail rx1145_pos = $P10."pos"() alt1148_end: .annotate 'line', 134 # rx subrule "newpad" subtype=method negate= rx1145_cur."!cursor_pos"(rx1145_pos) $P10 = rx1145_cur."newpad"() unless $P10, rx1145_fail rx1145_pos = $P10."pos"() .annotate 'line', 135 # rx subrule "blockoid" subtype=capture negate= rx1145_cur."!cursor_pos"(rx1145_pos) $P10 = rx1145_cur."blockoid"() unless $P10, rx1145_fail rx1145_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("blockoid") rx1145_pos = $P10."pos"() .annotate 'line', 132 # rx pass rx1145_cur."!cursor_pass"(rx1145_pos, "block") if_null rx1145_debug, debug_459 rx1145_cur."!cursor_debug"("PASS", "block", " at pos=", rx1145_pos) debug_459: .return (rx1145_cur) rx1145_restart: .annotate 'line', 4 if_null rx1145_debug, debug_460 rx1145_cur."!cursor_debug"("NEXT", "block") debug_460: rx1145_fail: (rx1145_rep, rx1145_pos, $I10, $P10) = rx1145_cur."!mark_fail"(0) lt rx1145_pos, -1, rx1145_done eq rx1145_pos, -1, rx1145_fail jump $I10 rx1145_done: rx1145_cur."!cursor_fail"() if_null rx1145_debug, debug_461 rx1145_cur."!cursor_debug"("FAIL", "block") debug_461: .return (rx1145_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__block" :subid("45_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("panic", "") new $P101, "ResizablePMCArray" push $P101, $P100 push $P101, "{" .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "blockoid" :subid("46_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1150_tgt .local int rx1150_pos .local int rx1150_off .local int rx1150_eos .local int rx1150_rep .local pmc rx1150_cur .local pmc rx1150_debug (rx1150_cur, rx1150_pos, rx1150_tgt, $I10) = self."!cursor_start"() getattribute rx1150_debug, rx1150_cur, "$!debug" .lex unicode:"$\x{a2}", rx1150_cur .local pmc match .lex "$/", match length rx1150_eos, rx1150_tgt gt rx1150_pos, rx1150_eos, rx1150_done set rx1150_off, 0 lt rx1150_pos, 2, rx1150_start sub rx1150_off, rx1150_pos, 1 substr rx1150_tgt, rx1150_tgt, rx1150_off rx1150_start: eq $I10, 1, rx1150_restart if_null rx1150_debug, debug_462 rx1150_cur."!cursor_debug"("START", "blockoid") debug_462: $I10 = self.'from'() ne $I10, -1, rxscan1152_done goto rxscan1152_scan rxscan1152_loop: ($P10) = rx1150_cur."from"() inc $P10 set rx1150_pos, $P10 ge rx1150_pos, rx1150_eos, rxscan1152_done rxscan1152_scan: set_addr $I10, rxscan1152_loop rx1150_cur."!mark_push"(0, rx1150_pos, $I10) rxscan1152_done: .annotate 'line', 139 # rx subrule "finishpad" subtype=method negate= rx1150_cur."!cursor_pos"(rx1150_pos) $P10 = rx1150_cur."finishpad"() unless $P10, rx1150_fail rx1150_pos = $P10."pos"() .annotate 'line', 140 # rx literal "{" add $I11, rx1150_pos, 1 gt $I11, rx1150_eos, rx1150_fail sub $I11, rx1150_pos, rx1150_off ord $I11, rx1150_tgt, $I11 ne $I11, 123, rx1150_fail add rx1150_pos, 1 # rx subrule "statementlist" subtype=capture negate= rx1150_cur."!cursor_pos"(rx1150_pos) $P10 = rx1150_cur."statementlist"() unless $P10, rx1150_fail rx1150_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("statementlist") rx1150_pos = $P10."pos"() alt1153_0: set_addr $I10, alt1153_1 rx1150_cur."!mark_push"(0, rx1150_pos, $I10) # rx literal "}" add $I11, rx1150_pos, 1 gt $I11, rx1150_eos, rx1150_fail sub $I11, rx1150_pos, rx1150_off ord $I11, rx1150_tgt, $I11 ne $I11, 125, rx1150_fail add rx1150_pos, 1 goto alt1153_end alt1153_1: # rx subrule "FAILGOAL" subtype=method negate= rx1150_cur."!cursor_pos"(rx1150_pos) $P10 = rx1150_cur."FAILGOAL"("'}'") unless $P10, rx1150_fail goto rxsubrule1154_pass rxsubrule1154_back: $P10 = $P10."!cursor_next"() unless $P10, rx1150_fail rxsubrule1154_pass: set_addr $I10, rxsubrule1154_back rx1150_cur."!mark_push"(0, rx1150_pos, $I10, $P10) rx1150_pos = $P10."pos"() alt1153_end: .annotate 'line', 141 # rx subrule "ENDSTMT" subtype=zerowidth negate= rx1150_cur."!cursor_pos"(rx1150_pos) $P10 = rx1150_cur."ENDSTMT"() unless $P10, rx1150_fail .annotate 'line', 138 # rx pass rx1150_cur."!cursor_pass"(rx1150_pos, "blockoid") if_null rx1150_debug, debug_463 rx1150_cur."!cursor_debug"("PASS", "blockoid", " at pos=", rx1150_pos) debug_463: .return (rx1150_cur) rx1150_restart: .annotate 'line', 4 if_null rx1150_debug, debug_464 rx1150_cur."!cursor_debug"("NEXT", "blockoid") debug_464: rx1150_fail: (rx1150_rep, rx1150_pos, $I10, $P10) = rx1150_cur."!mark_fail"(0) lt rx1150_pos, -1, rx1150_done eq rx1150_pos, -1, rx1150_fail jump $I10 rx1150_done: rx1150_cur."!cursor_fail"() if_null rx1150_debug, debug_465 rx1150_cur."!cursor_debug"("FAIL", "blockoid") debug_465: .return (rx1150_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__blockoid" :subid("47_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("finishpad", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "newpad" :subid("48_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1156_tgt .local int rx1156_pos .local int rx1156_off .local int rx1156_eos .local int rx1156_rep .local pmc rx1156_cur .local pmc rx1156_debug (rx1156_cur, rx1156_pos, rx1156_tgt, $I10) = self."!cursor_start"() getattribute rx1156_debug, rx1156_cur, "$!debug" .lex unicode:"$\x{a2}", rx1156_cur .local pmc match .lex "$/", match length rx1156_eos, rx1156_tgt gt rx1156_pos, rx1156_eos, rx1156_done set rx1156_off, 0 lt rx1156_pos, 2, rx1156_start sub rx1156_off, rx1156_pos, 1 substr rx1156_tgt, rx1156_tgt, rx1156_off rx1156_start: eq $I10, 1, rx1156_restart if_null rx1156_debug, debug_466 rx1156_cur."!cursor_debug"("START", "newpad") debug_466: $I10 = self.'from'() ne $I10, -1, rxscan1158_done goto rxscan1158_scan rxscan1158_loop: ($P10) = rx1156_cur."from"() inc $P10 set rx1156_pos, $P10 ge rx1156_pos, rx1156_eos, rxscan1158_done rxscan1158_scan: set_addr $I10, rxscan1158_loop rx1156_cur."!mark_push"(0, rx1156_pos, $I10) rxscan1158_done: .annotate 'line', 144 # rx pass rx1156_cur."!cursor_pass"(rx1156_pos, "newpad") if_null rx1156_debug, debug_467 rx1156_cur."!cursor_debug"("PASS", "newpad", " at pos=", rx1156_pos) debug_467: .return (rx1156_cur) rx1156_restart: .annotate 'line', 4 if_null rx1156_debug, debug_468 rx1156_cur."!cursor_debug"("NEXT", "newpad") debug_468: rx1156_fail: (rx1156_rep, rx1156_pos, $I10, $P10) = rx1156_cur."!mark_fail"(0) lt rx1156_pos, -1, rx1156_done eq rx1156_pos, -1, rx1156_fail jump $I10 rx1156_done: rx1156_cur."!cursor_fail"() if_null rx1156_debug, debug_469 rx1156_cur."!cursor_debug"("FAIL", "newpad") debug_469: .return (rx1156_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__newpad" :subid("49_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "outerctx" :subid("50_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1160_tgt .local int rx1160_pos .local int rx1160_off .local int rx1160_eos .local int rx1160_rep .local pmc rx1160_cur .local pmc rx1160_debug (rx1160_cur, rx1160_pos, rx1160_tgt, $I10) = self."!cursor_start"() getattribute rx1160_debug, rx1160_cur, "$!debug" .lex unicode:"$\x{a2}", rx1160_cur .local pmc match .lex "$/", match length rx1160_eos, rx1160_tgt gt rx1160_pos, rx1160_eos, rx1160_done set rx1160_off, 0 lt rx1160_pos, 2, rx1160_start sub rx1160_off, rx1160_pos, 1 substr rx1160_tgt, rx1160_tgt, rx1160_off rx1160_start: eq $I10, 1, rx1160_restart if_null rx1160_debug, debug_470 rx1160_cur."!cursor_debug"("START", "outerctx") debug_470: $I10 = self.'from'() ne $I10, -1, rxscan1162_done goto rxscan1162_scan rxscan1162_loop: ($P10) = rx1160_cur."from"() inc $P10 set rx1160_pos, $P10 ge rx1160_pos, rx1160_eos, rxscan1162_done rxscan1162_scan: set_addr $I10, rxscan1162_loop rx1160_cur."!mark_push"(0, rx1160_pos, $I10) rxscan1162_done: .annotate 'line', 145 # rx pass rx1160_cur."!cursor_pass"(rx1160_pos, "outerctx") if_null rx1160_debug, debug_471 rx1160_cur."!cursor_debug"("PASS", "outerctx", " at pos=", rx1160_pos) debug_471: .return (rx1160_cur) rx1160_restart: .annotate 'line', 4 if_null rx1160_debug, debug_472 rx1160_cur."!cursor_debug"("NEXT", "outerctx") debug_472: rx1160_fail: (rx1160_rep, rx1160_pos, $I10, $P10) = rx1160_cur."!mark_fail"(0) lt rx1160_pos, -1, rx1160_done eq rx1160_pos, -1, rx1160_fail jump $I10 rx1160_done: rx1160_cur."!cursor_fail"() if_null rx1160_debug, debug_473 rx1160_cur."!cursor_debug"("FAIL", "outerctx") debug_473: .return (rx1160_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__outerctx" :subid("51_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "finishpad" :subid("52_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1164_tgt .local int rx1164_pos .local int rx1164_off .local int rx1164_eos .local int rx1164_rep .local pmc rx1164_cur .local pmc rx1164_debug (rx1164_cur, rx1164_pos, rx1164_tgt, $I10) = self."!cursor_start"() getattribute rx1164_debug, rx1164_cur, "$!debug" .lex unicode:"$\x{a2}", rx1164_cur .local pmc match .lex "$/", match length rx1164_eos, rx1164_tgt gt rx1164_pos, rx1164_eos, rx1164_done set rx1164_off, 0 lt rx1164_pos, 2, rx1164_start sub rx1164_off, rx1164_pos, 1 substr rx1164_tgt, rx1164_tgt, rx1164_off rx1164_start: eq $I10, 1, rx1164_restart if_null rx1164_debug, debug_474 rx1164_cur."!cursor_debug"("START", "finishpad") debug_474: $I10 = self.'from'() ne $I10, -1, rxscan1166_done goto rxscan1166_scan rxscan1166_loop: ($P10) = rx1164_cur."from"() inc $P10 set rx1164_pos, $P10 ge rx1164_pos, rx1164_eos, rxscan1166_done rxscan1166_scan: set_addr $I10, rxscan1166_loop rx1164_cur."!mark_push"(0, rx1164_pos, $I10) rxscan1166_done: .annotate 'line', 146 # rx pass rx1164_cur."!cursor_pass"(rx1164_pos, "finishpad") if_null rx1164_debug, debug_475 rx1164_cur."!cursor_debug"("PASS", "finishpad", " at pos=", rx1164_pos) debug_475: .return (rx1164_cur) rx1164_restart: .annotate 'line', 4 if_null rx1164_debug, debug_476 rx1164_cur."!cursor_debug"("NEXT", "finishpad") debug_476: rx1164_fail: (rx1164_rep, rx1164_pos, $I10, $P10) = rx1164_cur."!mark_fail"(0) lt rx1164_pos, -1, rx1164_done eq rx1164_pos, -1, rx1164_fail jump $I10 rx1164_done: rx1164_cur."!cursor_fail"() if_null rx1164_debug, debug_477 rx1164_cur."!cursor_debug"("FAIL", "finishpad") debug_477: .return (rx1164_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__finishpad" :subid("53_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "terminator" :subid("54_1309998847.42912") :method .annotate 'line', 148 $P100 = self."!protoregex"("terminator") .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__terminator" :subid("55_1309998847.42912") :method .annotate 'line', 148 $P101 = self."!PREFIX__!protoregex"("terminator") .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "terminator:sym<;>" :subid("56_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1170_tgt .local int rx1170_pos .local int rx1170_off .local int rx1170_eos .local int rx1170_rep .local pmc rx1170_cur .local pmc rx1170_debug (rx1170_cur, rx1170_pos, rx1170_tgt, $I10) = self."!cursor_start"() getattribute rx1170_debug, rx1170_cur, "$!debug" .lex unicode:"$\x{a2}", rx1170_cur .local pmc match .lex "$/", match length rx1170_eos, rx1170_tgt gt rx1170_pos, rx1170_eos, rx1170_done set rx1170_off, 0 lt rx1170_pos, 2, rx1170_start sub rx1170_off, rx1170_pos, 1 substr rx1170_tgt, rx1170_tgt, rx1170_off rx1170_start: eq $I10, 1, rx1170_restart if_null rx1170_debug, debug_478 rx1170_cur."!cursor_debug"("START", "terminator:sym<;>") debug_478: $I10 = self.'from'() ne $I10, -1, rxscan1172_done goto rxscan1172_scan rxscan1172_loop: ($P10) = rx1170_cur."from"() inc $P10 set rx1170_pos, $P10 ge rx1170_pos, rx1170_eos, rxscan1172_done rxscan1172_scan: set_addr $I10, rxscan1172_loop rx1170_cur."!mark_push"(0, rx1170_pos, $I10) rxscan1172_done: .annotate 'line', 150 # rx enumcharlist negate=0 zerowidth sub $I10, rx1170_pos, rx1170_off substr $S10, rx1170_tgt, $I10, 1 index $I11, ";", $S10 lt $I11, 0, rx1170_fail # rx pass rx1170_cur."!cursor_pass"(rx1170_pos, "terminator:sym<;>") if_null rx1170_debug, debug_479 rx1170_cur."!cursor_debug"("PASS", "terminator:sym<;>", " at pos=", rx1170_pos) debug_479: .return (rx1170_cur) rx1170_restart: .annotate 'line', 4 if_null rx1170_debug, debug_480 rx1170_cur."!cursor_debug"("NEXT", "terminator:sym<;>") debug_480: rx1170_fail: (rx1170_rep, rx1170_pos, $I10, $P10) = rx1170_cur."!mark_fail"(0) lt rx1170_pos, -1, rx1170_done eq rx1170_pos, -1, rx1170_fail jump $I10 rx1170_done: rx1170_cur."!cursor_fail"() if_null rx1170_debug, debug_481 rx1170_cur."!cursor_debug"("FAIL", "terminator:sym<;>") debug_481: .return (rx1170_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__terminator:sym<;>" :subid("57_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, ";" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "terminator:sym<}>" :subid("58_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1174_tgt .local int rx1174_pos .local int rx1174_off .local int rx1174_eos .local int rx1174_rep .local pmc rx1174_cur .local pmc rx1174_debug (rx1174_cur, rx1174_pos, rx1174_tgt, $I10) = self."!cursor_start"() getattribute rx1174_debug, rx1174_cur, "$!debug" .lex unicode:"$\x{a2}", rx1174_cur .local pmc match .lex "$/", match length rx1174_eos, rx1174_tgt gt rx1174_pos, rx1174_eos, rx1174_done set rx1174_off, 0 lt rx1174_pos, 2, rx1174_start sub rx1174_off, rx1174_pos, 1 substr rx1174_tgt, rx1174_tgt, rx1174_off rx1174_start: eq $I10, 1, rx1174_restart if_null rx1174_debug, debug_482 rx1174_cur."!cursor_debug"("START", "terminator:sym<}>") debug_482: $I10 = self.'from'() ne $I10, -1, rxscan1176_done goto rxscan1176_scan rxscan1176_loop: ($P10) = rx1174_cur."from"() inc $P10 set rx1174_pos, $P10 ge rx1174_pos, rx1174_eos, rxscan1176_done rxscan1176_scan: set_addr $I10, rxscan1176_loop rx1174_cur."!mark_push"(0, rx1174_pos, $I10) rxscan1176_done: .annotate 'line', 151 # rx enumcharlist negate=0 zerowidth sub $I10, rx1174_pos, rx1174_off substr $S10, rx1174_tgt, $I10, 1 index $I11, "}", $S10 lt $I11, 0, rx1174_fail # rx pass rx1174_cur."!cursor_pass"(rx1174_pos, "terminator:sym<}>") if_null rx1174_debug, debug_483 rx1174_cur."!cursor_debug"("PASS", "terminator:sym<}>", " at pos=", rx1174_pos) debug_483: .return (rx1174_cur) rx1174_restart: .annotate 'line', 4 if_null rx1174_debug, debug_484 rx1174_cur."!cursor_debug"("NEXT", "terminator:sym<}>") debug_484: rx1174_fail: (rx1174_rep, rx1174_pos, $I10, $P10) = rx1174_cur."!mark_fail"(0) lt rx1174_pos, -1, rx1174_done eq rx1174_pos, -1, rx1174_fail jump $I10 rx1174_done: rx1174_cur."!cursor_fail"() if_null rx1174_debug, debug_485 rx1174_cur."!cursor_debug"("FAIL", "terminator:sym<}>") debug_485: .return (rx1174_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__terminator:sym<}>" :subid("59_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "}" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "statement_control" :subid("60_1309998847.42912") :method .annotate 'line', 155 $P100 = self."!protoregex"("statement_control") .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_control" :subid("61_1309998847.42912") :method .annotate 'line', 155 $P101 = self."!PREFIX__!protoregex"("statement_control") .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "statement_control:sym" :subid("62_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1180_tgt .local int rx1180_pos .local int rx1180_off .local int rx1180_eos .local int rx1180_rep .local pmc rx1180_cur .local pmc rx1180_debug (rx1180_cur, rx1180_pos, rx1180_tgt, $I10) = self."!cursor_start"() rx1180_cur."!cursor_caparray"("xblock", "else") getattribute rx1180_debug, rx1180_cur, "$!debug" .lex unicode:"$\x{a2}", rx1180_cur .local pmc match .lex "$/", match length rx1180_eos, rx1180_tgt gt rx1180_pos, rx1180_eos, rx1180_done set rx1180_off, 0 lt rx1180_pos, 2, rx1180_start sub rx1180_off, rx1180_pos, 1 substr rx1180_tgt, rx1180_tgt, rx1180_off rx1180_start: eq $I10, 1, rx1180_restart if_null rx1180_debug, debug_486 rx1180_cur."!cursor_debug"("START", "statement_control:sym") debug_486: $I10 = self.'from'() ne $I10, -1, rxscan1182_done goto rxscan1182_scan rxscan1182_loop: ($P10) = rx1180_cur."from"() inc $P10 set rx1180_pos, $P10 ge rx1180_pos, rx1180_eos, rxscan1182_done rxscan1182_scan: set_addr $I10, rxscan1182_loop rx1180_cur."!mark_push"(0, rx1180_pos, $I10) rxscan1182_done: .annotate 'line', 158 # rx subcapture "sym" set_addr $I10, rxcap_1183_fail rx1180_cur."!mark_push"(0, rx1180_pos, $I10) # rx literal "if" add $I11, rx1180_pos, 2 gt $I11, rx1180_eos, rx1180_fail sub $I11, rx1180_pos, rx1180_off substr $S10, rx1180_tgt, $I11, 2 ne $S10, "if", rx1180_fail add rx1180_pos, 2 set_addr $I10, rxcap_1183_fail ($I12, $I11) = rx1180_cur."!mark_peek"($I10) rx1180_cur."!cursor_pos"($I11) ($P10) = rx1180_cur."!cursor_start"() $P10."!cursor_pass"(rx1180_pos, "") rx1180_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1183_done rxcap_1183_fail: goto rx1180_fail rxcap_1183_done: # rx charclass s ge rx1180_pos, rx1180_eos, rx1180_fail sub $I10, rx1180_pos, rx1180_off is_cclass $I11, 32, rx1180_tgt, $I10 unless $I11, rx1180_fail inc rx1180_pos # rx subrule "ws" subtype=method negate= rx1180_cur."!cursor_pos"(rx1180_pos) $P10 = rx1180_cur."ws"() unless $P10, rx1180_fail rx1180_pos = $P10."pos"() .annotate 'line', 159 # rx subrule "xblock" subtype=capture negate= rx1180_cur."!cursor_pos"(rx1180_pos) $P10 = rx1180_cur."xblock"() unless $P10, rx1180_fail rx1180_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("xblock") rx1180_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1180_cur."!cursor_pos"(rx1180_pos) $P10 = rx1180_cur."ws"() unless $P10, rx1180_fail rx1180_pos = $P10."pos"() .annotate 'line', 160 # rx rxquantr1184 ** 0..* set_addr $I10, rxquantr1184_done rx1180_cur."!mark_push"(0, rx1180_pos, $I10) rxquantr1184_loop: # rx subrule "ws" subtype=method negate= rx1180_cur."!cursor_pos"(rx1180_pos) $P10 = rx1180_cur."ws"() unless $P10, rx1180_fail rx1180_pos = $P10."pos"() # rx literal "elsif" add $I11, rx1180_pos, 5 gt $I11, rx1180_eos, rx1180_fail sub $I11, rx1180_pos, rx1180_off substr $S10, rx1180_tgt, $I11, 5 ne $S10, "elsif", rx1180_fail add rx1180_pos, 5 # rx charclass s ge rx1180_pos, rx1180_eos, rx1180_fail sub $I10, rx1180_pos, rx1180_off is_cclass $I11, 32, rx1180_tgt, $I10 unless $I11, rx1180_fail inc rx1180_pos # rx subrule "ws" subtype=method negate= rx1180_cur."!cursor_pos"(rx1180_pos) $P10 = rx1180_cur."ws"() unless $P10, rx1180_fail rx1180_pos = $P10."pos"() # rx subrule "xblock" subtype=capture negate= rx1180_cur."!cursor_pos"(rx1180_pos) $P10 = rx1180_cur."xblock"() unless $P10, rx1180_fail rx1180_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("xblock") rx1180_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1180_cur."!cursor_pos"(rx1180_pos) $P10 = rx1180_cur."ws"() unless $P10, rx1180_fail rx1180_pos = $P10."pos"() set_addr $I10, rxquantr1184_done (rx1180_rep) = rx1180_cur."!mark_commit"($I10) set_addr $I10, rxquantr1184_done rx1180_cur."!mark_push"(rx1180_rep, rx1180_pos, $I10) goto rxquantr1184_loop rxquantr1184_done: # rx subrule "ws" subtype=method negate= rx1180_cur."!cursor_pos"(rx1180_pos) $P10 = rx1180_cur."ws"() unless $P10, rx1180_fail rx1180_pos = $P10."pos"() .annotate 'line', 161 # rx rxquantr1185 ** 0..1 set_addr $I10, rxquantr1185_done rx1180_cur."!mark_push"(0, rx1180_pos, $I10) rxquantr1185_loop: # rx subrule "ws" subtype=method negate= rx1180_cur."!cursor_pos"(rx1180_pos) $P10 = rx1180_cur."ws"() unless $P10, rx1180_fail rx1180_pos = $P10."pos"() # rx literal "else" add $I11, rx1180_pos, 4 gt $I11, rx1180_eos, rx1180_fail sub $I11, rx1180_pos, rx1180_off substr $S10, rx1180_tgt, $I11, 4 ne $S10, "else", rx1180_fail add rx1180_pos, 4 # rx charclass s ge rx1180_pos, rx1180_eos, rx1180_fail sub $I10, rx1180_pos, rx1180_off is_cclass $I11, 32, rx1180_tgt, $I10 unless $I11, rx1180_fail inc rx1180_pos # rx subrule "ws" subtype=method negate= rx1180_cur."!cursor_pos"(rx1180_pos) $P10 = rx1180_cur."ws"() unless $P10, rx1180_fail rx1180_pos = $P10."pos"() # rx subrule "pblock" subtype=capture negate= rx1180_cur."!cursor_pos"(rx1180_pos) $P10 = rx1180_cur."pblock"() unless $P10, rx1180_fail rx1180_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("else") rx1180_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1180_cur."!cursor_pos"(rx1180_pos) $P10 = rx1180_cur."ws"() unless $P10, rx1180_fail rx1180_pos = $P10."pos"() set_addr $I10, rxquantr1185_done (rx1180_rep) = rx1180_cur."!mark_commit"($I10) rxquantr1185_done: # rx subrule "ws" subtype=method negate= rx1180_cur."!cursor_pos"(rx1180_pos) $P10 = rx1180_cur."ws"() unless $P10, rx1180_fail rx1180_pos = $P10."pos"() .annotate 'line', 157 # rx pass rx1180_cur."!cursor_pass"(rx1180_pos, "statement_control:sym") if_null rx1180_debug, debug_487 rx1180_cur."!cursor_debug"("PASS", "statement_control:sym", " at pos=", rx1180_pos) debug_487: .return (rx1180_cur) rx1180_restart: .annotate 'line', 4 if_null rx1180_debug, debug_488 rx1180_cur."!cursor_debug"("NEXT", "statement_control:sym") debug_488: rx1180_fail: (rx1180_rep, rx1180_pos, $I10, $P10) = rx1180_cur."!mark_fail"(0) lt rx1180_pos, -1, rx1180_done eq rx1180_pos, -1, rx1180_fail jump $I10 rx1180_done: rx1180_cur."!cursor_fail"() if_null rx1180_debug, debug_489 rx1180_cur."!cursor_debug"("FAIL", "statement_control:sym") debug_489: .return (rx1180_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_control:sym" :subid("63_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "if" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "statement_control:sym" :subid("64_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .const 'Sub' $P1193 = "66_1309998847.42912" capture_lex $P1193 .local string rx1187_tgt .local int rx1187_pos .local int rx1187_off .local int rx1187_eos .local int rx1187_rep .local pmc rx1187_cur .local pmc rx1187_debug (rx1187_cur, rx1187_pos, rx1187_tgt, $I10) = self."!cursor_start"() getattribute rx1187_debug, rx1187_cur, "$!debug" .lex unicode:"$\x{a2}", rx1187_cur .local pmc match .lex "$/", match length rx1187_eos, rx1187_tgt gt rx1187_pos, rx1187_eos, rx1187_done set rx1187_off, 0 lt rx1187_pos, 2, rx1187_start sub rx1187_off, rx1187_pos, 1 substr rx1187_tgt, rx1187_tgt, rx1187_off rx1187_start: eq $I10, 1, rx1187_restart if_null rx1187_debug, debug_490 rx1187_cur."!cursor_debug"("START", "statement_control:sym") debug_490: $I10 = self.'from'() ne $I10, -1, rxscan1189_done goto rxscan1189_scan rxscan1189_loop: ($P10) = rx1187_cur."from"() inc $P10 set rx1187_pos, $P10 ge rx1187_pos, rx1187_eos, rxscan1189_done rxscan1189_scan: set_addr $I10, rxscan1189_loop rx1187_cur."!mark_push"(0, rx1187_pos, $I10) rxscan1189_done: .annotate 'line', 165 # rx subcapture "sym" set_addr $I10, rxcap_1190_fail rx1187_cur."!mark_push"(0, rx1187_pos, $I10) # rx literal "unless" add $I11, rx1187_pos, 6 gt $I11, rx1187_eos, rx1187_fail sub $I11, rx1187_pos, rx1187_off substr $S10, rx1187_tgt, $I11, 6 ne $S10, "unless", rx1187_fail add rx1187_pos, 6 set_addr $I10, rxcap_1190_fail ($I12, $I11) = rx1187_cur."!mark_peek"($I10) rx1187_cur."!cursor_pos"($I11) ($P10) = rx1187_cur."!cursor_start"() $P10."!cursor_pass"(rx1187_pos, "") rx1187_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1190_done rxcap_1190_fail: goto rx1187_fail rxcap_1190_done: # rx charclass s ge rx1187_pos, rx1187_eos, rx1187_fail sub $I10, rx1187_pos, rx1187_off is_cclass $I11, 32, rx1187_tgt, $I10 unless $I11, rx1187_fail inc rx1187_pos # rx subrule "ws" subtype=method negate= rx1187_cur."!cursor_pos"(rx1187_pos) $P10 = rx1187_cur."ws"() unless $P10, rx1187_fail rx1187_pos = $P10."pos"() .annotate 'line', 166 # rx subrule "xblock" subtype=capture negate= rx1187_cur."!cursor_pos"(rx1187_pos) $P10 = rx1187_cur."xblock"() unless $P10, rx1187_fail rx1187_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("xblock") rx1187_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1187_cur."!cursor_pos"(rx1187_pos) $P10 = rx1187_cur."ws"() unless $P10, rx1187_fail rx1187_pos = $P10."pos"() alt1191_0: .annotate 'line', 167 set_addr $I10, alt1191_1 rx1187_cur."!mark_push"(0, rx1187_pos, $I10) # rx subrule "ws" subtype=method negate= rx1187_cur."!cursor_pos"(rx1187_pos) $P10 = rx1187_cur."ws"() unless $P10, rx1187_fail rx1187_pos = $P10."pos"() # rx subrule "before" subtype=zerowidth negate=1 rx1187_cur."!cursor_pos"(rx1187_pos) .const 'Sub' $P1193 = "66_1309998847.42912" capture_lex $P1193 $P10 = rx1187_cur."before"($P1193) if $P10, rx1187_fail # rx subrule "ws" subtype=method negate= rx1187_cur."!cursor_pos"(rx1187_pos) $P10 = rx1187_cur."ws"() unless $P10, rx1187_fail rx1187_pos = $P10."pos"() goto alt1191_end alt1191_1: # rx subrule "ws" subtype=method negate= rx1187_cur."!cursor_pos"(rx1187_pos) $P10 = rx1187_cur."ws"() unless $P10, rx1187_fail rx1187_pos = $P10."pos"() # rx subrule "panic" subtype=method negate= rx1187_cur."!cursor_pos"(rx1187_pos) $P10 = rx1187_cur."panic"("unless does not take \"else\", please rewrite using \"if\"") unless $P10, rx1187_fail rx1187_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1187_cur."!cursor_pos"(rx1187_pos) $P10 = rx1187_cur."ws"() unless $P10, rx1187_fail rx1187_pos = $P10."pos"() alt1191_end: # rx subrule "ws" subtype=method negate= rx1187_cur."!cursor_pos"(rx1187_pos) $P10 = rx1187_cur."ws"() unless $P10, rx1187_fail rx1187_pos = $P10."pos"() .annotate 'line', 164 # rx pass rx1187_cur."!cursor_pass"(rx1187_pos, "statement_control:sym") if_null rx1187_debug, debug_495 rx1187_cur."!cursor_debug"("PASS", "statement_control:sym", " at pos=", rx1187_pos) debug_495: .return (rx1187_cur) rx1187_restart: .annotate 'line', 4 if_null rx1187_debug, debug_496 rx1187_cur."!cursor_debug"("NEXT", "statement_control:sym") debug_496: rx1187_fail: (rx1187_rep, rx1187_pos, $I10, $P10) = rx1187_cur."!mark_fail"(0) lt rx1187_pos, -1, rx1187_done eq rx1187_pos, -1, rx1187_fail jump $I10 rx1187_done: rx1187_cur."!cursor_fail"() if_null rx1187_debug, debug_497 rx1187_cur."!cursor_debug"("FAIL", "statement_control:sym") debug_497: .return (rx1187_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_control:sym" :subid("65_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "unless" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "_block1192" :anon :subid("66_1309998847.42912") :method :outer("64_1309998847.42912") .annotate 'line', 167 .local string rx1194_tgt .local int rx1194_pos .local int rx1194_off .local int rx1194_eos .local int rx1194_rep .local pmc rx1194_cur .local pmc rx1194_debug (rx1194_cur, rx1194_pos, rx1194_tgt, $I10) = self."!cursor_start"() getattribute rx1194_debug, rx1194_cur, "$!debug" .lex unicode:"$\x{a2}", rx1194_cur .local pmc match .lex "$/", match length rx1194_eos, rx1194_tgt gt rx1194_pos, rx1194_eos, rx1194_done set rx1194_off, 0 lt rx1194_pos, 2, rx1194_start sub rx1194_off, rx1194_pos, 1 substr rx1194_tgt, rx1194_tgt, rx1194_off rx1194_start: eq $I10, 1, rx1194_restart if_null rx1194_debug, debug_491 rx1194_cur."!cursor_debug"("START", "") debug_491: $I10 = self.'from'() ne $I10, -1, rxscan1195_done goto rxscan1195_scan rxscan1195_loop: ($P10) = rx1194_cur."from"() inc $P10 set rx1194_pos, $P10 ge rx1194_pos, rx1194_eos, rxscan1195_done rxscan1195_scan: set_addr $I10, rxscan1195_loop rx1194_cur."!mark_push"(0, rx1194_pos, $I10) rxscan1195_done: # rx literal "else" add $I11, rx1194_pos, 4 gt $I11, rx1194_eos, rx1194_fail sub $I11, rx1194_pos, rx1194_off substr $S10, rx1194_tgt, $I11, 4 ne $S10, "else", rx1194_fail add rx1194_pos, 4 # rx pass rx1194_cur."!cursor_pass"(rx1194_pos, "") if_null rx1194_debug, debug_492 rx1194_cur."!cursor_debug"("PASS", "", " at pos=", rx1194_pos) debug_492: .return (rx1194_cur) rx1194_restart: if_null rx1194_debug, debug_493 rx1194_cur."!cursor_debug"("NEXT", "") debug_493: rx1194_fail: (rx1194_rep, rx1194_pos, $I10, $P10) = rx1194_cur."!mark_fail"(0) lt rx1194_pos, -1, rx1194_done eq rx1194_pos, -1, rx1194_fail jump $I10 rx1194_done: rx1194_cur."!cursor_fail"() if_null rx1194_debug, debug_494 rx1194_cur."!cursor_debug"("FAIL", "") debug_494: .return (rx1194_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "statement_control:sym" :subid("67_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1197_tgt .local int rx1197_pos .local int rx1197_off .local int rx1197_eos .local int rx1197_rep .local pmc rx1197_cur .local pmc rx1197_debug (rx1197_cur, rx1197_pos, rx1197_tgt, $I10) = self."!cursor_start"() getattribute rx1197_debug, rx1197_cur, "$!debug" .lex unicode:"$\x{a2}", rx1197_cur .local pmc match .lex "$/", match length rx1197_eos, rx1197_tgt gt rx1197_pos, rx1197_eos, rx1197_done set rx1197_off, 0 lt rx1197_pos, 2, rx1197_start sub rx1197_off, rx1197_pos, 1 substr rx1197_tgt, rx1197_tgt, rx1197_off rx1197_start: eq $I10, 1, rx1197_restart if_null rx1197_debug, debug_498 rx1197_cur."!cursor_debug"("START", "statement_control:sym") debug_498: $I10 = self.'from'() ne $I10, -1, rxscan1199_done goto rxscan1199_scan rxscan1199_loop: ($P10) = rx1197_cur."from"() inc $P10 set rx1197_pos, $P10 ge rx1197_pos, rx1197_eos, rxscan1199_done rxscan1199_scan: set_addr $I10, rxscan1199_loop rx1197_cur."!mark_push"(0, rx1197_pos, $I10) rxscan1199_done: .annotate 'line', 171 # rx subcapture "sym" set_addr $I10, rxcap_1201_fail rx1197_cur."!mark_push"(0, rx1197_pos, $I10) alt1200_0: set_addr $I10, alt1200_1 rx1197_cur."!mark_push"(0, rx1197_pos, $I10) # rx literal "while" add $I11, rx1197_pos, 5 gt $I11, rx1197_eos, rx1197_fail sub $I11, rx1197_pos, rx1197_off substr $S10, rx1197_tgt, $I11, 5 ne $S10, "while", rx1197_fail add rx1197_pos, 5 goto alt1200_end alt1200_1: # rx literal "until" add $I11, rx1197_pos, 5 gt $I11, rx1197_eos, rx1197_fail sub $I11, rx1197_pos, rx1197_off substr $S10, rx1197_tgt, $I11, 5 ne $S10, "until", rx1197_fail add rx1197_pos, 5 alt1200_end: set_addr $I10, rxcap_1201_fail ($I12, $I11) = rx1197_cur."!mark_peek"($I10) rx1197_cur."!cursor_pos"($I11) ($P10) = rx1197_cur."!cursor_start"() $P10."!cursor_pass"(rx1197_pos, "") rx1197_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1201_done rxcap_1201_fail: goto rx1197_fail rxcap_1201_done: # rx charclass s ge rx1197_pos, rx1197_eos, rx1197_fail sub $I10, rx1197_pos, rx1197_off is_cclass $I11, 32, rx1197_tgt, $I10 unless $I11, rx1197_fail inc rx1197_pos # rx subrule "ws" subtype=method negate= rx1197_cur."!cursor_pos"(rx1197_pos) $P10 = rx1197_cur."ws"() unless $P10, rx1197_fail rx1197_pos = $P10."pos"() .annotate 'line', 172 # rx subrule "xblock" subtype=capture negate= rx1197_cur."!cursor_pos"(rx1197_pos) $P10 = rx1197_cur."xblock"() unless $P10, rx1197_fail rx1197_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("xblock") rx1197_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1197_cur."!cursor_pos"(rx1197_pos) $P10 = rx1197_cur."ws"() unless $P10, rx1197_fail rx1197_pos = $P10."pos"() .annotate 'line', 170 # rx pass rx1197_cur."!cursor_pass"(rx1197_pos, "statement_control:sym") if_null rx1197_debug, debug_499 rx1197_cur."!cursor_debug"("PASS", "statement_control:sym", " at pos=", rx1197_pos) debug_499: .return (rx1197_cur) rx1197_restart: .annotate 'line', 4 if_null rx1197_debug, debug_500 rx1197_cur."!cursor_debug"("NEXT", "statement_control:sym") debug_500: rx1197_fail: (rx1197_rep, rx1197_pos, $I10, $P10) = rx1197_cur."!mark_fail"(0) lt rx1197_pos, -1, rx1197_done eq rx1197_pos, -1, rx1197_fail jump $I10 rx1197_done: rx1197_cur."!cursor_fail"() if_null rx1197_debug, debug_501 rx1197_cur."!cursor_debug"("FAIL", "statement_control:sym") debug_501: .return (rx1197_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_control:sym" :subid("68_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "until" push $P100, "while" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "statement_control:sym" :subid("69_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1203_tgt .local int rx1203_pos .local int rx1203_off .local int rx1203_eos .local int rx1203_rep .local pmc rx1203_cur .local pmc rx1203_debug (rx1203_cur, rx1203_pos, rx1203_tgt, $I10) = self."!cursor_start"() getattribute rx1203_debug, rx1203_cur, "$!debug" .lex unicode:"$\x{a2}", rx1203_cur .local pmc match .lex "$/", match length rx1203_eos, rx1203_tgt gt rx1203_pos, rx1203_eos, rx1203_done set rx1203_off, 0 lt rx1203_pos, 2, rx1203_start sub rx1203_off, rx1203_pos, 1 substr rx1203_tgt, rx1203_tgt, rx1203_off rx1203_start: eq $I10, 1, rx1203_restart if_null rx1203_debug, debug_502 rx1203_cur."!cursor_debug"("START", "statement_control:sym") debug_502: $I10 = self.'from'() ne $I10, -1, rxscan1205_done goto rxscan1205_scan rxscan1205_loop: ($P10) = rx1203_cur."from"() inc $P10 set rx1203_pos, $P10 ge rx1203_pos, rx1203_eos, rxscan1205_done rxscan1205_scan: set_addr $I10, rxscan1205_loop rx1203_cur."!mark_push"(0, rx1203_pos, $I10) rxscan1205_done: .annotate 'line', 176 # rx subcapture "sym" set_addr $I10, rxcap_1206_fail rx1203_cur."!mark_push"(0, rx1203_pos, $I10) # rx literal "repeat" add $I11, rx1203_pos, 6 gt $I11, rx1203_eos, rx1203_fail sub $I11, rx1203_pos, rx1203_off substr $S10, rx1203_tgt, $I11, 6 ne $S10, "repeat", rx1203_fail add rx1203_pos, 6 set_addr $I10, rxcap_1206_fail ($I12, $I11) = rx1203_cur."!mark_peek"($I10) rx1203_cur."!cursor_pos"($I11) ($P10) = rx1203_cur."!cursor_start"() $P10."!cursor_pass"(rx1203_pos, "") rx1203_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1206_done rxcap_1206_fail: goto rx1203_fail rxcap_1206_done: # rx charclass s ge rx1203_pos, rx1203_eos, rx1203_fail sub $I10, rx1203_pos, rx1203_off is_cclass $I11, 32, rx1203_tgt, $I10 unless $I11, rx1203_fail inc rx1203_pos # rx subrule "ws" subtype=method negate= rx1203_cur."!cursor_pos"(rx1203_pos) $P10 = rx1203_cur."ws"() unless $P10, rx1203_fail rx1203_pos = $P10."pos"() alt1207_0: .annotate 'line', 177 set_addr $I10, alt1207_1 rx1203_cur."!mark_push"(0, rx1203_pos, $I10) .annotate 'line', 178 # rx subrule "ws" subtype=method negate= rx1203_cur."!cursor_pos"(rx1203_pos) $P10 = rx1203_cur."ws"() unless $P10, rx1203_fail rx1203_pos = $P10."pos"() # rx subcapture "wu" set_addr $I10, rxcap_1209_fail rx1203_cur."!mark_push"(0, rx1203_pos, $I10) alt1208_0: set_addr $I10, alt1208_1 rx1203_cur."!mark_push"(0, rx1203_pos, $I10) # rx literal "while" add $I11, rx1203_pos, 5 gt $I11, rx1203_eos, rx1203_fail sub $I11, rx1203_pos, rx1203_off substr $S10, rx1203_tgt, $I11, 5 ne $S10, "while", rx1203_fail add rx1203_pos, 5 goto alt1208_end alt1208_1: # rx literal "until" add $I11, rx1203_pos, 5 gt $I11, rx1203_eos, rx1203_fail sub $I11, rx1203_pos, rx1203_off substr $S10, rx1203_tgt, $I11, 5 ne $S10, "until", rx1203_fail add rx1203_pos, 5 alt1208_end: set_addr $I10, rxcap_1209_fail ($I12, $I11) = rx1203_cur."!mark_peek"($I10) rx1203_cur."!cursor_pos"($I11) ($P10) = rx1203_cur."!cursor_start"() $P10."!cursor_pass"(rx1203_pos, "") rx1203_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("wu") goto rxcap_1209_done rxcap_1209_fail: goto rx1203_fail rxcap_1209_done: # rx charclass s ge rx1203_pos, rx1203_eos, rx1203_fail sub $I10, rx1203_pos, rx1203_off is_cclass $I11, 32, rx1203_tgt, $I10 unless $I11, rx1203_fail inc rx1203_pos # rx subrule "ws" subtype=method negate= rx1203_cur."!cursor_pos"(rx1203_pos) $P10 = rx1203_cur."ws"() unless $P10, rx1203_fail rx1203_pos = $P10."pos"() # rx subrule "xblock" subtype=capture negate= rx1203_cur."!cursor_pos"(rx1203_pos) $P10 = rx1203_cur."xblock"() unless $P10, rx1203_fail rx1203_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("xblock") rx1203_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1203_cur."!cursor_pos"(rx1203_pos) $P10 = rx1203_cur."ws"() unless $P10, rx1203_fail rx1203_pos = $P10."pos"() goto alt1207_end alt1207_1: .annotate 'line', 179 # rx subrule "ws" subtype=method negate= rx1203_cur."!cursor_pos"(rx1203_pos) $P10 = rx1203_cur."ws"() unless $P10, rx1203_fail rx1203_pos = $P10."pos"() # rx subrule "pblock" subtype=capture negate= rx1203_cur."!cursor_pos"(rx1203_pos) $P10 = rx1203_cur."pblock"() unless $P10, rx1203_fail rx1203_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("pblock") rx1203_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1203_cur."!cursor_pos"(rx1203_pos) $P10 = rx1203_cur."ws"() unless $P10, rx1203_fail rx1203_pos = $P10."pos"() # rx subcapture "wu" set_addr $I10, rxcap_1211_fail rx1203_cur."!mark_push"(0, rx1203_pos, $I10) alt1210_0: set_addr $I10, alt1210_1 rx1203_cur."!mark_push"(0, rx1203_pos, $I10) # rx literal "while" add $I11, rx1203_pos, 5 gt $I11, rx1203_eos, rx1203_fail sub $I11, rx1203_pos, rx1203_off substr $S10, rx1203_tgt, $I11, 5 ne $S10, "while", rx1203_fail add rx1203_pos, 5 goto alt1210_end alt1210_1: # rx literal "until" add $I11, rx1203_pos, 5 gt $I11, rx1203_eos, rx1203_fail sub $I11, rx1203_pos, rx1203_off substr $S10, rx1203_tgt, $I11, 5 ne $S10, "until", rx1203_fail add rx1203_pos, 5 alt1210_end: set_addr $I10, rxcap_1211_fail ($I12, $I11) = rx1203_cur."!mark_peek"($I10) rx1203_cur."!cursor_pos"($I11) ($P10) = rx1203_cur."!cursor_start"() $P10."!cursor_pass"(rx1203_pos, "") rx1203_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("wu") goto rxcap_1211_done rxcap_1211_fail: goto rx1203_fail rxcap_1211_done: # rx charclass s ge rx1203_pos, rx1203_eos, rx1203_fail sub $I10, rx1203_pos, rx1203_off is_cclass $I11, 32, rx1203_tgt, $I10 unless $I11, rx1203_fail inc rx1203_pos # rx subrule "ws" subtype=method negate= rx1203_cur."!cursor_pos"(rx1203_pos) $P10 = rx1203_cur."ws"() unless $P10, rx1203_fail rx1203_pos = $P10."pos"() # rx subrule "EXPR" subtype=capture negate= rx1203_cur."!cursor_pos"(rx1203_pos) $P10 = rx1203_cur."EXPR"() unless $P10, rx1203_fail rx1203_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("EXPR") rx1203_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1203_cur."!cursor_pos"(rx1203_pos) $P10 = rx1203_cur."ws"() unless $P10, rx1203_fail rx1203_pos = $P10."pos"() alt1207_end: .annotate 'line', 180 # rx subrule "ws" subtype=method negate= rx1203_cur."!cursor_pos"(rx1203_pos) $P10 = rx1203_cur."ws"() unless $P10, rx1203_fail rx1203_pos = $P10."pos"() .annotate 'line', 175 # rx pass rx1203_cur."!cursor_pass"(rx1203_pos, "statement_control:sym") if_null rx1203_debug, debug_503 rx1203_cur."!cursor_debug"("PASS", "statement_control:sym", " at pos=", rx1203_pos) debug_503: .return (rx1203_cur) rx1203_restart: .annotate 'line', 4 if_null rx1203_debug, debug_504 rx1203_cur."!cursor_debug"("NEXT", "statement_control:sym") debug_504: rx1203_fail: (rx1203_rep, rx1203_pos, $I10, $P10) = rx1203_cur."!mark_fail"(0) lt rx1203_pos, -1, rx1203_done eq rx1203_pos, -1, rx1203_fail jump $I10 rx1203_done: rx1203_cur."!cursor_fail"() if_null rx1203_debug, debug_505 rx1203_cur."!cursor_debug"("FAIL", "statement_control:sym") debug_505: .return (rx1203_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_control:sym" :subid("70_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "repeat" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "statement_control:sym" :subid("71_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1213_tgt .local int rx1213_pos .local int rx1213_off .local int rx1213_eos .local int rx1213_rep .local pmc rx1213_cur .local pmc rx1213_debug (rx1213_cur, rx1213_pos, rx1213_tgt, $I10) = self."!cursor_start"() getattribute rx1213_debug, rx1213_cur, "$!debug" .lex unicode:"$\x{a2}", rx1213_cur .local pmc match .lex "$/", match length rx1213_eos, rx1213_tgt gt rx1213_pos, rx1213_eos, rx1213_done set rx1213_off, 0 lt rx1213_pos, 2, rx1213_start sub rx1213_off, rx1213_pos, 1 substr rx1213_tgt, rx1213_tgt, rx1213_off rx1213_start: eq $I10, 1, rx1213_restart if_null rx1213_debug, debug_506 rx1213_cur."!cursor_debug"("START", "statement_control:sym") debug_506: $I10 = self.'from'() ne $I10, -1, rxscan1215_done goto rxscan1215_scan rxscan1215_loop: ($P10) = rx1213_cur."from"() inc $P10 set rx1213_pos, $P10 ge rx1213_pos, rx1213_eos, rxscan1215_done rxscan1215_scan: set_addr $I10, rxscan1215_loop rx1213_cur."!mark_push"(0, rx1213_pos, $I10) rxscan1215_done: .annotate 'line', 184 # rx subcapture "sym" set_addr $I10, rxcap_1216_fail rx1213_cur."!mark_push"(0, rx1213_pos, $I10) # rx literal "for" add $I11, rx1213_pos, 3 gt $I11, rx1213_eos, rx1213_fail sub $I11, rx1213_pos, rx1213_off substr $S10, rx1213_tgt, $I11, 3 ne $S10, "for", rx1213_fail add rx1213_pos, 3 set_addr $I10, rxcap_1216_fail ($I12, $I11) = rx1213_cur."!mark_peek"($I10) rx1213_cur."!cursor_pos"($I11) ($P10) = rx1213_cur."!cursor_start"() $P10."!cursor_pass"(rx1213_pos, "") rx1213_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1216_done rxcap_1216_fail: goto rx1213_fail rxcap_1216_done: # rx charclass s ge rx1213_pos, rx1213_eos, rx1213_fail sub $I10, rx1213_pos, rx1213_off is_cclass $I11, 32, rx1213_tgt, $I10 unless $I11, rx1213_fail inc rx1213_pos # rx subrule "ws" subtype=method negate= rx1213_cur."!cursor_pos"(rx1213_pos) $P10 = rx1213_cur."ws"() unless $P10, rx1213_fail rx1213_pos = $P10."pos"() .annotate 'line', 185 # rx subrule "xblock" subtype=capture negate= rx1213_cur."!cursor_pos"(rx1213_pos) $P10 = rx1213_cur."xblock"() unless $P10, rx1213_fail rx1213_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("xblock") rx1213_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1213_cur."!cursor_pos"(rx1213_pos) $P10 = rx1213_cur."ws"() unless $P10, rx1213_fail rx1213_pos = $P10."pos"() .annotate 'line', 183 # rx pass rx1213_cur."!cursor_pass"(rx1213_pos, "statement_control:sym") if_null rx1213_debug, debug_507 rx1213_cur."!cursor_debug"("PASS", "statement_control:sym", " at pos=", rx1213_pos) debug_507: .return (rx1213_cur) rx1213_restart: .annotate 'line', 4 if_null rx1213_debug, debug_508 rx1213_cur."!cursor_debug"("NEXT", "statement_control:sym") debug_508: rx1213_fail: (rx1213_rep, rx1213_pos, $I10, $P10) = rx1213_cur."!mark_fail"(0) lt rx1213_pos, -1, rx1213_done eq rx1213_pos, -1, rx1213_fail jump $I10 rx1213_done: rx1213_cur."!cursor_fail"() if_null rx1213_debug, debug_509 rx1213_cur."!cursor_debug"("FAIL", "statement_control:sym") debug_509: .return (rx1213_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_control:sym" :subid("72_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "for" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "statement_control:sym" :subid("73_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1218_tgt .local int rx1218_pos .local int rx1218_off .local int rx1218_eos .local int rx1218_rep .local pmc rx1218_cur .local pmc rx1218_debug (rx1218_cur, rx1218_pos, rx1218_tgt, $I10) = self."!cursor_start"() getattribute rx1218_debug, rx1218_cur, "$!debug" .lex unicode:"$\x{a2}", rx1218_cur .local pmc match .lex "$/", match length rx1218_eos, rx1218_tgt gt rx1218_pos, rx1218_eos, rx1218_done set rx1218_off, 0 lt rx1218_pos, 2, rx1218_start sub rx1218_off, rx1218_pos, 1 substr rx1218_tgt, rx1218_tgt, rx1218_off rx1218_start: eq $I10, 1, rx1218_restart if_null rx1218_debug, debug_510 rx1218_cur."!cursor_debug"("START", "statement_control:sym") debug_510: $I10 = self.'from'() ne $I10, -1, rxscan1220_done goto rxscan1220_scan rxscan1220_loop: ($P10) = rx1218_cur."from"() inc $P10 set rx1218_pos, $P10 ge rx1218_pos, rx1218_eos, rxscan1220_done rxscan1220_scan: set_addr $I10, rxscan1220_loop rx1218_cur."!mark_push"(0, rx1218_pos, $I10) rxscan1220_done: .annotate 'line', 189 # rx subcapture "sym" set_addr $I10, rxcap_1221_fail rx1218_cur."!mark_push"(0, rx1218_pos, $I10) # rx literal "CATCH" add $I11, rx1218_pos, 5 gt $I11, rx1218_eos, rx1218_fail sub $I11, rx1218_pos, rx1218_off substr $S10, rx1218_tgt, $I11, 5 ne $S10, "CATCH", rx1218_fail add rx1218_pos, 5 set_addr $I10, rxcap_1221_fail ($I12, $I11) = rx1218_cur."!mark_peek"($I10) rx1218_cur."!cursor_pos"($I11) ($P10) = rx1218_cur."!cursor_start"() $P10."!cursor_pass"(rx1218_pos, "") rx1218_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1221_done rxcap_1221_fail: goto rx1218_fail rxcap_1221_done: # rx charclass s ge rx1218_pos, rx1218_eos, rx1218_fail sub $I10, rx1218_pos, rx1218_off is_cclass $I11, 32, rx1218_tgt, $I10 unless $I11, rx1218_fail inc rx1218_pos # rx subrule "ws" subtype=method negate= rx1218_cur."!cursor_pos"(rx1218_pos) $P10 = rx1218_cur."ws"() unless $P10, rx1218_fail rx1218_pos = $P10."pos"() .annotate 'line', 190 # rx subrule "block" subtype=capture negate= rx1218_cur."!cursor_pos"(rx1218_pos) $P10 = rx1218_cur."block"() unless $P10, rx1218_fail rx1218_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("block") rx1218_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1218_cur."!cursor_pos"(rx1218_pos) $P10 = rx1218_cur."ws"() unless $P10, rx1218_fail rx1218_pos = $P10."pos"() .annotate 'line', 188 # rx pass rx1218_cur."!cursor_pass"(rx1218_pos, "statement_control:sym") if_null rx1218_debug, debug_511 rx1218_cur."!cursor_debug"("PASS", "statement_control:sym", " at pos=", rx1218_pos) debug_511: .return (rx1218_cur) rx1218_restart: .annotate 'line', 4 if_null rx1218_debug, debug_512 rx1218_cur."!cursor_debug"("NEXT", "statement_control:sym") debug_512: rx1218_fail: (rx1218_rep, rx1218_pos, $I10, $P10) = rx1218_cur."!mark_fail"(0) lt rx1218_pos, -1, rx1218_done eq rx1218_pos, -1, rx1218_fail jump $I10 rx1218_done: rx1218_cur."!cursor_fail"() if_null rx1218_debug, debug_513 rx1218_cur."!cursor_debug"("FAIL", "statement_control:sym") debug_513: .return (rx1218_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_control:sym" :subid("74_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "CATCH" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "statement_control:sym" :subid("75_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1223_tgt .local int rx1223_pos .local int rx1223_off .local int rx1223_eos .local int rx1223_rep .local pmc rx1223_cur .local pmc rx1223_debug (rx1223_cur, rx1223_pos, rx1223_tgt, $I10) = self."!cursor_start"() getattribute rx1223_debug, rx1223_cur, "$!debug" .lex unicode:"$\x{a2}", rx1223_cur .local pmc match .lex "$/", match length rx1223_eos, rx1223_tgt gt rx1223_pos, rx1223_eos, rx1223_done set rx1223_off, 0 lt rx1223_pos, 2, rx1223_start sub rx1223_off, rx1223_pos, 1 substr rx1223_tgt, rx1223_tgt, rx1223_off rx1223_start: eq $I10, 1, rx1223_restart if_null rx1223_debug, debug_514 rx1223_cur."!cursor_debug"("START", "statement_control:sym") debug_514: $I10 = self.'from'() ne $I10, -1, rxscan1225_done goto rxscan1225_scan rxscan1225_loop: ($P10) = rx1223_cur."from"() inc $P10 set rx1223_pos, $P10 ge rx1223_pos, rx1223_eos, rxscan1225_done rxscan1225_scan: set_addr $I10, rxscan1225_loop rx1223_cur."!mark_push"(0, rx1223_pos, $I10) rxscan1225_done: .annotate 'line', 194 # rx subcapture "sym" set_addr $I10, rxcap_1226_fail rx1223_cur."!mark_push"(0, rx1223_pos, $I10) # rx literal "CONTROL" add $I11, rx1223_pos, 7 gt $I11, rx1223_eos, rx1223_fail sub $I11, rx1223_pos, rx1223_off substr $S10, rx1223_tgt, $I11, 7 ne $S10, "CONTROL", rx1223_fail add rx1223_pos, 7 set_addr $I10, rxcap_1226_fail ($I12, $I11) = rx1223_cur."!mark_peek"($I10) rx1223_cur."!cursor_pos"($I11) ($P10) = rx1223_cur."!cursor_start"() $P10."!cursor_pass"(rx1223_pos, "") rx1223_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1226_done rxcap_1226_fail: goto rx1223_fail rxcap_1226_done: # rx charclass s ge rx1223_pos, rx1223_eos, rx1223_fail sub $I10, rx1223_pos, rx1223_off is_cclass $I11, 32, rx1223_tgt, $I10 unless $I11, rx1223_fail inc rx1223_pos # rx subrule "ws" subtype=method negate= rx1223_cur."!cursor_pos"(rx1223_pos) $P10 = rx1223_cur."ws"() unless $P10, rx1223_fail rx1223_pos = $P10."pos"() .annotate 'line', 195 # rx subrule "block" subtype=capture negate= rx1223_cur."!cursor_pos"(rx1223_pos) $P10 = rx1223_cur."block"() unless $P10, rx1223_fail rx1223_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("block") rx1223_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1223_cur."!cursor_pos"(rx1223_pos) $P10 = rx1223_cur."ws"() unless $P10, rx1223_fail rx1223_pos = $P10."pos"() .annotate 'line', 193 # rx pass rx1223_cur."!cursor_pass"(rx1223_pos, "statement_control:sym") if_null rx1223_debug, debug_515 rx1223_cur."!cursor_debug"("PASS", "statement_control:sym", " at pos=", rx1223_pos) debug_515: .return (rx1223_cur) rx1223_restart: .annotate 'line', 4 if_null rx1223_debug, debug_516 rx1223_cur."!cursor_debug"("NEXT", "statement_control:sym") debug_516: rx1223_fail: (rx1223_rep, rx1223_pos, $I10, $P10) = rx1223_cur."!mark_fail"(0) lt rx1223_pos, -1, rx1223_done eq rx1223_pos, -1, rx1223_fail jump $I10 rx1223_done: rx1223_cur."!cursor_fail"() if_null rx1223_debug, debug_517 rx1223_cur."!cursor_debug"("FAIL", "statement_control:sym") debug_517: .return (rx1223_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_control:sym" :subid("76_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "CONTROL" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "statement_prefix" :subid("77_1309998847.42912") :method .annotate 'line', 198 $P100 = self."!protoregex"("statement_prefix") .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_prefix" :subid("78_1309998847.42912") :method .annotate 'line', 198 $P101 = self."!PREFIX__!protoregex"("statement_prefix") .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "statement_prefix:sym" :subid("79_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1230_tgt .local int rx1230_pos .local int rx1230_off .local int rx1230_eos .local int rx1230_rep .local pmc rx1230_cur .local pmc rx1230_debug (rx1230_cur, rx1230_pos, rx1230_tgt, $I10) = self."!cursor_start"() getattribute rx1230_debug, rx1230_cur, "$!debug" .lex unicode:"$\x{a2}", rx1230_cur .local pmc match .lex "$/", match length rx1230_eos, rx1230_tgt gt rx1230_pos, rx1230_eos, rx1230_done set rx1230_off, 0 lt rx1230_pos, 2, rx1230_start sub rx1230_off, rx1230_pos, 1 substr rx1230_tgt, rx1230_tgt, rx1230_off rx1230_start: eq $I10, 1, rx1230_restart if_null rx1230_debug, debug_518 rx1230_cur."!cursor_debug"("START", "statement_prefix:sym") debug_518: $I10 = self.'from'() ne $I10, -1, rxscan1232_done goto rxscan1232_scan rxscan1232_loop: ($P10) = rx1230_cur."from"() inc $P10 set rx1230_pos, $P10 ge rx1230_pos, rx1230_eos, rxscan1232_done rxscan1232_scan: set_addr $I10, rxscan1232_loop rx1230_cur."!mark_push"(0, rx1230_pos, $I10) rxscan1232_done: .annotate 'line', 199 # rx subcapture "sym" set_addr $I10, rxcap_1233_fail rx1230_cur."!mark_push"(0, rx1230_pos, $I10) # rx literal "INIT" add $I11, rx1230_pos, 4 gt $I11, rx1230_eos, rx1230_fail sub $I11, rx1230_pos, rx1230_off substr $S10, rx1230_tgt, $I11, 4 ne $S10, "INIT", rx1230_fail add rx1230_pos, 4 set_addr $I10, rxcap_1233_fail ($I12, $I11) = rx1230_cur."!mark_peek"($I10) rx1230_cur."!cursor_pos"($I11) ($P10) = rx1230_cur."!cursor_start"() $P10."!cursor_pass"(rx1230_pos, "") rx1230_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1233_done rxcap_1233_fail: goto rx1230_fail rxcap_1233_done: # rx subrule "blorst" subtype=capture negate= rx1230_cur."!cursor_pos"(rx1230_pos) $P10 = rx1230_cur."blorst"() unless $P10, rx1230_fail rx1230_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("blorst") rx1230_pos = $P10."pos"() # rx pass rx1230_cur."!cursor_pass"(rx1230_pos, "statement_prefix:sym") if_null rx1230_debug, debug_519 rx1230_cur."!cursor_debug"("PASS", "statement_prefix:sym", " at pos=", rx1230_pos) debug_519: .return (rx1230_cur) rx1230_restart: .annotate 'line', 4 if_null rx1230_debug, debug_520 rx1230_cur."!cursor_debug"("NEXT", "statement_prefix:sym") debug_520: rx1230_fail: (rx1230_rep, rx1230_pos, $I10, $P10) = rx1230_cur."!mark_fail"(0) lt rx1230_pos, -1, rx1230_done eq rx1230_pos, -1, rx1230_fail jump $I10 rx1230_done: rx1230_cur."!cursor_fail"() if_null rx1230_debug, debug_521 rx1230_cur."!cursor_debug"("FAIL", "statement_prefix:sym") debug_521: .return (rx1230_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_prefix:sym" :subid("80_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("blorst", "INIT") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "statement_prefix:sym" :subid("81_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1235_tgt .local int rx1235_pos .local int rx1235_off .local int rx1235_eos .local int rx1235_rep .local pmc rx1235_cur .local pmc rx1235_debug (rx1235_cur, rx1235_pos, rx1235_tgt, $I10) = self."!cursor_start"() getattribute rx1235_debug, rx1235_cur, "$!debug" .lex unicode:"$\x{a2}", rx1235_cur .local pmc match .lex "$/", match length rx1235_eos, rx1235_tgt gt rx1235_pos, rx1235_eos, rx1235_done set rx1235_off, 0 lt rx1235_pos, 2, rx1235_start sub rx1235_off, rx1235_pos, 1 substr rx1235_tgt, rx1235_tgt, rx1235_off rx1235_start: eq $I10, 1, rx1235_restart if_null rx1235_debug, debug_522 rx1235_cur."!cursor_debug"("START", "statement_prefix:sym") debug_522: $I10 = self.'from'() ne $I10, -1, rxscan1237_done goto rxscan1237_scan rxscan1237_loop: ($P10) = rx1235_cur."from"() inc $P10 set rx1235_pos, $P10 ge rx1235_pos, rx1235_eos, rxscan1237_done rxscan1237_scan: set_addr $I10, rxscan1237_loop rx1235_cur."!mark_push"(0, rx1235_pos, $I10) rxscan1237_done: .annotate 'line', 202 # rx subcapture "sym" set_addr $I10, rxcap_1238_fail rx1235_cur."!mark_push"(0, rx1235_pos, $I10) # rx literal "try" add $I11, rx1235_pos, 3 gt $I11, rx1235_eos, rx1235_fail sub $I11, rx1235_pos, rx1235_off substr $S10, rx1235_tgt, $I11, 3 ne $S10, "try", rx1235_fail add rx1235_pos, 3 set_addr $I10, rxcap_1238_fail ($I12, $I11) = rx1235_cur."!mark_peek"($I10) rx1235_cur."!cursor_pos"($I11) ($P10) = rx1235_cur."!cursor_start"() $P10."!cursor_pass"(rx1235_pos, "") rx1235_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1238_done rxcap_1238_fail: goto rx1235_fail rxcap_1238_done: .annotate 'line', 203 # rx subrule "blorst" subtype=capture negate= rx1235_cur."!cursor_pos"(rx1235_pos) $P10 = rx1235_cur."blorst"() unless $P10, rx1235_fail rx1235_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("blorst") rx1235_pos = $P10."pos"() .annotate 'line', 201 # rx pass rx1235_cur."!cursor_pass"(rx1235_pos, "statement_prefix:sym") if_null rx1235_debug, debug_523 rx1235_cur."!cursor_debug"("PASS", "statement_prefix:sym", " at pos=", rx1235_pos) debug_523: .return (rx1235_cur) rx1235_restart: .annotate 'line', 4 if_null rx1235_debug, debug_524 rx1235_cur."!cursor_debug"("NEXT", "statement_prefix:sym") debug_524: rx1235_fail: (rx1235_rep, rx1235_pos, $I10, $P10) = rx1235_cur."!mark_fail"(0) lt rx1235_pos, -1, rx1235_done eq rx1235_pos, -1, rx1235_fail jump $I10 rx1235_done: rx1235_cur."!cursor_fail"() if_null rx1235_debug, debug_525 rx1235_cur."!cursor_debug"("FAIL", "statement_prefix:sym") debug_525: .return (rx1235_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_prefix:sym" :subid("82_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("blorst", "try") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "blorst" :subid("83_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1240_tgt .local int rx1240_pos .local int rx1240_off .local int rx1240_eos .local int rx1240_rep .local pmc rx1240_cur .local pmc rx1240_debug (rx1240_cur, rx1240_pos, rx1240_tgt, $I10) = self."!cursor_start"() getattribute rx1240_debug, rx1240_cur, "$!debug" .lex unicode:"$\x{a2}", rx1240_cur .local pmc match .lex "$/", match length rx1240_eos, rx1240_tgt gt rx1240_pos, rx1240_eos, rx1240_done set rx1240_off, 0 lt rx1240_pos, 2, rx1240_start sub rx1240_off, rx1240_pos, 1 substr rx1240_tgt, rx1240_tgt, rx1240_off rx1240_start: eq $I10, 1, rx1240_restart if_null rx1240_debug, debug_526 rx1240_cur."!cursor_debug"("START", "blorst") debug_526: $I10 = self.'from'() ne $I10, -1, rxscan1242_done goto rxscan1242_scan rxscan1242_loop: ($P10) = rx1240_cur."from"() inc $P10 set rx1240_pos, $P10 ge rx1240_pos, rx1240_eos, rxscan1242_done rxscan1242_scan: set_addr $I10, rxscan1242_loop rx1240_cur."!mark_push"(0, rx1240_pos, $I10) rxscan1242_done: .annotate 'line', 207 # rx charclass s ge rx1240_pos, rx1240_eos, rx1240_fail sub $I10, rx1240_pos, rx1240_off is_cclass $I11, 32, rx1240_tgt, $I10 unless $I11, rx1240_fail inc rx1240_pos # rx subrule "ws" subtype=method negate= rx1240_cur."!cursor_pos"(rx1240_pos) $P10 = rx1240_cur."ws"() unless $P10, rx1240_fail rx1240_pos = $P10."pos"() alt1243_0: set_addr $I10, alt1243_1 rx1240_cur."!mark_push"(0, rx1240_pos, $I10) # rx enumcharlist negate=0 zerowidth sub $I10, rx1240_pos, rx1240_off substr $S10, rx1240_tgt, $I10, 1 index $I11, "{", $S10 lt $I11, 0, rx1240_fail # rx subrule "block" subtype=capture negate= rx1240_cur."!cursor_pos"(rx1240_pos) $P10 = rx1240_cur."block"() unless $P10, rx1240_fail rx1240_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("block") rx1240_pos = $P10."pos"() goto alt1243_end alt1243_1: # rx subrule "statement" subtype=capture negate= rx1240_cur."!cursor_pos"(rx1240_pos) $P10 = rx1240_cur."statement"() unless $P10, rx1240_fail rx1240_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("statement") rx1240_pos = $P10."pos"() alt1243_end: .annotate 'line', 206 # rx pass rx1240_cur."!cursor_pass"(rx1240_pos, "blorst") if_null rx1240_debug, debug_527 rx1240_cur."!cursor_debug"("PASS", "blorst", " at pos=", rx1240_pos) debug_527: .return (rx1240_cur) rx1240_restart: .annotate 'line', 4 if_null rx1240_debug, debug_528 rx1240_cur."!cursor_debug"("NEXT", "blorst") debug_528: rx1240_fail: (rx1240_rep, rx1240_pos, $I10, $P10) = rx1240_cur."!mark_fail"(0) lt rx1240_pos, -1, rx1240_done eq rx1240_pos, -1, rx1240_fail jump $I10 rx1240_done: rx1240_cur."!cursor_fail"() if_null rx1240_debug, debug_529 rx1240_cur."!cursor_debug"("FAIL", "blorst") debug_529: .return (rx1240_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__blorst" :subid("84_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "statement_mod_cond" :subid("85_1309998847.42912") :method .annotate 'line', 212 $P100 = self."!protoregex"("statement_mod_cond") .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_mod_cond" :subid("86_1309998847.42912") :method .annotate 'line', 212 $P101 = self."!PREFIX__!protoregex"("statement_mod_cond") .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "statement_mod_cond:sym" :subid("87_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1247_tgt .local int rx1247_pos .local int rx1247_off .local int rx1247_eos .local int rx1247_rep .local pmc rx1247_cur .local pmc rx1247_debug (rx1247_cur, rx1247_pos, rx1247_tgt, $I10) = self."!cursor_start"() getattribute rx1247_debug, rx1247_cur, "$!debug" .lex unicode:"$\x{a2}", rx1247_cur .local pmc match .lex "$/", match length rx1247_eos, rx1247_tgt gt rx1247_pos, rx1247_eos, rx1247_done set rx1247_off, 0 lt rx1247_pos, 2, rx1247_start sub rx1247_off, rx1247_pos, 1 substr rx1247_tgt, rx1247_tgt, rx1247_off rx1247_start: eq $I10, 1, rx1247_restart if_null rx1247_debug, debug_530 rx1247_cur."!cursor_debug"("START", "statement_mod_cond:sym") debug_530: $I10 = self.'from'() ne $I10, -1, rxscan1249_done goto rxscan1249_scan rxscan1249_loop: ($P10) = rx1247_cur."from"() inc $P10 set rx1247_pos, $P10 ge rx1247_pos, rx1247_eos, rxscan1249_done rxscan1249_scan: set_addr $I10, rxscan1249_loop rx1247_cur."!mark_push"(0, rx1247_pos, $I10) rxscan1249_done: .annotate 'line', 214 # rx subcapture "sym" set_addr $I10, rxcap_1250_fail rx1247_cur."!mark_push"(0, rx1247_pos, $I10) # rx literal "if" add $I11, rx1247_pos, 2 gt $I11, rx1247_eos, rx1247_fail sub $I11, rx1247_pos, rx1247_off substr $S10, rx1247_tgt, $I11, 2 ne $S10, "if", rx1247_fail add rx1247_pos, 2 set_addr $I10, rxcap_1250_fail ($I12, $I11) = rx1247_cur."!mark_peek"($I10) rx1247_cur."!cursor_pos"($I11) ($P10) = rx1247_cur."!cursor_start"() $P10."!cursor_pass"(rx1247_pos, "") rx1247_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1250_done rxcap_1250_fail: goto rx1247_fail rxcap_1250_done: # rx subrule "ws" subtype=method negate= rx1247_cur."!cursor_pos"(rx1247_pos) $P10 = rx1247_cur."ws"() unless $P10, rx1247_fail rx1247_pos = $P10."pos"() # rx subrule "EXPR" subtype=capture negate= rx1247_cur."!cursor_pos"(rx1247_pos) $P10 = rx1247_cur."EXPR"() unless $P10, rx1247_fail rx1247_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("cond") rx1247_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1247_cur."!cursor_pos"(rx1247_pos) $P10 = rx1247_cur."ws"() unless $P10, rx1247_fail rx1247_pos = $P10."pos"() # rx pass rx1247_cur."!cursor_pass"(rx1247_pos, "statement_mod_cond:sym") if_null rx1247_debug, debug_531 rx1247_cur."!cursor_debug"("PASS", "statement_mod_cond:sym", " at pos=", rx1247_pos) debug_531: .return (rx1247_cur) rx1247_restart: .annotate 'line', 4 if_null rx1247_debug, debug_532 rx1247_cur."!cursor_debug"("NEXT", "statement_mod_cond:sym") debug_532: rx1247_fail: (rx1247_rep, rx1247_pos, $I10, $P10) = rx1247_cur."!mark_fail"(0) lt rx1247_pos, -1, rx1247_done eq rx1247_pos, -1, rx1247_fail jump $I10 rx1247_done: rx1247_cur."!cursor_fail"() if_null rx1247_debug, debug_533 rx1247_cur."!cursor_debug"("FAIL", "statement_mod_cond:sym") debug_533: .return (rx1247_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_mod_cond:sym" :subid("88_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "if") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "statement_mod_cond:sym" :subid("89_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1252_tgt .local int rx1252_pos .local int rx1252_off .local int rx1252_eos .local int rx1252_rep .local pmc rx1252_cur .local pmc rx1252_debug (rx1252_cur, rx1252_pos, rx1252_tgt, $I10) = self."!cursor_start"() getattribute rx1252_debug, rx1252_cur, "$!debug" .lex unicode:"$\x{a2}", rx1252_cur .local pmc match .lex "$/", match length rx1252_eos, rx1252_tgt gt rx1252_pos, rx1252_eos, rx1252_done set rx1252_off, 0 lt rx1252_pos, 2, rx1252_start sub rx1252_off, rx1252_pos, 1 substr rx1252_tgt, rx1252_tgt, rx1252_off rx1252_start: eq $I10, 1, rx1252_restart if_null rx1252_debug, debug_534 rx1252_cur."!cursor_debug"("START", "statement_mod_cond:sym") debug_534: $I10 = self.'from'() ne $I10, -1, rxscan1254_done goto rxscan1254_scan rxscan1254_loop: ($P10) = rx1252_cur."from"() inc $P10 set rx1252_pos, $P10 ge rx1252_pos, rx1252_eos, rxscan1254_done rxscan1254_scan: set_addr $I10, rxscan1254_loop rx1252_cur."!mark_push"(0, rx1252_pos, $I10) rxscan1254_done: .annotate 'line', 215 # rx subcapture "sym" set_addr $I10, rxcap_1255_fail rx1252_cur."!mark_push"(0, rx1252_pos, $I10) # rx literal "unless" add $I11, rx1252_pos, 6 gt $I11, rx1252_eos, rx1252_fail sub $I11, rx1252_pos, rx1252_off substr $S10, rx1252_tgt, $I11, 6 ne $S10, "unless", rx1252_fail add rx1252_pos, 6 set_addr $I10, rxcap_1255_fail ($I12, $I11) = rx1252_cur."!mark_peek"($I10) rx1252_cur."!cursor_pos"($I11) ($P10) = rx1252_cur."!cursor_start"() $P10."!cursor_pass"(rx1252_pos, "") rx1252_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1255_done rxcap_1255_fail: goto rx1252_fail rxcap_1255_done: # rx subrule "ws" subtype=method negate= rx1252_cur."!cursor_pos"(rx1252_pos) $P10 = rx1252_cur."ws"() unless $P10, rx1252_fail rx1252_pos = $P10."pos"() # rx subrule "EXPR" subtype=capture negate= rx1252_cur."!cursor_pos"(rx1252_pos) $P10 = rx1252_cur."EXPR"() unless $P10, rx1252_fail rx1252_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("cond") rx1252_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1252_cur."!cursor_pos"(rx1252_pos) $P10 = rx1252_cur."ws"() unless $P10, rx1252_fail rx1252_pos = $P10."pos"() # rx pass rx1252_cur."!cursor_pass"(rx1252_pos, "statement_mod_cond:sym") if_null rx1252_debug, debug_535 rx1252_cur."!cursor_debug"("PASS", "statement_mod_cond:sym", " at pos=", rx1252_pos) debug_535: .return (rx1252_cur) rx1252_restart: .annotate 'line', 4 if_null rx1252_debug, debug_536 rx1252_cur."!cursor_debug"("NEXT", "statement_mod_cond:sym") debug_536: rx1252_fail: (rx1252_rep, rx1252_pos, $I10, $P10) = rx1252_cur."!mark_fail"(0) lt rx1252_pos, -1, rx1252_done eq rx1252_pos, -1, rx1252_fail jump $I10 rx1252_done: rx1252_cur."!cursor_fail"() if_null rx1252_debug, debug_537 rx1252_cur."!cursor_debug"("FAIL", "statement_mod_cond:sym") debug_537: .return (rx1252_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_mod_cond:sym" :subid("90_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "unless") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "statement_mod_loop" :subid("91_1309998847.42912") :method .annotate 'line', 217 $P100 = self."!protoregex"("statement_mod_loop") .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_mod_loop" :subid("92_1309998847.42912") :method .annotate 'line', 217 $P101 = self."!PREFIX__!protoregex"("statement_mod_loop") .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "statement_mod_loop:sym" :subid("93_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1259_tgt .local int rx1259_pos .local int rx1259_off .local int rx1259_eos .local int rx1259_rep .local pmc rx1259_cur .local pmc rx1259_debug (rx1259_cur, rx1259_pos, rx1259_tgt, $I10) = self."!cursor_start"() getattribute rx1259_debug, rx1259_cur, "$!debug" .lex unicode:"$\x{a2}", rx1259_cur .local pmc match .lex "$/", match length rx1259_eos, rx1259_tgt gt rx1259_pos, rx1259_eos, rx1259_done set rx1259_off, 0 lt rx1259_pos, 2, rx1259_start sub rx1259_off, rx1259_pos, 1 substr rx1259_tgt, rx1259_tgt, rx1259_off rx1259_start: eq $I10, 1, rx1259_restart if_null rx1259_debug, debug_538 rx1259_cur."!cursor_debug"("START", "statement_mod_loop:sym") debug_538: $I10 = self.'from'() ne $I10, -1, rxscan1261_done goto rxscan1261_scan rxscan1261_loop: ($P10) = rx1259_cur."from"() inc $P10 set rx1259_pos, $P10 ge rx1259_pos, rx1259_eos, rxscan1261_done rxscan1261_scan: set_addr $I10, rxscan1261_loop rx1259_cur."!mark_push"(0, rx1259_pos, $I10) rxscan1261_done: .annotate 'line', 219 # rx subcapture "sym" set_addr $I10, rxcap_1262_fail rx1259_cur."!mark_push"(0, rx1259_pos, $I10) # rx literal "while" add $I11, rx1259_pos, 5 gt $I11, rx1259_eos, rx1259_fail sub $I11, rx1259_pos, rx1259_off substr $S10, rx1259_tgt, $I11, 5 ne $S10, "while", rx1259_fail add rx1259_pos, 5 set_addr $I10, rxcap_1262_fail ($I12, $I11) = rx1259_cur."!mark_peek"($I10) rx1259_cur."!cursor_pos"($I11) ($P10) = rx1259_cur."!cursor_start"() $P10."!cursor_pass"(rx1259_pos, "") rx1259_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1262_done rxcap_1262_fail: goto rx1259_fail rxcap_1262_done: # rx subrule "ws" subtype=method negate= rx1259_cur."!cursor_pos"(rx1259_pos) $P10 = rx1259_cur."ws"() unless $P10, rx1259_fail rx1259_pos = $P10."pos"() # rx subrule "EXPR" subtype=capture negate= rx1259_cur."!cursor_pos"(rx1259_pos) $P10 = rx1259_cur."EXPR"() unless $P10, rx1259_fail rx1259_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("cond") rx1259_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1259_cur."!cursor_pos"(rx1259_pos) $P10 = rx1259_cur."ws"() unless $P10, rx1259_fail rx1259_pos = $P10."pos"() # rx pass rx1259_cur."!cursor_pass"(rx1259_pos, "statement_mod_loop:sym") if_null rx1259_debug, debug_539 rx1259_cur."!cursor_debug"("PASS", "statement_mod_loop:sym", " at pos=", rx1259_pos) debug_539: .return (rx1259_cur) rx1259_restart: .annotate 'line', 4 if_null rx1259_debug, debug_540 rx1259_cur."!cursor_debug"("NEXT", "statement_mod_loop:sym") debug_540: rx1259_fail: (rx1259_rep, rx1259_pos, $I10, $P10) = rx1259_cur."!mark_fail"(0) lt rx1259_pos, -1, rx1259_done eq rx1259_pos, -1, rx1259_fail jump $I10 rx1259_done: rx1259_cur."!cursor_fail"() if_null rx1259_debug, debug_541 rx1259_cur."!cursor_debug"("FAIL", "statement_mod_loop:sym") debug_541: .return (rx1259_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_mod_loop:sym" :subid("94_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "while") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "statement_mod_loop:sym" :subid("95_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1264_tgt .local int rx1264_pos .local int rx1264_off .local int rx1264_eos .local int rx1264_rep .local pmc rx1264_cur .local pmc rx1264_debug (rx1264_cur, rx1264_pos, rx1264_tgt, $I10) = self."!cursor_start"() getattribute rx1264_debug, rx1264_cur, "$!debug" .lex unicode:"$\x{a2}", rx1264_cur .local pmc match .lex "$/", match length rx1264_eos, rx1264_tgt gt rx1264_pos, rx1264_eos, rx1264_done set rx1264_off, 0 lt rx1264_pos, 2, rx1264_start sub rx1264_off, rx1264_pos, 1 substr rx1264_tgt, rx1264_tgt, rx1264_off rx1264_start: eq $I10, 1, rx1264_restart if_null rx1264_debug, debug_542 rx1264_cur."!cursor_debug"("START", "statement_mod_loop:sym") debug_542: $I10 = self.'from'() ne $I10, -1, rxscan1266_done goto rxscan1266_scan rxscan1266_loop: ($P10) = rx1264_cur."from"() inc $P10 set rx1264_pos, $P10 ge rx1264_pos, rx1264_eos, rxscan1266_done rxscan1266_scan: set_addr $I10, rxscan1266_loop rx1264_cur."!mark_push"(0, rx1264_pos, $I10) rxscan1266_done: .annotate 'line', 220 # rx subcapture "sym" set_addr $I10, rxcap_1267_fail rx1264_cur."!mark_push"(0, rx1264_pos, $I10) # rx literal "until" add $I11, rx1264_pos, 5 gt $I11, rx1264_eos, rx1264_fail sub $I11, rx1264_pos, rx1264_off substr $S10, rx1264_tgt, $I11, 5 ne $S10, "until", rx1264_fail add rx1264_pos, 5 set_addr $I10, rxcap_1267_fail ($I12, $I11) = rx1264_cur."!mark_peek"($I10) rx1264_cur."!cursor_pos"($I11) ($P10) = rx1264_cur."!cursor_start"() $P10."!cursor_pass"(rx1264_pos, "") rx1264_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1267_done rxcap_1267_fail: goto rx1264_fail rxcap_1267_done: # rx subrule "ws" subtype=method negate= rx1264_cur."!cursor_pos"(rx1264_pos) $P10 = rx1264_cur."ws"() unless $P10, rx1264_fail rx1264_pos = $P10."pos"() # rx subrule "EXPR" subtype=capture negate= rx1264_cur."!cursor_pos"(rx1264_pos) $P10 = rx1264_cur."EXPR"() unless $P10, rx1264_fail rx1264_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("cond") rx1264_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1264_cur."!cursor_pos"(rx1264_pos) $P10 = rx1264_cur."ws"() unless $P10, rx1264_fail rx1264_pos = $P10."pos"() # rx pass rx1264_cur."!cursor_pass"(rx1264_pos, "statement_mod_loop:sym") if_null rx1264_debug, debug_543 rx1264_cur."!cursor_debug"("PASS", "statement_mod_loop:sym", " at pos=", rx1264_pos) debug_543: .return (rx1264_cur) rx1264_restart: .annotate 'line', 4 if_null rx1264_debug, debug_544 rx1264_cur."!cursor_debug"("NEXT", "statement_mod_loop:sym") debug_544: rx1264_fail: (rx1264_rep, rx1264_pos, $I10, $P10) = rx1264_cur."!mark_fail"(0) lt rx1264_pos, -1, rx1264_done eq rx1264_pos, -1, rx1264_fail jump $I10 rx1264_done: rx1264_cur."!cursor_fail"() if_null rx1264_debug, debug_545 rx1264_cur."!cursor_debug"("FAIL", "statement_mod_loop:sym") debug_545: .return (rx1264_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_mod_loop:sym" :subid("96_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "until") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "statement_mod_loop:sym" :subid("97_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1269_tgt .local int rx1269_pos .local int rx1269_off .local int rx1269_eos .local int rx1269_rep .local pmc rx1269_cur .local pmc rx1269_debug (rx1269_cur, rx1269_pos, rx1269_tgt, $I10) = self."!cursor_start"() getattribute rx1269_debug, rx1269_cur, "$!debug" .lex unicode:"$\x{a2}", rx1269_cur .local pmc match .lex "$/", match length rx1269_eos, rx1269_tgt gt rx1269_pos, rx1269_eos, rx1269_done set rx1269_off, 0 lt rx1269_pos, 2, rx1269_start sub rx1269_off, rx1269_pos, 1 substr rx1269_tgt, rx1269_tgt, rx1269_off rx1269_start: eq $I10, 1, rx1269_restart if_null rx1269_debug, debug_546 rx1269_cur."!cursor_debug"("START", "statement_mod_loop:sym") debug_546: $I10 = self.'from'() ne $I10, -1, rxscan1271_done goto rxscan1271_scan rxscan1271_loop: ($P10) = rx1269_cur."from"() inc $P10 set rx1269_pos, $P10 ge rx1269_pos, rx1269_eos, rxscan1271_done rxscan1271_scan: set_addr $I10, rxscan1271_loop rx1269_cur."!mark_push"(0, rx1269_pos, $I10) rxscan1271_done: .annotate 'line', 221 # rx subcapture "sym" set_addr $I10, rxcap_1272_fail rx1269_cur."!mark_push"(0, rx1269_pos, $I10) # rx literal "for" add $I11, rx1269_pos, 3 gt $I11, rx1269_eos, rx1269_fail sub $I11, rx1269_pos, rx1269_off substr $S10, rx1269_tgt, $I11, 3 ne $S10, "for", rx1269_fail add rx1269_pos, 3 set_addr $I10, rxcap_1272_fail ($I12, $I11) = rx1269_cur."!mark_peek"($I10) rx1269_cur."!cursor_pos"($I11) ($P10) = rx1269_cur."!cursor_start"() $P10."!cursor_pass"(rx1269_pos, "") rx1269_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1272_done rxcap_1272_fail: goto rx1269_fail rxcap_1272_done: # rx subrule "ws" subtype=method negate= rx1269_cur."!cursor_pos"(rx1269_pos) $P10 = rx1269_cur."ws"() unless $P10, rx1269_fail rx1269_pos = $P10."pos"() # rx subrule "EXPR" subtype=capture negate= rx1269_cur."!cursor_pos"(rx1269_pos) $P10 = rx1269_cur."EXPR"() unless $P10, rx1269_fail rx1269_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("cond") rx1269_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1269_cur."!cursor_pos"(rx1269_pos) $P10 = rx1269_cur."ws"() unless $P10, rx1269_fail rx1269_pos = $P10."pos"() # rx pass rx1269_cur."!cursor_pass"(rx1269_pos, "statement_mod_loop:sym") if_null rx1269_debug, debug_547 rx1269_cur."!cursor_debug"("PASS", "statement_mod_loop:sym", " at pos=", rx1269_pos) debug_547: .return (rx1269_cur) rx1269_restart: .annotate 'line', 4 if_null rx1269_debug, debug_548 rx1269_cur."!cursor_debug"("NEXT", "statement_mod_loop:sym") debug_548: rx1269_fail: (rx1269_rep, rx1269_pos, $I10, $P10) = rx1269_cur."!mark_fail"(0) lt rx1269_pos, -1, rx1269_done eq rx1269_pos, -1, rx1269_fail jump $I10 rx1269_done: rx1269_cur."!cursor_fail"() if_null rx1269_debug, debug_549 rx1269_cur."!cursor_debug"("FAIL", "statement_mod_loop:sym") debug_549: .return (rx1269_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__statement_mod_loop:sym" :subid("98_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "for") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("99_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1274_tgt .local int rx1274_pos .local int rx1274_off .local int rx1274_eos .local int rx1274_rep .local pmc rx1274_cur .local pmc rx1274_debug (rx1274_cur, rx1274_pos, rx1274_tgt, $I10) = self."!cursor_start"() getattribute rx1274_debug, rx1274_cur, "$!debug" .lex unicode:"$\x{a2}", rx1274_cur .local pmc match .lex "$/", match length rx1274_eos, rx1274_tgt gt rx1274_pos, rx1274_eos, rx1274_done set rx1274_off, 0 lt rx1274_pos, 2, rx1274_start sub rx1274_off, rx1274_pos, 1 substr rx1274_tgt, rx1274_tgt, rx1274_off rx1274_start: eq $I10, 1, rx1274_restart if_null rx1274_debug, debug_550 rx1274_cur."!cursor_debug"("START", "term:sym") debug_550: $I10 = self.'from'() ne $I10, -1, rxscan1276_done goto rxscan1276_scan rxscan1276_loop: ($P10) = rx1274_cur."from"() inc $P10 set rx1274_pos, $P10 ge rx1274_pos, rx1274_eos, rxscan1276_done rxscan1276_scan: set_addr $I10, rxscan1276_loop rx1274_cur."!mark_push"(0, rx1274_pos, $I10) rxscan1276_done: .annotate 'line', 225 # rx subrule "fatarrow" subtype=capture negate= rx1274_cur."!cursor_pos"(rx1274_pos) $P10 = rx1274_cur."fatarrow"() unless $P10, rx1274_fail rx1274_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("fatarrow") rx1274_pos = $P10."pos"() # rx pass rx1274_cur."!cursor_pass"(rx1274_pos, "term:sym") if_null rx1274_debug, debug_551 rx1274_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1274_pos) debug_551: .return (rx1274_cur) rx1274_restart: .annotate 'line', 4 if_null rx1274_debug, debug_552 rx1274_cur."!cursor_debug"("NEXT", "term:sym") debug_552: rx1274_fail: (rx1274_rep, rx1274_pos, $I10, $P10) = rx1274_cur."!mark_fail"(0) lt rx1274_pos, -1, rx1274_done eq rx1274_pos, -1, rx1274_fail jump $I10 rx1274_done: rx1274_cur."!cursor_fail"() if_null rx1274_debug, debug_553 rx1274_cur."!cursor_debug"("FAIL", "term:sym") debug_553: .return (rx1274_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("100_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("fatarrow", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("101_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1278_tgt .local int rx1278_pos .local int rx1278_off .local int rx1278_eos .local int rx1278_rep .local pmc rx1278_cur .local pmc rx1278_debug (rx1278_cur, rx1278_pos, rx1278_tgt, $I10) = self."!cursor_start"() getattribute rx1278_debug, rx1278_cur, "$!debug" .lex unicode:"$\x{a2}", rx1278_cur .local pmc match .lex "$/", match length rx1278_eos, rx1278_tgt gt rx1278_pos, rx1278_eos, rx1278_done set rx1278_off, 0 lt rx1278_pos, 2, rx1278_start sub rx1278_off, rx1278_pos, 1 substr rx1278_tgt, rx1278_tgt, rx1278_off rx1278_start: eq $I10, 1, rx1278_restart if_null rx1278_debug, debug_554 rx1278_cur."!cursor_debug"("START", "term:sym") debug_554: $I10 = self.'from'() ne $I10, -1, rxscan1280_done goto rxscan1280_scan rxscan1280_loop: ($P10) = rx1278_cur."from"() inc $P10 set rx1278_pos, $P10 ge rx1278_pos, rx1278_eos, rxscan1280_done rxscan1280_scan: set_addr $I10, rxscan1280_loop rx1278_cur."!mark_push"(0, rx1278_pos, $I10) rxscan1280_done: .annotate 'line', 226 # rx subrule "colonpair" subtype=capture negate= rx1278_cur."!cursor_pos"(rx1278_pos) $P10 = rx1278_cur."colonpair"() unless $P10, rx1278_fail rx1278_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("colonpair") rx1278_pos = $P10."pos"() # rx pass rx1278_cur."!cursor_pass"(rx1278_pos, "term:sym") if_null rx1278_debug, debug_555 rx1278_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1278_pos) debug_555: .return (rx1278_cur) rx1278_restart: .annotate 'line', 4 if_null rx1278_debug, debug_556 rx1278_cur."!cursor_debug"("NEXT", "term:sym") debug_556: rx1278_fail: (rx1278_rep, rx1278_pos, $I10, $P10) = rx1278_cur."!mark_fail"(0) lt rx1278_pos, -1, rx1278_done eq rx1278_pos, -1, rx1278_fail jump $I10 rx1278_done: rx1278_cur."!cursor_fail"() if_null rx1278_debug, debug_557 rx1278_cur."!cursor_debug"("FAIL", "term:sym") debug_557: .return (rx1278_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("102_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("colonpair", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("103_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1282_tgt .local int rx1282_pos .local int rx1282_off .local int rx1282_eos .local int rx1282_rep .local pmc rx1282_cur .local pmc rx1282_debug (rx1282_cur, rx1282_pos, rx1282_tgt, $I10) = self."!cursor_start"() getattribute rx1282_debug, rx1282_cur, "$!debug" .lex unicode:"$\x{a2}", rx1282_cur .local pmc match .lex "$/", match length rx1282_eos, rx1282_tgt gt rx1282_pos, rx1282_eos, rx1282_done set rx1282_off, 0 lt rx1282_pos, 2, rx1282_start sub rx1282_off, rx1282_pos, 1 substr rx1282_tgt, rx1282_tgt, rx1282_off rx1282_start: eq $I10, 1, rx1282_restart if_null rx1282_debug, debug_558 rx1282_cur."!cursor_debug"("START", "term:sym") debug_558: $I10 = self.'from'() ne $I10, -1, rxscan1284_done goto rxscan1284_scan rxscan1284_loop: ($P10) = rx1282_cur."from"() inc $P10 set rx1282_pos, $P10 ge rx1282_pos, rx1282_eos, rxscan1284_done rxscan1284_scan: set_addr $I10, rxscan1284_loop rx1282_cur."!mark_push"(0, rx1282_pos, $I10) rxscan1284_done: .annotate 'line', 227 # rx subrule "variable" subtype=capture negate= rx1282_cur."!cursor_pos"(rx1282_pos) $P10 = rx1282_cur."variable"() unless $P10, rx1282_fail rx1282_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("variable") rx1282_pos = $P10."pos"() # rx pass rx1282_cur."!cursor_pass"(rx1282_pos, "term:sym") if_null rx1282_debug, debug_559 rx1282_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1282_pos) debug_559: .return (rx1282_cur) rx1282_restart: .annotate 'line', 4 if_null rx1282_debug, debug_560 rx1282_cur."!cursor_debug"("NEXT", "term:sym") debug_560: rx1282_fail: (rx1282_rep, rx1282_pos, $I10, $P10) = rx1282_cur."!mark_fail"(0) lt rx1282_pos, -1, rx1282_done eq rx1282_pos, -1, rx1282_fail jump $I10 rx1282_done: rx1282_cur."!cursor_fail"() if_null rx1282_debug, debug_561 rx1282_cur."!cursor_debug"("FAIL", "term:sym") debug_561: .return (rx1282_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("104_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("variable", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("105_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1286_tgt .local int rx1286_pos .local int rx1286_off .local int rx1286_eos .local int rx1286_rep .local pmc rx1286_cur .local pmc rx1286_debug (rx1286_cur, rx1286_pos, rx1286_tgt, $I10) = self."!cursor_start"() getattribute rx1286_debug, rx1286_cur, "$!debug" .lex unicode:"$\x{a2}", rx1286_cur .local pmc match .lex "$/", match length rx1286_eos, rx1286_tgt gt rx1286_pos, rx1286_eos, rx1286_done set rx1286_off, 0 lt rx1286_pos, 2, rx1286_start sub rx1286_off, rx1286_pos, 1 substr rx1286_tgt, rx1286_tgt, rx1286_off rx1286_start: eq $I10, 1, rx1286_restart if_null rx1286_debug, debug_562 rx1286_cur."!cursor_debug"("START", "term:sym") debug_562: $I10 = self.'from'() ne $I10, -1, rxscan1288_done goto rxscan1288_scan rxscan1288_loop: ($P10) = rx1286_cur."from"() inc $P10 set rx1286_pos, $P10 ge rx1286_pos, rx1286_eos, rxscan1288_done rxscan1288_scan: set_addr $I10, rxscan1288_loop rx1286_cur."!mark_push"(0, rx1286_pos, $I10) rxscan1288_done: .annotate 'line', 228 # rx subrule "package_declarator" subtype=capture negate= rx1286_cur."!cursor_pos"(rx1286_pos) $P10 = rx1286_cur."package_declarator"() unless $P10, rx1286_fail rx1286_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("package_declarator") rx1286_pos = $P10."pos"() # rx pass rx1286_cur."!cursor_pass"(rx1286_pos, "term:sym") if_null rx1286_debug, debug_563 rx1286_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1286_pos) debug_563: .return (rx1286_cur) rx1286_restart: .annotate 'line', 4 if_null rx1286_debug, debug_564 rx1286_cur."!cursor_debug"("NEXT", "term:sym") debug_564: rx1286_fail: (rx1286_rep, rx1286_pos, $I10, $P10) = rx1286_cur."!mark_fail"(0) lt rx1286_pos, -1, rx1286_done eq rx1286_pos, -1, rx1286_fail jump $I10 rx1286_done: rx1286_cur."!cursor_fail"() if_null rx1286_debug, debug_565 rx1286_cur."!cursor_debug"("FAIL", "term:sym") debug_565: .return (rx1286_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("106_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("package_declarator", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("107_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1290_tgt .local int rx1290_pos .local int rx1290_off .local int rx1290_eos .local int rx1290_rep .local pmc rx1290_cur .local pmc rx1290_debug (rx1290_cur, rx1290_pos, rx1290_tgt, $I10) = self."!cursor_start"() getattribute rx1290_debug, rx1290_cur, "$!debug" .lex unicode:"$\x{a2}", rx1290_cur .local pmc match .lex "$/", match length rx1290_eos, rx1290_tgt gt rx1290_pos, rx1290_eos, rx1290_done set rx1290_off, 0 lt rx1290_pos, 2, rx1290_start sub rx1290_off, rx1290_pos, 1 substr rx1290_tgt, rx1290_tgt, rx1290_off rx1290_start: eq $I10, 1, rx1290_restart if_null rx1290_debug, debug_566 rx1290_cur."!cursor_debug"("START", "term:sym") debug_566: $I10 = self.'from'() ne $I10, -1, rxscan1292_done goto rxscan1292_scan rxscan1292_loop: ($P10) = rx1290_cur."from"() inc $P10 set rx1290_pos, $P10 ge rx1290_pos, rx1290_eos, rxscan1292_done rxscan1292_scan: set_addr $I10, rxscan1292_loop rx1290_cur."!mark_push"(0, rx1290_pos, $I10) rxscan1292_done: .annotate 'line', 229 # rx subrule "scope_declarator" subtype=capture negate= rx1290_cur."!cursor_pos"(rx1290_pos) $P10 = rx1290_cur."scope_declarator"() unless $P10, rx1290_fail rx1290_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("scope_declarator") rx1290_pos = $P10."pos"() # rx pass rx1290_cur."!cursor_pass"(rx1290_pos, "term:sym") if_null rx1290_debug, debug_567 rx1290_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1290_pos) debug_567: .return (rx1290_cur) rx1290_restart: .annotate 'line', 4 if_null rx1290_debug, debug_568 rx1290_cur."!cursor_debug"("NEXT", "term:sym") debug_568: rx1290_fail: (rx1290_rep, rx1290_pos, $I10, $P10) = rx1290_cur."!mark_fail"(0) lt rx1290_pos, -1, rx1290_done eq rx1290_pos, -1, rx1290_fail jump $I10 rx1290_done: rx1290_cur."!cursor_fail"() if_null rx1290_debug, debug_569 rx1290_cur."!cursor_debug"("FAIL", "term:sym") debug_569: .return (rx1290_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("108_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("scope_declarator", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("109_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1294_tgt .local int rx1294_pos .local int rx1294_off .local int rx1294_eos .local int rx1294_rep .local pmc rx1294_cur .local pmc rx1294_debug (rx1294_cur, rx1294_pos, rx1294_tgt, $I10) = self."!cursor_start"() getattribute rx1294_debug, rx1294_cur, "$!debug" .lex unicode:"$\x{a2}", rx1294_cur .local pmc match .lex "$/", match length rx1294_eos, rx1294_tgt gt rx1294_pos, rx1294_eos, rx1294_done set rx1294_off, 0 lt rx1294_pos, 2, rx1294_start sub rx1294_off, rx1294_pos, 1 substr rx1294_tgt, rx1294_tgt, rx1294_off rx1294_start: eq $I10, 1, rx1294_restart if_null rx1294_debug, debug_570 rx1294_cur."!cursor_debug"("START", "term:sym") debug_570: $I10 = self.'from'() ne $I10, -1, rxscan1296_done goto rxscan1296_scan rxscan1296_loop: ($P10) = rx1294_cur."from"() inc $P10 set rx1294_pos, $P10 ge rx1294_pos, rx1294_eos, rxscan1296_done rxscan1296_scan: set_addr $I10, rxscan1296_loop rx1294_cur."!mark_push"(0, rx1294_pos, $I10) rxscan1296_done: .annotate 'line', 230 # rx subrule "routine_declarator" subtype=capture negate= rx1294_cur."!cursor_pos"(rx1294_pos) $P10 = rx1294_cur."routine_declarator"() unless $P10, rx1294_fail rx1294_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("routine_declarator") rx1294_pos = $P10."pos"() # rx pass rx1294_cur."!cursor_pass"(rx1294_pos, "term:sym") if_null rx1294_debug, debug_571 rx1294_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1294_pos) debug_571: .return (rx1294_cur) rx1294_restart: .annotate 'line', 4 if_null rx1294_debug, debug_572 rx1294_cur."!cursor_debug"("NEXT", "term:sym") debug_572: rx1294_fail: (rx1294_rep, rx1294_pos, $I10, $P10) = rx1294_cur."!mark_fail"(0) lt rx1294_pos, -1, rx1294_done eq rx1294_pos, -1, rx1294_fail jump $I10 rx1294_done: rx1294_cur."!cursor_fail"() if_null rx1294_debug, debug_573 rx1294_cur."!cursor_debug"("FAIL", "term:sym") debug_573: .return (rx1294_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("110_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("routine_declarator", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("111_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .const 'Sub' $P1302 = "113_1309998847.42912" capture_lex $P1302 .local string rx1298_tgt .local int rx1298_pos .local int rx1298_off .local int rx1298_eos .local int rx1298_rep .local pmc rx1298_cur .local pmc rx1298_debug (rx1298_cur, rx1298_pos, rx1298_tgt, $I10) = self."!cursor_start"() getattribute rx1298_debug, rx1298_cur, "$!debug" .lex unicode:"$\x{a2}", rx1298_cur .local pmc match .lex "$/", match length rx1298_eos, rx1298_tgt gt rx1298_pos, rx1298_eos, rx1298_done set rx1298_off, 0 lt rx1298_pos, 2, rx1298_start sub rx1298_off, rx1298_pos, 1 substr rx1298_tgt, rx1298_tgt, rx1298_off rx1298_start: eq $I10, 1, rx1298_restart if_null rx1298_debug, debug_574 rx1298_cur."!cursor_debug"("START", "term:sym") debug_574: $I10 = self.'from'() ne $I10, -1, rxscan1300_done goto rxscan1300_scan rxscan1300_loop: ($P10) = rx1298_cur."from"() inc $P10 set rx1298_pos, $P10 ge rx1298_pos, rx1298_eos, rxscan1300_done rxscan1300_scan: set_addr $I10, rxscan1300_loop rx1298_cur."!mark_push"(0, rx1298_pos, $I10) rxscan1300_done: .annotate 'line', 231 # rx subrule "before" subtype=zerowidth negate= rx1298_cur."!cursor_pos"(rx1298_pos) .const 'Sub' $P1302 = "113_1309998847.42912" capture_lex $P1302 $P10 = rx1298_cur."before"($P1302) unless $P10, rx1298_fail # rx subrule "multi_declarator" subtype=capture negate= rx1298_cur."!cursor_pos"(rx1298_pos) $P10 = rx1298_cur."multi_declarator"() unless $P10, rx1298_fail rx1298_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("multi_declarator") rx1298_pos = $P10."pos"() # rx pass rx1298_cur."!cursor_pass"(rx1298_pos, "term:sym") if_null rx1298_debug, debug_579 rx1298_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1298_pos) debug_579: .return (rx1298_cur) rx1298_restart: .annotate 'line', 4 if_null rx1298_debug, debug_580 rx1298_cur."!cursor_debug"("NEXT", "term:sym") debug_580: rx1298_fail: (rx1298_rep, rx1298_pos, $I10, $P10) = rx1298_cur."!mark_fail"(0) lt rx1298_pos, -1, rx1298_done eq rx1298_pos, -1, rx1298_fail jump $I10 rx1298_done: rx1298_cur."!cursor_fail"() if_null rx1298_debug, debug_581 rx1298_cur."!cursor_debug"("FAIL", "term:sym") debug_581: .return (rx1298_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("112_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "_block1301" :anon :subid("113_1309998847.42912") :method :outer("111_1309998847.42912") .annotate 'line', 231 .local string rx1303_tgt .local int rx1303_pos .local int rx1303_off .local int rx1303_eos .local int rx1303_rep .local pmc rx1303_cur .local pmc rx1303_debug (rx1303_cur, rx1303_pos, rx1303_tgt, $I10) = self."!cursor_start"() getattribute rx1303_debug, rx1303_cur, "$!debug" .lex unicode:"$\x{a2}", rx1303_cur .local pmc match .lex "$/", match length rx1303_eos, rx1303_tgt gt rx1303_pos, rx1303_eos, rx1303_done set rx1303_off, 0 lt rx1303_pos, 2, rx1303_start sub rx1303_off, rx1303_pos, 1 substr rx1303_tgt, rx1303_tgt, rx1303_off rx1303_start: eq $I10, 1, rx1303_restart if_null rx1303_debug, debug_575 rx1303_cur."!cursor_debug"("START", "") debug_575: $I10 = self.'from'() ne $I10, -1, rxscan1304_done goto rxscan1304_scan rxscan1304_loop: ($P10) = rx1303_cur."from"() inc $P10 set rx1303_pos, $P10 ge rx1303_pos, rx1303_eos, rxscan1304_done rxscan1304_scan: set_addr $I10, rxscan1304_loop rx1303_cur."!mark_push"(0, rx1303_pos, $I10) rxscan1304_done: alt1305_0: set_addr $I10, alt1305_1 rx1303_cur."!mark_push"(0, rx1303_pos, $I10) # rx literal "multi" add $I11, rx1303_pos, 5 gt $I11, rx1303_eos, rx1303_fail sub $I11, rx1303_pos, rx1303_off substr $S10, rx1303_tgt, $I11, 5 ne $S10, "multi", rx1303_fail add rx1303_pos, 5 goto alt1305_end alt1305_1: set_addr $I10, alt1305_2 rx1303_cur."!mark_push"(0, rx1303_pos, $I10) # rx literal "proto" add $I11, rx1303_pos, 5 gt $I11, rx1303_eos, rx1303_fail sub $I11, rx1303_pos, rx1303_off substr $S10, rx1303_tgt, $I11, 5 ne $S10, "proto", rx1303_fail add rx1303_pos, 5 goto alt1305_end alt1305_2: # rx literal "only" add $I11, rx1303_pos, 4 gt $I11, rx1303_eos, rx1303_fail sub $I11, rx1303_pos, rx1303_off substr $S10, rx1303_tgt, $I11, 4 ne $S10, "only", rx1303_fail add rx1303_pos, 4 alt1305_end: # rx pass rx1303_cur."!cursor_pass"(rx1303_pos, "") if_null rx1303_debug, debug_576 rx1303_cur."!cursor_debug"("PASS", "", " at pos=", rx1303_pos) debug_576: .return (rx1303_cur) rx1303_restart: if_null rx1303_debug, debug_577 rx1303_cur."!cursor_debug"("NEXT", "") debug_577: rx1303_fail: (rx1303_rep, rx1303_pos, $I10, $P10) = rx1303_cur."!mark_fail"(0) lt rx1303_pos, -1, rx1303_done eq rx1303_pos, -1, rx1303_fail jump $I10 rx1303_done: rx1303_cur."!cursor_fail"() if_null rx1303_debug, debug_578 rx1303_cur."!cursor_debug"("FAIL", "") debug_578: .return (rx1303_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("114_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1307_tgt .local int rx1307_pos .local int rx1307_off .local int rx1307_eos .local int rx1307_rep .local pmc rx1307_cur .local pmc rx1307_debug (rx1307_cur, rx1307_pos, rx1307_tgt, $I10) = self."!cursor_start"() getattribute rx1307_debug, rx1307_cur, "$!debug" .lex unicode:"$\x{a2}", rx1307_cur .local pmc match .lex "$/", match length rx1307_eos, rx1307_tgt gt rx1307_pos, rx1307_eos, rx1307_done set rx1307_off, 0 lt rx1307_pos, 2, rx1307_start sub rx1307_off, rx1307_pos, 1 substr rx1307_tgt, rx1307_tgt, rx1307_off rx1307_start: eq $I10, 1, rx1307_restart if_null rx1307_debug, debug_582 rx1307_cur."!cursor_debug"("START", "term:sym") debug_582: $I10 = self.'from'() ne $I10, -1, rxscan1309_done goto rxscan1309_scan rxscan1309_loop: ($P10) = rx1307_cur."from"() inc $P10 set rx1307_pos, $P10 ge rx1307_pos, rx1307_eos, rxscan1309_done rxscan1309_scan: set_addr $I10, rxscan1309_loop rx1307_cur."!mark_push"(0, rx1307_pos, $I10) rxscan1309_done: .annotate 'line', 232 # rx subrule "regex_declarator" subtype=capture negate= rx1307_cur."!cursor_pos"(rx1307_pos) $P10 = rx1307_cur."regex_declarator"() unless $P10, rx1307_fail rx1307_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("regex_declarator") rx1307_pos = $P10."pos"() # rx pass rx1307_cur."!cursor_pass"(rx1307_pos, "term:sym") if_null rx1307_debug, debug_583 rx1307_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1307_pos) debug_583: .return (rx1307_cur) rx1307_restart: .annotate 'line', 4 if_null rx1307_debug, debug_584 rx1307_cur."!cursor_debug"("NEXT", "term:sym") debug_584: rx1307_fail: (rx1307_rep, rx1307_pos, $I10, $P10) = rx1307_cur."!mark_fail"(0) lt rx1307_pos, -1, rx1307_done eq rx1307_pos, -1, rx1307_fail jump $I10 rx1307_done: rx1307_cur."!cursor_fail"() if_null rx1307_debug, debug_585 rx1307_cur."!cursor_debug"("FAIL", "term:sym") debug_585: .return (rx1307_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("115_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("regex_declarator", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("116_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1311_tgt .local int rx1311_pos .local int rx1311_off .local int rx1311_eos .local int rx1311_rep .local pmc rx1311_cur .local pmc rx1311_debug (rx1311_cur, rx1311_pos, rx1311_tgt, $I10) = self."!cursor_start"() getattribute rx1311_debug, rx1311_cur, "$!debug" .lex unicode:"$\x{a2}", rx1311_cur .local pmc match .lex "$/", match length rx1311_eos, rx1311_tgt gt rx1311_pos, rx1311_eos, rx1311_done set rx1311_off, 0 lt rx1311_pos, 2, rx1311_start sub rx1311_off, rx1311_pos, 1 substr rx1311_tgt, rx1311_tgt, rx1311_off rx1311_start: eq $I10, 1, rx1311_restart if_null rx1311_debug, debug_586 rx1311_cur."!cursor_debug"("START", "term:sym") debug_586: $I10 = self.'from'() ne $I10, -1, rxscan1313_done goto rxscan1313_scan rxscan1313_loop: ($P10) = rx1311_cur."from"() inc $P10 set rx1311_pos, $P10 ge rx1311_pos, rx1311_eos, rxscan1313_done rxscan1313_scan: set_addr $I10, rxscan1313_loop rx1311_cur."!mark_push"(0, rx1311_pos, $I10) rxscan1313_done: .annotate 'line', 233 # rx subrule "statement_prefix" subtype=capture negate= rx1311_cur."!cursor_pos"(rx1311_pos) $P10 = rx1311_cur."statement_prefix"() unless $P10, rx1311_fail rx1311_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("statement_prefix") rx1311_pos = $P10."pos"() # rx pass rx1311_cur."!cursor_pass"(rx1311_pos, "term:sym") if_null rx1311_debug, debug_587 rx1311_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1311_pos) debug_587: .return (rx1311_cur) rx1311_restart: .annotate 'line', 4 if_null rx1311_debug, debug_588 rx1311_cur."!cursor_debug"("NEXT", "term:sym") debug_588: rx1311_fail: (rx1311_rep, rx1311_pos, $I10, $P10) = rx1311_cur."!mark_fail"(0) lt rx1311_pos, -1, rx1311_done eq rx1311_pos, -1, rx1311_fail jump $I10 rx1311_done: rx1311_cur."!cursor_fail"() if_null rx1311_debug, debug_589 rx1311_cur."!cursor_debug"("FAIL", "term:sym") debug_589: .return (rx1311_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("117_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("statement_prefix", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("118_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1315_tgt .local int rx1315_pos .local int rx1315_off .local int rx1315_eos .local int rx1315_rep .local pmc rx1315_cur .local pmc rx1315_debug (rx1315_cur, rx1315_pos, rx1315_tgt, $I10) = self."!cursor_start"() getattribute rx1315_debug, rx1315_cur, "$!debug" .lex unicode:"$\x{a2}", rx1315_cur .local pmc match .lex "$/", match length rx1315_eos, rx1315_tgt gt rx1315_pos, rx1315_eos, rx1315_done set rx1315_off, 0 lt rx1315_pos, 2, rx1315_start sub rx1315_off, rx1315_pos, 1 substr rx1315_tgt, rx1315_tgt, rx1315_off rx1315_start: eq $I10, 1, rx1315_restart if_null rx1315_debug, debug_590 rx1315_cur."!cursor_debug"("START", "term:sym") debug_590: $I10 = self.'from'() ne $I10, -1, rxscan1317_done goto rxscan1317_scan rxscan1317_loop: ($P10) = rx1315_cur."from"() inc $P10 set rx1315_pos, $P10 ge rx1315_pos, rx1315_eos, rxscan1317_done rxscan1317_scan: set_addr $I10, rxscan1317_loop rx1315_cur."!mark_push"(0, rx1315_pos, $I10) rxscan1317_done: .annotate 'line', 234 # rx subrule "lambda" subtype=zerowidth negate= rx1315_cur."!cursor_pos"(rx1315_pos) $P10 = rx1315_cur."lambda"() unless $P10, rx1315_fail # rx subrule "pblock" subtype=capture negate= rx1315_cur."!cursor_pos"(rx1315_pos) $P10 = rx1315_cur."pblock"() unless $P10, rx1315_fail rx1315_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("pblock") rx1315_pos = $P10."pos"() # rx pass rx1315_cur."!cursor_pass"(rx1315_pos, "term:sym") if_null rx1315_debug, debug_591 rx1315_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1315_pos) debug_591: .return (rx1315_cur) rx1315_restart: .annotate 'line', 4 if_null rx1315_debug, debug_592 rx1315_cur."!cursor_debug"("NEXT", "term:sym") debug_592: rx1315_fail: (rx1315_rep, rx1315_pos, $I10, $P10) = rx1315_cur."!mark_fail"(0) lt rx1315_pos, -1, rx1315_done eq rx1315_pos, -1, rx1315_fail jump $I10 rx1315_done: rx1315_cur."!cursor_fail"() if_null rx1315_debug, debug_593 rx1315_cur."!cursor_debug"("FAIL", "term:sym") debug_593: .return (rx1315_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("119_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "fatarrow" :subid("120_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1319_tgt .local int rx1319_pos .local int rx1319_off .local int rx1319_eos .local int rx1319_rep .local pmc rx1319_cur .local pmc rx1319_debug (rx1319_cur, rx1319_pos, rx1319_tgt, $I10) = self."!cursor_start"() getattribute rx1319_debug, rx1319_cur, "$!debug" .lex unicode:"$\x{a2}", rx1319_cur .local pmc match .lex "$/", match length rx1319_eos, rx1319_tgt gt rx1319_pos, rx1319_eos, rx1319_done set rx1319_off, 0 lt rx1319_pos, 2, rx1319_start sub rx1319_off, rx1319_pos, 1 substr rx1319_tgt, rx1319_tgt, rx1319_off rx1319_start: eq $I10, 1, rx1319_restart if_null rx1319_debug, debug_594 rx1319_cur."!cursor_debug"("START", "fatarrow") debug_594: $I10 = self.'from'() ne $I10, -1, rxscan1321_done goto rxscan1321_scan rxscan1321_loop: ($P10) = rx1319_cur."from"() inc $P10 set rx1319_pos, $P10 ge rx1319_pos, rx1319_eos, rxscan1321_done rxscan1321_scan: set_addr $I10, rxscan1321_loop rx1319_cur."!mark_push"(0, rx1319_pos, $I10) rxscan1321_done: .annotate 'line', 237 # rx subrule "identifier" subtype=capture negate= rx1319_cur."!cursor_pos"(rx1319_pos) $P10 = rx1319_cur."identifier"() unless $P10, rx1319_fail rx1319_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("key") rx1319_pos = $P10."pos"() # rx enumcharlist_q negate=0 r 0..-1 sub $I10, rx1319_pos, rx1319_off set rx1319_rep, 0 sub $I12, rx1319_eos, rx1319_pos rxenumcharlistq1322_loop: le $I12, 0, rxenumcharlistq1322_done substr $S10, rx1319_tgt, $I10, 1 index $I11, unicode:"\t \x{a0}\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000", $S10 lt $I11, 0, rxenumcharlistq1322_done inc rx1319_rep inc $I10 dec $I12 goto rxenumcharlistq1322_loop rxenumcharlistq1322_done: add rx1319_pos, rx1319_pos, rx1319_rep # rx literal "=>" add $I11, rx1319_pos, 2 gt $I11, rx1319_eos, rx1319_fail sub $I11, rx1319_pos, rx1319_off substr $S10, rx1319_tgt, $I11, 2 ne $S10, "=>", rx1319_fail add rx1319_pos, 2 # rx subrule "ws" subtype=method negate= rx1319_cur."!cursor_pos"(rx1319_pos) $P10 = rx1319_cur."ws"() unless $P10, rx1319_fail rx1319_pos = $P10."pos"() # rx subrule "EXPR" subtype=capture negate= rx1319_cur."!cursor_pos"(rx1319_pos) $P10 = rx1319_cur."EXPR"("i=") unless $P10, rx1319_fail rx1319_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("val") rx1319_pos = $P10."pos"() .annotate 'line', 236 # rx pass rx1319_cur."!cursor_pass"(rx1319_pos, "fatarrow") if_null rx1319_debug, debug_595 rx1319_cur."!cursor_debug"("PASS", "fatarrow", " at pos=", rx1319_pos) debug_595: .return (rx1319_cur) rx1319_restart: .annotate 'line', 4 if_null rx1319_debug, debug_596 rx1319_cur."!cursor_debug"("NEXT", "fatarrow") debug_596: rx1319_fail: (rx1319_rep, rx1319_pos, $I10, $P10) = rx1319_cur."!mark_fail"(0) lt rx1319_pos, -1, rx1319_done eq rx1319_pos, -1, rx1319_fail jump $I10 rx1319_done: rx1319_cur."!cursor_fail"() if_null rx1319_debug, debug_597 rx1319_cur."!cursor_debug"("FAIL", "fatarrow") debug_597: .return (rx1319_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__fatarrow" :subid("121_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("identifier", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "colonpair" :subid("122_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1324_tgt .local int rx1324_pos .local int rx1324_off .local int rx1324_eos .local int rx1324_rep .local pmc rx1324_cur .local pmc rx1324_debug (rx1324_cur, rx1324_pos, rx1324_tgt, $I10) = self."!cursor_start"() rx1324_cur."!cursor_caparray"("circumfix") getattribute rx1324_debug, rx1324_cur, "$!debug" .lex unicode:"$\x{a2}", rx1324_cur .local pmc match .lex "$/", match length rx1324_eos, rx1324_tgt gt rx1324_pos, rx1324_eos, rx1324_done set rx1324_off, 0 lt rx1324_pos, 2, rx1324_start sub rx1324_off, rx1324_pos, 1 substr rx1324_tgt, rx1324_tgt, rx1324_off rx1324_start: eq $I10, 1, rx1324_restart if_null rx1324_debug, debug_598 rx1324_cur."!cursor_debug"("START", "colonpair") debug_598: $I10 = self.'from'() ne $I10, -1, rxscan1326_done goto rxscan1326_scan rxscan1326_loop: ($P10) = rx1324_cur."from"() inc $P10 set rx1324_pos, $P10 ge rx1324_pos, rx1324_eos, rxscan1326_done rxscan1326_scan: set_addr $I10, rxscan1326_loop rx1324_cur."!mark_push"(0, rx1324_pos, $I10) rxscan1326_done: .annotate 'line', 241 # rx literal ":" add $I11, rx1324_pos, 1 gt $I11, rx1324_eos, rx1324_fail sub $I11, rx1324_pos, rx1324_off ord $I11, rx1324_tgt, $I11 ne $I11, 58, rx1324_fail add rx1324_pos, 1 alt1327_0: .annotate 'line', 242 set_addr $I10, alt1327_1 rx1324_cur."!mark_push"(0, rx1324_pos, $I10) .annotate 'line', 243 # rx subcapture "not" set_addr $I10, rxcap_1328_fail rx1324_cur."!mark_push"(0, rx1324_pos, $I10) # rx literal "!" add $I11, rx1324_pos, 1 gt $I11, rx1324_eos, rx1324_fail sub $I11, rx1324_pos, rx1324_off ord $I11, rx1324_tgt, $I11 ne $I11, 33, rx1324_fail add rx1324_pos, 1 set_addr $I10, rxcap_1328_fail ($I12, $I11) = rx1324_cur."!mark_peek"($I10) rx1324_cur."!cursor_pos"($I11) ($P10) = rx1324_cur."!cursor_start"() $P10."!cursor_pass"(rx1324_pos, "") rx1324_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("not") goto rxcap_1328_done rxcap_1328_fail: goto rx1324_fail rxcap_1328_done: # rx subrule "identifier" subtype=capture negate= rx1324_cur."!cursor_pos"(rx1324_pos) $P10 = rx1324_cur."identifier"() unless $P10, rx1324_fail rx1324_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("identifier") rx1324_pos = $P10."pos"() goto alt1327_end alt1327_1: set_addr $I10, alt1327_2 rx1324_cur."!mark_push"(0, rx1324_pos, $I10) .annotate 'line', 244 # rx subrule "identifier" subtype=capture negate= rx1324_cur."!cursor_pos"(rx1324_pos) $P10 = rx1324_cur."identifier"() unless $P10, rx1324_fail rx1324_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("identifier") rx1324_pos = $P10."pos"() # rx rxquantr1329 ** 0..1 set_addr $I10, rxquantr1329_done rx1324_cur."!mark_push"(0, rx1324_pos, $I10) rxquantr1329_loop: # rx subrule "circumfix" subtype=capture negate= rx1324_cur."!cursor_pos"(rx1324_pos) $P10 = rx1324_cur."circumfix"() unless $P10, rx1324_fail goto rxsubrule1330_pass rxsubrule1330_back: $P10 = $P10."!cursor_next"() unless $P10, rx1324_fail rxsubrule1330_pass: set_addr $I10, rxsubrule1330_back rx1324_cur."!mark_push"(0, rx1324_pos, $I10, $P10) $P10."!cursor_names"("circumfix") rx1324_pos = $P10."pos"() set_addr $I10, rxquantr1329_done (rx1324_rep) = rx1324_cur."!mark_commit"($I10) rxquantr1329_done: goto alt1327_end alt1327_2: .annotate 'line', 245 # rx subrule "circumfix" subtype=capture negate= rx1324_cur."!cursor_pos"(rx1324_pos) $P10 = rx1324_cur."circumfix"() unless $P10, rx1324_fail rx1324_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("circumfix") rx1324_pos = $P10."pos"() alt1327_end: .annotate 'line', 240 # rx pass rx1324_cur."!cursor_pass"(rx1324_pos, "colonpair") if_null rx1324_debug, debug_599 rx1324_cur."!cursor_debug"("PASS", "colonpair", " at pos=", rx1324_pos) debug_599: .return (rx1324_cur) rx1324_restart: .annotate 'line', 4 if_null rx1324_debug, debug_600 rx1324_cur."!cursor_debug"("NEXT", "colonpair") debug_600: rx1324_fail: (rx1324_rep, rx1324_pos, $I10, $P10) = rx1324_cur."!mark_fail"(0) lt rx1324_pos, -1, rx1324_done eq rx1324_pos, -1, rx1324_fail jump $I10 rx1324_done: rx1324_cur."!cursor_fail"() if_null rx1324_debug, debug_601 rx1324_cur."!cursor_debug"("FAIL", "colonpair") debug_601: .return (rx1324_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__colonpair" :subid("123_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("circumfix", ":") $P101 = self."!PREFIX__!subrule"("identifier", ":") $P102 = self."!PREFIX__!subrule"("identifier", ":!") new $P103, "ResizablePMCArray" push $P103, $P100 push $P103, $P101 push $P103, $P102 .return ($P103) .end .namespace ["NQP";"Grammar"] .sub "variable" :subid("124_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1332_tgt .local int rx1332_pos .local int rx1332_off .local int rx1332_eos .local int rx1332_rep .local pmc rx1332_cur .local pmc rx1332_debug (rx1332_cur, rx1332_pos, rx1332_tgt, $I10) = self."!cursor_start"() rx1332_cur."!cursor_caparray"("twigil") getattribute rx1332_debug, rx1332_cur, "$!debug" .lex unicode:"$\x{a2}", rx1332_cur .local pmc match .lex "$/", match length rx1332_eos, rx1332_tgt gt rx1332_pos, rx1332_eos, rx1332_done set rx1332_off, 0 lt rx1332_pos, 2, rx1332_start sub rx1332_off, rx1332_pos, 1 substr rx1332_tgt, rx1332_tgt, rx1332_off rx1332_start: eq $I10, 1, rx1332_restart if_null rx1332_debug, debug_602 rx1332_cur."!cursor_debug"("START", "variable") debug_602: $I10 = self.'from'() ne $I10, -1, rxscan1334_done goto rxscan1334_scan rxscan1334_loop: ($P10) = rx1332_cur."from"() inc $P10 set rx1332_pos, $P10 ge rx1332_pos, rx1332_eos, rxscan1334_done rxscan1334_scan: set_addr $I10, rxscan1334_loop rx1332_cur."!mark_push"(0, rx1332_pos, $I10) rxscan1334_done: alt1335_0: .annotate 'line', 249 set_addr $I10, alt1335_1 rx1332_cur."!mark_push"(0, rx1332_pos, $I10) .annotate 'line', 250 # rx subrule "sigil" subtype=capture negate= rx1332_cur."!cursor_pos"(rx1332_pos) $P10 = rx1332_cur."sigil"() unless $P10, rx1332_fail rx1332_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sigil") rx1332_pos = $P10."pos"() # rx rxquantr1336 ** 0..1 set_addr $I10, rxquantr1336_done rx1332_cur."!mark_push"(0, rx1332_pos, $I10) rxquantr1336_loop: # rx subrule "twigil" subtype=capture negate= rx1332_cur."!cursor_pos"(rx1332_pos) $P10 = rx1332_cur."twigil"() unless $P10, rx1332_fail goto rxsubrule1337_pass rxsubrule1337_back: $P10 = $P10."!cursor_next"() unless $P10, rx1332_fail rxsubrule1337_pass: set_addr $I10, rxsubrule1337_back rx1332_cur."!mark_push"(0, rx1332_pos, $I10, $P10) $P10."!cursor_names"("twigil") rx1332_pos = $P10."pos"() set_addr $I10, rxquantr1336_done (rx1332_rep) = rx1332_cur."!mark_commit"($I10) rxquantr1336_done: # rx subrule "name" subtype=capture negate= rx1332_cur."!cursor_pos"(rx1332_pos) $P10 = rx1332_cur."name"() unless $P10, rx1332_fail rx1332_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("desigilname") rx1332_pos = $P10."pos"() goto alt1335_end alt1335_1: set_addr $I10, alt1335_2 rx1332_cur."!mark_push"(0, rx1332_pos, $I10) .annotate 'line', 251 # rx subrule "sigil" subtype=capture negate= rx1332_cur."!cursor_pos"(rx1332_pos) $P10 = rx1332_cur."sigil"() unless $P10, rx1332_fail rx1332_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sigil") rx1332_pos = $P10."pos"() # rx enumcharlist negate=0 zerowidth sub $I10, rx1332_pos, rx1332_off substr $S10, rx1332_tgt, $I10, 1 index $I11, "<[", $S10 lt $I11, 0, rx1332_fail # rx subrule "postcircumfix" subtype=capture negate= rx1332_cur."!cursor_pos"(rx1332_pos) $P10 = rx1332_cur."postcircumfix"() unless $P10, rx1332_fail rx1332_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("postcircumfix") rx1332_pos = $P10."pos"() goto alt1335_end alt1335_2: .annotate 'line', 252 # rx subcapture "sigil" set_addr $I10, rxcap_1338_fail rx1332_cur."!mark_push"(0, rx1332_pos, $I10) # rx literal "$" add $I11, rx1332_pos, 1 gt $I11, rx1332_eos, rx1332_fail sub $I11, rx1332_pos, rx1332_off ord $I11, rx1332_tgt, $I11 ne $I11, 36, rx1332_fail add rx1332_pos, 1 set_addr $I10, rxcap_1338_fail ($I12, $I11) = rx1332_cur."!mark_peek"($I10) rx1332_cur."!cursor_pos"($I11) ($P10) = rx1332_cur."!cursor_start"() $P10."!cursor_pass"(rx1332_pos, "") rx1332_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sigil") goto rxcap_1338_done rxcap_1338_fail: goto rx1332_fail rxcap_1338_done: # rx subcapture "desigilname" set_addr $I10, rxcap_1339_fail rx1332_cur."!mark_push"(0, rx1332_pos, $I10) # rx enumcharlist negate=0 ge rx1332_pos, rx1332_eos, rx1332_fail sub $I10, rx1332_pos, rx1332_off substr $S10, rx1332_tgt, $I10, 1 index $I11, "/_!", $S10 lt $I11, 0, rx1332_fail inc rx1332_pos set_addr $I10, rxcap_1339_fail ($I12, $I11) = rx1332_cur."!mark_peek"($I10) rx1332_cur."!cursor_pos"($I11) ($P10) = rx1332_cur."!cursor_start"() $P10."!cursor_pass"(rx1332_pos, "") rx1332_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("desigilname") goto rxcap_1339_done rxcap_1339_fail: goto rx1332_fail rxcap_1339_done: alt1335_end: .annotate 'line', 249 # rx pass rx1332_cur."!cursor_pass"(rx1332_pos, "variable") if_null rx1332_debug, debug_603 rx1332_cur."!cursor_debug"("PASS", "variable", " at pos=", rx1332_pos) debug_603: .return (rx1332_cur) rx1332_restart: .annotate 'line', 4 if_null rx1332_debug, debug_604 rx1332_cur."!cursor_debug"("NEXT", "variable") debug_604: rx1332_fail: (rx1332_rep, rx1332_pos, $I10, $P10) = rx1332_cur."!mark_fail"(0) lt rx1332_pos, -1, rx1332_done eq rx1332_pos, -1, rx1332_fail jump $I10 rx1332_done: rx1332_cur."!cursor_fail"() if_null rx1332_debug, debug_605 rx1332_cur."!cursor_debug"("FAIL", "variable") debug_605: .return (rx1332_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__variable" :subid("125_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("sigil", "") $P101 = self."!PREFIX__!subrule"("sigil", "") new $P102, "ResizablePMCArray" push $P102, "$!" push $P102, "$_" push $P102, "$/" push $P102, $P100 push $P102, $P101 .return ($P102) .end .namespace ["NQP";"Grammar"] .sub "sigil" :subid("126_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1341_tgt .local int rx1341_pos .local int rx1341_off .local int rx1341_eos .local int rx1341_rep .local pmc rx1341_cur .local pmc rx1341_debug (rx1341_cur, rx1341_pos, rx1341_tgt, $I10) = self."!cursor_start"() getattribute rx1341_debug, rx1341_cur, "$!debug" .lex unicode:"$\x{a2}", rx1341_cur .local pmc match .lex "$/", match length rx1341_eos, rx1341_tgt gt rx1341_pos, rx1341_eos, rx1341_done set rx1341_off, 0 lt rx1341_pos, 2, rx1341_start sub rx1341_off, rx1341_pos, 1 substr rx1341_tgt, rx1341_tgt, rx1341_off rx1341_start: eq $I10, 1, rx1341_restart if_null rx1341_debug, debug_606 rx1341_cur."!cursor_debug"("START", "sigil") debug_606: $I10 = self.'from'() ne $I10, -1, rxscan1343_done goto rxscan1343_scan rxscan1343_loop: ($P10) = rx1341_cur."from"() inc $P10 set rx1341_pos, $P10 ge rx1341_pos, rx1341_eos, rxscan1343_done rxscan1343_scan: set_addr $I10, rxscan1343_loop rx1341_cur."!mark_push"(0, rx1341_pos, $I10) rxscan1343_done: .annotate 'line', 255 # rx enumcharlist negate=0 ge rx1341_pos, rx1341_eos, rx1341_fail sub $I10, rx1341_pos, rx1341_off substr $S10, rx1341_tgt, $I10, 1 index $I11, "$@%&", $S10 lt $I11, 0, rx1341_fail inc rx1341_pos # rx pass rx1341_cur."!cursor_pass"(rx1341_pos, "sigil") if_null rx1341_debug, debug_607 rx1341_cur."!cursor_debug"("PASS", "sigil", " at pos=", rx1341_pos) debug_607: .return (rx1341_cur) rx1341_restart: .annotate 'line', 4 if_null rx1341_debug, debug_608 rx1341_cur."!cursor_debug"("NEXT", "sigil") debug_608: rx1341_fail: (rx1341_rep, rx1341_pos, $I10, $P10) = rx1341_cur."!mark_fail"(0) lt rx1341_pos, -1, rx1341_done eq rx1341_pos, -1, rx1341_fail jump $I10 rx1341_done: rx1341_cur."!cursor_fail"() if_null rx1341_debug, debug_609 rx1341_cur."!cursor_debug"("FAIL", "sigil") debug_609: .return (rx1341_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__sigil" :subid("127_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "&" push $P100, "%" push $P100, "@" push $P100, "$" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "twigil" :subid("128_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1345_tgt .local int rx1345_pos .local int rx1345_off .local int rx1345_eos .local int rx1345_rep .local pmc rx1345_cur .local pmc rx1345_debug (rx1345_cur, rx1345_pos, rx1345_tgt, $I10) = self."!cursor_start"() getattribute rx1345_debug, rx1345_cur, "$!debug" .lex unicode:"$\x{a2}", rx1345_cur .local pmc match .lex "$/", match length rx1345_eos, rx1345_tgt gt rx1345_pos, rx1345_eos, rx1345_done set rx1345_off, 0 lt rx1345_pos, 2, rx1345_start sub rx1345_off, rx1345_pos, 1 substr rx1345_tgt, rx1345_tgt, rx1345_off rx1345_start: eq $I10, 1, rx1345_restart if_null rx1345_debug, debug_610 rx1345_cur."!cursor_debug"("START", "twigil") debug_610: $I10 = self.'from'() ne $I10, -1, rxscan1347_done goto rxscan1347_scan rxscan1347_loop: ($P10) = rx1345_cur."from"() inc $P10 set rx1345_pos, $P10 ge rx1345_pos, rx1345_eos, rxscan1347_done rxscan1347_scan: set_addr $I10, rxscan1347_loop rx1345_cur."!mark_push"(0, rx1345_pos, $I10) rxscan1347_done: .annotate 'line', 257 # rx enumcharlist negate=0 ge rx1345_pos, rx1345_eos, rx1345_fail sub $I10, rx1345_pos, rx1345_off substr $S10, rx1345_tgt, $I10, 1 index $I11, "*!?", $S10 lt $I11, 0, rx1345_fail inc rx1345_pos # rx pass rx1345_cur."!cursor_pass"(rx1345_pos, "twigil") if_null rx1345_debug, debug_611 rx1345_cur."!cursor_debug"("PASS", "twigil", " at pos=", rx1345_pos) debug_611: .return (rx1345_cur) rx1345_restart: .annotate 'line', 4 if_null rx1345_debug, debug_612 rx1345_cur."!cursor_debug"("NEXT", "twigil") debug_612: rx1345_fail: (rx1345_rep, rx1345_pos, $I10, $P10) = rx1345_cur."!mark_fail"(0) lt rx1345_pos, -1, rx1345_done eq rx1345_pos, -1, rx1345_fail jump $I10 rx1345_done: rx1345_cur."!cursor_fail"() if_null rx1345_debug, debug_613 rx1345_cur."!cursor_debug"("FAIL", "twigil") debug_613: .return (rx1345_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__twigil" :subid("129_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "?" push $P100, "!" push $P100, "*" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "package_declarator" :subid("130_1309998847.42912") :method .annotate 'line', 259 $P100 = self."!protoregex"("package_declarator") .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__package_declarator" :subid("131_1309998847.42912") :method .annotate 'line', 259 $P101 = self."!PREFIX__!protoregex"("package_declarator") .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "package_declarator:sym" :subid("132_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1351_tgt .local int rx1351_pos .local int rx1351_off .local int rx1351_eos .local int rx1351_rep .local pmc rx1351_cur .local pmc rx1351_debug (rx1351_cur, rx1351_pos, rx1351_tgt, $I10) = self."!cursor_start"() getattribute rx1351_debug, rx1351_cur, "$!debug" .lex unicode:"$\x{a2}", rx1351_cur .local pmc match .lex "$/", match length rx1351_eos, rx1351_tgt gt rx1351_pos, rx1351_eos, rx1351_done set rx1351_off, 0 lt rx1351_pos, 2, rx1351_start sub rx1351_off, rx1351_pos, 1 substr rx1351_tgt, rx1351_tgt, rx1351_off rx1351_start: eq $I10, 1, rx1351_restart if_null rx1351_debug, debug_614 rx1351_cur."!cursor_debug"("START", "package_declarator:sym") debug_614: $I10 = self.'from'() ne $I10, -1, rxscan1353_done goto rxscan1353_scan rxscan1353_loop: ($P10) = rx1351_cur."from"() inc $P10 set rx1351_pos, $P10 ge rx1351_pos, rx1351_eos, rxscan1353_done rxscan1353_scan: set_addr $I10, rxscan1353_loop rx1351_cur."!mark_push"(0, rx1351_pos, $I10) rxscan1353_done: .annotate 'line', 260 # rx subcapture "sym" set_addr $I10, rxcap_1354_fail rx1351_cur."!mark_push"(0, rx1351_pos, $I10) # rx literal "module" add $I11, rx1351_pos, 6 gt $I11, rx1351_eos, rx1351_fail sub $I11, rx1351_pos, rx1351_off substr $S10, rx1351_tgt, $I11, 6 ne $S10, "module", rx1351_fail add rx1351_pos, 6 set_addr $I10, rxcap_1354_fail ($I12, $I11) = rx1351_cur."!mark_peek"($I10) rx1351_cur."!cursor_pos"($I11) ($P10) = rx1351_cur."!cursor_start"() $P10."!cursor_pass"(rx1351_pos, "") rx1351_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1354_done rxcap_1354_fail: goto rx1351_fail rxcap_1354_done: # rx subrule "package_def" subtype=capture negate= rx1351_cur."!cursor_pos"(rx1351_pos) $P10 = rx1351_cur."package_def"() unless $P10, rx1351_fail rx1351_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("package_def") rx1351_pos = $P10."pos"() # rx pass rx1351_cur."!cursor_pass"(rx1351_pos, "package_declarator:sym") if_null rx1351_debug, debug_615 rx1351_cur."!cursor_debug"("PASS", "package_declarator:sym", " at pos=", rx1351_pos) debug_615: .return (rx1351_cur) rx1351_restart: .annotate 'line', 4 if_null rx1351_debug, debug_616 rx1351_cur."!cursor_debug"("NEXT", "package_declarator:sym") debug_616: rx1351_fail: (rx1351_rep, rx1351_pos, $I10, $P10) = rx1351_cur."!mark_fail"(0) lt rx1351_pos, -1, rx1351_done eq rx1351_pos, -1, rx1351_fail jump $I10 rx1351_done: rx1351_cur."!cursor_fail"() if_null rx1351_debug, debug_617 rx1351_cur."!cursor_debug"("FAIL", "package_declarator:sym") debug_617: .return (rx1351_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__package_declarator:sym" :subid("133_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("package_def", "module") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "package_declarator:sym" :subid("134_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1356_tgt .local int rx1356_pos .local int rx1356_off .local int rx1356_eos .local int rx1356_rep .local pmc rx1356_cur .local pmc rx1356_debug (rx1356_cur, rx1356_pos, rx1356_tgt, $I10) = self."!cursor_start"() getattribute rx1356_debug, rx1356_cur, "$!debug" .lex unicode:"$\x{a2}", rx1356_cur .local pmc match .lex "$/", match length rx1356_eos, rx1356_tgt gt rx1356_pos, rx1356_eos, rx1356_done set rx1356_off, 0 lt rx1356_pos, 2, rx1356_start sub rx1356_off, rx1356_pos, 1 substr rx1356_tgt, rx1356_tgt, rx1356_off rx1356_start: eq $I10, 1, rx1356_restart if_null rx1356_debug, debug_618 rx1356_cur."!cursor_debug"("START", "package_declarator:sym") debug_618: $I10 = self.'from'() ne $I10, -1, rxscan1358_done goto rxscan1358_scan rxscan1358_loop: ($P10) = rx1356_cur."from"() inc $P10 set rx1356_pos, $P10 ge rx1356_pos, rx1356_eos, rxscan1358_done rxscan1358_scan: set_addr $I10, rxscan1358_loop rx1356_cur."!mark_push"(0, rx1356_pos, $I10) rxscan1358_done: .annotate 'line', 261 # rx subcapture "sym" set_addr $I10, rxcap_1360_fail rx1356_cur."!mark_push"(0, rx1356_pos, $I10) alt1359_0: set_addr $I10, alt1359_1 rx1356_cur."!mark_push"(0, rx1356_pos, $I10) # rx literal "class" add $I11, rx1356_pos, 5 gt $I11, rx1356_eos, rx1356_fail sub $I11, rx1356_pos, rx1356_off substr $S10, rx1356_tgt, $I11, 5 ne $S10, "class", rx1356_fail add rx1356_pos, 5 goto alt1359_end alt1359_1: # rx literal "grammar" add $I11, rx1356_pos, 7 gt $I11, rx1356_eos, rx1356_fail sub $I11, rx1356_pos, rx1356_off substr $S10, rx1356_tgt, $I11, 7 ne $S10, "grammar", rx1356_fail add rx1356_pos, 7 alt1359_end: set_addr $I10, rxcap_1360_fail ($I12, $I11) = rx1356_cur."!mark_peek"($I10) rx1356_cur."!cursor_pos"($I11) ($P10) = rx1356_cur."!cursor_start"() $P10."!cursor_pass"(rx1356_pos, "") rx1356_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1360_done rxcap_1360_fail: goto rx1356_fail rxcap_1360_done: # rx subrule "package_def" subtype=capture negate= rx1356_cur."!cursor_pos"(rx1356_pos) $P10 = rx1356_cur."package_def"() unless $P10, rx1356_fail rx1356_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("package_def") rx1356_pos = $P10."pos"() # rx pass rx1356_cur."!cursor_pass"(rx1356_pos, "package_declarator:sym") if_null rx1356_debug, debug_619 rx1356_cur."!cursor_debug"("PASS", "package_declarator:sym", " at pos=", rx1356_pos) debug_619: .return (rx1356_cur) rx1356_restart: .annotate 'line', 4 if_null rx1356_debug, debug_620 rx1356_cur."!cursor_debug"("NEXT", "package_declarator:sym") debug_620: rx1356_fail: (rx1356_rep, rx1356_pos, $I10, $P10) = rx1356_cur."!mark_fail"(0) lt rx1356_pos, -1, rx1356_done eq rx1356_pos, -1, rx1356_fail jump $I10 rx1356_done: rx1356_cur."!cursor_fail"() if_null rx1356_debug, debug_621 rx1356_cur."!cursor_debug"("FAIL", "package_declarator:sym") debug_621: .return (rx1356_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__package_declarator:sym" :subid("135_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("package_def", "grammar") $P101 = self."!PREFIX__!subrule"("package_def", "class") new $P102, "ResizablePMCArray" push $P102, $P100 push $P102, $P101 .return ($P102) .end .namespace ["NQP";"Grammar"] .sub "package_def" :subid("136_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1362_tgt .local int rx1362_pos .local int rx1362_off .local int rx1362_eos .local int rx1362_rep .local pmc rx1362_cur .local pmc rx1362_debug (rx1362_cur, rx1362_pos, rx1362_tgt, $I10) = self."!cursor_start"() rx1362_cur."!cursor_caparray"("parent") getattribute rx1362_debug, rx1362_cur, "$!debug" .lex unicode:"$\x{a2}", rx1362_cur .local pmc match .lex "$/", match length rx1362_eos, rx1362_tgt gt rx1362_pos, rx1362_eos, rx1362_done set rx1362_off, 0 lt rx1362_pos, 2, rx1362_start sub rx1362_off, rx1362_pos, 1 substr rx1362_tgt, rx1362_tgt, rx1362_off rx1362_start: eq $I10, 1, rx1362_restart if_null rx1362_debug, debug_622 rx1362_cur."!cursor_debug"("START", "package_def") debug_622: $I10 = self.'from'() ne $I10, -1, rxscan1364_done goto rxscan1364_scan rxscan1364_loop: ($P10) = rx1362_cur."from"() inc $P10 set rx1362_pos, $P10 ge rx1362_pos, rx1362_eos, rxscan1364_done rxscan1364_scan: set_addr $I10, rxscan1364_loop rx1362_cur."!mark_push"(0, rx1362_pos, $I10) rxscan1364_done: .annotate 'line', 263 # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() .annotate 'line', 264 # rx subrule "name" subtype=capture negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."name"() unless $P10, rx1362_fail rx1362_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("name") rx1362_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() .annotate 'line', 265 # rx rxquantr1365 ** 0..1 set_addr $I10, rxquantr1365_done rx1362_cur."!mark_push"(0, rx1362_pos, $I10) rxquantr1365_loop: # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() # rx literal "is" add $I11, rx1362_pos, 2 gt $I11, rx1362_eos, rx1362_fail sub $I11, rx1362_pos, rx1362_off substr $S10, rx1362_tgt, $I11, 2 ne $S10, "is", rx1362_fail add rx1362_pos, 2 # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() # rx subrule "name" subtype=capture negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."name"() unless $P10, rx1362_fail rx1362_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("parent") rx1362_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() set_addr $I10, rxquantr1365_done (rx1362_rep) = rx1362_cur."!mark_commit"($I10) rxquantr1365_done: # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() alt1366_0: .annotate 'line', 266 set_addr $I10, alt1366_1 rx1362_cur."!mark_push"(0, rx1362_pos, $I10) .annotate 'line', 267 # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() # rx literal ";" add $I11, rx1362_pos, 1 gt $I11, rx1362_eos, rx1362_fail sub $I11, rx1362_pos, rx1362_off ord $I11, rx1362_tgt, $I11 ne $I11, 59, rx1362_fail add rx1362_pos, 1 # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() # rx subrule "comp_unit" subtype=capture negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."comp_unit"() unless $P10, rx1362_fail rx1362_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("comp_unit") rx1362_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() goto alt1366_end alt1366_1: set_addr $I10, alt1366_2 rx1362_cur."!mark_push"(0, rx1362_pos, $I10) .annotate 'line', 268 # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() # rx enumcharlist negate=0 zerowidth sub $I10, rx1362_pos, rx1362_off substr $S10, rx1362_tgt, $I10, 1 index $I11, "{", $S10 lt $I11, 0, rx1362_fail # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() # rx subrule "block" subtype=capture negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."block"() unless $P10, rx1362_fail rx1362_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("block") rx1362_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() goto alt1366_end alt1366_2: .annotate 'line', 269 # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() # rx subrule "panic" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."panic"("Malformed package declaration") unless $P10, rx1362_fail rx1362_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() alt1366_end: .annotate 'line', 270 # rx subrule "ws" subtype=method negate= rx1362_cur."!cursor_pos"(rx1362_pos) $P10 = rx1362_cur."ws"() unless $P10, rx1362_fail rx1362_pos = $P10."pos"() .annotate 'line', 263 # rx pass rx1362_cur."!cursor_pass"(rx1362_pos, "package_def") if_null rx1362_debug, debug_623 rx1362_cur."!cursor_debug"("PASS", "package_def", " at pos=", rx1362_pos) debug_623: .return (rx1362_cur) rx1362_restart: .annotate 'line', 4 if_null rx1362_debug, debug_624 rx1362_cur."!cursor_debug"("NEXT", "package_def") debug_624: rx1362_fail: (rx1362_rep, rx1362_pos, $I10, $P10) = rx1362_cur."!mark_fail"(0) lt rx1362_pos, -1, rx1362_done eq rx1362_pos, -1, rx1362_fail jump $I10 rx1362_done: rx1362_cur."!cursor_fail"() if_null rx1362_debug, debug_625 rx1362_cur."!cursor_debug"("FAIL", "package_def") debug_625: .return (rx1362_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__package_def" :subid("137_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "scope_declarator" :subid("138_1309998847.42912") :method .annotate 'line', 273 $P100 = self."!protoregex"("scope_declarator") .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__scope_declarator" :subid("139_1309998847.42912") :method .annotate 'line', 273 $P101 = self."!PREFIX__!protoregex"("scope_declarator") .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "scope_declarator:sym" :subid("140_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1370_tgt .local int rx1370_pos .local int rx1370_off .local int rx1370_eos .local int rx1370_rep .local pmc rx1370_cur .local pmc rx1370_debug (rx1370_cur, rx1370_pos, rx1370_tgt, $I10) = self."!cursor_start"() getattribute rx1370_debug, rx1370_cur, "$!debug" .lex unicode:"$\x{a2}", rx1370_cur .local pmc match .lex "$/", match length rx1370_eos, rx1370_tgt gt rx1370_pos, rx1370_eos, rx1370_done set rx1370_off, 0 lt rx1370_pos, 2, rx1370_start sub rx1370_off, rx1370_pos, 1 substr rx1370_tgt, rx1370_tgt, rx1370_off rx1370_start: eq $I10, 1, rx1370_restart if_null rx1370_debug, debug_626 rx1370_cur."!cursor_debug"("START", "scope_declarator:sym") debug_626: $I10 = self.'from'() ne $I10, -1, rxscan1372_done goto rxscan1372_scan rxscan1372_loop: ($P10) = rx1370_cur."from"() inc $P10 set rx1370_pos, $P10 ge rx1370_pos, rx1370_eos, rxscan1372_done rxscan1372_scan: set_addr $I10, rxscan1372_loop rx1370_cur."!mark_push"(0, rx1370_pos, $I10) rxscan1372_done: .annotate 'line', 274 # rx subcapture "sym" set_addr $I10, rxcap_1373_fail rx1370_cur."!mark_push"(0, rx1370_pos, $I10) # rx literal "my" add $I11, rx1370_pos, 2 gt $I11, rx1370_eos, rx1370_fail sub $I11, rx1370_pos, rx1370_off substr $S10, rx1370_tgt, $I11, 2 ne $S10, "my", rx1370_fail add rx1370_pos, 2 set_addr $I10, rxcap_1373_fail ($I12, $I11) = rx1370_cur."!mark_peek"($I10) rx1370_cur."!cursor_pos"($I11) ($P10) = rx1370_cur."!cursor_start"() $P10."!cursor_pass"(rx1370_pos, "") rx1370_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1373_done rxcap_1373_fail: goto rx1370_fail rxcap_1373_done: # rx subrule "scoped" subtype=capture negate= rx1370_cur."!cursor_pos"(rx1370_pos) $P10 = rx1370_cur."scoped"("my") unless $P10, rx1370_fail rx1370_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("scoped") rx1370_pos = $P10."pos"() # rx pass rx1370_cur."!cursor_pass"(rx1370_pos, "scope_declarator:sym") if_null rx1370_debug, debug_627 rx1370_cur."!cursor_debug"("PASS", "scope_declarator:sym", " at pos=", rx1370_pos) debug_627: .return (rx1370_cur) rx1370_restart: .annotate 'line', 4 if_null rx1370_debug, debug_628 rx1370_cur."!cursor_debug"("NEXT", "scope_declarator:sym") debug_628: rx1370_fail: (rx1370_rep, rx1370_pos, $I10, $P10) = rx1370_cur."!mark_fail"(0) lt rx1370_pos, -1, rx1370_done eq rx1370_pos, -1, rx1370_fail jump $I10 rx1370_done: rx1370_cur."!cursor_fail"() if_null rx1370_debug, debug_629 rx1370_cur."!cursor_debug"("FAIL", "scope_declarator:sym") debug_629: .return (rx1370_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__scope_declarator:sym" :subid("141_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("scoped", "my") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "scope_declarator:sym" :subid("142_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1375_tgt .local int rx1375_pos .local int rx1375_off .local int rx1375_eos .local int rx1375_rep .local pmc rx1375_cur .local pmc rx1375_debug (rx1375_cur, rx1375_pos, rx1375_tgt, $I10) = self."!cursor_start"() getattribute rx1375_debug, rx1375_cur, "$!debug" .lex unicode:"$\x{a2}", rx1375_cur .local pmc match .lex "$/", match length rx1375_eos, rx1375_tgt gt rx1375_pos, rx1375_eos, rx1375_done set rx1375_off, 0 lt rx1375_pos, 2, rx1375_start sub rx1375_off, rx1375_pos, 1 substr rx1375_tgt, rx1375_tgt, rx1375_off rx1375_start: eq $I10, 1, rx1375_restart if_null rx1375_debug, debug_630 rx1375_cur."!cursor_debug"("START", "scope_declarator:sym") debug_630: $I10 = self.'from'() ne $I10, -1, rxscan1377_done goto rxscan1377_scan rxscan1377_loop: ($P10) = rx1375_cur."from"() inc $P10 set rx1375_pos, $P10 ge rx1375_pos, rx1375_eos, rxscan1377_done rxscan1377_scan: set_addr $I10, rxscan1377_loop rx1375_cur."!mark_push"(0, rx1375_pos, $I10) rxscan1377_done: .annotate 'line', 275 # rx subcapture "sym" set_addr $I10, rxcap_1378_fail rx1375_cur."!mark_push"(0, rx1375_pos, $I10) # rx literal "our" add $I11, rx1375_pos, 3 gt $I11, rx1375_eos, rx1375_fail sub $I11, rx1375_pos, rx1375_off substr $S10, rx1375_tgt, $I11, 3 ne $S10, "our", rx1375_fail add rx1375_pos, 3 set_addr $I10, rxcap_1378_fail ($I12, $I11) = rx1375_cur."!mark_peek"($I10) rx1375_cur."!cursor_pos"($I11) ($P10) = rx1375_cur."!cursor_start"() $P10."!cursor_pass"(rx1375_pos, "") rx1375_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1378_done rxcap_1378_fail: goto rx1375_fail rxcap_1378_done: # rx subrule "scoped" subtype=capture negate= rx1375_cur."!cursor_pos"(rx1375_pos) $P10 = rx1375_cur."scoped"("our") unless $P10, rx1375_fail rx1375_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("scoped") rx1375_pos = $P10."pos"() # rx pass rx1375_cur."!cursor_pass"(rx1375_pos, "scope_declarator:sym") if_null rx1375_debug, debug_631 rx1375_cur."!cursor_debug"("PASS", "scope_declarator:sym", " at pos=", rx1375_pos) debug_631: .return (rx1375_cur) rx1375_restart: .annotate 'line', 4 if_null rx1375_debug, debug_632 rx1375_cur."!cursor_debug"("NEXT", "scope_declarator:sym") debug_632: rx1375_fail: (rx1375_rep, rx1375_pos, $I10, $P10) = rx1375_cur."!mark_fail"(0) lt rx1375_pos, -1, rx1375_done eq rx1375_pos, -1, rx1375_fail jump $I10 rx1375_done: rx1375_cur."!cursor_fail"() if_null rx1375_debug, debug_633 rx1375_cur."!cursor_debug"("FAIL", "scope_declarator:sym") debug_633: .return (rx1375_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__scope_declarator:sym" :subid("143_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("scoped", "our") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "scope_declarator:sym" :subid("144_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1380_tgt .local int rx1380_pos .local int rx1380_off .local int rx1380_eos .local int rx1380_rep .local pmc rx1380_cur .local pmc rx1380_debug (rx1380_cur, rx1380_pos, rx1380_tgt, $I10) = self."!cursor_start"() getattribute rx1380_debug, rx1380_cur, "$!debug" .lex unicode:"$\x{a2}", rx1380_cur .local pmc match .lex "$/", match length rx1380_eos, rx1380_tgt gt rx1380_pos, rx1380_eos, rx1380_done set rx1380_off, 0 lt rx1380_pos, 2, rx1380_start sub rx1380_off, rx1380_pos, 1 substr rx1380_tgt, rx1380_tgt, rx1380_off rx1380_start: eq $I10, 1, rx1380_restart if_null rx1380_debug, debug_634 rx1380_cur."!cursor_debug"("START", "scope_declarator:sym") debug_634: $I10 = self.'from'() ne $I10, -1, rxscan1382_done goto rxscan1382_scan rxscan1382_loop: ($P10) = rx1380_cur."from"() inc $P10 set rx1380_pos, $P10 ge rx1380_pos, rx1380_eos, rxscan1382_done rxscan1382_scan: set_addr $I10, rxscan1382_loop rx1380_cur."!mark_push"(0, rx1380_pos, $I10) rxscan1382_done: .annotate 'line', 276 # rx subcapture "sym" set_addr $I10, rxcap_1383_fail rx1380_cur."!mark_push"(0, rx1380_pos, $I10) # rx literal "has" add $I11, rx1380_pos, 3 gt $I11, rx1380_eos, rx1380_fail sub $I11, rx1380_pos, rx1380_off substr $S10, rx1380_tgt, $I11, 3 ne $S10, "has", rx1380_fail add rx1380_pos, 3 set_addr $I10, rxcap_1383_fail ($I12, $I11) = rx1380_cur."!mark_peek"($I10) rx1380_cur."!cursor_pos"($I11) ($P10) = rx1380_cur."!cursor_start"() $P10."!cursor_pass"(rx1380_pos, "") rx1380_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1383_done rxcap_1383_fail: goto rx1380_fail rxcap_1383_done: # rx subrule "scoped" subtype=capture negate= rx1380_cur."!cursor_pos"(rx1380_pos) $P10 = rx1380_cur."scoped"("has") unless $P10, rx1380_fail rx1380_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("scoped") rx1380_pos = $P10."pos"() # rx pass rx1380_cur."!cursor_pass"(rx1380_pos, "scope_declarator:sym") if_null rx1380_debug, debug_635 rx1380_cur."!cursor_debug"("PASS", "scope_declarator:sym", " at pos=", rx1380_pos) debug_635: .return (rx1380_cur) rx1380_restart: .annotate 'line', 4 if_null rx1380_debug, debug_636 rx1380_cur."!cursor_debug"("NEXT", "scope_declarator:sym") debug_636: rx1380_fail: (rx1380_rep, rx1380_pos, $I10, $P10) = rx1380_cur."!mark_fail"(0) lt rx1380_pos, -1, rx1380_done eq rx1380_pos, -1, rx1380_fail jump $I10 rx1380_done: rx1380_cur."!cursor_fail"() if_null rx1380_debug, debug_637 rx1380_cur."!cursor_debug"("FAIL", "scope_declarator:sym") debug_637: .return (rx1380_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__scope_declarator:sym" :subid("145_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("scoped", "has") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "scoped" :subid("146_1309998847.42912") :method :outer("11_1309998847.42912") .param pmc param_1385 .annotate 'line', 278 .lex "$*SCOPE", param_1385 .annotate 'line', 4 .local string rx1386_tgt .local int rx1386_pos .local int rx1386_off .local int rx1386_eos .local int rx1386_rep .local pmc rx1386_cur .local pmc rx1386_debug (rx1386_cur, rx1386_pos, rx1386_tgt, $I10) = self."!cursor_start"() getattribute rx1386_debug, rx1386_cur, "$!debug" .lex unicode:"$\x{a2}", rx1386_cur .local pmc match .lex "$/", match length rx1386_eos, rx1386_tgt gt rx1386_pos, rx1386_eos, rx1386_done set rx1386_off, 0 lt rx1386_pos, 2, rx1386_start sub rx1386_off, rx1386_pos, 1 substr rx1386_tgt, rx1386_tgt, rx1386_off rx1386_start: eq $I10, 1, rx1386_restart if_null rx1386_debug, debug_638 rx1386_cur."!cursor_debug"("START", "scoped") debug_638: $I10 = self.'from'() ne $I10, -1, rxscan1388_done goto rxscan1388_scan rxscan1388_loop: ($P10) = rx1386_cur."from"() inc $P10 set rx1386_pos, $P10 ge rx1386_pos, rx1386_eos, rxscan1388_done rxscan1388_scan: set_addr $I10, rxscan1388_loop rx1386_cur."!mark_push"(0, rx1386_pos, $I10) rxscan1388_done: alt1389_0: .annotate 'line', 278 set_addr $I10, alt1389_1 rx1386_cur."!mark_push"(0, rx1386_pos, $I10) .annotate 'line', 279 # rx subrule "ws" subtype=method negate= rx1386_cur."!cursor_pos"(rx1386_pos) $P10 = rx1386_cur."ws"() unless $P10, rx1386_fail rx1386_pos = $P10."pos"() # rx subrule "declarator" subtype=capture negate= rx1386_cur."!cursor_pos"(rx1386_pos) $P10 = rx1386_cur."declarator"() unless $P10, rx1386_fail rx1386_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("declarator") rx1386_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1386_cur."!cursor_pos"(rx1386_pos) $P10 = rx1386_cur."ws"() unless $P10, rx1386_fail rx1386_pos = $P10."pos"() goto alt1389_end alt1389_1: .annotate 'line', 280 # rx subrule "ws" subtype=method negate= rx1386_cur."!cursor_pos"(rx1386_pos) $P10 = rx1386_cur."ws"() unless $P10, rx1386_fail rx1386_pos = $P10."pos"() # rx subrule "multi_declarator" subtype=capture negate= rx1386_cur."!cursor_pos"(rx1386_pos) $P10 = rx1386_cur."multi_declarator"() unless $P10, rx1386_fail rx1386_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("multi_declarator") rx1386_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1386_cur."!cursor_pos"(rx1386_pos) $P10 = rx1386_cur."ws"() unless $P10, rx1386_fail rx1386_pos = $P10."pos"() alt1389_end: .annotate 'line', 278 # rx pass rx1386_cur."!cursor_pass"(rx1386_pos, "scoped") if_null rx1386_debug, debug_639 rx1386_cur."!cursor_debug"("PASS", "scoped", " at pos=", rx1386_pos) debug_639: .return (rx1386_cur) rx1386_restart: .annotate 'line', 4 if_null rx1386_debug, debug_640 rx1386_cur."!cursor_debug"("NEXT", "scoped") debug_640: rx1386_fail: (rx1386_rep, rx1386_pos, $I10, $P10) = rx1386_cur."!mark_fail"(0) lt rx1386_pos, -1, rx1386_done eq rx1386_pos, -1, rx1386_fail jump $I10 rx1386_done: rx1386_cur."!cursor_fail"() if_null rx1386_debug, debug_641 rx1386_cur."!cursor_debug"("FAIL", "scoped") debug_641: .return (rx1386_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__scoped" :subid("147_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "") $P101 = self."!PREFIX__!subrule"("ws", "") new $P102, "ResizablePMCArray" push $P102, $P100 push $P102, $P101 .return ($P102) .end .namespace ["NQP";"Grammar"] .sub "typename" :subid("148_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1391_tgt .local int rx1391_pos .local int rx1391_off .local int rx1391_eos .local int rx1391_rep .local pmc rx1391_cur .local pmc rx1391_debug (rx1391_cur, rx1391_pos, rx1391_tgt, $I10) = self."!cursor_start"() getattribute rx1391_debug, rx1391_cur, "$!debug" .lex unicode:"$\x{a2}", rx1391_cur .local pmc match .lex "$/", match length rx1391_eos, rx1391_tgt gt rx1391_pos, rx1391_eos, rx1391_done set rx1391_off, 0 lt rx1391_pos, 2, rx1391_start sub rx1391_off, rx1391_pos, 1 substr rx1391_tgt, rx1391_tgt, rx1391_off rx1391_start: eq $I10, 1, rx1391_restart if_null rx1391_debug, debug_642 rx1391_cur."!cursor_debug"("START", "typename") debug_642: $I10 = self.'from'() ne $I10, -1, rxscan1393_done goto rxscan1393_scan rxscan1393_loop: ($P10) = rx1391_cur."from"() inc $P10 set rx1391_pos, $P10 ge rx1391_pos, rx1391_eos, rxscan1393_done rxscan1393_scan: set_addr $I10, rxscan1393_loop rx1391_cur."!mark_push"(0, rx1391_pos, $I10) rxscan1393_done: .annotate 'line', 283 # rx subrule "name" subtype=capture negate= rx1391_cur."!cursor_pos"(rx1391_pos) $P10 = rx1391_cur."name"() unless $P10, rx1391_fail rx1391_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("name") rx1391_pos = $P10."pos"() # rx pass rx1391_cur."!cursor_pass"(rx1391_pos, "typename") if_null rx1391_debug, debug_643 rx1391_cur."!cursor_debug"("PASS", "typename", " at pos=", rx1391_pos) debug_643: .return (rx1391_cur) rx1391_restart: .annotate 'line', 4 if_null rx1391_debug, debug_644 rx1391_cur."!cursor_debug"("NEXT", "typename") debug_644: rx1391_fail: (rx1391_rep, rx1391_pos, $I10, $P10) = rx1391_cur."!mark_fail"(0) lt rx1391_pos, -1, rx1391_done eq rx1391_pos, -1, rx1391_fail jump $I10 rx1391_done: rx1391_cur."!cursor_fail"() if_null rx1391_debug, debug_645 rx1391_cur."!cursor_debug"("FAIL", "typename") debug_645: .return (rx1391_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__typename" :subid("149_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("name", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "declarator" :subid("150_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1395_tgt .local int rx1395_pos .local int rx1395_off .local int rx1395_eos .local int rx1395_rep .local pmc rx1395_cur .local pmc rx1395_debug (rx1395_cur, rx1395_pos, rx1395_tgt, $I10) = self."!cursor_start"() getattribute rx1395_debug, rx1395_cur, "$!debug" .lex unicode:"$\x{a2}", rx1395_cur .local pmc match .lex "$/", match length rx1395_eos, rx1395_tgt gt rx1395_pos, rx1395_eos, rx1395_done set rx1395_off, 0 lt rx1395_pos, 2, rx1395_start sub rx1395_off, rx1395_pos, 1 substr rx1395_tgt, rx1395_tgt, rx1395_off rx1395_start: eq $I10, 1, rx1395_restart if_null rx1395_debug, debug_646 rx1395_cur."!cursor_debug"("START", "declarator") debug_646: $I10 = self.'from'() ne $I10, -1, rxscan1397_done goto rxscan1397_scan rxscan1397_loop: ($P10) = rx1395_cur."from"() inc $P10 set rx1395_pos, $P10 ge rx1395_pos, rx1395_eos, rxscan1397_done rxscan1397_scan: set_addr $I10, rxscan1397_loop rx1395_cur."!mark_push"(0, rx1395_pos, $I10) rxscan1397_done: alt1398_0: .annotate 'line', 285 set_addr $I10, alt1398_1 rx1395_cur."!mark_push"(0, rx1395_pos, $I10) .annotate 'line', 286 # rx subrule "variable_declarator" subtype=capture negate= rx1395_cur."!cursor_pos"(rx1395_pos) $P10 = rx1395_cur."variable_declarator"() unless $P10, rx1395_fail rx1395_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("variable_declarator") rx1395_pos = $P10."pos"() goto alt1398_end alt1398_1: .annotate 'line', 287 # rx subrule "routine_declarator" subtype=capture negate= rx1395_cur."!cursor_pos"(rx1395_pos) $P10 = rx1395_cur."routine_declarator"() unless $P10, rx1395_fail rx1395_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("routine_declarator") rx1395_pos = $P10."pos"() alt1398_end: .annotate 'line', 285 # rx pass rx1395_cur."!cursor_pass"(rx1395_pos, "declarator") if_null rx1395_debug, debug_647 rx1395_cur."!cursor_debug"("PASS", "declarator", " at pos=", rx1395_pos) debug_647: .return (rx1395_cur) rx1395_restart: .annotate 'line', 4 if_null rx1395_debug, debug_648 rx1395_cur."!cursor_debug"("NEXT", "declarator") debug_648: rx1395_fail: (rx1395_rep, rx1395_pos, $I10, $P10) = rx1395_cur."!mark_fail"(0) lt rx1395_pos, -1, rx1395_done eq rx1395_pos, -1, rx1395_fail jump $I10 rx1395_done: rx1395_cur."!cursor_fail"() if_null rx1395_debug, debug_649 rx1395_cur."!cursor_debug"("FAIL", "declarator") debug_649: .return (rx1395_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__declarator" :subid("151_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("routine_declarator", "") $P101 = self."!PREFIX__!subrule"("variable_declarator", "") new $P102, "ResizablePMCArray" push $P102, $P100 push $P102, $P101 .return ($P102) .end .namespace ["NQP";"Grammar"] .sub "variable_declarator" :subid("152_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1400_tgt .local int rx1400_pos .local int rx1400_off .local int rx1400_eos .local int rx1400_rep .local pmc rx1400_cur .local pmc rx1400_debug (rx1400_cur, rx1400_pos, rx1400_tgt, $I10) = self."!cursor_start"() getattribute rx1400_debug, rx1400_cur, "$!debug" .lex unicode:"$\x{a2}", rx1400_cur .local pmc match .lex "$/", match length rx1400_eos, rx1400_tgt gt rx1400_pos, rx1400_eos, rx1400_done set rx1400_off, 0 lt rx1400_pos, 2, rx1400_start sub rx1400_off, rx1400_pos, 1 substr rx1400_tgt, rx1400_tgt, rx1400_off rx1400_start: eq $I10, 1, rx1400_restart if_null rx1400_debug, debug_650 rx1400_cur."!cursor_debug"("START", "variable_declarator") debug_650: $I10 = self.'from'() ne $I10, -1, rxscan1402_done goto rxscan1402_scan rxscan1402_loop: ($P10) = rx1400_cur."from"() inc $P10 set rx1400_pos, $P10 ge rx1400_pos, rx1400_eos, rxscan1402_done rxscan1402_scan: set_addr $I10, rxscan1402_loop rx1400_cur."!mark_push"(0, rx1400_pos, $I10) rxscan1402_done: .annotate 'line', 290 # rx subrule "variable" subtype=capture negate= rx1400_cur."!cursor_pos"(rx1400_pos) $P10 = rx1400_cur."variable"() unless $P10, rx1400_fail rx1400_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("variable") rx1400_pos = $P10."pos"() # rx pass rx1400_cur."!cursor_pass"(rx1400_pos, "variable_declarator") if_null rx1400_debug, debug_651 rx1400_cur."!cursor_debug"("PASS", "variable_declarator", " at pos=", rx1400_pos) debug_651: .return (rx1400_cur) rx1400_restart: .annotate 'line', 4 if_null rx1400_debug, debug_652 rx1400_cur."!cursor_debug"("NEXT", "variable_declarator") debug_652: rx1400_fail: (rx1400_rep, rx1400_pos, $I10, $P10) = rx1400_cur."!mark_fail"(0) lt rx1400_pos, -1, rx1400_done eq rx1400_pos, -1, rx1400_fail jump $I10 rx1400_done: rx1400_cur."!cursor_fail"() if_null rx1400_debug, debug_653 rx1400_cur."!cursor_debug"("FAIL", "variable_declarator") debug_653: .return (rx1400_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__variable_declarator" :subid("153_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("variable", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "routine_declarator" :subid("154_1309998847.42912") :method .annotate 'line', 292 $P100 = self."!protoregex"("routine_declarator") .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__routine_declarator" :subid("155_1309998847.42912") :method .annotate 'line', 292 $P101 = self."!PREFIX__!protoregex"("routine_declarator") .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "routine_declarator:sym" :subid("156_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1406_tgt .local int rx1406_pos .local int rx1406_off .local int rx1406_eos .local int rx1406_rep .local pmc rx1406_cur .local pmc rx1406_debug (rx1406_cur, rx1406_pos, rx1406_tgt, $I10) = self."!cursor_start"() getattribute rx1406_debug, rx1406_cur, "$!debug" .lex unicode:"$\x{a2}", rx1406_cur .local pmc match .lex "$/", match length rx1406_eos, rx1406_tgt gt rx1406_pos, rx1406_eos, rx1406_done set rx1406_off, 0 lt rx1406_pos, 2, rx1406_start sub rx1406_off, rx1406_pos, 1 substr rx1406_tgt, rx1406_tgt, rx1406_off rx1406_start: eq $I10, 1, rx1406_restart if_null rx1406_debug, debug_654 rx1406_cur."!cursor_debug"("START", "routine_declarator:sym") debug_654: $I10 = self.'from'() ne $I10, -1, rxscan1408_done goto rxscan1408_scan rxscan1408_loop: ($P10) = rx1406_cur."from"() inc $P10 set rx1406_pos, $P10 ge rx1406_pos, rx1406_eos, rxscan1408_done rxscan1408_scan: set_addr $I10, rxscan1408_loop rx1406_cur."!mark_push"(0, rx1406_pos, $I10) rxscan1408_done: .annotate 'line', 293 # rx subcapture "sym" set_addr $I10, rxcap_1409_fail rx1406_cur."!mark_push"(0, rx1406_pos, $I10) # rx literal "sub" add $I11, rx1406_pos, 3 gt $I11, rx1406_eos, rx1406_fail sub $I11, rx1406_pos, rx1406_off substr $S10, rx1406_tgt, $I11, 3 ne $S10, "sub", rx1406_fail add rx1406_pos, 3 set_addr $I10, rxcap_1409_fail ($I12, $I11) = rx1406_cur."!mark_peek"($I10) rx1406_cur."!cursor_pos"($I11) ($P10) = rx1406_cur."!cursor_start"() $P10."!cursor_pass"(rx1406_pos, "") rx1406_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1409_done rxcap_1409_fail: goto rx1406_fail rxcap_1409_done: # rx subrule "routine_def" subtype=capture negate= rx1406_cur."!cursor_pos"(rx1406_pos) $P10 = rx1406_cur."routine_def"() unless $P10, rx1406_fail rx1406_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("routine_def") rx1406_pos = $P10."pos"() # rx pass rx1406_cur."!cursor_pass"(rx1406_pos, "routine_declarator:sym") if_null rx1406_debug, debug_655 rx1406_cur."!cursor_debug"("PASS", "routine_declarator:sym", " at pos=", rx1406_pos) debug_655: .return (rx1406_cur) rx1406_restart: .annotate 'line', 4 if_null rx1406_debug, debug_656 rx1406_cur."!cursor_debug"("NEXT", "routine_declarator:sym") debug_656: rx1406_fail: (rx1406_rep, rx1406_pos, $I10, $P10) = rx1406_cur."!mark_fail"(0) lt rx1406_pos, -1, rx1406_done eq rx1406_pos, -1, rx1406_fail jump $I10 rx1406_done: rx1406_cur."!cursor_fail"() if_null rx1406_debug, debug_657 rx1406_cur."!cursor_debug"("FAIL", "routine_declarator:sym") debug_657: .return (rx1406_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__routine_declarator:sym" :subid("157_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("routine_def", "sub") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "routine_declarator:sym" :subid("158_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1411_tgt .local int rx1411_pos .local int rx1411_off .local int rx1411_eos .local int rx1411_rep .local pmc rx1411_cur .local pmc rx1411_debug (rx1411_cur, rx1411_pos, rx1411_tgt, $I10) = self."!cursor_start"() getattribute rx1411_debug, rx1411_cur, "$!debug" .lex unicode:"$\x{a2}", rx1411_cur .local pmc match .lex "$/", match length rx1411_eos, rx1411_tgt gt rx1411_pos, rx1411_eos, rx1411_done set rx1411_off, 0 lt rx1411_pos, 2, rx1411_start sub rx1411_off, rx1411_pos, 1 substr rx1411_tgt, rx1411_tgt, rx1411_off rx1411_start: eq $I10, 1, rx1411_restart if_null rx1411_debug, debug_658 rx1411_cur."!cursor_debug"("START", "routine_declarator:sym") debug_658: $I10 = self.'from'() ne $I10, -1, rxscan1413_done goto rxscan1413_scan rxscan1413_loop: ($P10) = rx1411_cur."from"() inc $P10 set rx1411_pos, $P10 ge rx1411_pos, rx1411_eos, rxscan1413_done rxscan1413_scan: set_addr $I10, rxscan1413_loop rx1411_cur."!mark_push"(0, rx1411_pos, $I10) rxscan1413_done: .annotate 'line', 294 # rx subcapture "sym" set_addr $I10, rxcap_1414_fail rx1411_cur."!mark_push"(0, rx1411_pos, $I10) # rx literal "method" add $I11, rx1411_pos, 6 gt $I11, rx1411_eos, rx1411_fail sub $I11, rx1411_pos, rx1411_off substr $S10, rx1411_tgt, $I11, 6 ne $S10, "method", rx1411_fail add rx1411_pos, 6 set_addr $I10, rxcap_1414_fail ($I12, $I11) = rx1411_cur."!mark_peek"($I10) rx1411_cur."!cursor_pos"($I11) ($P10) = rx1411_cur."!cursor_start"() $P10."!cursor_pass"(rx1411_pos, "") rx1411_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1414_done rxcap_1414_fail: goto rx1411_fail rxcap_1414_done: # rx subrule "method_def" subtype=capture negate= rx1411_cur."!cursor_pos"(rx1411_pos) $P10 = rx1411_cur."method_def"() unless $P10, rx1411_fail rx1411_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("method_def") rx1411_pos = $P10."pos"() # rx pass rx1411_cur."!cursor_pass"(rx1411_pos, "routine_declarator:sym") if_null rx1411_debug, debug_659 rx1411_cur."!cursor_debug"("PASS", "routine_declarator:sym", " at pos=", rx1411_pos) debug_659: .return (rx1411_cur) rx1411_restart: .annotate 'line', 4 if_null rx1411_debug, debug_660 rx1411_cur."!cursor_debug"("NEXT", "routine_declarator:sym") debug_660: rx1411_fail: (rx1411_rep, rx1411_pos, $I10, $P10) = rx1411_cur."!mark_fail"(0) lt rx1411_pos, -1, rx1411_done eq rx1411_pos, -1, rx1411_fail jump $I10 rx1411_done: rx1411_cur."!cursor_fail"() if_null rx1411_debug, debug_661 rx1411_cur."!cursor_debug"("FAIL", "routine_declarator:sym") debug_661: .return (rx1411_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__routine_declarator:sym" :subid("159_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("method_def", "method") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "routine_def" :subid("160_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1416_tgt .local int rx1416_pos .local int rx1416_off .local int rx1416_eos .local int rx1416_rep .local pmc rx1416_cur .local pmc rx1416_debug (rx1416_cur, rx1416_pos, rx1416_tgt, $I10) = self."!cursor_start"() rx1416_cur."!cursor_caparray"("sigil", "deflongname", "trait") getattribute rx1416_debug, rx1416_cur, "$!debug" .lex unicode:"$\x{a2}", rx1416_cur .local pmc match .lex "$/", match length rx1416_eos, rx1416_tgt gt rx1416_pos, rx1416_eos, rx1416_done set rx1416_off, 0 lt rx1416_pos, 2, rx1416_start sub rx1416_off, rx1416_pos, 1 substr rx1416_tgt, rx1416_tgt, rx1416_off rx1416_start: eq $I10, 1, rx1416_restart if_null rx1416_debug, debug_662 rx1416_cur."!cursor_debug"("START", "routine_def") debug_662: $I10 = self.'from'() ne $I10, -1, rxscan1418_done goto rxscan1418_scan rxscan1418_loop: ($P10) = rx1416_cur."from"() inc $P10 set rx1416_pos, $P10 ge rx1416_pos, rx1416_eos, rxscan1418_done rxscan1418_scan: set_addr $I10, rxscan1418_loop rx1416_cur."!mark_push"(0, rx1416_pos, $I10) rxscan1418_done: .annotate 'line', 296 # rx subrule "ws" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."ws"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() .annotate 'line', 297 # rx rxquantr1419 ** 0..1 set_addr $I10, rxquantr1419_done rx1416_cur."!mark_push"(0, rx1416_pos, $I10) rxquantr1419_loop: # rx subrule "ws" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."ws"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() # rx subcapture "sigil" set_addr $I10, rxcap_1421_fail rx1416_cur."!mark_push"(0, rx1416_pos, $I10) # rx rxquantr1420 ** 0..1 set_addr $I10, rxquantr1420_done rx1416_cur."!mark_push"(0, rx1416_pos, $I10) rxquantr1420_loop: # rx literal "&" add $I11, rx1416_pos, 1 gt $I11, rx1416_eos, rx1416_fail sub $I11, rx1416_pos, rx1416_off ord $I11, rx1416_tgt, $I11 ne $I11, 38, rx1416_fail add rx1416_pos, 1 set_addr $I10, rxquantr1420_done (rx1416_rep) = rx1416_cur."!mark_commit"($I10) rxquantr1420_done: set_addr $I10, rxcap_1421_fail ($I12, $I11) = rx1416_cur."!mark_peek"($I10) rx1416_cur."!cursor_pos"($I11) ($P10) = rx1416_cur."!cursor_start"() $P10."!cursor_pass"(rx1416_pos, "") rx1416_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sigil") goto rxcap_1421_done rxcap_1421_fail: goto rx1416_fail rxcap_1421_done: # rx subrule "deflongname" subtype=capture negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."deflongname"() unless $P10, rx1416_fail rx1416_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("deflongname") rx1416_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."ws"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() set_addr $I10, rxquantr1419_done (rx1416_rep) = rx1416_cur."!mark_commit"($I10) rxquantr1419_done: # rx subrule "ws" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."ws"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() .annotate 'line', 298 # rx subrule "newpad" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."newpad"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."ws"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() alt1422_0: .annotate 'line', 299 set_addr $I10, alt1422_1 rx1416_cur."!mark_push"(0, rx1416_pos, $I10) # rx subrule "ws" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."ws"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() # rx literal "(" add $I11, rx1416_pos, 1 gt $I11, rx1416_eos, rx1416_fail sub $I11, rx1416_pos, rx1416_off ord $I11, rx1416_tgt, $I11 ne $I11, 40, rx1416_fail add rx1416_pos, 1 # rx subrule "ws" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."ws"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() # rx subrule "signature" subtype=capture negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."signature"() unless $P10, rx1416_fail rx1416_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("signature") rx1416_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."ws"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() # rx literal ")" add $I11, rx1416_pos, 1 gt $I11, rx1416_eos, rx1416_fail sub $I11, rx1416_pos, rx1416_off ord $I11, rx1416_tgt, $I11 ne $I11, 41, rx1416_fail add rx1416_pos, 1 # rx subrule "ws" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."ws"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() goto alt1422_end alt1422_1: .annotate 'line', 300 # rx subrule "ws" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."ws"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() # rx subrule "panic" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."panic"("Routine declaration requires a signature") unless $P10, rx1416_fail rx1416_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."ws"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() alt1422_end: # rx subrule "ws" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."ws"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() .annotate 'line', 301 # rx rxquantr1423 ** 0..* set_addr $I10, rxquantr1423_done rx1416_cur."!mark_push"(0, rx1416_pos, $I10) rxquantr1423_loop: # rx subrule "trait" subtype=capture negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."trait"() unless $P10, rx1416_fail goto rxsubrule1424_pass rxsubrule1424_back: $P10 = $P10."!cursor_next"() unless $P10, rx1416_fail rxsubrule1424_pass: set_addr $I10, rxsubrule1424_back rx1416_cur."!mark_push"(0, rx1416_pos, $I10, $P10) $P10."!cursor_names"("trait") rx1416_pos = $P10."pos"() set_addr $I10, rxquantr1423_done (rx1416_rep) = rx1416_cur."!mark_commit"($I10) set_addr $I10, rxquantr1423_done rx1416_cur."!mark_push"(rx1416_rep, rx1416_pos, $I10) goto rxquantr1423_loop rxquantr1423_done: # rx subrule "ws" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."ws"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() .annotate 'line', 302 # rx subrule "blockoid" subtype=capture negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."blockoid"() unless $P10, rx1416_fail rx1416_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("blockoid") rx1416_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1416_cur."!cursor_pos"(rx1416_pos) $P10 = rx1416_cur."ws"() unless $P10, rx1416_fail rx1416_pos = $P10."pos"() .annotate 'line', 296 # rx pass rx1416_cur."!cursor_pass"(rx1416_pos, "routine_def") if_null rx1416_debug, debug_663 rx1416_cur."!cursor_debug"("PASS", "routine_def", " at pos=", rx1416_pos) debug_663: .return (rx1416_cur) rx1416_restart: .annotate 'line', 4 if_null rx1416_debug, debug_664 rx1416_cur."!cursor_debug"("NEXT", "routine_def") debug_664: rx1416_fail: (rx1416_rep, rx1416_pos, $I10, $P10) = rx1416_cur."!mark_fail"(0) lt rx1416_pos, -1, rx1416_done eq rx1416_pos, -1, rx1416_fail jump $I10 rx1416_done: rx1416_cur."!cursor_fail"() if_null rx1416_debug, debug_665 rx1416_cur."!cursor_debug"("FAIL", "routine_def") debug_665: .return (rx1416_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__routine_def" :subid("161_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "method_def" :subid("162_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1426_tgt .local int rx1426_pos .local int rx1426_off .local int rx1426_eos .local int rx1426_rep .local pmc rx1426_cur .local pmc rx1426_debug (rx1426_cur, rx1426_pos, rx1426_tgt, $I10) = self."!cursor_start"() rx1426_cur."!cursor_caparray"("deflongname", "trait") getattribute rx1426_debug, rx1426_cur, "$!debug" .lex unicode:"$\x{a2}", rx1426_cur .local pmc match .lex "$/", match length rx1426_eos, rx1426_tgt gt rx1426_pos, rx1426_eos, rx1426_done set rx1426_off, 0 lt rx1426_pos, 2, rx1426_start sub rx1426_off, rx1426_pos, 1 substr rx1426_tgt, rx1426_tgt, rx1426_off rx1426_start: eq $I10, 1, rx1426_restart if_null rx1426_debug, debug_666 rx1426_cur."!cursor_debug"("START", "method_def") debug_666: $I10 = self.'from'() ne $I10, -1, rxscan1428_done goto rxscan1428_scan rxscan1428_loop: ($P10) = rx1426_cur."from"() inc $P10 set rx1426_pos, $P10 ge rx1426_pos, rx1426_eos, rxscan1428_done rxscan1428_scan: set_addr $I10, rxscan1428_loop rx1426_cur."!mark_push"(0, rx1426_pos, $I10) rxscan1428_done: .annotate 'line', 305 # rx subrule "ws" subtype=method negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."ws"() unless $P10, rx1426_fail rx1426_pos = $P10."pos"() .annotate 'line', 306 # rx rxquantr1429 ** 0..1 set_addr $I10, rxquantr1429_done rx1426_cur."!mark_push"(0, rx1426_pos, $I10) rxquantr1429_loop: # rx subrule "deflongname" subtype=capture negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."deflongname"() unless $P10, rx1426_fail goto rxsubrule1430_pass rxsubrule1430_back: $P10 = $P10."!cursor_next"() unless $P10, rx1426_fail rxsubrule1430_pass: set_addr $I10, rxsubrule1430_back rx1426_cur."!mark_push"(0, rx1426_pos, $I10, $P10) $P10."!cursor_names"("deflongname") rx1426_pos = $P10."pos"() set_addr $I10, rxquantr1429_done (rx1426_rep) = rx1426_cur."!mark_commit"($I10) rxquantr1429_done: # rx subrule "ws" subtype=method negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."ws"() unless $P10, rx1426_fail rx1426_pos = $P10."pos"() .annotate 'line', 307 # rx subrule "newpad" subtype=method negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."newpad"() unless $P10, rx1426_fail rx1426_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."ws"() unless $P10, rx1426_fail rx1426_pos = $P10."pos"() alt1431_0: .annotate 'line', 308 set_addr $I10, alt1431_1 rx1426_cur."!mark_push"(0, rx1426_pos, $I10) # rx subrule "ws" subtype=method negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."ws"() unless $P10, rx1426_fail rx1426_pos = $P10."pos"() # rx literal "(" add $I11, rx1426_pos, 1 gt $I11, rx1426_eos, rx1426_fail sub $I11, rx1426_pos, rx1426_off ord $I11, rx1426_tgt, $I11 ne $I11, 40, rx1426_fail add rx1426_pos, 1 # rx subrule "ws" subtype=method negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."ws"() unless $P10, rx1426_fail rx1426_pos = $P10."pos"() # rx subrule "signature" subtype=capture negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."signature"() unless $P10, rx1426_fail rx1426_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("signature") rx1426_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."ws"() unless $P10, rx1426_fail rx1426_pos = $P10."pos"() # rx literal ")" add $I11, rx1426_pos, 1 gt $I11, rx1426_eos, rx1426_fail sub $I11, rx1426_pos, rx1426_off ord $I11, rx1426_tgt, $I11 ne $I11, 41, rx1426_fail add rx1426_pos, 1 # rx subrule "ws" subtype=method negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."ws"() unless $P10, rx1426_fail rx1426_pos = $P10."pos"() goto alt1431_end alt1431_1: .annotate 'line', 309 # rx subrule "ws" subtype=method negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."ws"() unless $P10, rx1426_fail rx1426_pos = $P10."pos"() # rx subrule "panic" subtype=method negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."panic"("Routine declaration requires a signature") unless $P10, rx1426_fail rx1426_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."ws"() unless $P10, rx1426_fail rx1426_pos = $P10."pos"() alt1431_end: # rx subrule "ws" subtype=method negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."ws"() unless $P10, rx1426_fail rx1426_pos = $P10."pos"() .annotate 'line', 310 # rx rxquantr1432 ** 0..* set_addr $I10, rxquantr1432_done rx1426_cur."!mark_push"(0, rx1426_pos, $I10) rxquantr1432_loop: # rx subrule "trait" subtype=capture negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."trait"() unless $P10, rx1426_fail goto rxsubrule1433_pass rxsubrule1433_back: $P10 = $P10."!cursor_next"() unless $P10, rx1426_fail rxsubrule1433_pass: set_addr $I10, rxsubrule1433_back rx1426_cur."!mark_push"(0, rx1426_pos, $I10, $P10) $P10."!cursor_names"("trait") rx1426_pos = $P10."pos"() set_addr $I10, rxquantr1432_done (rx1426_rep) = rx1426_cur."!mark_commit"($I10) set_addr $I10, rxquantr1432_done rx1426_cur."!mark_push"(rx1426_rep, rx1426_pos, $I10) goto rxquantr1432_loop rxquantr1432_done: # rx subrule "ws" subtype=method negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."ws"() unless $P10, rx1426_fail rx1426_pos = $P10."pos"() .annotate 'line', 311 # rx subrule "blockoid" subtype=capture negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."blockoid"() unless $P10, rx1426_fail rx1426_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("blockoid") rx1426_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1426_cur."!cursor_pos"(rx1426_pos) $P10 = rx1426_cur."ws"() unless $P10, rx1426_fail rx1426_pos = $P10."pos"() .annotate 'line', 305 # rx pass rx1426_cur."!cursor_pass"(rx1426_pos, "method_def") if_null rx1426_debug, debug_667 rx1426_cur."!cursor_debug"("PASS", "method_def", " at pos=", rx1426_pos) debug_667: .return (rx1426_cur) rx1426_restart: .annotate 'line', 4 if_null rx1426_debug, debug_668 rx1426_cur."!cursor_debug"("NEXT", "method_def") debug_668: rx1426_fail: (rx1426_rep, rx1426_pos, $I10, $P10) = rx1426_cur."!mark_fail"(0) lt rx1426_pos, -1, rx1426_done eq rx1426_pos, -1, rx1426_fail jump $I10 rx1426_done: rx1426_cur."!cursor_fail"() if_null rx1426_debug, debug_669 rx1426_cur."!cursor_debug"("FAIL", "method_def") debug_669: .return (rx1426_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__method_def" :subid("163_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "multi_declarator" :subid("164_1309998847.42912") :method .annotate 'line', 314 $P100 = self."!protoregex"("multi_declarator") .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__multi_declarator" :subid("165_1309998847.42912") :method .annotate 'line', 314 $P101 = self."!PREFIX__!protoregex"("multi_declarator") .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "multi_declarator:sym" :subid("166_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 316 new $P100, "Undef" set $P1437, $P100 .lex "$*MULTINESS", $P1437 .annotate 'line', 4 .local string rx1438_tgt .local int rx1438_pos .local int rx1438_off .local int rx1438_eos .local int rx1438_rep .local pmc rx1438_cur .local pmc rx1438_debug (rx1438_cur, rx1438_pos, rx1438_tgt, $I10) = self."!cursor_start"() getattribute rx1438_debug, rx1438_cur, "$!debug" .lex unicode:"$\x{a2}", rx1438_cur .local pmc match .lex "$/", match length rx1438_eos, rx1438_tgt gt rx1438_pos, rx1438_eos, rx1438_done set rx1438_off, 0 lt rx1438_pos, 2, rx1438_start sub rx1438_off, rx1438_pos, 1 substr rx1438_tgt, rx1438_tgt, rx1438_off rx1438_start: eq $I10, 1, rx1438_restart if_null rx1438_debug, debug_670 rx1438_cur."!cursor_debug"("START", "multi_declarator:sym") debug_670: $I10 = self.'from'() ne $I10, -1, rxscan1440_done goto rxscan1440_scan rxscan1440_loop: ($P10) = rx1438_cur."from"() inc $P10 set rx1438_pos, $P10 ge rx1438_pos, rx1438_eos, rxscan1440_done rxscan1440_scan: set_addr $I10, rxscan1440_loop rx1438_cur."!mark_push"(0, rx1438_pos, $I10) rxscan1440_done: .annotate 'line', 316 rx1438_cur."!cursor_pos"(rx1438_pos) new $P103, "String" assign $P103, "multi" store_lex "$*MULTINESS", $P103 .annotate 'line', 317 # rx subcapture "sym" set_addr $I10, rxcap_1441_fail rx1438_cur."!mark_push"(0, rx1438_pos, $I10) # rx literal "multi" add $I11, rx1438_pos, 5 gt $I11, rx1438_eos, rx1438_fail sub $I11, rx1438_pos, rx1438_off substr $S10, rx1438_tgt, $I11, 5 ne $S10, "multi", rx1438_fail add rx1438_pos, 5 set_addr $I10, rxcap_1441_fail ($I12, $I11) = rx1438_cur."!mark_peek"($I10) rx1438_cur."!cursor_pos"($I11) ($P10) = rx1438_cur."!cursor_start"() $P10."!cursor_pass"(rx1438_pos, "") rx1438_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1441_done rxcap_1441_fail: goto rx1438_fail rxcap_1441_done: .annotate 'line', 318 # rx subrule "ws" subtype=method negate= rx1438_cur."!cursor_pos"(rx1438_pos) $P10 = rx1438_cur."ws"() unless $P10, rx1438_fail rx1438_pos = $P10."pos"() alt1442_0: set_addr $I10, alt1442_1 rx1438_cur."!mark_push"(0, rx1438_pos, $I10) # rx subrule "declarator" subtype=capture negate= rx1438_cur."!cursor_pos"(rx1438_pos) $P10 = rx1438_cur."declarator"() unless $P10, rx1438_fail rx1438_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("declarator") rx1438_pos = $P10."pos"() goto alt1442_end alt1442_1: set_addr $I10, alt1442_2 rx1438_cur."!mark_push"(0, rx1438_pos, $I10) # rx subrule "routine_def" subtype=capture negate= rx1438_cur."!cursor_pos"(rx1438_pos) $P10 = rx1438_cur."routine_def"() unless $P10, rx1438_fail rx1438_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("routine_def") rx1438_pos = $P10."pos"() goto alt1442_end alt1442_2: # rx subrule "panic" subtype=method negate= rx1438_cur."!cursor_pos"(rx1438_pos) $P10 = rx1438_cur."panic"("Malformed multi") unless $P10, rx1438_fail rx1438_pos = $P10."pos"() alt1442_end: .annotate 'line', 315 # rx pass rx1438_cur."!cursor_pass"(rx1438_pos, "multi_declarator:sym") if_null rx1438_debug, debug_671 rx1438_cur."!cursor_debug"("PASS", "multi_declarator:sym", " at pos=", rx1438_pos) debug_671: .return (rx1438_cur) rx1438_restart: .annotate 'line', 4 if_null rx1438_debug, debug_672 rx1438_cur."!cursor_debug"("NEXT", "multi_declarator:sym") debug_672: rx1438_fail: (rx1438_rep, rx1438_pos, $I10, $P10) = rx1438_cur."!mark_fail"(0) lt rx1438_pos, -1, rx1438_done eq rx1438_pos, -1, rx1438_fail jump $I10 rx1438_done: rx1438_cur."!cursor_fail"() if_null rx1438_debug, debug_673 rx1438_cur."!cursor_debug"("FAIL", "multi_declarator:sym") debug_673: .return (rx1438_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__multi_declarator:sym" :subid("167_1309998847.42912") :method .annotate 'line', 4 $P101 = self."!PREFIX__!subrule"("ws", "multi") new $P102, "ResizablePMCArray" push $P102, $P101 .return ($P102) .end .namespace ["NQP";"Grammar"] .sub "multi_declarator:sym" :subid("168_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 321 new $P100, "Undef" set $P1444, $P100 .lex "$*MULTINESS", $P1444 .annotate 'line', 4 .local string rx1445_tgt .local int rx1445_pos .local int rx1445_off .local int rx1445_eos .local int rx1445_rep .local pmc rx1445_cur .local pmc rx1445_debug (rx1445_cur, rx1445_pos, rx1445_tgt, $I10) = self."!cursor_start"() getattribute rx1445_debug, rx1445_cur, "$!debug" .lex unicode:"$\x{a2}", rx1445_cur .local pmc match .lex "$/", match length rx1445_eos, rx1445_tgt gt rx1445_pos, rx1445_eos, rx1445_done set rx1445_off, 0 lt rx1445_pos, 2, rx1445_start sub rx1445_off, rx1445_pos, 1 substr rx1445_tgt, rx1445_tgt, rx1445_off rx1445_start: eq $I10, 1, rx1445_restart if_null rx1445_debug, debug_674 rx1445_cur."!cursor_debug"("START", "multi_declarator:sym") debug_674: $I10 = self.'from'() ne $I10, -1, rxscan1447_done goto rxscan1447_scan rxscan1447_loop: ($P10) = rx1445_cur."from"() inc $P10 set rx1445_pos, $P10 ge rx1445_pos, rx1445_eos, rxscan1447_done rxscan1447_scan: set_addr $I10, rxscan1447_loop rx1445_cur."!mark_push"(0, rx1445_pos, $I10) rxscan1447_done: .annotate 'line', 321 rx1445_cur."!cursor_pos"(rx1445_pos) new $P103, "String" assign $P103, "" store_lex "$*MULTINESS", $P103 .annotate 'line', 322 # rx subrule "declarator" subtype=capture negate= rx1445_cur."!cursor_pos"(rx1445_pos) $P10 = rx1445_cur."declarator"() unless $P10, rx1445_fail rx1445_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("declarator") rx1445_pos = $P10."pos"() .annotate 'line', 320 # rx pass rx1445_cur."!cursor_pass"(rx1445_pos, "multi_declarator:sym") if_null rx1445_debug, debug_675 rx1445_cur."!cursor_debug"("PASS", "multi_declarator:sym", " at pos=", rx1445_pos) debug_675: .return (rx1445_cur) rx1445_restart: .annotate 'line', 4 if_null rx1445_debug, debug_676 rx1445_cur."!cursor_debug"("NEXT", "multi_declarator:sym") debug_676: rx1445_fail: (rx1445_rep, rx1445_pos, $I10, $P10) = rx1445_cur."!mark_fail"(0) lt rx1445_pos, -1, rx1445_done eq rx1445_pos, -1, rx1445_fail jump $I10 rx1445_done: rx1445_cur."!cursor_fail"() if_null rx1445_debug, debug_677 rx1445_cur."!cursor_debug"("FAIL", "multi_declarator:sym") debug_677: .return (rx1445_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__multi_declarator:sym" :subid("169_1309998847.42912") :method .annotate 'line', 4 $P101 = self."!PREFIX__!subrule"("declarator", "") new $P102, "ResizablePMCArray" push $P102, $P101 .return ($P102) .end .namespace ["NQP";"Grammar"] .sub "signature" :subid("170_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1449_tgt .local int rx1449_pos .local int rx1449_off .local int rx1449_eos .local int rx1449_rep .local pmc rx1449_cur .local pmc rx1449_debug (rx1449_cur, rx1449_pos, rx1449_tgt, $I10) = self."!cursor_start"() rx1449_cur."!cursor_caparray"("parameter") getattribute rx1449_debug, rx1449_cur, "$!debug" .lex unicode:"$\x{a2}", rx1449_cur .local pmc match .lex "$/", match length rx1449_eos, rx1449_tgt gt rx1449_pos, rx1449_eos, rx1449_done set rx1449_off, 0 lt rx1449_pos, 2, rx1449_start sub rx1449_off, rx1449_pos, 1 substr rx1449_tgt, rx1449_tgt, rx1449_off rx1449_start: eq $I10, 1, rx1449_restart if_null rx1449_debug, debug_678 rx1449_cur."!cursor_debug"("START", "signature") debug_678: $I10 = self.'from'() ne $I10, -1, rxscan1451_done goto rxscan1451_scan rxscan1451_loop: ($P10) = rx1449_cur."from"() inc $P10 set rx1449_pos, $P10 ge rx1449_pos, rx1449_eos, rxscan1451_done rxscan1451_scan: set_addr $I10, rxscan1451_loop rx1449_cur."!mark_push"(0, rx1449_pos, $I10) rxscan1451_done: .annotate 'line', 325 # rx rxquantr1452 ** 0..1 set_addr $I10, rxquantr1452_done rx1449_cur."!mark_push"(0, rx1449_pos, $I10) rxquantr1452_loop: # rx rxquantr1453 ** 1..* set_addr $I10, rxquantr1453_done rx1449_cur."!mark_push"(0, -1, $I10) rxquantr1453_loop: # rx subrule "ws" subtype=method negate= rx1449_cur."!cursor_pos"(rx1449_pos) $P10 = rx1449_cur."ws"() unless $P10, rx1449_fail rx1449_pos = $P10."pos"() # rx subrule "parameter" subtype=capture negate= rx1449_cur."!cursor_pos"(rx1449_pos) $P10 = rx1449_cur."parameter"() unless $P10, rx1449_fail rx1449_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("parameter") rx1449_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1449_cur."!cursor_pos"(rx1449_pos) $P10 = rx1449_cur."ws"() unless $P10, rx1449_fail rx1449_pos = $P10."pos"() set_addr $I10, rxquantr1453_done (rx1449_rep) = rx1449_cur."!mark_commit"($I10) set_addr $I10, rxquantr1453_done rx1449_cur."!mark_push"(rx1449_rep, rx1449_pos, $I10) # rx literal "," add $I11, rx1449_pos, 1 gt $I11, rx1449_eos, rx1449_fail sub $I11, rx1449_pos, rx1449_off ord $I11, rx1449_tgt, $I11 ne $I11, 44, rx1449_fail add rx1449_pos, 1 goto rxquantr1453_loop rxquantr1453_done: set_addr $I10, rxquantr1452_done (rx1449_rep) = rx1449_cur."!mark_commit"($I10) rxquantr1452_done: # rx pass rx1449_cur."!cursor_pass"(rx1449_pos, "signature") if_null rx1449_debug, debug_679 rx1449_cur."!cursor_debug"("PASS", "signature", " at pos=", rx1449_pos) debug_679: .return (rx1449_cur) rx1449_restart: .annotate 'line', 4 if_null rx1449_debug, debug_680 rx1449_cur."!cursor_debug"("NEXT", "signature") debug_680: rx1449_fail: (rx1449_rep, rx1449_pos, $I10, $P10) = rx1449_cur."!mark_fail"(0) lt rx1449_pos, -1, rx1449_done eq rx1449_pos, -1, rx1449_fail jump $I10 rx1449_done: rx1449_cur."!cursor_fail"() if_null rx1449_debug, debug_681 rx1449_cur."!cursor_debug"("FAIL", "signature") debug_681: .return (rx1449_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__signature" :subid("171_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "parameter" :subid("172_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1455_tgt .local int rx1455_pos .local int rx1455_off .local int rx1455_eos .local int rx1455_rep .local pmc rx1455_cur .local pmc rx1455_debug (rx1455_cur, rx1455_pos, rx1455_tgt, $I10) = self."!cursor_start"() rx1455_cur."!cursor_caparray"("typename", "default_value") getattribute rx1455_debug, rx1455_cur, "$!debug" .lex unicode:"$\x{a2}", rx1455_cur .local pmc match .lex "$/", match length rx1455_eos, rx1455_tgt gt rx1455_pos, rx1455_eos, rx1455_done set rx1455_off, 0 lt rx1455_pos, 2, rx1455_start sub rx1455_off, rx1455_pos, 1 substr rx1455_tgt, rx1455_tgt, rx1455_off rx1455_start: eq $I10, 1, rx1455_restart if_null rx1455_debug, debug_682 rx1455_cur."!cursor_debug"("START", "parameter") debug_682: $I10 = self.'from'() ne $I10, -1, rxscan1457_done goto rxscan1457_scan rxscan1457_loop: ($P10) = rx1455_cur."from"() inc $P10 set rx1455_pos, $P10 ge rx1455_pos, rx1455_eos, rxscan1457_done rxscan1457_scan: set_addr $I10, rxscan1457_loop rx1455_cur."!mark_push"(0, rx1455_pos, $I10) rxscan1457_done: .annotate 'line', 328 # rx rxquantr1458 ** 0..* set_addr $I10, rxquantr1458_done rx1455_cur."!mark_push"(0, rx1455_pos, $I10) rxquantr1458_loop: # rx subrule "typename" subtype=capture negate= rx1455_cur."!cursor_pos"(rx1455_pos) $P10 = rx1455_cur."typename"() unless $P10, rx1455_fail rx1455_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("typename") rx1455_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1455_cur."!cursor_pos"(rx1455_pos) $P10 = rx1455_cur."ws"() unless $P10, rx1455_fail rx1455_pos = $P10."pos"() set_addr $I10, rxquantr1458_done (rx1455_rep) = rx1455_cur."!mark_commit"($I10) set_addr $I10, rxquantr1458_done rx1455_cur."!mark_push"(rx1455_rep, rx1455_pos, $I10) goto rxquantr1458_loop rxquantr1458_done: alt1459_0: .annotate 'line', 329 set_addr $I10, alt1459_1 rx1455_cur."!mark_push"(0, rx1455_pos, $I10) .annotate 'line', 330 # rx subcapture "quant" set_addr $I10, rxcap_1460_fail rx1455_cur."!mark_push"(0, rx1455_pos, $I10) # rx literal "*" add $I11, rx1455_pos, 1 gt $I11, rx1455_eos, rx1455_fail sub $I11, rx1455_pos, rx1455_off ord $I11, rx1455_tgt, $I11 ne $I11, 42, rx1455_fail add rx1455_pos, 1 set_addr $I10, rxcap_1460_fail ($I12, $I11) = rx1455_cur."!mark_peek"($I10) rx1455_cur."!cursor_pos"($I11) ($P10) = rx1455_cur."!cursor_start"() $P10."!cursor_pass"(rx1455_pos, "") rx1455_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("quant") goto rxcap_1460_done rxcap_1460_fail: goto rx1455_fail rxcap_1460_done: # rx subrule "param_var" subtype=capture negate= rx1455_cur."!cursor_pos"(rx1455_pos) $P10 = rx1455_cur."param_var"() unless $P10, rx1455_fail rx1455_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("param_var") rx1455_pos = $P10."pos"() goto alt1459_end alt1459_1: alt1461_0: .annotate 'line', 331 set_addr $I10, alt1461_1 rx1455_cur."!mark_push"(0, rx1455_pos, $I10) # rx subrule "param_var" subtype=capture negate= rx1455_cur."!cursor_pos"(rx1455_pos) $P10 = rx1455_cur."param_var"() unless $P10, rx1455_fail rx1455_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("param_var") rx1455_pos = $P10."pos"() goto alt1461_end alt1461_1: # rx subrule "named_param" subtype=capture negate= rx1455_cur."!cursor_pos"(rx1455_pos) $P10 = rx1455_cur."named_param"() unless $P10, rx1455_fail rx1455_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("named_param") rx1455_pos = $P10."pos"() alt1461_end: # rx subcapture "quant" set_addr $I10, rxcap_1463_fail rx1455_cur."!mark_push"(0, rx1455_pos, $I10) alt1462_0: set_addr $I10, alt1462_1 rx1455_cur."!mark_push"(0, rx1455_pos, $I10) # rx literal "?" add $I11, rx1455_pos, 1 gt $I11, rx1455_eos, rx1455_fail sub $I11, rx1455_pos, rx1455_off ord $I11, rx1455_tgt, $I11 ne $I11, 63, rx1455_fail add rx1455_pos, 1 goto alt1462_end alt1462_1: set_addr $I10, alt1462_2 rx1455_cur."!mark_push"(0, rx1455_pos, $I10) # rx literal "!" add $I11, rx1455_pos, 1 gt $I11, rx1455_eos, rx1455_fail sub $I11, rx1455_pos, rx1455_off ord $I11, rx1455_tgt, $I11 ne $I11, 33, rx1455_fail add rx1455_pos, 1 goto alt1462_end alt1462_2: alt1462_end: set_addr $I10, rxcap_1463_fail ($I12, $I11) = rx1455_cur."!mark_peek"($I10) rx1455_cur."!cursor_pos"($I11) ($P10) = rx1455_cur."!cursor_start"() $P10."!cursor_pass"(rx1455_pos, "") rx1455_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("quant") goto rxcap_1463_done rxcap_1463_fail: goto rx1455_fail rxcap_1463_done: alt1459_end: .annotate 'line', 333 # rx rxquantr1464 ** 0..1 set_addr $I10, rxquantr1464_done rx1455_cur."!mark_push"(0, rx1455_pos, $I10) rxquantr1464_loop: # rx subrule "default_value" subtype=capture negate= rx1455_cur."!cursor_pos"(rx1455_pos) $P10 = rx1455_cur."default_value"() unless $P10, rx1455_fail goto rxsubrule1465_pass rxsubrule1465_back: $P10 = $P10."!cursor_next"() unless $P10, rx1455_fail rxsubrule1465_pass: set_addr $I10, rxsubrule1465_back rx1455_cur."!mark_push"(0, rx1455_pos, $I10, $P10) $P10."!cursor_names"("default_value") rx1455_pos = $P10."pos"() set_addr $I10, rxquantr1464_done (rx1455_rep) = rx1455_cur."!mark_commit"($I10) rxquantr1464_done: .annotate 'line', 327 # rx pass rx1455_cur."!cursor_pass"(rx1455_pos, "parameter") if_null rx1455_debug, debug_683 rx1455_cur."!cursor_debug"("PASS", "parameter", " at pos=", rx1455_pos) debug_683: .return (rx1455_cur) rx1455_restart: .annotate 'line', 4 if_null rx1455_debug, debug_684 rx1455_cur."!cursor_debug"("NEXT", "parameter") debug_684: rx1455_fail: (rx1455_rep, rx1455_pos, $I10, $P10) = rx1455_cur."!mark_fail"(0) lt rx1455_pos, -1, rx1455_done eq rx1455_pos, -1, rx1455_fail jump $I10 rx1455_done: rx1455_cur."!cursor_fail"() if_null rx1455_debug, debug_685 rx1455_cur."!cursor_debug"("FAIL", "parameter") debug_685: .return (rx1455_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__parameter" :subid("173_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "param_var" :subid("174_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1467_tgt .local int rx1467_pos .local int rx1467_off .local int rx1467_eos .local int rx1467_rep .local pmc rx1467_cur .local pmc rx1467_debug (rx1467_cur, rx1467_pos, rx1467_tgt, $I10) = self."!cursor_start"() rx1467_cur."!cursor_caparray"("twigil") getattribute rx1467_debug, rx1467_cur, "$!debug" .lex unicode:"$\x{a2}", rx1467_cur .local pmc match .lex "$/", match length rx1467_eos, rx1467_tgt gt rx1467_pos, rx1467_eos, rx1467_done set rx1467_off, 0 lt rx1467_pos, 2, rx1467_start sub rx1467_off, rx1467_pos, 1 substr rx1467_tgt, rx1467_tgt, rx1467_off rx1467_start: eq $I10, 1, rx1467_restart if_null rx1467_debug, debug_686 rx1467_cur."!cursor_debug"("START", "param_var") debug_686: $I10 = self.'from'() ne $I10, -1, rxscan1469_done goto rxscan1469_scan rxscan1469_loop: ($P10) = rx1467_cur."from"() inc $P10 set rx1467_pos, $P10 ge rx1467_pos, rx1467_eos, rxscan1469_done rxscan1469_scan: set_addr $I10, rxscan1469_loop rx1467_cur."!mark_push"(0, rx1467_pos, $I10) rxscan1469_done: .annotate 'line', 337 # rx subrule "sigil" subtype=capture negate= rx1467_cur."!cursor_pos"(rx1467_pos) $P10 = rx1467_cur."sigil"() unless $P10, rx1467_fail rx1467_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sigil") rx1467_pos = $P10."pos"() # rx rxquantr1470 ** 0..1 set_addr $I10, rxquantr1470_done rx1467_cur."!mark_push"(0, rx1467_pos, $I10) rxquantr1470_loop: # rx subrule "twigil" subtype=capture negate= rx1467_cur."!cursor_pos"(rx1467_pos) $P10 = rx1467_cur."twigil"() unless $P10, rx1467_fail goto rxsubrule1471_pass rxsubrule1471_back: $P10 = $P10."!cursor_next"() unless $P10, rx1467_fail rxsubrule1471_pass: set_addr $I10, rxsubrule1471_back rx1467_cur."!mark_push"(0, rx1467_pos, $I10, $P10) $P10."!cursor_names"("twigil") rx1467_pos = $P10."pos"() set_addr $I10, rxquantr1470_done (rx1467_rep) = rx1467_cur."!mark_commit"($I10) rxquantr1470_done: alt1472_0: .annotate 'line', 338 set_addr $I10, alt1472_1 rx1467_cur."!mark_push"(0, rx1467_pos, $I10) # rx subrule "ident" subtype=capture negate= rx1467_cur."!cursor_pos"(rx1467_pos) $P10 = rx1467_cur."ident"() unless $P10, rx1467_fail rx1467_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("name") rx1467_pos = $P10."pos"() goto alt1472_end alt1472_1: # rx subcapture "name" set_addr $I10, rxcap_1473_fail rx1467_cur."!mark_push"(0, rx1467_pos, $I10) # rx enumcharlist negate=0 ge rx1467_pos, rx1467_eos, rx1467_fail sub $I10, rx1467_pos, rx1467_off substr $S10, rx1467_tgt, $I10, 1 index $I11, "/!", $S10 lt $I11, 0, rx1467_fail inc rx1467_pos set_addr $I10, rxcap_1473_fail ($I12, $I11) = rx1467_cur."!mark_peek"($I10) rx1467_cur."!cursor_pos"($I11) ($P10) = rx1467_cur."!cursor_start"() $P10."!cursor_pass"(rx1467_pos, "") rx1467_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("name") goto rxcap_1473_done rxcap_1473_fail: goto rx1467_fail rxcap_1473_done: alt1472_end: .annotate 'line', 336 # rx pass rx1467_cur."!cursor_pass"(rx1467_pos, "param_var") if_null rx1467_debug, debug_687 rx1467_cur."!cursor_debug"("PASS", "param_var", " at pos=", rx1467_pos) debug_687: .return (rx1467_cur) rx1467_restart: .annotate 'line', 4 if_null rx1467_debug, debug_688 rx1467_cur."!cursor_debug"("NEXT", "param_var") debug_688: rx1467_fail: (rx1467_rep, rx1467_pos, $I10, $P10) = rx1467_cur."!mark_fail"(0) lt rx1467_pos, -1, rx1467_done eq rx1467_pos, -1, rx1467_fail jump $I10 rx1467_done: rx1467_cur."!cursor_fail"() if_null rx1467_debug, debug_689 rx1467_cur."!cursor_debug"("FAIL", "param_var") debug_689: .return (rx1467_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__param_var" :subid("175_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("sigil", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "named_param" :subid("176_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1475_tgt .local int rx1475_pos .local int rx1475_off .local int rx1475_eos .local int rx1475_rep .local pmc rx1475_cur .local pmc rx1475_debug (rx1475_cur, rx1475_pos, rx1475_tgt, $I10) = self."!cursor_start"() getattribute rx1475_debug, rx1475_cur, "$!debug" .lex unicode:"$\x{a2}", rx1475_cur .local pmc match .lex "$/", match length rx1475_eos, rx1475_tgt gt rx1475_pos, rx1475_eos, rx1475_done set rx1475_off, 0 lt rx1475_pos, 2, rx1475_start sub rx1475_off, rx1475_pos, 1 substr rx1475_tgt, rx1475_tgt, rx1475_off rx1475_start: eq $I10, 1, rx1475_restart if_null rx1475_debug, debug_690 rx1475_cur."!cursor_debug"("START", "named_param") debug_690: $I10 = self.'from'() ne $I10, -1, rxscan1477_done goto rxscan1477_scan rxscan1477_loop: ($P10) = rx1475_cur."from"() inc $P10 set rx1475_pos, $P10 ge rx1475_pos, rx1475_eos, rxscan1477_done rxscan1477_scan: set_addr $I10, rxscan1477_loop rx1475_cur."!mark_push"(0, rx1475_pos, $I10) rxscan1477_done: .annotate 'line', 342 # rx literal ":" add $I11, rx1475_pos, 1 gt $I11, rx1475_eos, rx1475_fail sub $I11, rx1475_pos, rx1475_off ord $I11, rx1475_tgt, $I11 ne $I11, 58, rx1475_fail add rx1475_pos, 1 # rx subrule "param_var" subtype=capture negate= rx1475_cur."!cursor_pos"(rx1475_pos) $P10 = rx1475_cur."param_var"() unless $P10, rx1475_fail rx1475_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("param_var") rx1475_pos = $P10."pos"() .annotate 'line', 341 # rx pass rx1475_cur."!cursor_pass"(rx1475_pos, "named_param") if_null rx1475_debug, debug_691 rx1475_cur."!cursor_debug"("PASS", "named_param", " at pos=", rx1475_pos) debug_691: .return (rx1475_cur) rx1475_restart: .annotate 'line', 4 if_null rx1475_debug, debug_692 rx1475_cur."!cursor_debug"("NEXT", "named_param") debug_692: rx1475_fail: (rx1475_rep, rx1475_pos, $I10, $P10) = rx1475_cur."!mark_fail"(0) lt rx1475_pos, -1, rx1475_done eq rx1475_pos, -1, rx1475_fail jump $I10 rx1475_done: rx1475_cur."!cursor_fail"() if_null rx1475_debug, debug_693 rx1475_cur."!cursor_debug"("FAIL", "named_param") debug_693: .return (rx1475_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__named_param" :subid("177_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("param_var", ":") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "default_value" :subid("178_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1479_tgt .local int rx1479_pos .local int rx1479_off .local int rx1479_eos .local int rx1479_rep .local pmc rx1479_cur .local pmc rx1479_debug (rx1479_cur, rx1479_pos, rx1479_tgt, $I10) = self."!cursor_start"() getattribute rx1479_debug, rx1479_cur, "$!debug" .lex unicode:"$\x{a2}", rx1479_cur .local pmc match .lex "$/", match length rx1479_eos, rx1479_tgt gt rx1479_pos, rx1479_eos, rx1479_done set rx1479_off, 0 lt rx1479_pos, 2, rx1479_start sub rx1479_off, rx1479_pos, 1 substr rx1479_tgt, rx1479_tgt, rx1479_off rx1479_start: eq $I10, 1, rx1479_restart if_null rx1479_debug, debug_694 rx1479_cur."!cursor_debug"("START", "default_value") debug_694: $I10 = self.'from'() ne $I10, -1, rxscan1481_done goto rxscan1481_scan rxscan1481_loop: ($P10) = rx1479_cur."from"() inc $P10 set rx1479_pos, $P10 ge rx1479_pos, rx1479_eos, rxscan1481_done rxscan1481_scan: set_addr $I10, rxscan1481_loop rx1479_cur."!mark_push"(0, rx1479_pos, $I10) rxscan1481_done: .annotate 'line', 345 # rx subrule "ws" subtype=method negate= rx1479_cur."!cursor_pos"(rx1479_pos) $P10 = rx1479_cur."ws"() unless $P10, rx1479_fail rx1479_pos = $P10."pos"() # rx literal "=" add $I11, rx1479_pos, 1 gt $I11, rx1479_eos, rx1479_fail sub $I11, rx1479_pos, rx1479_off ord $I11, rx1479_tgt, $I11 ne $I11, 61, rx1479_fail add rx1479_pos, 1 # rx subrule "ws" subtype=method negate= rx1479_cur."!cursor_pos"(rx1479_pos) $P10 = rx1479_cur."ws"() unless $P10, rx1479_fail rx1479_pos = $P10."pos"() # rx subrule "EXPR" subtype=capture negate= rx1479_cur."!cursor_pos"(rx1479_pos) $P10 = rx1479_cur."EXPR"("i=") unless $P10, rx1479_fail rx1479_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("EXPR") rx1479_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1479_cur."!cursor_pos"(rx1479_pos) $P10 = rx1479_cur."ws"() unless $P10, rx1479_fail rx1479_pos = $P10."pos"() # rx pass rx1479_cur."!cursor_pass"(rx1479_pos, "default_value") if_null rx1479_debug, debug_695 rx1479_cur."!cursor_debug"("PASS", "default_value", " at pos=", rx1479_pos) debug_695: .return (rx1479_cur) rx1479_restart: .annotate 'line', 4 if_null rx1479_debug, debug_696 rx1479_cur."!cursor_debug"("NEXT", "default_value") debug_696: rx1479_fail: (rx1479_rep, rx1479_pos, $I10, $P10) = rx1479_cur."!mark_fail"(0) lt rx1479_pos, -1, rx1479_done eq rx1479_pos, -1, rx1479_fail jump $I10 rx1479_done: rx1479_cur."!cursor_fail"() if_null rx1479_debug, debug_697 rx1479_cur."!cursor_debug"("FAIL", "default_value") debug_697: .return (rx1479_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__default_value" :subid("179_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "trait" :subid("180_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1483_tgt .local int rx1483_pos .local int rx1483_off .local int rx1483_eos .local int rx1483_rep .local pmc rx1483_cur .local pmc rx1483_debug (rx1483_cur, rx1483_pos, rx1483_tgt, $I10) = self."!cursor_start"() getattribute rx1483_debug, rx1483_cur, "$!debug" .lex unicode:"$\x{a2}", rx1483_cur .local pmc match .lex "$/", match length rx1483_eos, rx1483_tgt gt rx1483_pos, rx1483_eos, rx1483_done set rx1483_off, 0 lt rx1483_pos, 2, rx1483_start sub rx1483_off, rx1483_pos, 1 substr rx1483_tgt, rx1483_tgt, rx1483_off rx1483_start: eq $I10, 1, rx1483_restart if_null rx1483_debug, debug_698 rx1483_cur."!cursor_debug"("START", "trait") debug_698: $I10 = self.'from'() ne $I10, -1, rxscan1485_done goto rxscan1485_scan rxscan1485_loop: ($P10) = rx1483_cur."from"() inc $P10 set rx1483_pos, $P10 ge rx1483_pos, rx1483_eos, rxscan1485_done rxscan1485_scan: set_addr $I10, rxscan1485_loop rx1483_cur."!mark_push"(0, rx1483_pos, $I10) rxscan1485_done: .annotate 'line', 347 # rx subrule "ws" subtype=method negate= rx1483_cur."!cursor_pos"(rx1483_pos) $P10 = rx1483_cur."ws"() unless $P10, rx1483_fail rx1483_pos = $P10."pos"() # rx subrule "trait_mod" subtype=capture negate= rx1483_cur."!cursor_pos"(rx1483_pos) $P10 = rx1483_cur."trait_mod"() unless $P10, rx1483_fail rx1483_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("trait_mod") rx1483_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1483_cur."!cursor_pos"(rx1483_pos) $P10 = rx1483_cur."ws"() unless $P10, rx1483_fail rx1483_pos = $P10."pos"() # rx pass rx1483_cur."!cursor_pass"(rx1483_pos, "trait") if_null rx1483_debug, debug_699 rx1483_cur."!cursor_debug"("PASS", "trait", " at pos=", rx1483_pos) debug_699: .return (rx1483_cur) rx1483_restart: .annotate 'line', 4 if_null rx1483_debug, debug_700 rx1483_cur."!cursor_debug"("NEXT", "trait") debug_700: rx1483_fail: (rx1483_rep, rx1483_pos, $I10, $P10) = rx1483_cur."!mark_fail"(0) lt rx1483_pos, -1, rx1483_done eq rx1483_pos, -1, rx1483_fail jump $I10 rx1483_done: rx1483_cur."!cursor_fail"() if_null rx1483_debug, debug_701 rx1483_cur."!cursor_debug"("FAIL", "trait") debug_701: .return (rx1483_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__trait" :subid("181_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "trait_mod" :subid("182_1309998847.42912") :method .annotate 'line', 349 $P100 = self."!protoregex"("trait_mod") .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__trait_mod" :subid("183_1309998847.42912") :method .annotate 'line', 349 $P101 = self."!PREFIX__!protoregex"("trait_mod") .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "trait_mod:sym" :subid("184_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1489_tgt .local int rx1489_pos .local int rx1489_off .local int rx1489_eos .local int rx1489_rep .local pmc rx1489_cur .local pmc rx1489_debug (rx1489_cur, rx1489_pos, rx1489_tgt, $I10) = self."!cursor_start"() rx1489_cur."!cursor_caparray"("circumfix") getattribute rx1489_debug, rx1489_cur, "$!debug" .lex unicode:"$\x{a2}", rx1489_cur .local pmc match .lex "$/", match length rx1489_eos, rx1489_tgt gt rx1489_pos, rx1489_eos, rx1489_done set rx1489_off, 0 lt rx1489_pos, 2, rx1489_start sub rx1489_off, rx1489_pos, 1 substr rx1489_tgt, rx1489_tgt, rx1489_off rx1489_start: eq $I10, 1, rx1489_restart if_null rx1489_debug, debug_702 rx1489_cur."!cursor_debug"("START", "trait_mod:sym") debug_702: $I10 = self.'from'() ne $I10, -1, rxscan1491_done goto rxscan1491_scan rxscan1491_loop: ($P10) = rx1489_cur."from"() inc $P10 set rx1489_pos, $P10 ge rx1489_pos, rx1489_eos, rxscan1491_done rxscan1491_scan: set_addr $I10, rxscan1491_loop rx1489_cur."!mark_push"(0, rx1489_pos, $I10) rxscan1491_done: .annotate 'line', 350 # rx subcapture "sym" set_addr $I10, rxcap_1492_fail rx1489_cur."!mark_push"(0, rx1489_pos, $I10) # rx literal "is" add $I11, rx1489_pos, 2 gt $I11, rx1489_eos, rx1489_fail sub $I11, rx1489_pos, rx1489_off substr $S10, rx1489_tgt, $I11, 2 ne $S10, "is", rx1489_fail add rx1489_pos, 2 set_addr $I10, rxcap_1492_fail ($I12, $I11) = rx1489_cur."!mark_peek"($I10) rx1489_cur."!cursor_pos"($I11) ($P10) = rx1489_cur."!cursor_start"() $P10."!cursor_pass"(rx1489_pos, "") rx1489_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1492_done rxcap_1492_fail: goto rx1489_fail rxcap_1492_done: # rx subrule "ws" subtype=method negate= rx1489_cur."!cursor_pos"(rx1489_pos) $P10 = rx1489_cur."ws"() unless $P10, rx1489_fail rx1489_pos = $P10."pos"() # rx subrule "deflongname" subtype=capture negate= rx1489_cur."!cursor_pos"(rx1489_pos) $P10 = rx1489_cur."deflongname"() unless $P10, rx1489_fail rx1489_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("longname") rx1489_pos = $P10."pos"() # rx rxquantr1493 ** 0..1 set_addr $I10, rxquantr1493_done rx1489_cur."!mark_push"(0, rx1489_pos, $I10) rxquantr1493_loop: # rx subrule "circumfix" subtype=capture negate= rx1489_cur."!cursor_pos"(rx1489_pos) $P10 = rx1489_cur."circumfix"() unless $P10, rx1489_fail goto rxsubrule1494_pass rxsubrule1494_back: $P10 = $P10."!cursor_next"() unless $P10, rx1489_fail rxsubrule1494_pass: set_addr $I10, rxsubrule1494_back rx1489_cur."!mark_push"(0, rx1489_pos, $I10, $P10) $P10."!cursor_names"("circumfix") rx1489_pos = $P10."pos"() set_addr $I10, rxquantr1493_done (rx1489_rep) = rx1489_cur."!mark_commit"($I10) rxquantr1493_done: # rx subrule "ws" subtype=method negate= rx1489_cur."!cursor_pos"(rx1489_pos) $P10 = rx1489_cur."ws"() unless $P10, rx1489_fail rx1489_pos = $P10."pos"() # rx pass rx1489_cur."!cursor_pass"(rx1489_pos, "trait_mod:sym") if_null rx1489_debug, debug_703 rx1489_cur."!cursor_debug"("PASS", "trait_mod:sym", " at pos=", rx1489_pos) debug_703: .return (rx1489_cur) rx1489_restart: .annotate 'line', 4 if_null rx1489_debug, debug_704 rx1489_cur."!cursor_debug"("NEXT", "trait_mod:sym") debug_704: rx1489_fail: (rx1489_rep, rx1489_pos, $I10, $P10) = rx1489_cur."!mark_fail"(0) lt rx1489_pos, -1, rx1489_done eq rx1489_pos, -1, rx1489_fail jump $I10 rx1489_done: rx1489_cur."!cursor_fail"() if_null rx1489_debug, debug_705 rx1489_cur."!cursor_debug"("FAIL", "trait_mod:sym") debug_705: .return (rx1489_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__trait_mod:sym" :subid("185_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "is") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "regex_declarator" :subid("186_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1496_tgt .local int rx1496_pos .local int rx1496_off .local int rx1496_eos .local int rx1496_rep .local pmc rx1496_cur .local pmc rx1496_debug (rx1496_cur, rx1496_pos, rx1496_tgt, $I10) = self."!cursor_start"() rx1496_cur."!cursor_caparray"("signature") getattribute rx1496_debug, rx1496_cur, "$!debug" .lex unicode:"$\x{a2}", rx1496_cur .local pmc match .lex "$/", match length rx1496_eos, rx1496_tgt gt rx1496_pos, rx1496_eos, rx1496_done set rx1496_off, 0 lt rx1496_pos, 2, rx1496_start sub rx1496_off, rx1496_pos, 1 substr rx1496_tgt, rx1496_tgt, rx1496_off rx1496_start: eq $I10, 1, rx1496_restart if_null rx1496_debug, debug_706 rx1496_cur."!cursor_debug"("START", "regex_declarator") debug_706: $I10 = self.'from'() ne $I10, -1, rxscan1498_done goto rxscan1498_scan rxscan1498_loop: ($P10) = rx1496_cur."from"() inc $P10 set rx1496_pos, $P10 ge rx1496_pos, rx1496_eos, rxscan1498_done rxscan1498_scan: set_addr $I10, rxscan1498_loop rx1496_cur."!mark_push"(0, rx1496_pos, $I10) rxscan1498_done: .annotate 'line', 352 # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() alt1499_0: .annotate 'line', 353 set_addr $I10, alt1499_1 rx1496_cur."!mark_push"(0, rx1496_pos, $I10) .annotate 'line', 354 # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() # rx subcapture "proto" set_addr $I10, rxcap_1500_fail rx1496_cur."!mark_push"(0, rx1496_pos, $I10) # rx literal "proto" add $I11, rx1496_pos, 5 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off substr $S10, rx1496_tgt, $I11, 5 ne $S10, "proto", rx1496_fail add rx1496_pos, 5 set_addr $I10, rxcap_1500_fail ($I12, $I11) = rx1496_cur."!mark_peek"($I10) rx1496_cur."!cursor_pos"($I11) ($P10) = rx1496_cur."!cursor_start"() $P10."!cursor_pass"(rx1496_pos, "") rx1496_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("proto") goto rxcap_1500_done rxcap_1500_fail: goto rx1496_fail rxcap_1500_done: # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() alt1501_0: set_addr $I10, alt1501_1 rx1496_cur."!mark_push"(0, rx1496_pos, $I10) # rx literal "regex" add $I11, rx1496_pos, 5 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off substr $S10, rx1496_tgt, $I11, 5 ne $S10, "regex", rx1496_fail add rx1496_pos, 5 goto alt1501_end alt1501_1: set_addr $I10, alt1501_2 rx1496_cur."!mark_push"(0, rx1496_pos, $I10) # rx literal "token" add $I11, rx1496_pos, 5 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off substr $S10, rx1496_tgt, $I11, 5 ne $S10, "token", rx1496_fail add rx1496_pos, 5 goto alt1501_end alt1501_2: # rx literal "rule" add $I11, rx1496_pos, 4 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off substr $S10, rx1496_tgt, $I11, 4 ne $S10, "rule", rx1496_fail add rx1496_pos, 4 alt1501_end: # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() .annotate 'line', 355 # rx subrule "deflongname" subtype=capture negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."deflongname"() unless $P10, rx1496_fail rx1496_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("deflongname") rx1496_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() alt1502_0: .annotate 'line', 356 set_addr $I10, alt1502_1 rx1496_cur."!mark_push"(0, rx1496_pos, $I10) .annotate 'line', 357 # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() # rx literal "{" add $I11, rx1496_pos, 1 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off ord $I11, rx1496_tgt, $I11 ne $I11, 123, rx1496_fail add rx1496_pos, 1 # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() # rx literal "<...>" add $I11, rx1496_pos, 5 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off substr $S10, rx1496_tgt, $I11, 5 ne $S10, "<...>", rx1496_fail add rx1496_pos, 5 # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() # rx literal "}" add $I11, rx1496_pos, 1 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off ord $I11, rx1496_tgt, $I11 ne $I11, 125, rx1496_fail add rx1496_pos, 1 # rx subrule "ENDSTMT" subtype=zerowidth negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ENDSTMT"() unless $P10, rx1496_fail # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() goto alt1502_end alt1502_1: set_addr $I10, alt1502_2 rx1496_cur."!mark_push"(0, rx1496_pos, $I10) .annotate 'line', 358 # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() # rx literal "{" add $I11, rx1496_pos, 1 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off ord $I11, rx1496_tgt, $I11 ne $I11, 123, rx1496_fail add rx1496_pos, 1 # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() # rx literal "<*>" add $I11, rx1496_pos, 3 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off substr $S10, rx1496_tgt, $I11, 3 ne $S10, "<*>", rx1496_fail add rx1496_pos, 3 # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() # rx literal "}" add $I11, rx1496_pos, 1 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off ord $I11, rx1496_tgt, $I11 ne $I11, 125, rx1496_fail add rx1496_pos, 1 # rx subrule "ENDSTMT" subtype=zerowidth negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ENDSTMT"() unless $P10, rx1496_fail # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() goto alt1502_end alt1502_2: .annotate 'line', 359 # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() # rx subrule "panic" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."panic"("Proto regex body must be <*> (or <...>, which is deprecated)") unless $P10, rx1496_fail rx1496_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() alt1502_end: .annotate 'line', 360 # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() .annotate 'line', 354 goto alt1499_end alt1499_1: .annotate 'line', 361 # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() # rx subcapture "sym" set_addr $I10, rxcap_1504_fail rx1496_cur."!mark_push"(0, rx1496_pos, $I10) alt1503_0: set_addr $I10, alt1503_1 rx1496_cur."!mark_push"(0, rx1496_pos, $I10) # rx literal "regex" add $I11, rx1496_pos, 5 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off substr $S10, rx1496_tgt, $I11, 5 ne $S10, "regex", rx1496_fail add rx1496_pos, 5 goto alt1503_end alt1503_1: set_addr $I10, alt1503_2 rx1496_cur."!mark_push"(0, rx1496_pos, $I10) # rx literal "token" add $I11, rx1496_pos, 5 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off substr $S10, rx1496_tgt, $I11, 5 ne $S10, "token", rx1496_fail add rx1496_pos, 5 goto alt1503_end alt1503_2: # rx literal "rule" add $I11, rx1496_pos, 4 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off substr $S10, rx1496_tgt, $I11, 4 ne $S10, "rule", rx1496_fail add rx1496_pos, 4 alt1503_end: set_addr $I10, rxcap_1504_fail ($I12, $I11) = rx1496_cur."!mark_peek"($I10) rx1496_cur."!cursor_pos"($I11) ($P10) = rx1496_cur."!cursor_start"() $P10."!cursor_pass"(rx1496_pos, "") rx1496_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1504_done rxcap_1504_fail: goto rx1496_fail rxcap_1504_done: # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() .annotate 'line', 362 # rx subrule "deflongname" subtype=capture negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."deflongname"() unless $P10, rx1496_fail rx1496_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("deflongname") rx1496_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() .annotate 'line', 363 # rx subrule "newpad" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."newpad"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() .annotate 'line', 364 # rx rxquantr1505 ** 0..1 set_addr $I10, rxquantr1505_done rx1496_cur."!mark_push"(0, rx1496_pos, $I10) rxquantr1505_loop: # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() # rx literal "(" add $I11, rx1496_pos, 1 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off ord $I11, rx1496_tgt, $I11 ne $I11, 40, rx1496_fail add rx1496_pos, 1 # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() # rx subrule "signature" subtype=capture negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."signature"() unless $P10, rx1496_fail rx1496_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("signature") rx1496_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() # rx literal ")" add $I11, rx1496_pos, 1 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off ord $I11, rx1496_tgt, $I11 ne $I11, 41, rx1496_fail add rx1496_pos, 1 # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() set_addr $I10, rxquantr1505_done (rx1496_rep) = rx1496_cur."!mark_commit"($I10) rxquantr1505_done: # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() .annotate 'line', 365 # rx reduce name="regex_declarator" key="open" rx1496_cur."!cursor_pos"(rx1496_pos) rx1496_cur."!reduce"("regex_declarator", "open") # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() .annotate 'line', 366 # rx literal "{" add $I11, rx1496_pos, 1 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off ord $I11, rx1496_tgt, $I11 ne $I11, 123, rx1496_fail add rx1496_pos, 1 # rx subrule "LANG" subtype=capture negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."LANG"("Regex", "nibbler") unless $P10, rx1496_fail rx1496_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("p6regex") rx1496_pos = $P10."pos"() # rx literal "}" add $I11, rx1496_pos, 1 gt $I11, rx1496_eos, rx1496_fail sub $I11, rx1496_pos, rx1496_off ord $I11, rx1496_tgt, $I11 ne $I11, 125, rx1496_fail add rx1496_pos, 1 # rx subrule "ENDSTMT" subtype=zerowidth negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ENDSTMT"() unless $P10, rx1496_fail # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() alt1499_end: .annotate 'line', 367 # rx subrule "ws" subtype=method negate= rx1496_cur."!cursor_pos"(rx1496_pos) $P10 = rx1496_cur."ws"() unless $P10, rx1496_fail rx1496_pos = $P10."pos"() .annotate 'line', 352 # rx pass rx1496_cur."!cursor_pass"(rx1496_pos, "regex_declarator") if_null rx1496_debug, debug_707 rx1496_cur."!cursor_debug"("PASS", "regex_declarator", " at pos=", rx1496_pos) debug_707: .return (rx1496_cur) rx1496_restart: .annotate 'line', 4 if_null rx1496_debug, debug_708 rx1496_cur."!cursor_debug"("NEXT", "regex_declarator") debug_708: rx1496_fail: (rx1496_rep, rx1496_pos, $I10, $P10) = rx1496_cur."!mark_fail"(0) lt rx1496_pos, -1, rx1496_done eq rx1496_pos, -1, rx1496_fail jump $I10 rx1496_done: rx1496_cur."!cursor_fail"() if_null rx1496_debug, debug_709 rx1496_cur."!cursor_debug"("FAIL", "regex_declarator") debug_709: .return (rx1496_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__regex_declarator" :subid("187_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "dotty" :subid("188_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1507_tgt .local int rx1507_pos .local int rx1507_off .local int rx1507_eos .local int rx1507_rep .local pmc rx1507_cur .local pmc rx1507_debug (rx1507_cur, rx1507_pos, rx1507_tgt, $I10) = self."!cursor_start"() rx1507_cur."!cursor_caparray"("args") getattribute rx1507_debug, rx1507_cur, "$!debug" .lex unicode:"$\x{a2}", rx1507_cur .local pmc match .lex "$/", match length rx1507_eos, rx1507_tgt gt rx1507_pos, rx1507_eos, rx1507_done set rx1507_off, 0 lt rx1507_pos, 2, rx1507_start sub rx1507_off, rx1507_pos, 1 substr rx1507_tgt, rx1507_tgt, rx1507_off rx1507_start: eq $I10, 1, rx1507_restart if_null rx1507_debug, debug_710 rx1507_cur."!cursor_debug"("START", "dotty") debug_710: $I10 = self.'from'() ne $I10, -1, rxscan1509_done goto rxscan1509_scan rxscan1509_loop: ($P10) = rx1507_cur."from"() inc $P10 set rx1507_pos, $P10 ge rx1507_pos, rx1507_eos, rxscan1509_done rxscan1509_scan: set_addr $I10, rxscan1509_loop rx1507_cur."!mark_push"(0, rx1507_pos, $I10) rxscan1509_done: .annotate 'line', 371 # rx literal "." add $I11, rx1507_pos, 1 gt $I11, rx1507_eos, rx1507_fail sub $I11, rx1507_pos, rx1507_off ord $I11, rx1507_tgt, $I11 ne $I11, 46, rx1507_fail add rx1507_pos, 1 alt1510_0: .annotate 'line', 372 set_addr $I10, alt1510_1 rx1507_cur."!mark_push"(0, rx1507_pos, $I10) # rx subrule "deflongname" subtype=capture negate= rx1507_cur."!cursor_pos"(rx1507_pos) $P10 = rx1507_cur."deflongname"() unless $P10, rx1507_fail rx1507_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("longname=deflongname") rx1507_pos = $P10."pos"() goto alt1510_end alt1510_1: .annotate 'line', 373 # rx enumcharlist negate=0 zerowidth sub $I10, rx1507_pos, rx1507_off substr $S10, rx1507_tgt, $I10, 1 index $I11, "'\"", $S10 lt $I11, 0, rx1507_fail # rx subrule "quote" subtype=capture negate= rx1507_cur."!cursor_pos"(rx1507_pos) $P10 = rx1507_cur."quote"() unless $P10, rx1507_fail rx1507_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("quote") rx1507_pos = $P10."pos"() alt1511_0: .annotate 'line', 374 set_addr $I10, alt1511_1 rx1507_cur."!mark_push"(0, rx1507_pos, $I10) # rx enumcharlist negate=0 zerowidth sub $I10, rx1507_pos, rx1507_off substr $S10, rx1507_tgt, $I10, 1 index $I11, "(", $S10 lt $I11, 0, rx1507_fail goto alt1511_end alt1511_1: # rx subrule "panic" subtype=method negate= rx1507_cur."!cursor_pos"(rx1507_pos) $P10 = rx1507_cur."panic"("Quoted method name requires parenthesized arguments") unless $P10, rx1507_fail rx1507_pos = $P10."pos"() alt1511_end: alt1510_end: .annotate 'line', 380 # rx rxquantr1512 ** 0..1 set_addr $I10, rxquantr1512_done rx1507_cur."!mark_push"(0, rx1507_pos, $I10) rxquantr1512_loop: alt1513_0: .annotate 'line', 377 set_addr $I10, alt1513_1 rx1507_cur."!mark_push"(0, rx1507_pos, $I10) .annotate 'line', 378 # rx enumcharlist negate=0 zerowidth sub $I10, rx1507_pos, rx1507_off substr $S10, rx1507_tgt, $I10, 1 index $I11, "(", $S10 lt $I11, 0, rx1507_fail # rx subrule "args" subtype=capture negate= rx1507_cur."!cursor_pos"(rx1507_pos) $P10 = rx1507_cur."args"() unless $P10, rx1507_fail rx1507_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("args") rx1507_pos = $P10."pos"() goto alt1513_end alt1513_1: .annotate 'line', 379 # rx literal ":" add $I11, rx1507_pos, 1 gt $I11, rx1507_eos, rx1507_fail sub $I11, rx1507_pos, rx1507_off ord $I11, rx1507_tgt, $I11 ne $I11, 58, rx1507_fail add rx1507_pos, 1 # rx charclass s ge rx1507_pos, rx1507_eos, rx1507_fail sub $I10, rx1507_pos, rx1507_off is_cclass $I11, 32, rx1507_tgt, $I10 unless $I11, rx1507_fail inc rx1507_pos # rx subrule "arglist" subtype=capture negate= rx1507_cur."!cursor_pos"(rx1507_pos) $P10 = rx1507_cur."arglist"() unless $P10, rx1507_fail rx1507_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("args") rx1507_pos = $P10."pos"() alt1513_end: .annotate 'line', 380 set_addr $I10, rxquantr1512_done (rx1507_rep) = rx1507_cur."!mark_commit"($I10) rxquantr1512_done: .annotate 'line', 370 # rx pass rx1507_cur."!cursor_pass"(rx1507_pos, "dotty") if_null rx1507_debug, debug_711 rx1507_cur."!cursor_debug"("PASS", "dotty", " at pos=", rx1507_pos) debug_711: .return (rx1507_cur) rx1507_restart: .annotate 'line', 4 if_null rx1507_debug, debug_712 rx1507_cur."!cursor_debug"("NEXT", "dotty") debug_712: rx1507_fail: (rx1507_rep, rx1507_pos, $I10, $P10) = rx1507_cur."!mark_fail"(0) lt rx1507_pos, -1, rx1507_done eq rx1507_pos, -1, rx1507_fail jump $I10 rx1507_done: rx1507_cur."!cursor_fail"() if_null rx1507_debug, debug_713 rx1507_cur."!cursor_debug"("FAIL", "dotty") debug_713: .return (rx1507_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__dotty" :subid("189_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("deflongname", ".") new $P101, "ResizablePMCArray" push $P101, "'" push $P101, "\"" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "term" :subid("190_1309998847.42912") :method .annotate 'line', 384 $P100 = self."!protoregex"("term") .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term" :subid("191_1309998847.42912") :method .annotate 'line', 384 $P101 = self."!PREFIX__!protoregex"("term") .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("192_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1517_tgt .local int rx1517_pos .local int rx1517_off .local int rx1517_eos .local int rx1517_rep .local pmc rx1517_cur .local pmc rx1517_debug (rx1517_cur, rx1517_pos, rx1517_tgt, $I10) = self."!cursor_start"() getattribute rx1517_debug, rx1517_cur, "$!debug" .lex unicode:"$\x{a2}", rx1517_cur .local pmc match .lex "$/", match length rx1517_eos, rx1517_tgt gt rx1517_pos, rx1517_eos, rx1517_done set rx1517_off, 0 lt rx1517_pos, 2, rx1517_start sub rx1517_off, rx1517_pos, 1 substr rx1517_tgt, rx1517_tgt, rx1517_off rx1517_start: eq $I10, 1, rx1517_restart if_null rx1517_debug, debug_714 rx1517_cur."!cursor_debug"("START", "term:sym") debug_714: $I10 = self.'from'() ne $I10, -1, rxscan1519_done goto rxscan1519_scan rxscan1519_loop: ($P10) = rx1517_cur."from"() inc $P10 set rx1517_pos, $P10 ge rx1517_pos, rx1517_eos, rxscan1519_done rxscan1519_scan: set_addr $I10, rxscan1519_loop rx1517_cur."!mark_push"(0, rx1517_pos, $I10) rxscan1519_done: .annotate 'line', 386 # rx subcapture "sym" set_addr $I10, rxcap_1520_fail rx1517_cur."!mark_push"(0, rx1517_pos, $I10) # rx literal "self" add $I11, rx1517_pos, 4 gt $I11, rx1517_eos, rx1517_fail sub $I11, rx1517_pos, rx1517_off substr $S10, rx1517_tgt, $I11, 4 ne $S10, "self", rx1517_fail add rx1517_pos, 4 set_addr $I10, rxcap_1520_fail ($I12, $I11) = rx1517_cur."!mark_peek"($I10) rx1517_cur."!cursor_pos"($I11) ($P10) = rx1517_cur."!cursor_start"() $P10."!cursor_pass"(rx1517_pos, "") rx1517_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1520_done rxcap_1520_fail: goto rx1517_fail rxcap_1520_done: # rxanchor rwb le rx1517_pos, 0, rx1517_fail sub $I10, rx1517_pos, rx1517_off is_cclass $I11, 8192, rx1517_tgt, $I10 if $I11, rx1517_fail dec $I10 is_cclass $I11, 8192, rx1517_tgt, $I10 unless $I11, rx1517_fail # rx pass rx1517_cur."!cursor_pass"(rx1517_pos, "term:sym") if_null rx1517_debug, debug_715 rx1517_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1517_pos) debug_715: .return (rx1517_cur) rx1517_restart: .annotate 'line', 4 if_null rx1517_debug, debug_716 rx1517_cur."!cursor_debug"("NEXT", "term:sym") debug_716: rx1517_fail: (rx1517_rep, rx1517_pos, $I10, $P10) = rx1517_cur."!mark_fail"(0) lt rx1517_pos, -1, rx1517_done eq rx1517_pos, -1, rx1517_fail jump $I10 rx1517_done: rx1517_cur."!cursor_fail"() if_null rx1517_debug, debug_717 rx1517_cur."!cursor_debug"("FAIL", "term:sym") debug_717: .return (rx1517_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("193_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "self" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("194_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1522_tgt .local int rx1522_pos .local int rx1522_off .local int rx1522_eos .local int rx1522_rep .local pmc rx1522_cur .local pmc rx1522_debug (rx1522_cur, rx1522_pos, rx1522_tgt, $I10) = self."!cursor_start"() getattribute rx1522_debug, rx1522_cur, "$!debug" .lex unicode:"$\x{a2}", rx1522_cur .local pmc match .lex "$/", match length rx1522_eos, rx1522_tgt gt rx1522_pos, rx1522_eos, rx1522_done set rx1522_off, 0 lt rx1522_pos, 2, rx1522_start sub rx1522_off, rx1522_pos, 1 substr rx1522_tgt, rx1522_tgt, rx1522_off rx1522_start: eq $I10, 1, rx1522_restart if_null rx1522_debug, debug_718 rx1522_cur."!cursor_debug"("START", "term:sym") debug_718: $I10 = self.'from'() ne $I10, -1, rxscan1524_done goto rxscan1524_scan rxscan1524_loop: ($P10) = rx1522_cur."from"() inc $P10 set rx1522_pos, $P10 ge rx1522_pos, rx1522_eos, rxscan1524_done rxscan1524_scan: set_addr $I10, rxscan1524_loop rx1522_cur."!mark_push"(0, rx1522_pos, $I10) rxscan1524_done: .annotate 'line', 389 # rx subrule "deflongname" subtype=capture negate= rx1522_cur."!cursor_pos"(rx1522_pos) $P10 = rx1522_cur."deflongname"() unless $P10, rx1522_fail rx1522_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("deflongname") rx1522_pos = $P10."pos"() # rx enumcharlist negate=0 zerowidth sub $I10, rx1522_pos, rx1522_off substr $S10, rx1522_tgt, $I10, 1 index $I11, "(", $S10 lt $I11, 0, rx1522_fail # rx subrule "args" subtype=capture negate= rx1522_cur."!cursor_pos"(rx1522_pos) $P10 = rx1522_cur."args"() unless $P10, rx1522_fail rx1522_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("args") rx1522_pos = $P10."pos"() .annotate 'line', 388 # rx pass rx1522_cur."!cursor_pass"(rx1522_pos, "term:sym") if_null rx1522_debug, debug_719 rx1522_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1522_pos) debug_719: .return (rx1522_cur) rx1522_restart: .annotate 'line', 4 if_null rx1522_debug, debug_720 rx1522_cur."!cursor_debug"("NEXT", "term:sym") debug_720: rx1522_fail: (rx1522_rep, rx1522_pos, $I10, $P10) = rx1522_cur."!mark_fail"(0) lt rx1522_pos, -1, rx1522_done eq rx1522_pos, -1, rx1522_fail jump $I10 rx1522_done: rx1522_cur."!cursor_fail"() if_null rx1522_debug, debug_721 rx1522_cur."!cursor_debug"("FAIL", "term:sym") debug_721: .return (rx1522_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("195_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("deflongname", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("196_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1526_tgt .local int rx1526_pos .local int rx1526_off .local int rx1526_eos .local int rx1526_rep .local pmc rx1526_cur .local pmc rx1526_debug (rx1526_cur, rx1526_pos, rx1526_tgt, $I10) = self."!cursor_start"() rx1526_cur."!cursor_caparray"("args") getattribute rx1526_debug, rx1526_cur, "$!debug" .lex unicode:"$\x{a2}", rx1526_cur .local pmc match .lex "$/", match length rx1526_eos, rx1526_tgt gt rx1526_pos, rx1526_eos, rx1526_done set rx1526_off, 0 lt rx1526_pos, 2, rx1526_start sub rx1526_off, rx1526_pos, 1 substr rx1526_tgt, rx1526_tgt, rx1526_off rx1526_start: eq $I10, 1, rx1526_restart if_null rx1526_debug, debug_722 rx1526_cur."!cursor_debug"("START", "term:sym") debug_722: $I10 = self.'from'() ne $I10, -1, rxscan1528_done goto rxscan1528_scan rxscan1528_loop: ($P10) = rx1526_cur."from"() inc $P10 set rx1526_pos, $P10 ge rx1526_pos, rx1526_eos, rxscan1528_done rxscan1528_scan: set_addr $I10, rxscan1528_loop rx1526_cur."!mark_push"(0, rx1526_pos, $I10) rxscan1528_done: .annotate 'line', 393 # rx subrule "name" subtype=capture negate= rx1526_cur."!cursor_pos"(rx1526_pos) $P10 = rx1526_cur."name"() unless $P10, rx1526_fail rx1526_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("name") rx1526_pos = $P10."pos"() # rx rxquantr1529 ** 0..1 set_addr $I10, rxquantr1529_done rx1526_cur."!mark_push"(0, rx1526_pos, $I10) rxquantr1529_loop: # rx subrule "args" subtype=capture negate= rx1526_cur."!cursor_pos"(rx1526_pos) $P10 = rx1526_cur."args"() unless $P10, rx1526_fail goto rxsubrule1530_pass rxsubrule1530_back: $P10 = $P10."!cursor_next"() unless $P10, rx1526_fail rxsubrule1530_pass: set_addr $I10, rxsubrule1530_back rx1526_cur."!mark_push"(0, rx1526_pos, $I10, $P10) $P10."!cursor_names"("args") rx1526_pos = $P10."pos"() set_addr $I10, rxquantr1529_done (rx1526_rep) = rx1526_cur."!mark_commit"($I10) rxquantr1529_done: .annotate 'line', 392 # rx pass rx1526_cur."!cursor_pass"(rx1526_pos, "term:sym") if_null rx1526_debug, debug_723 rx1526_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1526_pos) debug_723: .return (rx1526_cur) rx1526_restart: .annotate 'line', 4 if_null rx1526_debug, debug_724 rx1526_cur."!cursor_debug"("NEXT", "term:sym") debug_724: rx1526_fail: (rx1526_rep, rx1526_pos, $I10, $P10) = rx1526_cur."!mark_fail"(0) lt rx1526_pos, -1, rx1526_done eq rx1526_pos, -1, rx1526_fail jump $I10 rx1526_done: rx1526_cur."!cursor_fail"() if_null rx1526_debug, debug_725 rx1526_cur."!cursor_debug"("FAIL", "term:sym") debug_725: .return (rx1526_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("197_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("name", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("198_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1532_tgt .local int rx1532_pos .local int rx1532_off .local int rx1532_eos .local int rx1532_rep .local pmc rx1532_cur .local pmc rx1532_debug (rx1532_cur, rx1532_pos, rx1532_tgt, $I10) = self."!cursor_start"() rx1532_cur."!cursor_caparray"("args") getattribute rx1532_debug, rx1532_cur, "$!debug" .lex unicode:"$\x{a2}", rx1532_cur .local pmc match .lex "$/", match length rx1532_eos, rx1532_tgt gt rx1532_pos, rx1532_eos, rx1532_done set rx1532_off, 0 lt rx1532_pos, 2, rx1532_start sub rx1532_off, rx1532_pos, 1 substr rx1532_tgt, rx1532_tgt, rx1532_off rx1532_start: eq $I10, 1, rx1532_restart if_null rx1532_debug, debug_726 rx1532_cur."!cursor_debug"("START", "term:sym") debug_726: $I10 = self.'from'() ne $I10, -1, rxscan1534_done goto rxscan1534_scan rxscan1534_loop: ($P10) = rx1532_cur."from"() inc $P10 set rx1532_pos, $P10 ge rx1532_pos, rx1532_eos, rxscan1534_done rxscan1534_scan: set_addr $I10, rxscan1534_loop rx1532_cur."!mark_push"(0, rx1532_pos, $I10) rxscan1534_done: .annotate 'line', 397 # rx literal "pir::" add $I11, rx1532_pos, 5 gt $I11, rx1532_eos, rx1532_fail sub $I11, rx1532_pos, rx1532_off substr $S10, rx1532_tgt, $I11, 5 ne $S10, "pir::", rx1532_fail add rx1532_pos, 5 # rx subcapture "op" set_addr $I10, rxcap_1535_fail rx1532_cur."!mark_push"(0, rx1532_pos, $I10) # rx charclass_q w r 1..-1 sub $I10, rx1532_pos, rx1532_off find_not_cclass $I11, 8192, rx1532_tgt, $I10, rx1532_eos add $I12, $I10, 1 lt $I11, $I12, rx1532_fail add rx1532_pos, rx1532_off, $I11 set_addr $I10, rxcap_1535_fail ($I12, $I11) = rx1532_cur."!mark_peek"($I10) rx1532_cur."!cursor_pos"($I11) ($P10) = rx1532_cur."!cursor_start"() $P10."!cursor_pass"(rx1532_pos, "") rx1532_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("op") goto rxcap_1535_done rxcap_1535_fail: goto rx1532_fail rxcap_1535_done: # rx rxquantr1536 ** 0..1 set_addr $I10, rxquantr1536_done rx1532_cur."!mark_push"(0, rx1532_pos, $I10) rxquantr1536_loop: # rx subrule "args" subtype=capture negate= rx1532_cur."!cursor_pos"(rx1532_pos) $P10 = rx1532_cur."args"() unless $P10, rx1532_fail goto rxsubrule1537_pass rxsubrule1537_back: $P10 = $P10."!cursor_next"() unless $P10, rx1532_fail rxsubrule1537_pass: set_addr $I10, rxsubrule1537_back rx1532_cur."!mark_push"(0, rx1532_pos, $I10, $P10) $P10."!cursor_names"("args") rx1532_pos = $P10."pos"() set_addr $I10, rxquantr1536_done (rx1532_rep) = rx1532_cur."!mark_commit"($I10) rxquantr1536_done: .annotate 'line', 396 # rx pass rx1532_cur."!cursor_pass"(rx1532_pos, "term:sym") if_null rx1532_debug, debug_727 rx1532_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1532_pos) debug_727: .return (rx1532_cur) rx1532_restart: .annotate 'line', 4 if_null rx1532_debug, debug_728 rx1532_cur."!cursor_debug"("NEXT", "term:sym") debug_728: rx1532_fail: (rx1532_rep, rx1532_pos, $I10, $P10) = rx1532_cur."!mark_fail"(0) lt rx1532_pos, -1, rx1532_done eq rx1532_pos, -1, rx1532_fail jump $I10 rx1532_done: rx1532_cur."!cursor_fail"() if_null rx1532_debug, debug_729 rx1532_cur."!cursor_debug"("FAIL", "term:sym") debug_729: .return (rx1532_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("199_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "pir::" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "args" :subid("200_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1539_tgt .local int rx1539_pos .local int rx1539_off .local int rx1539_eos .local int rx1539_rep .local pmc rx1539_cur .local pmc rx1539_debug (rx1539_cur, rx1539_pos, rx1539_tgt, $I10) = self."!cursor_start"() getattribute rx1539_debug, rx1539_cur, "$!debug" .lex unicode:"$\x{a2}", rx1539_cur .local pmc match .lex "$/", match length rx1539_eos, rx1539_tgt gt rx1539_pos, rx1539_eos, rx1539_done set rx1539_off, 0 lt rx1539_pos, 2, rx1539_start sub rx1539_off, rx1539_pos, 1 substr rx1539_tgt, rx1539_tgt, rx1539_off rx1539_start: eq $I10, 1, rx1539_restart if_null rx1539_debug, debug_730 rx1539_cur."!cursor_debug"("START", "args") debug_730: $I10 = self.'from'() ne $I10, -1, rxscan1541_done goto rxscan1541_scan rxscan1541_loop: ($P10) = rx1539_cur."from"() inc $P10 set rx1539_pos, $P10 ge rx1539_pos, rx1539_eos, rxscan1541_done rxscan1541_scan: set_addr $I10, rxscan1541_loop rx1539_cur."!mark_push"(0, rx1539_pos, $I10) rxscan1541_done: .annotate 'line', 401 # rx literal "(" add $I11, rx1539_pos, 1 gt $I11, rx1539_eos, rx1539_fail sub $I11, rx1539_pos, rx1539_off ord $I11, rx1539_tgt, $I11 ne $I11, 40, rx1539_fail add rx1539_pos, 1 # rx subrule "arglist" subtype=capture negate= rx1539_cur."!cursor_pos"(rx1539_pos) $P10 = rx1539_cur."arglist"() unless $P10, rx1539_fail rx1539_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("arglist") rx1539_pos = $P10."pos"() # rx literal ")" add $I11, rx1539_pos, 1 gt $I11, rx1539_eos, rx1539_fail sub $I11, rx1539_pos, rx1539_off ord $I11, rx1539_tgt, $I11 ne $I11, 41, rx1539_fail add rx1539_pos, 1 # rx pass rx1539_cur."!cursor_pass"(rx1539_pos, "args") if_null rx1539_debug, debug_731 rx1539_cur."!cursor_debug"("PASS", "args", " at pos=", rx1539_pos) debug_731: .return (rx1539_cur) rx1539_restart: .annotate 'line', 4 if_null rx1539_debug, debug_732 rx1539_cur."!cursor_debug"("NEXT", "args") debug_732: rx1539_fail: (rx1539_rep, rx1539_pos, $I10, $P10) = rx1539_cur."!mark_fail"(0) lt rx1539_pos, -1, rx1539_done eq rx1539_pos, -1, rx1539_fail jump $I10 rx1539_done: rx1539_cur."!cursor_fail"() if_null rx1539_debug, debug_733 rx1539_cur."!cursor_debug"("FAIL", "args") debug_733: .return (rx1539_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__args" :subid("201_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("arglist", "(") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "arglist" :subid("202_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1543_tgt .local int rx1543_pos .local int rx1543_off .local int rx1543_eos .local int rx1543_rep .local pmc rx1543_cur .local pmc rx1543_debug (rx1543_cur, rx1543_pos, rx1543_tgt, $I10) = self."!cursor_start"() getattribute rx1543_debug, rx1543_cur, "$!debug" .lex unicode:"$\x{a2}", rx1543_cur .local pmc match .lex "$/", match length rx1543_eos, rx1543_tgt gt rx1543_pos, rx1543_eos, rx1543_done set rx1543_off, 0 lt rx1543_pos, 2, rx1543_start sub rx1543_off, rx1543_pos, 1 substr rx1543_tgt, rx1543_tgt, rx1543_off rx1543_start: eq $I10, 1, rx1543_restart if_null rx1543_debug, debug_734 rx1543_cur."!cursor_debug"("START", "arglist") debug_734: $I10 = self.'from'() ne $I10, -1, rxscan1545_done goto rxscan1545_scan rxscan1545_loop: ($P10) = rx1543_cur."from"() inc $P10 set rx1543_pos, $P10 ge rx1543_pos, rx1543_eos, rxscan1545_done rxscan1545_scan: set_addr $I10, rxscan1545_loop rx1543_cur."!mark_push"(0, rx1543_pos, $I10) rxscan1545_done: .annotate 'line', 405 # rx subrule "ws" subtype=method negate= rx1543_cur."!cursor_pos"(rx1543_pos) $P10 = rx1543_cur."ws"() unless $P10, rx1543_fail rx1543_pos = $P10."pos"() alt1546_0: .annotate 'line', 406 set_addr $I10, alt1546_1 rx1543_cur."!mark_push"(0, rx1543_pos, $I10) .annotate 'line', 407 # rx subrule "EXPR" subtype=capture negate= rx1543_cur."!cursor_pos"(rx1543_pos) $P10 = rx1543_cur."EXPR"("f=") unless $P10, rx1543_fail rx1543_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("EXPR") rx1543_pos = $P10."pos"() goto alt1546_end alt1546_1: alt1546_end: .annotate 'line', 404 # rx pass rx1543_cur."!cursor_pass"(rx1543_pos, "arglist") if_null rx1543_debug, debug_735 rx1543_cur."!cursor_debug"("PASS", "arglist", " at pos=", rx1543_pos) debug_735: .return (rx1543_cur) rx1543_restart: .annotate 'line', 4 if_null rx1543_debug, debug_736 rx1543_cur."!cursor_debug"("NEXT", "arglist") debug_736: rx1543_fail: (rx1543_rep, rx1543_pos, $I10, $P10) = rx1543_cur."!mark_fail"(0) lt rx1543_pos, -1, rx1543_done eq rx1543_pos, -1, rx1543_fail jump $I10 rx1543_done: rx1543_cur."!cursor_fail"() if_null rx1543_debug, debug_737 rx1543_cur."!cursor_debug"("FAIL", "arglist") debug_737: .return (rx1543_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__arglist" :subid("203_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("204_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1548_tgt .local int rx1548_pos .local int rx1548_off .local int rx1548_eos .local int rx1548_rep .local pmc rx1548_cur .local pmc rx1548_debug (rx1548_cur, rx1548_pos, rx1548_tgt, $I10) = self."!cursor_start"() getattribute rx1548_debug, rx1548_cur, "$!debug" .lex unicode:"$\x{a2}", rx1548_cur .local pmc match .lex "$/", match length rx1548_eos, rx1548_tgt gt rx1548_pos, rx1548_eos, rx1548_done set rx1548_off, 0 lt rx1548_pos, 2, rx1548_start sub rx1548_off, rx1548_pos, 1 substr rx1548_tgt, rx1548_tgt, rx1548_off rx1548_start: eq $I10, 1, rx1548_restart if_null rx1548_debug, debug_738 rx1548_cur."!cursor_debug"("START", "term:sym") debug_738: $I10 = self.'from'() ne $I10, -1, rxscan1550_done goto rxscan1550_scan rxscan1550_loop: ($P10) = rx1548_cur."from"() inc $P10 set rx1548_pos, $P10 ge rx1548_pos, rx1548_eos, rxscan1550_done rxscan1550_scan: set_addr $I10, rxscan1550_loop rx1548_cur."!mark_push"(0, rx1548_pos, $I10) rxscan1550_done: .annotate 'line', 413 # rx subrule "value" subtype=capture negate= rx1548_cur."!cursor_pos"(rx1548_pos) $P10 = rx1548_cur."value"() unless $P10, rx1548_fail rx1548_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("value") rx1548_pos = $P10."pos"() # rx pass rx1548_cur."!cursor_pass"(rx1548_pos, "term:sym") if_null rx1548_debug, debug_739 rx1548_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1548_pos) debug_739: .return (rx1548_cur) rx1548_restart: .annotate 'line', 4 if_null rx1548_debug, debug_740 rx1548_cur."!cursor_debug"("NEXT", "term:sym") debug_740: rx1548_fail: (rx1548_rep, rx1548_pos, $I10, $P10) = rx1548_cur."!mark_fail"(0) lt rx1548_pos, -1, rx1548_done eq rx1548_pos, -1, rx1548_fail jump $I10 rx1548_done: rx1548_cur."!cursor_fail"() if_null rx1548_debug, debug_741 rx1548_cur."!cursor_debug"("FAIL", "term:sym") debug_741: .return (rx1548_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("205_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("value", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "value" :subid("206_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1552_tgt .local int rx1552_pos .local int rx1552_off .local int rx1552_eos .local int rx1552_rep .local pmc rx1552_cur .local pmc rx1552_debug (rx1552_cur, rx1552_pos, rx1552_tgt, $I10) = self."!cursor_start"() getattribute rx1552_debug, rx1552_cur, "$!debug" .lex unicode:"$\x{a2}", rx1552_cur .local pmc match .lex "$/", match length rx1552_eos, rx1552_tgt gt rx1552_pos, rx1552_eos, rx1552_done set rx1552_off, 0 lt rx1552_pos, 2, rx1552_start sub rx1552_off, rx1552_pos, 1 substr rx1552_tgt, rx1552_tgt, rx1552_off rx1552_start: eq $I10, 1, rx1552_restart if_null rx1552_debug, debug_742 rx1552_cur."!cursor_debug"("START", "value") debug_742: $I10 = self.'from'() ne $I10, -1, rxscan1554_done goto rxscan1554_scan rxscan1554_loop: ($P10) = rx1552_cur."from"() inc $P10 set rx1552_pos, $P10 ge rx1552_pos, rx1552_eos, rxscan1554_done rxscan1554_scan: set_addr $I10, rxscan1554_loop rx1552_cur."!mark_push"(0, rx1552_pos, $I10) rxscan1554_done: alt1555_0: .annotate 'line', 415 set_addr $I10, alt1555_1 rx1552_cur."!mark_push"(0, rx1552_pos, $I10) .annotate 'line', 416 # rx subrule "quote" subtype=capture negate= rx1552_cur."!cursor_pos"(rx1552_pos) $P10 = rx1552_cur."quote"() unless $P10, rx1552_fail rx1552_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("quote") rx1552_pos = $P10."pos"() goto alt1555_end alt1555_1: .annotate 'line', 417 # rx subrule "number" subtype=capture negate= rx1552_cur."!cursor_pos"(rx1552_pos) $P10 = rx1552_cur."number"() unless $P10, rx1552_fail rx1552_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("number") rx1552_pos = $P10."pos"() alt1555_end: .annotate 'line', 415 # rx pass rx1552_cur."!cursor_pass"(rx1552_pos, "value") if_null rx1552_debug, debug_743 rx1552_cur."!cursor_debug"("PASS", "value", " at pos=", rx1552_pos) debug_743: .return (rx1552_cur) rx1552_restart: .annotate 'line', 4 if_null rx1552_debug, debug_744 rx1552_cur."!cursor_debug"("NEXT", "value") debug_744: rx1552_fail: (rx1552_rep, rx1552_pos, $I10, $P10) = rx1552_cur."!mark_fail"(0) lt rx1552_pos, -1, rx1552_done eq rx1552_pos, -1, rx1552_fail jump $I10 rx1552_done: rx1552_cur."!cursor_fail"() if_null rx1552_debug, debug_745 rx1552_cur."!cursor_debug"("FAIL", "value") debug_745: .return (rx1552_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__value" :subid("207_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("number", "") $P101 = self."!PREFIX__!subrule"("quote", "") new $P102, "ResizablePMCArray" push $P102, $P100 push $P102, $P101 .return ($P102) .end .namespace ["NQP";"Grammar"] .sub "number" :subid("208_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1557_tgt .local int rx1557_pos .local int rx1557_off .local int rx1557_eos .local int rx1557_rep .local pmc rx1557_cur .local pmc rx1557_debug (rx1557_cur, rx1557_pos, rx1557_tgt, $I10) = self."!cursor_start"() getattribute rx1557_debug, rx1557_cur, "$!debug" .lex unicode:"$\x{a2}", rx1557_cur .local pmc match .lex "$/", match length rx1557_eos, rx1557_tgt gt rx1557_pos, rx1557_eos, rx1557_done set rx1557_off, 0 lt rx1557_pos, 2, rx1557_start sub rx1557_off, rx1557_pos, 1 substr rx1557_tgt, rx1557_tgt, rx1557_off rx1557_start: eq $I10, 1, rx1557_restart if_null rx1557_debug, debug_746 rx1557_cur."!cursor_debug"("START", "number") debug_746: $I10 = self.'from'() ne $I10, -1, rxscan1559_done goto rxscan1559_scan rxscan1559_loop: ($P10) = rx1557_cur."from"() inc $P10 set rx1557_pos, $P10 ge rx1557_pos, rx1557_eos, rxscan1559_done rxscan1559_scan: set_addr $I10, rxscan1559_loop rx1557_cur."!mark_push"(0, rx1557_pos, $I10) rxscan1559_done: .annotate 'line', 421 # rx subcapture "sign" set_addr $I10, rxcap_1561_fail rx1557_cur."!mark_push"(0, rx1557_pos, $I10) # rx enumcharlist_q negate=0 r 0..1 sub $I10, rx1557_pos, rx1557_off set rx1557_rep, 0 sub $I12, rx1557_eos, rx1557_pos le $I12, 1, rxenumcharlistq1560_loop set $I12, 1 rxenumcharlistq1560_loop: le $I12, 0, rxenumcharlistq1560_done substr $S10, rx1557_tgt, $I10, 1 index $I11, "+-", $S10 lt $I11, 0, rxenumcharlistq1560_done inc rx1557_rep rxenumcharlistq1560_done: add rx1557_pos, rx1557_pos, rx1557_rep set_addr $I10, rxcap_1561_fail ($I12, $I11) = rx1557_cur."!mark_peek"($I10) rx1557_cur."!cursor_pos"($I11) ($P10) = rx1557_cur."!cursor_start"() $P10."!cursor_pass"(rx1557_pos, "") rx1557_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sign") goto rxcap_1561_done rxcap_1561_fail: goto rx1557_fail rxcap_1561_done: alt1562_0: .annotate 'line', 422 set_addr $I10, alt1562_1 rx1557_cur."!mark_push"(0, rx1557_pos, $I10) # rx subrule "dec_number" subtype=capture negate= rx1557_cur."!cursor_pos"(rx1557_pos) $P10 = rx1557_cur."dec_number"() unless $P10, rx1557_fail rx1557_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("dec_number") rx1557_pos = $P10."pos"() goto alt1562_end alt1562_1: # rx subrule "integer" subtype=capture negate= rx1557_cur."!cursor_pos"(rx1557_pos) $P10 = rx1557_cur."integer"() unless $P10, rx1557_fail rx1557_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("integer") rx1557_pos = $P10."pos"() alt1562_end: .annotate 'line', 420 # rx pass rx1557_cur."!cursor_pass"(rx1557_pos, "number") if_null rx1557_debug, debug_747 rx1557_cur."!cursor_debug"("PASS", "number", " at pos=", rx1557_pos) debug_747: .return (rx1557_cur) rx1557_restart: .annotate 'line', 4 if_null rx1557_debug, debug_748 rx1557_cur."!cursor_debug"("NEXT", "number") debug_748: rx1557_fail: (rx1557_rep, rx1557_pos, $I10, $P10) = rx1557_cur."!mark_fail"(0) lt rx1557_pos, -1, rx1557_done eq rx1557_pos, -1, rx1557_fail jump $I10 rx1557_done: rx1557_cur."!cursor_fail"() if_null rx1557_debug, debug_749 rx1557_cur."!cursor_debug"("FAIL", "number") debug_749: .return (rx1557_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__number" :subid("209_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "quote" :subid("210_1309998847.42912") :method .annotate 'line', 425 $P100 = self."!protoregex"("quote") .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__quote" :subid("211_1309998847.42912") :method .annotate 'line', 425 $P101 = self."!PREFIX__!protoregex"("quote") .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "quote:sym" :subid("212_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1566_tgt .local int rx1566_pos .local int rx1566_off .local int rx1566_eos .local int rx1566_rep .local pmc rx1566_cur .local pmc rx1566_debug (rx1566_cur, rx1566_pos, rx1566_tgt, $I10) = self."!cursor_start"() getattribute rx1566_debug, rx1566_cur, "$!debug" .lex unicode:"$\x{a2}", rx1566_cur .local pmc match .lex "$/", match length rx1566_eos, rx1566_tgt gt rx1566_pos, rx1566_eos, rx1566_done set rx1566_off, 0 lt rx1566_pos, 2, rx1566_start sub rx1566_off, rx1566_pos, 1 substr rx1566_tgt, rx1566_tgt, rx1566_off rx1566_start: eq $I10, 1, rx1566_restart if_null rx1566_debug, debug_750 rx1566_cur."!cursor_debug"("START", "quote:sym") debug_750: $I10 = self.'from'() ne $I10, -1, rxscan1568_done goto rxscan1568_scan rxscan1568_loop: ($P10) = rx1566_cur."from"() inc $P10 set rx1566_pos, $P10 ge rx1566_pos, rx1566_eos, rxscan1568_done rxscan1568_scan: set_addr $I10, rxscan1568_loop rx1566_cur."!mark_push"(0, rx1566_pos, $I10) rxscan1568_done: .annotate 'line', 426 # rx enumcharlist negate=0 zerowidth sub $I10, rx1566_pos, rx1566_off substr $S10, rx1566_tgt, $I10, 1 index $I11, "'", $S10 lt $I11, 0, rx1566_fail # rx subrule "quote_EXPR" subtype=capture negate= rx1566_cur."!cursor_pos"(rx1566_pos) $P10 = rx1566_cur."quote_EXPR"(":q") unless $P10, rx1566_fail rx1566_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("quote_EXPR") rx1566_pos = $P10."pos"() # rx pass rx1566_cur."!cursor_pass"(rx1566_pos, "quote:sym") if_null rx1566_debug, debug_751 rx1566_cur."!cursor_debug"("PASS", "quote:sym", " at pos=", rx1566_pos) debug_751: .return (rx1566_cur) rx1566_restart: .annotate 'line', 4 if_null rx1566_debug, debug_752 rx1566_cur."!cursor_debug"("NEXT", "quote:sym") debug_752: rx1566_fail: (rx1566_rep, rx1566_pos, $I10, $P10) = rx1566_cur."!mark_fail"(0) lt rx1566_pos, -1, rx1566_done eq rx1566_pos, -1, rx1566_fail jump $I10 rx1566_done: rx1566_cur."!cursor_fail"() if_null rx1566_debug, debug_753 rx1566_cur."!cursor_debug"("FAIL", "quote:sym") debug_753: .return (rx1566_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__quote:sym" :subid("213_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "'" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "quote:sym" :subid("214_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1570_tgt .local int rx1570_pos .local int rx1570_off .local int rx1570_eos .local int rx1570_rep .local pmc rx1570_cur .local pmc rx1570_debug (rx1570_cur, rx1570_pos, rx1570_tgt, $I10) = self."!cursor_start"() getattribute rx1570_debug, rx1570_cur, "$!debug" .lex unicode:"$\x{a2}", rx1570_cur .local pmc match .lex "$/", match length rx1570_eos, rx1570_tgt gt rx1570_pos, rx1570_eos, rx1570_done set rx1570_off, 0 lt rx1570_pos, 2, rx1570_start sub rx1570_off, rx1570_pos, 1 substr rx1570_tgt, rx1570_tgt, rx1570_off rx1570_start: eq $I10, 1, rx1570_restart if_null rx1570_debug, debug_754 rx1570_cur."!cursor_debug"("START", "quote:sym") debug_754: $I10 = self.'from'() ne $I10, -1, rxscan1572_done goto rxscan1572_scan rxscan1572_loop: ($P10) = rx1570_cur."from"() inc $P10 set rx1570_pos, $P10 ge rx1570_pos, rx1570_eos, rxscan1572_done rxscan1572_scan: set_addr $I10, rxscan1572_loop rx1570_cur."!mark_push"(0, rx1570_pos, $I10) rxscan1572_done: .annotate 'line', 427 # rx enumcharlist negate=0 zerowidth sub $I10, rx1570_pos, rx1570_off substr $S10, rx1570_tgt, $I10, 1 index $I11, "\"", $S10 lt $I11, 0, rx1570_fail # rx subrule "quote_EXPR" subtype=capture negate= rx1570_cur."!cursor_pos"(rx1570_pos) $P10 = rx1570_cur."quote_EXPR"(":qq") unless $P10, rx1570_fail rx1570_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("quote_EXPR") rx1570_pos = $P10."pos"() # rx pass rx1570_cur."!cursor_pass"(rx1570_pos, "quote:sym") if_null rx1570_debug, debug_755 rx1570_cur."!cursor_debug"("PASS", "quote:sym", " at pos=", rx1570_pos) debug_755: .return (rx1570_cur) rx1570_restart: .annotate 'line', 4 if_null rx1570_debug, debug_756 rx1570_cur."!cursor_debug"("NEXT", "quote:sym") debug_756: rx1570_fail: (rx1570_rep, rx1570_pos, $I10, $P10) = rx1570_cur."!mark_fail"(0) lt rx1570_pos, -1, rx1570_done eq rx1570_pos, -1, rx1570_fail jump $I10 rx1570_done: rx1570_cur."!cursor_fail"() if_null rx1570_debug, debug_757 rx1570_cur."!cursor_debug"("FAIL", "quote:sym") debug_757: .return (rx1570_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__quote:sym" :subid("215_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "\"" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "quote:sym" :subid("216_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1574_tgt .local int rx1574_pos .local int rx1574_off .local int rx1574_eos .local int rx1574_rep .local pmc rx1574_cur .local pmc rx1574_debug (rx1574_cur, rx1574_pos, rx1574_tgt, $I10) = self."!cursor_start"() getattribute rx1574_debug, rx1574_cur, "$!debug" .lex unicode:"$\x{a2}", rx1574_cur .local pmc match .lex "$/", match length rx1574_eos, rx1574_tgt gt rx1574_pos, rx1574_eos, rx1574_done set rx1574_off, 0 lt rx1574_pos, 2, rx1574_start sub rx1574_off, rx1574_pos, 1 substr rx1574_tgt, rx1574_tgt, rx1574_off rx1574_start: eq $I10, 1, rx1574_restart if_null rx1574_debug, debug_758 rx1574_cur."!cursor_debug"("START", "quote:sym") debug_758: $I10 = self.'from'() ne $I10, -1, rxscan1576_done goto rxscan1576_scan rxscan1576_loop: ($P10) = rx1574_cur."from"() inc $P10 set rx1574_pos, $P10 ge rx1574_pos, rx1574_eos, rxscan1576_done rxscan1576_scan: set_addr $I10, rxscan1576_loop rx1574_cur."!mark_push"(0, rx1574_pos, $I10) rxscan1576_done: .annotate 'line', 428 # rx literal "q" add $I11, rx1574_pos, 1 gt $I11, rx1574_eos, rx1574_fail sub $I11, rx1574_pos, rx1574_off ord $I11, rx1574_tgt, $I11 ne $I11, 113, rx1574_fail add rx1574_pos, 1 # rxanchor rwb le rx1574_pos, 0, rx1574_fail sub $I10, rx1574_pos, rx1574_off is_cclass $I11, 8192, rx1574_tgt, $I10 if $I11, rx1574_fail dec $I10 is_cclass $I11, 8192, rx1574_tgt, $I10 unless $I11, rx1574_fail # rx enumcharlist negate=1 zerowidth sub $I10, rx1574_pos, rx1574_off substr $S10, rx1574_tgt, $I10, 1 index $I11, "(", $S10 ge $I11, 0, rx1574_fail # rx subrule "ws" subtype=method negate= rx1574_cur."!cursor_pos"(rx1574_pos) $P10 = rx1574_cur."ws"() unless $P10, rx1574_fail rx1574_pos = $P10."pos"() # rx subrule "quote_EXPR" subtype=capture negate= rx1574_cur."!cursor_pos"(rx1574_pos) $P10 = rx1574_cur."quote_EXPR"(":q") unless $P10, rx1574_fail rx1574_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("quote_EXPR") rx1574_pos = $P10."pos"() # rx pass rx1574_cur."!cursor_pass"(rx1574_pos, "quote:sym") if_null rx1574_debug, debug_759 rx1574_cur."!cursor_debug"("PASS", "quote:sym", " at pos=", rx1574_pos) debug_759: .return (rx1574_cur) rx1574_restart: .annotate 'line', 4 if_null rx1574_debug, debug_760 rx1574_cur."!cursor_debug"("NEXT", "quote:sym") debug_760: rx1574_fail: (rx1574_rep, rx1574_pos, $I10, $P10) = rx1574_cur."!mark_fail"(0) lt rx1574_pos, -1, rx1574_done eq rx1574_pos, -1, rx1574_fail jump $I10 rx1574_done: rx1574_cur."!cursor_fail"() if_null rx1574_debug, debug_761 rx1574_cur."!cursor_debug"("FAIL", "quote:sym") debug_761: .return (rx1574_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__quote:sym" :subid("217_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "q") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "quote:sym" :subid("218_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1578_tgt .local int rx1578_pos .local int rx1578_off .local int rx1578_eos .local int rx1578_rep .local pmc rx1578_cur .local pmc rx1578_debug (rx1578_cur, rx1578_pos, rx1578_tgt, $I10) = self."!cursor_start"() getattribute rx1578_debug, rx1578_cur, "$!debug" .lex unicode:"$\x{a2}", rx1578_cur .local pmc match .lex "$/", match length rx1578_eos, rx1578_tgt gt rx1578_pos, rx1578_eos, rx1578_done set rx1578_off, 0 lt rx1578_pos, 2, rx1578_start sub rx1578_off, rx1578_pos, 1 substr rx1578_tgt, rx1578_tgt, rx1578_off rx1578_start: eq $I10, 1, rx1578_restart if_null rx1578_debug, debug_762 rx1578_cur."!cursor_debug"("START", "quote:sym") debug_762: $I10 = self.'from'() ne $I10, -1, rxscan1580_done goto rxscan1580_scan rxscan1580_loop: ($P10) = rx1578_cur."from"() inc $P10 set rx1578_pos, $P10 ge rx1578_pos, rx1578_eos, rxscan1580_done rxscan1580_scan: set_addr $I10, rxscan1580_loop rx1578_cur."!mark_push"(0, rx1578_pos, $I10) rxscan1580_done: .annotate 'line', 429 # rx literal "qq" add $I11, rx1578_pos, 2 gt $I11, rx1578_eos, rx1578_fail sub $I11, rx1578_pos, rx1578_off substr $S10, rx1578_tgt, $I11, 2 ne $S10, "qq", rx1578_fail add rx1578_pos, 2 # rxanchor rwb le rx1578_pos, 0, rx1578_fail sub $I10, rx1578_pos, rx1578_off is_cclass $I11, 8192, rx1578_tgt, $I10 if $I11, rx1578_fail dec $I10 is_cclass $I11, 8192, rx1578_tgt, $I10 unless $I11, rx1578_fail # rx enumcharlist negate=1 zerowidth sub $I10, rx1578_pos, rx1578_off substr $S10, rx1578_tgt, $I10, 1 index $I11, "(", $S10 ge $I11, 0, rx1578_fail # rx subrule "ws" subtype=method negate= rx1578_cur."!cursor_pos"(rx1578_pos) $P10 = rx1578_cur."ws"() unless $P10, rx1578_fail rx1578_pos = $P10."pos"() # rx subrule "quote_EXPR" subtype=capture negate= rx1578_cur."!cursor_pos"(rx1578_pos) $P10 = rx1578_cur."quote_EXPR"(":qq") unless $P10, rx1578_fail rx1578_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("quote_EXPR") rx1578_pos = $P10."pos"() # rx pass rx1578_cur."!cursor_pass"(rx1578_pos, "quote:sym") if_null rx1578_debug, debug_763 rx1578_cur."!cursor_debug"("PASS", "quote:sym", " at pos=", rx1578_pos) debug_763: .return (rx1578_cur) rx1578_restart: .annotate 'line', 4 if_null rx1578_debug, debug_764 rx1578_cur."!cursor_debug"("NEXT", "quote:sym") debug_764: rx1578_fail: (rx1578_rep, rx1578_pos, $I10, $P10) = rx1578_cur."!mark_fail"(0) lt rx1578_pos, -1, rx1578_done eq rx1578_pos, -1, rx1578_fail jump $I10 rx1578_done: rx1578_cur."!cursor_fail"() if_null rx1578_debug, debug_765 rx1578_cur."!cursor_debug"("FAIL", "quote:sym") debug_765: .return (rx1578_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__quote:sym" :subid("219_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "qq") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "quote:sym" :subid("220_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1582_tgt .local int rx1582_pos .local int rx1582_off .local int rx1582_eos .local int rx1582_rep .local pmc rx1582_cur .local pmc rx1582_debug (rx1582_cur, rx1582_pos, rx1582_tgt, $I10) = self."!cursor_start"() getattribute rx1582_debug, rx1582_cur, "$!debug" .lex unicode:"$\x{a2}", rx1582_cur .local pmc match .lex "$/", match length rx1582_eos, rx1582_tgt gt rx1582_pos, rx1582_eos, rx1582_done set rx1582_off, 0 lt rx1582_pos, 2, rx1582_start sub rx1582_off, rx1582_pos, 1 substr rx1582_tgt, rx1582_tgt, rx1582_off rx1582_start: eq $I10, 1, rx1582_restart if_null rx1582_debug, debug_766 rx1582_cur."!cursor_debug"("START", "quote:sym") debug_766: $I10 = self.'from'() ne $I10, -1, rxscan1584_done goto rxscan1584_scan rxscan1584_loop: ($P10) = rx1582_cur."from"() inc $P10 set rx1582_pos, $P10 ge rx1582_pos, rx1582_eos, rxscan1584_done rxscan1584_scan: set_addr $I10, rxscan1584_loop rx1582_cur."!mark_push"(0, rx1582_pos, $I10) rxscan1584_done: .annotate 'line', 430 # rx literal "Q" add $I11, rx1582_pos, 1 gt $I11, rx1582_eos, rx1582_fail sub $I11, rx1582_pos, rx1582_off ord $I11, rx1582_tgt, $I11 ne $I11, 81, rx1582_fail add rx1582_pos, 1 # rxanchor rwb le rx1582_pos, 0, rx1582_fail sub $I10, rx1582_pos, rx1582_off is_cclass $I11, 8192, rx1582_tgt, $I10 if $I11, rx1582_fail dec $I10 is_cclass $I11, 8192, rx1582_tgt, $I10 unless $I11, rx1582_fail # rx enumcharlist negate=1 zerowidth sub $I10, rx1582_pos, rx1582_off substr $S10, rx1582_tgt, $I10, 1 index $I11, "(", $S10 ge $I11, 0, rx1582_fail # rx subrule "ws" subtype=method negate= rx1582_cur."!cursor_pos"(rx1582_pos) $P10 = rx1582_cur."ws"() unless $P10, rx1582_fail rx1582_pos = $P10."pos"() # rx subrule "quote_EXPR" subtype=capture negate= rx1582_cur."!cursor_pos"(rx1582_pos) $P10 = rx1582_cur."quote_EXPR"() unless $P10, rx1582_fail rx1582_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("quote_EXPR") rx1582_pos = $P10."pos"() # rx pass rx1582_cur."!cursor_pass"(rx1582_pos, "quote:sym") if_null rx1582_debug, debug_767 rx1582_cur."!cursor_debug"("PASS", "quote:sym", " at pos=", rx1582_pos) debug_767: .return (rx1582_cur) rx1582_restart: .annotate 'line', 4 if_null rx1582_debug, debug_768 rx1582_cur."!cursor_debug"("NEXT", "quote:sym") debug_768: rx1582_fail: (rx1582_rep, rx1582_pos, $I10, $P10) = rx1582_cur."!mark_fail"(0) lt rx1582_pos, -1, rx1582_done eq rx1582_pos, -1, rx1582_fail jump $I10 rx1582_done: rx1582_cur."!cursor_fail"() if_null rx1582_debug, debug_769 rx1582_cur."!cursor_debug"("FAIL", "quote:sym") debug_769: .return (rx1582_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__quote:sym" :subid("221_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "Q") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "quote:sym" :subid("222_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1586_tgt .local int rx1586_pos .local int rx1586_off .local int rx1586_eos .local int rx1586_rep .local pmc rx1586_cur .local pmc rx1586_debug (rx1586_cur, rx1586_pos, rx1586_tgt, $I10) = self."!cursor_start"() getattribute rx1586_debug, rx1586_cur, "$!debug" .lex unicode:"$\x{a2}", rx1586_cur .local pmc match .lex "$/", match length rx1586_eos, rx1586_tgt gt rx1586_pos, rx1586_eos, rx1586_done set rx1586_off, 0 lt rx1586_pos, 2, rx1586_start sub rx1586_off, rx1586_pos, 1 substr rx1586_tgt, rx1586_tgt, rx1586_off rx1586_start: eq $I10, 1, rx1586_restart if_null rx1586_debug, debug_770 rx1586_cur."!cursor_debug"("START", "quote:sym") debug_770: $I10 = self.'from'() ne $I10, -1, rxscan1588_done goto rxscan1588_scan rxscan1588_loop: ($P10) = rx1586_cur."from"() inc $P10 set rx1586_pos, $P10 ge rx1586_pos, rx1586_eos, rxscan1588_done rxscan1588_scan: set_addr $I10, rxscan1588_loop rx1586_cur."!mark_push"(0, rx1586_pos, $I10) rxscan1588_done: .annotate 'line', 431 # rx literal "Q:PIR" add $I11, rx1586_pos, 5 gt $I11, rx1586_eos, rx1586_fail sub $I11, rx1586_pos, rx1586_off substr $S10, rx1586_tgt, $I11, 5 ne $S10, "Q:PIR", rx1586_fail add rx1586_pos, 5 # rx subrule "ws" subtype=method negate= rx1586_cur."!cursor_pos"(rx1586_pos) $P10 = rx1586_cur."ws"() unless $P10, rx1586_fail rx1586_pos = $P10."pos"() # rx subrule "quote_EXPR" subtype=capture negate= rx1586_cur."!cursor_pos"(rx1586_pos) $P10 = rx1586_cur."quote_EXPR"() unless $P10, rx1586_fail rx1586_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("quote_EXPR") rx1586_pos = $P10."pos"() # rx pass rx1586_cur."!cursor_pass"(rx1586_pos, "quote:sym") if_null rx1586_debug, debug_771 rx1586_cur."!cursor_debug"("PASS", "quote:sym", " at pos=", rx1586_pos) debug_771: .return (rx1586_cur) rx1586_restart: .annotate 'line', 4 if_null rx1586_debug, debug_772 rx1586_cur."!cursor_debug"("NEXT", "quote:sym") debug_772: rx1586_fail: (rx1586_rep, rx1586_pos, $I10, $P10) = rx1586_cur."!mark_fail"(0) lt rx1586_pos, -1, rx1586_done eq rx1586_pos, -1, rx1586_fail jump $I10 rx1586_done: rx1586_cur."!cursor_fail"() if_null rx1586_debug, debug_773 rx1586_cur."!cursor_debug"("FAIL", "quote:sym") debug_773: .return (rx1586_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__quote:sym" :subid("223_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "Q:PIR") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "quote:sym" :subid("224_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1590_tgt .local int rx1590_pos .local int rx1590_off .local int rx1590_eos .local int rx1590_rep .local pmc rx1590_cur .local pmc rx1590_debug (rx1590_cur, rx1590_pos, rx1590_tgt, $I10) = self."!cursor_start"() getattribute rx1590_debug, rx1590_cur, "$!debug" .lex unicode:"$\x{a2}", rx1590_cur .local pmc match .lex "$/", match length rx1590_eos, rx1590_tgt gt rx1590_pos, rx1590_eos, rx1590_done set rx1590_off, 0 lt rx1590_pos, 2, rx1590_start sub rx1590_off, rx1590_pos, 1 substr rx1590_tgt, rx1590_tgt, rx1590_off rx1590_start: eq $I10, 1, rx1590_restart if_null rx1590_debug, debug_774 rx1590_cur."!cursor_debug"("START", "quote:sym") debug_774: $I10 = self.'from'() ne $I10, -1, rxscan1592_done goto rxscan1592_scan rxscan1592_loop: ($P10) = rx1590_cur."from"() inc $P10 set rx1590_pos, $P10 ge rx1590_pos, rx1590_eos, rxscan1592_done rxscan1592_scan: set_addr $I10, rxscan1592_loop rx1590_cur."!mark_push"(0, rx1590_pos, $I10) rxscan1592_done: .annotate 'line', 433 # rx literal "/" add $I11, rx1590_pos, 1 gt $I11, rx1590_eos, rx1590_fail sub $I11, rx1590_pos, rx1590_off ord $I11, rx1590_tgt, $I11 ne $I11, 47, rx1590_fail add rx1590_pos, 1 .annotate 'line', 434 # rx subrule "newpad" subtype=method negate= rx1590_cur."!cursor_pos"(rx1590_pos) $P10 = rx1590_cur."newpad"() unless $P10, rx1590_fail rx1590_pos = $P10."pos"() .annotate 'line', 435 # rx reduce name="quote:sym" key="open" rx1590_cur."!cursor_pos"(rx1590_pos) rx1590_cur."!reduce"("quote:sym", "open") .annotate 'line', 436 # rx subrule "LANG" subtype=capture negate= rx1590_cur."!cursor_pos"(rx1590_pos) $P10 = rx1590_cur."LANG"("Regex", "nibbler") unless $P10, rx1590_fail rx1590_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("p6regex") rx1590_pos = $P10."pos"() .annotate 'line', 437 # rx literal "/" add $I11, rx1590_pos, 1 gt $I11, rx1590_eos, rx1590_fail sub $I11, rx1590_pos, rx1590_off ord $I11, rx1590_tgt, $I11 ne $I11, 47, rx1590_fail add rx1590_pos, 1 .annotate 'line', 432 # rx pass rx1590_cur."!cursor_pass"(rx1590_pos, "quote:sym") if_null rx1590_debug, debug_775 rx1590_cur."!cursor_debug"("PASS", "quote:sym", " at pos=", rx1590_pos) debug_775: .return (rx1590_cur) rx1590_restart: .annotate 'line', 4 if_null rx1590_debug, debug_776 rx1590_cur."!cursor_debug"("NEXT", "quote:sym") debug_776: rx1590_fail: (rx1590_rep, rx1590_pos, $I10, $P10) = rx1590_cur."!mark_fail"(0) lt rx1590_pos, -1, rx1590_done eq rx1590_pos, -1, rx1590_fail jump $I10 rx1590_done: rx1590_cur."!cursor_fail"() if_null rx1590_debug, debug_777 rx1590_cur."!cursor_debug"("FAIL", "quote:sym") debug_777: .return (rx1590_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__quote:sym" :subid("225_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("newpad", "/") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "quote_escape:sym<$>" :subid("226_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1594_tgt .local int rx1594_pos .local int rx1594_off .local int rx1594_eos .local int rx1594_rep .local pmc rx1594_cur .local pmc rx1594_debug (rx1594_cur, rx1594_pos, rx1594_tgt, $I10) = self."!cursor_start"() getattribute rx1594_debug, rx1594_cur, "$!debug" .lex unicode:"$\x{a2}", rx1594_cur .local pmc match .lex "$/", match length rx1594_eos, rx1594_tgt gt rx1594_pos, rx1594_eos, rx1594_done set rx1594_off, 0 lt rx1594_pos, 2, rx1594_start sub rx1594_off, rx1594_pos, 1 substr rx1594_tgt, rx1594_tgt, rx1594_off rx1594_start: eq $I10, 1, rx1594_restart if_null rx1594_debug, debug_778 rx1594_cur."!cursor_debug"("START", "quote_escape:sym<$>") debug_778: $I10 = self.'from'() ne $I10, -1, rxscan1596_done goto rxscan1596_scan rxscan1596_loop: ($P10) = rx1594_cur."from"() inc $P10 set rx1594_pos, $P10 ge rx1594_pos, rx1594_eos, rxscan1596_done rxscan1596_scan: set_addr $I10, rxscan1596_loop rx1594_cur."!mark_push"(0, rx1594_pos, $I10) rxscan1596_done: .annotate 'line', 440 # rx enumcharlist negate=0 zerowidth sub $I10, rx1594_pos, rx1594_off substr $S10, rx1594_tgt, $I10, 1 index $I11, "$", $S10 lt $I11, 0, rx1594_fail # rx subrule "quotemod_check" subtype=zerowidth negate= rx1594_cur."!cursor_pos"(rx1594_pos) $P10 = rx1594_cur."quotemod_check"("s") unless $P10, rx1594_fail # rx subrule "variable" subtype=capture negate= rx1594_cur."!cursor_pos"(rx1594_pos) $P10 = rx1594_cur."variable"() unless $P10, rx1594_fail rx1594_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("variable") rx1594_pos = $P10."pos"() # rx pass rx1594_cur."!cursor_pass"(rx1594_pos, "quote_escape:sym<$>") if_null rx1594_debug, debug_779 rx1594_cur."!cursor_debug"("PASS", "quote_escape:sym<$>", " at pos=", rx1594_pos) debug_779: .return (rx1594_cur) rx1594_restart: .annotate 'line', 4 if_null rx1594_debug, debug_780 rx1594_cur."!cursor_debug"("NEXT", "quote_escape:sym<$>") debug_780: rx1594_fail: (rx1594_rep, rx1594_pos, $I10, $P10) = rx1594_cur."!mark_fail"(0) lt rx1594_pos, -1, rx1594_done eq rx1594_pos, -1, rx1594_fail jump $I10 rx1594_done: rx1594_cur."!cursor_fail"() if_null rx1594_debug, debug_781 rx1594_cur."!cursor_debug"("FAIL", "quote_escape:sym<$>") debug_781: .return (rx1594_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__quote_escape:sym<$>" :subid("227_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "$" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "quote_escape:sym<{ }>" :subid("228_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1598_tgt .local int rx1598_pos .local int rx1598_off .local int rx1598_eos .local int rx1598_rep .local pmc rx1598_cur .local pmc rx1598_debug (rx1598_cur, rx1598_pos, rx1598_tgt, $I10) = self."!cursor_start"() getattribute rx1598_debug, rx1598_cur, "$!debug" .lex unicode:"$\x{a2}", rx1598_cur .local pmc match .lex "$/", match length rx1598_eos, rx1598_tgt gt rx1598_pos, rx1598_eos, rx1598_done set rx1598_off, 0 lt rx1598_pos, 2, rx1598_start sub rx1598_off, rx1598_pos, 1 substr rx1598_tgt, rx1598_tgt, rx1598_off rx1598_start: eq $I10, 1, rx1598_restart if_null rx1598_debug, debug_782 rx1598_cur."!cursor_debug"("START", "quote_escape:sym<{ }>") debug_782: $I10 = self.'from'() ne $I10, -1, rxscan1600_done goto rxscan1600_scan rxscan1600_loop: ($P10) = rx1598_cur."from"() inc $P10 set rx1598_pos, $P10 ge rx1598_pos, rx1598_eos, rxscan1600_done rxscan1600_scan: set_addr $I10, rxscan1600_loop rx1598_cur."!mark_push"(0, rx1598_pos, $I10) rxscan1600_done: .annotate 'line', 441 # rx enumcharlist negate=0 zerowidth sub $I10, rx1598_pos, rx1598_off substr $S10, rx1598_tgt, $I10, 1 index $I11, "{", $S10 lt $I11, 0, rx1598_fail # rx subrule "quotemod_check" subtype=zerowidth negate= rx1598_cur."!cursor_pos"(rx1598_pos) $P10 = rx1598_cur."quotemod_check"("c") unless $P10, rx1598_fail # rx subrule "block" subtype=capture negate= rx1598_cur."!cursor_pos"(rx1598_pos) $P10 = rx1598_cur."block"() unless $P10, rx1598_fail rx1598_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("block") rx1598_pos = $P10."pos"() # rx pass rx1598_cur."!cursor_pass"(rx1598_pos, "quote_escape:sym<{ }>") if_null rx1598_debug, debug_783 rx1598_cur."!cursor_debug"("PASS", "quote_escape:sym<{ }>", " at pos=", rx1598_pos) debug_783: .return (rx1598_cur) rx1598_restart: .annotate 'line', 4 if_null rx1598_debug, debug_784 rx1598_cur."!cursor_debug"("NEXT", "quote_escape:sym<{ }>") debug_784: rx1598_fail: (rx1598_rep, rx1598_pos, $I10, $P10) = rx1598_cur."!mark_fail"(0) lt rx1598_pos, -1, rx1598_done eq rx1598_pos, -1, rx1598_fail jump $I10 rx1598_done: rx1598_cur."!cursor_fail"() if_null rx1598_debug, debug_785 rx1598_cur."!cursor_debug"("FAIL", "quote_escape:sym<{ }>") debug_785: .return (rx1598_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__quote_escape:sym<{ }>" :subid("229_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "{" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "quote_escape:sym" :subid("230_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1602_tgt .local int rx1602_pos .local int rx1602_off .local int rx1602_eos .local int rx1602_rep .local pmc rx1602_cur .local pmc rx1602_debug (rx1602_cur, rx1602_pos, rx1602_tgt, $I10) = self."!cursor_start"() getattribute rx1602_debug, rx1602_cur, "$!debug" .lex unicode:"$\x{a2}", rx1602_cur .local pmc match .lex "$/", match length rx1602_eos, rx1602_tgt gt rx1602_pos, rx1602_eos, rx1602_done set rx1602_off, 0 lt rx1602_pos, 2, rx1602_start sub rx1602_off, rx1602_pos, 1 substr rx1602_tgt, rx1602_tgt, rx1602_off rx1602_start: eq $I10, 1, rx1602_restart if_null rx1602_debug, debug_786 rx1602_cur."!cursor_debug"("START", "quote_escape:sym") debug_786: $I10 = self.'from'() ne $I10, -1, rxscan1604_done goto rxscan1604_scan rxscan1604_loop: ($P10) = rx1602_cur."from"() inc $P10 set rx1602_pos, $P10 ge rx1602_pos, rx1602_eos, rxscan1604_done rxscan1604_scan: set_addr $I10, rxscan1604_loop rx1602_cur."!mark_push"(0, rx1602_pos, $I10) rxscan1604_done: .annotate 'line', 442 # rx literal "\\e" add $I11, rx1602_pos, 2 gt $I11, rx1602_eos, rx1602_fail sub $I11, rx1602_pos, rx1602_off substr $S10, rx1602_tgt, $I11, 2 ne $S10, "\\e", rx1602_fail add rx1602_pos, 2 # rx subrule "quotemod_check" subtype=zerowidth negate= rx1602_cur."!cursor_pos"(rx1602_pos) $P10 = rx1602_cur."quotemod_check"("b") unless $P10, rx1602_fail # rx pass rx1602_cur."!cursor_pass"(rx1602_pos, "quote_escape:sym") if_null rx1602_debug, debug_787 rx1602_cur."!cursor_debug"("PASS", "quote_escape:sym", " at pos=", rx1602_pos) debug_787: .return (rx1602_cur) rx1602_restart: .annotate 'line', 4 if_null rx1602_debug, debug_788 rx1602_cur."!cursor_debug"("NEXT", "quote_escape:sym") debug_788: rx1602_fail: (rx1602_rep, rx1602_pos, $I10, $P10) = rx1602_cur."!mark_fail"(0) lt rx1602_pos, -1, rx1602_done eq rx1602_pos, -1, rx1602_fail jump $I10 rx1602_done: rx1602_cur."!cursor_fail"() if_null rx1602_debug, debug_789 rx1602_cur."!cursor_debug"("FAIL", "quote_escape:sym") debug_789: .return (rx1602_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__quote_escape:sym" :subid("231_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "\\e" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "circumfix:sym<( )>" :subid("232_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1606_tgt .local int rx1606_pos .local int rx1606_off .local int rx1606_eos .local int rx1606_rep .local pmc rx1606_cur .local pmc rx1606_debug (rx1606_cur, rx1606_pos, rx1606_tgt, $I10) = self."!cursor_start"() rx1606_cur."!cursor_caparray"("EXPR") getattribute rx1606_debug, rx1606_cur, "$!debug" .lex unicode:"$\x{a2}", rx1606_cur .local pmc match .lex "$/", match length rx1606_eos, rx1606_tgt gt rx1606_pos, rx1606_eos, rx1606_done set rx1606_off, 0 lt rx1606_pos, 2, rx1606_start sub rx1606_off, rx1606_pos, 1 substr rx1606_tgt, rx1606_tgt, rx1606_off rx1606_start: eq $I10, 1, rx1606_restart if_null rx1606_debug, debug_790 rx1606_cur."!cursor_debug"("START", "circumfix:sym<( )>") debug_790: $I10 = self.'from'() ne $I10, -1, rxscan1608_done goto rxscan1608_scan rxscan1608_loop: ($P10) = rx1606_cur."from"() inc $P10 set rx1606_pos, $P10 ge rx1606_pos, rx1606_eos, rxscan1608_done rxscan1608_scan: set_addr $I10, rxscan1608_loop rx1606_cur."!mark_push"(0, rx1606_pos, $I10) rxscan1608_done: .annotate 'line', 444 # rx literal "(" add $I11, rx1606_pos, 1 gt $I11, rx1606_eos, rx1606_fail sub $I11, rx1606_pos, rx1606_off ord $I11, rx1606_tgt, $I11 ne $I11, 40, rx1606_fail add rx1606_pos, 1 # rx subrule "ws" subtype=method negate= rx1606_cur."!cursor_pos"(rx1606_pos) $P10 = rx1606_cur."ws"() unless $P10, rx1606_fail rx1606_pos = $P10."pos"() # rx rxquantr1609 ** 0..1 set_addr $I10, rxquantr1609_done rx1606_cur."!mark_push"(0, rx1606_pos, $I10) rxquantr1609_loop: # rx subrule "EXPR" subtype=capture negate= rx1606_cur."!cursor_pos"(rx1606_pos) $P10 = rx1606_cur."EXPR"() unless $P10, rx1606_fail goto rxsubrule1610_pass rxsubrule1610_back: $P10 = $P10."!cursor_next"() unless $P10, rx1606_fail rxsubrule1610_pass: set_addr $I10, rxsubrule1610_back rx1606_cur."!mark_push"(0, rx1606_pos, $I10, $P10) $P10."!cursor_names"("EXPR") rx1606_pos = $P10."pos"() set_addr $I10, rxquantr1609_done (rx1606_rep) = rx1606_cur."!mark_commit"($I10) rxquantr1609_done: # rx literal ")" add $I11, rx1606_pos, 1 gt $I11, rx1606_eos, rx1606_fail sub $I11, rx1606_pos, rx1606_off ord $I11, rx1606_tgt, $I11 ne $I11, 41, rx1606_fail add rx1606_pos, 1 # rx pass rx1606_cur."!cursor_pass"(rx1606_pos, "circumfix:sym<( )>") if_null rx1606_debug, debug_791 rx1606_cur."!cursor_debug"("PASS", "circumfix:sym<( )>", " at pos=", rx1606_pos) debug_791: .return (rx1606_cur) rx1606_restart: .annotate 'line', 4 if_null rx1606_debug, debug_792 rx1606_cur."!cursor_debug"("NEXT", "circumfix:sym<( )>") debug_792: rx1606_fail: (rx1606_rep, rx1606_pos, $I10, $P10) = rx1606_cur."!mark_fail"(0) lt rx1606_pos, -1, rx1606_done eq rx1606_pos, -1, rx1606_fail jump $I10 rx1606_done: rx1606_cur."!cursor_fail"() if_null rx1606_debug, debug_793 rx1606_cur."!cursor_debug"("FAIL", "circumfix:sym<( )>") debug_793: .return (rx1606_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__circumfix:sym<( )>" :subid("233_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "(") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "circumfix:sym<[ ]>" :subid("234_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1612_tgt .local int rx1612_pos .local int rx1612_off .local int rx1612_eos .local int rx1612_rep .local pmc rx1612_cur .local pmc rx1612_debug (rx1612_cur, rx1612_pos, rx1612_tgt, $I10) = self."!cursor_start"() rx1612_cur."!cursor_caparray"("EXPR") getattribute rx1612_debug, rx1612_cur, "$!debug" .lex unicode:"$\x{a2}", rx1612_cur .local pmc match .lex "$/", match length rx1612_eos, rx1612_tgt gt rx1612_pos, rx1612_eos, rx1612_done set rx1612_off, 0 lt rx1612_pos, 2, rx1612_start sub rx1612_off, rx1612_pos, 1 substr rx1612_tgt, rx1612_tgt, rx1612_off rx1612_start: eq $I10, 1, rx1612_restart if_null rx1612_debug, debug_794 rx1612_cur."!cursor_debug"("START", "circumfix:sym<[ ]>") debug_794: $I10 = self.'from'() ne $I10, -1, rxscan1614_done goto rxscan1614_scan rxscan1614_loop: ($P10) = rx1612_cur."from"() inc $P10 set rx1612_pos, $P10 ge rx1612_pos, rx1612_eos, rxscan1614_done rxscan1614_scan: set_addr $I10, rxscan1614_loop rx1612_cur."!mark_push"(0, rx1612_pos, $I10) rxscan1614_done: .annotate 'line', 445 # rx literal "[" add $I11, rx1612_pos, 1 gt $I11, rx1612_eos, rx1612_fail sub $I11, rx1612_pos, rx1612_off ord $I11, rx1612_tgt, $I11 ne $I11, 91, rx1612_fail add rx1612_pos, 1 # rx subrule "ws" subtype=method negate= rx1612_cur."!cursor_pos"(rx1612_pos) $P10 = rx1612_cur."ws"() unless $P10, rx1612_fail rx1612_pos = $P10."pos"() # rx rxquantr1615 ** 0..1 set_addr $I10, rxquantr1615_done rx1612_cur."!mark_push"(0, rx1612_pos, $I10) rxquantr1615_loop: # rx subrule "EXPR" subtype=capture negate= rx1612_cur."!cursor_pos"(rx1612_pos) $P10 = rx1612_cur."EXPR"() unless $P10, rx1612_fail goto rxsubrule1616_pass rxsubrule1616_back: $P10 = $P10."!cursor_next"() unless $P10, rx1612_fail rxsubrule1616_pass: set_addr $I10, rxsubrule1616_back rx1612_cur."!mark_push"(0, rx1612_pos, $I10, $P10) $P10."!cursor_names"("EXPR") rx1612_pos = $P10."pos"() set_addr $I10, rxquantr1615_done (rx1612_rep) = rx1612_cur."!mark_commit"($I10) rxquantr1615_done: # rx literal "]" add $I11, rx1612_pos, 1 gt $I11, rx1612_eos, rx1612_fail sub $I11, rx1612_pos, rx1612_off ord $I11, rx1612_tgt, $I11 ne $I11, 93, rx1612_fail add rx1612_pos, 1 # rx pass rx1612_cur."!cursor_pass"(rx1612_pos, "circumfix:sym<[ ]>") if_null rx1612_debug, debug_795 rx1612_cur."!cursor_debug"("PASS", "circumfix:sym<[ ]>", " at pos=", rx1612_pos) debug_795: .return (rx1612_cur) rx1612_restart: .annotate 'line', 4 if_null rx1612_debug, debug_796 rx1612_cur."!cursor_debug"("NEXT", "circumfix:sym<[ ]>") debug_796: rx1612_fail: (rx1612_rep, rx1612_pos, $I10, $P10) = rx1612_cur."!mark_fail"(0) lt rx1612_pos, -1, rx1612_done eq rx1612_pos, -1, rx1612_fail jump $I10 rx1612_done: rx1612_cur."!cursor_fail"() if_null rx1612_debug, debug_797 rx1612_cur."!cursor_debug"("FAIL", "circumfix:sym<[ ]>") debug_797: .return (rx1612_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__circumfix:sym<[ ]>" :subid("235_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "[") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "circumfix:sym" :subid("236_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1618_tgt .local int rx1618_pos .local int rx1618_off .local int rx1618_eos .local int rx1618_rep .local pmc rx1618_cur .local pmc rx1618_debug (rx1618_cur, rx1618_pos, rx1618_tgt, $I10) = self."!cursor_start"() getattribute rx1618_debug, rx1618_cur, "$!debug" .lex unicode:"$\x{a2}", rx1618_cur .local pmc match .lex "$/", match length rx1618_eos, rx1618_tgt gt rx1618_pos, rx1618_eos, rx1618_done set rx1618_off, 0 lt rx1618_pos, 2, rx1618_start sub rx1618_off, rx1618_pos, 1 substr rx1618_tgt, rx1618_tgt, rx1618_off rx1618_start: eq $I10, 1, rx1618_restart if_null rx1618_debug, debug_798 rx1618_cur."!cursor_debug"("START", "circumfix:sym") debug_798: $I10 = self.'from'() ne $I10, -1, rxscan1620_done goto rxscan1620_scan rxscan1620_loop: ($P10) = rx1618_cur."from"() inc $P10 set rx1618_pos, $P10 ge rx1618_pos, rx1618_eos, rxscan1620_done rxscan1620_scan: set_addr $I10, rxscan1620_loop rx1618_cur."!mark_push"(0, rx1618_pos, $I10) rxscan1620_done: .annotate 'line', 446 # rx enumcharlist negate=0 zerowidth sub $I10, rx1618_pos, rx1618_off substr $S10, rx1618_tgt, $I10, 1 index $I11, "<", $S10 lt $I11, 0, rx1618_fail # rx subrule "quote_EXPR" subtype=capture negate= rx1618_cur."!cursor_pos"(rx1618_pos) $P10 = rx1618_cur."quote_EXPR"(":q", ":w") unless $P10, rx1618_fail rx1618_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("quote_EXPR") rx1618_pos = $P10."pos"() # rx pass rx1618_cur."!cursor_pass"(rx1618_pos, "circumfix:sym") if_null rx1618_debug, debug_799 rx1618_cur."!cursor_debug"("PASS", "circumfix:sym", " at pos=", rx1618_pos) debug_799: .return (rx1618_cur) rx1618_restart: .annotate 'line', 4 if_null rx1618_debug, debug_800 rx1618_cur."!cursor_debug"("NEXT", "circumfix:sym") debug_800: rx1618_fail: (rx1618_rep, rx1618_pos, $I10, $P10) = rx1618_cur."!mark_fail"(0) lt rx1618_pos, -1, rx1618_done eq rx1618_pos, -1, rx1618_fail jump $I10 rx1618_done: rx1618_cur."!cursor_fail"() if_null rx1618_debug, debug_801 rx1618_cur."!cursor_debug"("FAIL", "circumfix:sym") debug_801: .return (rx1618_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__circumfix:sym" :subid("237_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "<" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub unicode:"circumfix:sym<\x{ab} \x{bb}>" :subid("238_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1622_tgt .local int rx1622_pos .local int rx1622_off .local int rx1622_eos .local int rx1622_rep .local pmc rx1622_cur .local pmc rx1622_debug (rx1622_cur, rx1622_pos, rx1622_tgt, $I10) = self."!cursor_start"() getattribute rx1622_debug, rx1622_cur, "$!debug" .lex unicode:"$\x{a2}", rx1622_cur .local pmc match .lex "$/", match length rx1622_eos, rx1622_tgt gt rx1622_pos, rx1622_eos, rx1622_done set rx1622_off, 0 lt rx1622_pos, 2, rx1622_start sub rx1622_off, rx1622_pos, 1 substr rx1622_tgt, rx1622_tgt, rx1622_off rx1622_start: eq $I10, 1, rx1622_restart if_null rx1622_debug, debug_802 rx1622_cur."!cursor_debug"("START", unicode:"circumfix:sym<\x{ab} \x{bb}>") debug_802: $I10 = self.'from'() ne $I10, -1, rxscan1624_done goto rxscan1624_scan rxscan1624_loop: ($P10) = rx1622_cur."from"() inc $P10 set rx1622_pos, $P10 ge rx1622_pos, rx1622_eos, rxscan1624_done rxscan1624_scan: set_addr $I10, rxscan1624_loop rx1622_cur."!mark_push"(0, rx1622_pos, $I10) rxscan1624_done: .annotate 'line', 447 # rx enumcharlist negate=0 zerowidth sub $I10, rx1622_pos, rx1622_off substr $S10, rx1622_tgt, $I10, 1 index $I11, unicode:"\x{ab}", $S10 lt $I11, 0, rx1622_fail # rx subrule "quote_EXPR" subtype=capture negate= rx1622_cur."!cursor_pos"(rx1622_pos) $P10 = rx1622_cur."quote_EXPR"(":qq", ":w") unless $P10, rx1622_fail rx1622_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("quote_EXPR") rx1622_pos = $P10."pos"() # rx pass rx1622_cur."!cursor_pass"(rx1622_pos, unicode:"circumfix:sym<\x{ab} \x{bb}>") if_null rx1622_debug, debug_803 rx1622_cur."!cursor_debug"("PASS", unicode:"circumfix:sym<\x{ab} \x{bb}>", " at pos=", rx1622_pos) debug_803: .return (rx1622_cur) rx1622_restart: .annotate 'line', 4 if_null rx1622_debug, debug_804 rx1622_cur."!cursor_debug"("NEXT", unicode:"circumfix:sym<\x{ab} \x{bb}>") debug_804: rx1622_fail: (rx1622_rep, rx1622_pos, $I10, $P10) = rx1622_cur."!mark_fail"(0) lt rx1622_pos, -1, rx1622_done eq rx1622_pos, -1, rx1622_fail jump $I10 rx1622_done: rx1622_cur."!cursor_fail"() if_null rx1622_debug, debug_805 rx1622_cur."!cursor_debug"("FAIL", unicode:"circumfix:sym<\x{ab} \x{bb}>") debug_805: .return (rx1622_cur) .return () .end .namespace ["NQP";"Grammar"] .sub unicode:"!PREFIX__circumfix:sym<\x{ab} \x{bb}>" :subid("239_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, unicode:"\x{ab}" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "circumfix:sym<{ }>" :subid("240_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1626_tgt .local int rx1626_pos .local int rx1626_off .local int rx1626_eos .local int rx1626_rep .local pmc rx1626_cur .local pmc rx1626_debug (rx1626_cur, rx1626_pos, rx1626_tgt, $I10) = self."!cursor_start"() getattribute rx1626_debug, rx1626_cur, "$!debug" .lex unicode:"$\x{a2}", rx1626_cur .local pmc match .lex "$/", match length rx1626_eos, rx1626_tgt gt rx1626_pos, rx1626_eos, rx1626_done set rx1626_off, 0 lt rx1626_pos, 2, rx1626_start sub rx1626_off, rx1626_pos, 1 substr rx1626_tgt, rx1626_tgt, rx1626_off rx1626_start: eq $I10, 1, rx1626_restart if_null rx1626_debug, debug_806 rx1626_cur."!cursor_debug"("START", "circumfix:sym<{ }>") debug_806: $I10 = self.'from'() ne $I10, -1, rxscan1628_done goto rxscan1628_scan rxscan1628_loop: ($P10) = rx1626_cur."from"() inc $P10 set rx1626_pos, $P10 ge rx1626_pos, rx1626_eos, rxscan1628_done rxscan1628_scan: set_addr $I10, rxscan1628_loop rx1626_cur."!mark_push"(0, rx1626_pos, $I10) rxscan1628_done: .annotate 'line', 448 # rx enumcharlist negate=0 zerowidth sub $I10, rx1626_pos, rx1626_off substr $S10, rx1626_tgt, $I10, 1 index $I11, "{", $S10 lt $I11, 0, rx1626_fail # rx subrule "pblock" subtype=capture negate= rx1626_cur."!cursor_pos"(rx1626_pos) $P10 = rx1626_cur."pblock"() unless $P10, rx1626_fail rx1626_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("pblock") rx1626_pos = $P10."pos"() # rx pass rx1626_cur."!cursor_pass"(rx1626_pos, "circumfix:sym<{ }>") if_null rx1626_debug, debug_807 rx1626_cur."!cursor_debug"("PASS", "circumfix:sym<{ }>", " at pos=", rx1626_pos) debug_807: .return (rx1626_cur) rx1626_restart: .annotate 'line', 4 if_null rx1626_debug, debug_808 rx1626_cur."!cursor_debug"("NEXT", "circumfix:sym<{ }>") debug_808: rx1626_fail: (rx1626_rep, rx1626_pos, $I10, $P10) = rx1626_cur."!mark_fail"(0) lt rx1626_pos, -1, rx1626_done eq rx1626_pos, -1, rx1626_fail jump $I10 rx1626_done: rx1626_cur."!cursor_fail"() if_null rx1626_debug, debug_809 rx1626_cur."!cursor_debug"("FAIL", "circumfix:sym<{ }>") debug_809: .return (rx1626_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__circumfix:sym<{ }>" :subid("241_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "{" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "circumfix:sym" :subid("242_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1630_tgt .local int rx1630_pos .local int rx1630_off .local int rx1630_eos .local int rx1630_rep .local pmc rx1630_cur .local pmc rx1630_debug (rx1630_cur, rx1630_pos, rx1630_tgt, $I10) = self."!cursor_start"() getattribute rx1630_debug, rx1630_cur, "$!debug" .lex unicode:"$\x{a2}", rx1630_cur .local pmc match .lex "$/", match length rx1630_eos, rx1630_tgt gt rx1630_pos, rx1630_eos, rx1630_done set rx1630_off, 0 lt rx1630_pos, 2, rx1630_start sub rx1630_off, rx1630_pos, 1 substr rx1630_tgt, rx1630_tgt, rx1630_off rx1630_start: eq $I10, 1, rx1630_restart if_null rx1630_debug, debug_810 rx1630_cur."!cursor_debug"("START", "circumfix:sym") debug_810: $I10 = self.'from'() ne $I10, -1, rxscan1632_done goto rxscan1632_scan rxscan1632_loop: ($P10) = rx1630_cur."from"() inc $P10 set rx1630_pos, $P10 ge rx1630_pos, rx1630_eos, rxscan1632_done rxscan1632_scan: set_addr $I10, rxscan1632_loop rx1630_cur."!mark_push"(0, rx1630_pos, $I10) rxscan1632_done: .annotate 'line', 449 # rx subrule "sigil" subtype=capture negate= rx1630_cur."!cursor_pos"(rx1630_pos) $P10 = rx1630_cur."sigil"() unless $P10, rx1630_fail rx1630_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sigil") rx1630_pos = $P10."pos"() # rx literal "(" add $I11, rx1630_pos, 1 gt $I11, rx1630_eos, rx1630_fail sub $I11, rx1630_pos, rx1630_off ord $I11, rx1630_tgt, $I11 ne $I11, 40, rx1630_fail add rx1630_pos, 1 # rx subrule "semilist" subtype=capture negate= rx1630_cur."!cursor_pos"(rx1630_pos) $P10 = rx1630_cur."semilist"() unless $P10, rx1630_fail rx1630_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("semilist") rx1630_pos = $P10."pos"() alt1633_0: set_addr $I10, alt1633_1 rx1630_cur."!mark_push"(0, rx1630_pos, $I10) # rx literal ")" add $I11, rx1630_pos, 1 gt $I11, rx1630_eos, rx1630_fail sub $I11, rx1630_pos, rx1630_off ord $I11, rx1630_tgt, $I11 ne $I11, 41, rx1630_fail add rx1630_pos, 1 goto alt1633_end alt1633_1: # rx subrule "FAILGOAL" subtype=method negate= rx1630_cur."!cursor_pos"(rx1630_pos) $P10 = rx1630_cur."FAILGOAL"("')'") unless $P10, rx1630_fail goto rxsubrule1634_pass rxsubrule1634_back: $P10 = $P10."!cursor_next"() unless $P10, rx1630_fail rxsubrule1634_pass: set_addr $I10, rxsubrule1634_back rx1630_cur."!mark_push"(0, rx1630_pos, $I10, $P10) rx1630_pos = $P10."pos"() alt1633_end: # rx pass rx1630_cur."!cursor_pass"(rx1630_pos, "circumfix:sym") if_null rx1630_debug, debug_811 rx1630_cur."!cursor_debug"("PASS", "circumfix:sym", " at pos=", rx1630_pos) debug_811: .return (rx1630_cur) rx1630_restart: .annotate 'line', 4 if_null rx1630_debug, debug_812 rx1630_cur."!cursor_debug"("NEXT", "circumfix:sym") debug_812: rx1630_fail: (rx1630_rep, rx1630_pos, $I10, $P10) = rx1630_cur."!mark_fail"(0) lt rx1630_pos, -1, rx1630_done eq rx1630_pos, -1, rx1630_fail jump $I10 rx1630_done: rx1630_cur."!cursor_fail"() if_null rx1630_debug, debug_813 rx1630_cur."!cursor_debug"("FAIL", "circumfix:sym") debug_813: .return (rx1630_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__circumfix:sym" :subid("243_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("sigil", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "semilist" :subid("244_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1636_tgt .local int rx1636_pos .local int rx1636_off .local int rx1636_eos .local int rx1636_rep .local pmc rx1636_cur .local pmc rx1636_debug (rx1636_cur, rx1636_pos, rx1636_tgt, $I10) = self."!cursor_start"() getattribute rx1636_debug, rx1636_cur, "$!debug" .lex unicode:"$\x{a2}", rx1636_cur .local pmc match .lex "$/", match length rx1636_eos, rx1636_tgt gt rx1636_pos, rx1636_eos, rx1636_done set rx1636_off, 0 lt rx1636_pos, 2, rx1636_start sub rx1636_off, rx1636_pos, 1 substr rx1636_tgt, rx1636_tgt, rx1636_off rx1636_start: eq $I10, 1, rx1636_restart if_null rx1636_debug, debug_814 rx1636_cur."!cursor_debug"("START", "semilist") debug_814: $I10 = self.'from'() ne $I10, -1, rxscan1638_done goto rxscan1638_scan rxscan1638_loop: ($P10) = rx1636_cur."from"() inc $P10 set rx1636_pos, $P10 ge rx1636_pos, rx1636_eos, rxscan1638_done rxscan1638_scan: set_addr $I10, rxscan1638_loop rx1636_cur."!mark_push"(0, rx1636_pos, $I10) rxscan1638_done: .annotate 'line', 451 # rx subrule "ws" subtype=method negate= rx1636_cur."!cursor_pos"(rx1636_pos) $P10 = rx1636_cur."ws"() unless $P10, rx1636_fail rx1636_pos = $P10."pos"() # rx subrule "statement" subtype=capture negate= rx1636_cur."!cursor_pos"(rx1636_pos) $P10 = rx1636_cur."statement"() unless $P10, rx1636_fail rx1636_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("statement") rx1636_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1636_cur."!cursor_pos"(rx1636_pos) $P10 = rx1636_cur."ws"() unless $P10, rx1636_fail rx1636_pos = $P10."pos"() # rx pass rx1636_cur."!cursor_pass"(rx1636_pos, "semilist") if_null rx1636_debug, debug_815 rx1636_cur."!cursor_debug"("PASS", "semilist", " at pos=", rx1636_pos) debug_815: .return (rx1636_cur) rx1636_restart: .annotate 'line', 4 if_null rx1636_debug, debug_816 rx1636_cur."!cursor_debug"("NEXT", "semilist") debug_816: rx1636_fail: (rx1636_rep, rx1636_pos, $I10, $P10) = rx1636_cur."!mark_fail"(0) lt rx1636_pos, -1, rx1636_done eq rx1636_pos, -1, rx1636_fail jump $I10 rx1636_done: rx1636_cur."!cursor_fail"() if_null rx1636_debug, debug_817 rx1636_cur."!cursor_debug"("FAIL", "semilist") debug_817: .return (rx1636_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__semilist" :subid("245_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infixish" :subid("246_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1640_tgt .local int rx1640_pos .local int rx1640_off .local int rx1640_eos .local int rx1640_rep .local pmc rx1640_cur .local pmc rx1640_debug (rx1640_cur, rx1640_pos, rx1640_tgt, $I10) = self."!cursor_start"() getattribute rx1640_debug, rx1640_cur, "$!debug" .lex unicode:"$\x{a2}", rx1640_cur .local pmc match .lex "$/", match length rx1640_eos, rx1640_tgt gt rx1640_pos, rx1640_eos, rx1640_done set rx1640_off, 0 lt rx1640_pos, 2, rx1640_start sub rx1640_off, rx1640_pos, 1 substr rx1640_tgt, rx1640_tgt, rx1640_off rx1640_start: eq $I10, 1, rx1640_restart if_null rx1640_debug, debug_818 rx1640_cur."!cursor_debug"("START", "infixish") debug_818: $I10 = self.'from'() ne $I10, -1, rxscan1642_done goto rxscan1642_scan rxscan1642_loop: ($P10) = rx1640_cur."from"() inc $P10 set rx1640_pos, $P10 ge rx1640_pos, rx1640_eos, rxscan1642_done rxscan1642_scan: set_addr $I10, rxscan1642_loop rx1640_cur."!mark_push"(0, rx1640_pos, $I10) rxscan1642_done: .annotate 'line', 474 # rx subrule "infixstopper" subtype=zerowidth negate=1 rx1640_cur."!cursor_pos"(rx1640_pos) $P10 = rx1640_cur."infixstopper"() if $P10, rx1640_fail # rx subrule "infix" subtype=capture negate= rx1640_cur."!cursor_pos"(rx1640_pos) $P10 = rx1640_cur."infix"() unless $P10, rx1640_fail rx1640_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("OPER=infix") rx1640_pos = $P10."pos"() # rx pass rx1640_cur."!cursor_pass"(rx1640_pos, "infixish") if_null rx1640_debug, debug_819 rx1640_cur."!cursor_debug"("PASS", "infixish", " at pos=", rx1640_pos) debug_819: .return (rx1640_cur) rx1640_restart: .annotate 'line', 4 if_null rx1640_debug, debug_820 rx1640_cur."!cursor_debug"("NEXT", "infixish") debug_820: rx1640_fail: (rx1640_rep, rx1640_pos, $I10, $P10) = rx1640_cur."!mark_fail"(0) lt rx1640_pos, -1, rx1640_done eq rx1640_pos, -1, rx1640_fail jump $I10 rx1640_done: rx1640_cur."!cursor_fail"() if_null rx1640_debug, debug_821 rx1640_cur."!cursor_debug"("FAIL", "infixish") debug_821: .return (rx1640_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infixish" :subid("247_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "infixstopper" :subid("248_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1644_tgt .local int rx1644_pos .local int rx1644_off .local int rx1644_eos .local int rx1644_rep .local pmc rx1644_cur .local pmc rx1644_debug (rx1644_cur, rx1644_pos, rx1644_tgt, $I10) = self."!cursor_start"() getattribute rx1644_debug, rx1644_cur, "$!debug" .lex unicode:"$\x{a2}", rx1644_cur .local pmc match .lex "$/", match length rx1644_eos, rx1644_tgt gt rx1644_pos, rx1644_eos, rx1644_done set rx1644_off, 0 lt rx1644_pos, 2, rx1644_start sub rx1644_off, rx1644_pos, 1 substr rx1644_tgt, rx1644_tgt, rx1644_off rx1644_start: eq $I10, 1, rx1644_restart if_null rx1644_debug, debug_822 rx1644_cur."!cursor_debug"("START", "infixstopper") debug_822: $I10 = self.'from'() ne $I10, -1, rxscan1646_done goto rxscan1646_scan rxscan1646_loop: ($P10) = rx1644_cur."from"() inc $P10 set rx1644_pos, $P10 ge rx1644_pos, rx1644_eos, rxscan1646_done rxscan1646_scan: set_addr $I10, rxscan1646_loop rx1644_cur."!mark_push"(0, rx1644_pos, $I10) rxscan1646_done: .annotate 'line', 475 # rx subrule "lambda" subtype=zerowidth negate= rx1644_cur."!cursor_pos"(rx1644_pos) $P10 = rx1644_cur."lambda"() unless $P10, rx1644_fail # rx pass rx1644_cur."!cursor_pass"(rx1644_pos, "infixstopper") if_null rx1644_debug, debug_823 rx1644_cur."!cursor_debug"("PASS", "infixstopper", " at pos=", rx1644_pos) debug_823: .return (rx1644_cur) rx1644_restart: .annotate 'line', 4 if_null rx1644_debug, debug_824 rx1644_cur."!cursor_debug"("NEXT", "infixstopper") debug_824: rx1644_fail: (rx1644_rep, rx1644_pos, $I10, $P10) = rx1644_cur."!mark_fail"(0) lt rx1644_pos, -1, rx1644_done eq rx1644_pos, -1, rx1644_fail jump $I10 rx1644_done: rx1644_cur."!cursor_fail"() if_null rx1644_debug, debug_825 rx1644_cur."!cursor_debug"("FAIL", "infixstopper") debug_825: .return (rx1644_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infixstopper" :subid("249_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "postcircumfix:sym<[ ]>" :subid("250_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1648_tgt .local int rx1648_pos .local int rx1648_off .local int rx1648_eos .local int rx1648_rep .local pmc rx1648_cur .local pmc rx1648_debug (rx1648_cur, rx1648_pos, rx1648_tgt, $I10) = self."!cursor_start"() getattribute rx1648_debug, rx1648_cur, "$!debug" .lex unicode:"$\x{a2}", rx1648_cur .local pmc match .lex "$/", match length rx1648_eos, rx1648_tgt gt rx1648_pos, rx1648_eos, rx1648_done set rx1648_off, 0 lt rx1648_pos, 2, rx1648_start sub rx1648_off, rx1648_pos, 1 substr rx1648_tgt, rx1648_tgt, rx1648_off rx1648_start: eq $I10, 1, rx1648_restart if_null rx1648_debug, debug_826 rx1648_cur."!cursor_debug"("START", "postcircumfix:sym<[ ]>") debug_826: $I10 = self.'from'() ne $I10, -1, rxscan1650_done goto rxscan1650_scan rxscan1650_loop: ($P10) = rx1648_cur."from"() inc $P10 set rx1648_pos, $P10 ge rx1648_pos, rx1648_eos, rxscan1650_done rxscan1650_scan: set_addr $I10, rxscan1650_loop rx1648_cur."!mark_push"(0, rx1648_pos, $I10) rxscan1650_done: .annotate 'line', 478 # rx literal "[" add $I11, rx1648_pos, 1 gt $I11, rx1648_eos, rx1648_fail sub $I11, rx1648_pos, rx1648_off ord $I11, rx1648_tgt, $I11 ne $I11, 91, rx1648_fail add rx1648_pos, 1 # rx subrule "ws" subtype=method negate= rx1648_cur."!cursor_pos"(rx1648_pos) $P10 = rx1648_cur."ws"() unless $P10, rx1648_fail rx1648_pos = $P10."pos"() # rx subrule "EXPR" subtype=capture negate= rx1648_cur."!cursor_pos"(rx1648_pos) $P10 = rx1648_cur."EXPR"() unless $P10, rx1648_fail rx1648_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("EXPR") rx1648_pos = $P10."pos"() # rx literal "]" add $I11, rx1648_pos, 1 gt $I11, rx1648_eos, rx1648_fail sub $I11, rx1648_pos, rx1648_off ord $I11, rx1648_tgt, $I11 ne $I11, 93, rx1648_fail add rx1648_pos, 1 .annotate 'line', 479 # rx subrule "O" subtype=capture negate= rx1648_cur."!cursor_pos"(rx1648_pos) $P10 = rx1648_cur."O"("%methodop") unless $P10, rx1648_fail rx1648_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1648_pos = $P10."pos"() .annotate 'line', 477 # rx pass rx1648_cur."!cursor_pass"(rx1648_pos, "postcircumfix:sym<[ ]>") if_null rx1648_debug, debug_827 rx1648_cur."!cursor_debug"("PASS", "postcircumfix:sym<[ ]>", " at pos=", rx1648_pos) debug_827: .return (rx1648_cur) rx1648_restart: .annotate 'line', 4 if_null rx1648_debug, debug_828 rx1648_cur."!cursor_debug"("NEXT", "postcircumfix:sym<[ ]>") debug_828: rx1648_fail: (rx1648_rep, rx1648_pos, $I10, $P10) = rx1648_cur."!mark_fail"(0) lt rx1648_pos, -1, rx1648_done eq rx1648_pos, -1, rx1648_fail jump $I10 rx1648_done: rx1648_cur."!cursor_fail"() if_null rx1648_debug, debug_829 rx1648_cur."!cursor_debug"("FAIL", "postcircumfix:sym<[ ]>") debug_829: .return (rx1648_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__postcircumfix:sym<[ ]>" :subid("251_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "[") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "postcircumfix:sym<{ }>" :subid("252_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1652_tgt .local int rx1652_pos .local int rx1652_off .local int rx1652_eos .local int rx1652_rep .local pmc rx1652_cur .local pmc rx1652_debug (rx1652_cur, rx1652_pos, rx1652_tgt, $I10) = self."!cursor_start"() getattribute rx1652_debug, rx1652_cur, "$!debug" .lex unicode:"$\x{a2}", rx1652_cur .local pmc match .lex "$/", match length rx1652_eos, rx1652_tgt gt rx1652_pos, rx1652_eos, rx1652_done set rx1652_off, 0 lt rx1652_pos, 2, rx1652_start sub rx1652_off, rx1652_pos, 1 substr rx1652_tgt, rx1652_tgt, rx1652_off rx1652_start: eq $I10, 1, rx1652_restart if_null rx1652_debug, debug_830 rx1652_cur."!cursor_debug"("START", "postcircumfix:sym<{ }>") debug_830: $I10 = self.'from'() ne $I10, -1, rxscan1654_done goto rxscan1654_scan rxscan1654_loop: ($P10) = rx1652_cur."from"() inc $P10 set rx1652_pos, $P10 ge rx1652_pos, rx1652_eos, rxscan1654_done rxscan1654_scan: set_addr $I10, rxscan1654_loop rx1652_cur."!mark_push"(0, rx1652_pos, $I10) rxscan1654_done: .annotate 'line', 483 # rx literal "{" add $I11, rx1652_pos, 1 gt $I11, rx1652_eos, rx1652_fail sub $I11, rx1652_pos, rx1652_off ord $I11, rx1652_tgt, $I11 ne $I11, 123, rx1652_fail add rx1652_pos, 1 # rx subrule "ws" subtype=method negate= rx1652_cur."!cursor_pos"(rx1652_pos) $P10 = rx1652_cur."ws"() unless $P10, rx1652_fail rx1652_pos = $P10."pos"() # rx subrule "EXPR" subtype=capture negate= rx1652_cur."!cursor_pos"(rx1652_pos) $P10 = rx1652_cur."EXPR"() unless $P10, rx1652_fail rx1652_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("EXPR") rx1652_pos = $P10."pos"() # rx literal "}" add $I11, rx1652_pos, 1 gt $I11, rx1652_eos, rx1652_fail sub $I11, rx1652_pos, rx1652_off ord $I11, rx1652_tgt, $I11 ne $I11, 125, rx1652_fail add rx1652_pos, 1 .annotate 'line', 484 # rx subrule "O" subtype=capture negate= rx1652_cur."!cursor_pos"(rx1652_pos) $P10 = rx1652_cur."O"("%methodop") unless $P10, rx1652_fail rx1652_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1652_pos = $P10."pos"() .annotate 'line', 482 # rx pass rx1652_cur."!cursor_pass"(rx1652_pos, "postcircumfix:sym<{ }>") if_null rx1652_debug, debug_831 rx1652_cur."!cursor_debug"("PASS", "postcircumfix:sym<{ }>", " at pos=", rx1652_pos) debug_831: .return (rx1652_cur) rx1652_restart: .annotate 'line', 4 if_null rx1652_debug, debug_832 rx1652_cur."!cursor_debug"("NEXT", "postcircumfix:sym<{ }>") debug_832: rx1652_fail: (rx1652_rep, rx1652_pos, $I10, $P10) = rx1652_cur."!mark_fail"(0) lt rx1652_pos, -1, rx1652_done eq rx1652_pos, -1, rx1652_fail jump $I10 rx1652_done: rx1652_cur."!cursor_fail"() if_null rx1652_debug, debug_833 rx1652_cur."!cursor_debug"("FAIL", "postcircumfix:sym<{ }>") debug_833: .return (rx1652_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__postcircumfix:sym<{ }>" :subid("253_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "{") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "postcircumfix:sym" :subid("254_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1656_tgt .local int rx1656_pos .local int rx1656_off .local int rx1656_eos .local int rx1656_rep .local pmc rx1656_cur .local pmc rx1656_debug (rx1656_cur, rx1656_pos, rx1656_tgt, $I10) = self."!cursor_start"() getattribute rx1656_debug, rx1656_cur, "$!debug" .lex unicode:"$\x{a2}", rx1656_cur .local pmc match .lex "$/", match length rx1656_eos, rx1656_tgt gt rx1656_pos, rx1656_eos, rx1656_done set rx1656_off, 0 lt rx1656_pos, 2, rx1656_start sub rx1656_off, rx1656_pos, 1 substr rx1656_tgt, rx1656_tgt, rx1656_off rx1656_start: eq $I10, 1, rx1656_restart if_null rx1656_debug, debug_834 rx1656_cur."!cursor_debug"("START", "postcircumfix:sym") debug_834: $I10 = self.'from'() ne $I10, -1, rxscan1658_done goto rxscan1658_scan rxscan1658_loop: ($P10) = rx1656_cur."from"() inc $P10 set rx1656_pos, $P10 ge rx1656_pos, rx1656_eos, rxscan1658_done rxscan1658_scan: set_addr $I10, rxscan1658_loop rx1656_cur."!mark_push"(0, rx1656_pos, $I10) rxscan1658_done: .annotate 'line', 488 # rx enumcharlist negate=0 zerowidth sub $I10, rx1656_pos, rx1656_off substr $S10, rx1656_tgt, $I10, 1 index $I11, "<", $S10 lt $I11, 0, rx1656_fail # rx subrule "quote_EXPR" subtype=capture negate= rx1656_cur."!cursor_pos"(rx1656_pos) $P10 = rx1656_cur."quote_EXPR"(":q") unless $P10, rx1656_fail rx1656_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("quote_EXPR") rx1656_pos = $P10."pos"() .annotate 'line', 489 # rx subrule "O" subtype=capture negate= rx1656_cur."!cursor_pos"(rx1656_pos) $P10 = rx1656_cur."O"("%methodop") unless $P10, rx1656_fail rx1656_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1656_pos = $P10."pos"() .annotate 'line', 487 # rx pass rx1656_cur."!cursor_pass"(rx1656_pos, "postcircumfix:sym") if_null rx1656_debug, debug_835 rx1656_cur."!cursor_debug"("PASS", "postcircumfix:sym", " at pos=", rx1656_pos) debug_835: .return (rx1656_cur) rx1656_restart: .annotate 'line', 4 if_null rx1656_debug, debug_836 rx1656_cur."!cursor_debug"("NEXT", "postcircumfix:sym") debug_836: rx1656_fail: (rx1656_rep, rx1656_pos, $I10, $P10) = rx1656_cur."!mark_fail"(0) lt rx1656_pos, -1, rx1656_done eq rx1656_pos, -1, rx1656_fail jump $I10 rx1656_done: rx1656_cur."!cursor_fail"() if_null rx1656_debug, debug_837 rx1656_cur."!cursor_debug"("FAIL", "postcircumfix:sym") debug_837: .return (rx1656_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__postcircumfix:sym" :subid("255_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "<" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "postcircumfix:sym<( )>" :subid("256_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1660_tgt .local int rx1660_pos .local int rx1660_off .local int rx1660_eos .local int rx1660_rep .local pmc rx1660_cur .local pmc rx1660_debug (rx1660_cur, rx1660_pos, rx1660_tgt, $I10) = self."!cursor_start"() getattribute rx1660_debug, rx1660_cur, "$!debug" .lex unicode:"$\x{a2}", rx1660_cur .local pmc match .lex "$/", match length rx1660_eos, rx1660_tgt gt rx1660_pos, rx1660_eos, rx1660_done set rx1660_off, 0 lt rx1660_pos, 2, rx1660_start sub rx1660_off, rx1660_pos, 1 substr rx1660_tgt, rx1660_tgt, rx1660_off rx1660_start: eq $I10, 1, rx1660_restart if_null rx1660_debug, debug_838 rx1660_cur."!cursor_debug"("START", "postcircumfix:sym<( )>") debug_838: $I10 = self.'from'() ne $I10, -1, rxscan1662_done goto rxscan1662_scan rxscan1662_loop: ($P10) = rx1660_cur."from"() inc $P10 set rx1660_pos, $P10 ge rx1660_pos, rx1660_eos, rxscan1662_done rxscan1662_scan: set_addr $I10, rxscan1662_loop rx1660_cur."!mark_push"(0, rx1660_pos, $I10) rxscan1662_done: .annotate 'line', 493 # rx literal "(" add $I11, rx1660_pos, 1 gt $I11, rx1660_eos, rx1660_fail sub $I11, rx1660_pos, rx1660_off ord $I11, rx1660_tgt, $I11 ne $I11, 40, rx1660_fail add rx1660_pos, 1 # rx subrule "ws" subtype=method negate= rx1660_cur."!cursor_pos"(rx1660_pos) $P10 = rx1660_cur."ws"() unless $P10, rx1660_fail rx1660_pos = $P10."pos"() # rx subrule "arglist" subtype=capture negate= rx1660_cur."!cursor_pos"(rx1660_pos) $P10 = rx1660_cur."arglist"() unless $P10, rx1660_fail rx1660_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("arglist") rx1660_pos = $P10."pos"() # rx literal ")" add $I11, rx1660_pos, 1 gt $I11, rx1660_eos, rx1660_fail sub $I11, rx1660_pos, rx1660_off ord $I11, rx1660_tgt, $I11 ne $I11, 41, rx1660_fail add rx1660_pos, 1 .annotate 'line', 494 # rx subrule "O" subtype=capture negate= rx1660_cur."!cursor_pos"(rx1660_pos) $P10 = rx1660_cur."O"("%methodop") unless $P10, rx1660_fail rx1660_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1660_pos = $P10."pos"() .annotate 'line', 492 # rx pass rx1660_cur."!cursor_pass"(rx1660_pos, "postcircumfix:sym<( )>") if_null rx1660_debug, debug_839 rx1660_cur."!cursor_debug"("PASS", "postcircumfix:sym<( )>", " at pos=", rx1660_pos) debug_839: .return (rx1660_cur) rx1660_restart: .annotate 'line', 4 if_null rx1660_debug, debug_840 rx1660_cur."!cursor_debug"("NEXT", "postcircumfix:sym<( )>") debug_840: rx1660_fail: (rx1660_rep, rx1660_pos, $I10, $P10) = rx1660_cur."!mark_fail"(0) lt rx1660_pos, -1, rx1660_done eq rx1660_pos, -1, rx1660_fail jump $I10 rx1660_done: rx1660_cur."!cursor_fail"() if_null rx1660_debug, debug_841 rx1660_cur."!cursor_debug"("FAIL", "postcircumfix:sym<( )>") debug_841: .return (rx1660_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__postcircumfix:sym<( )>" :subid("257_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "(") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "postfix:sym<.>" :subid("258_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1664_tgt .local int rx1664_pos .local int rx1664_off .local int rx1664_eos .local int rx1664_rep .local pmc rx1664_cur .local pmc rx1664_debug (rx1664_cur, rx1664_pos, rx1664_tgt, $I10) = self."!cursor_start"() getattribute rx1664_debug, rx1664_cur, "$!debug" .lex unicode:"$\x{a2}", rx1664_cur .local pmc match .lex "$/", match length rx1664_eos, rx1664_tgt gt rx1664_pos, rx1664_eos, rx1664_done set rx1664_off, 0 lt rx1664_pos, 2, rx1664_start sub rx1664_off, rx1664_pos, 1 substr rx1664_tgt, rx1664_tgt, rx1664_off rx1664_start: eq $I10, 1, rx1664_restart if_null rx1664_debug, debug_842 rx1664_cur."!cursor_debug"("START", "postfix:sym<.>") debug_842: $I10 = self.'from'() ne $I10, -1, rxscan1666_done goto rxscan1666_scan rxscan1666_loop: ($P10) = rx1664_cur."from"() inc $P10 set rx1664_pos, $P10 ge rx1664_pos, rx1664_eos, rxscan1666_done rxscan1666_scan: set_addr $I10, rxscan1666_loop rx1664_cur."!mark_push"(0, rx1664_pos, $I10) rxscan1666_done: .annotate 'line', 497 # rx subrule "dotty" subtype=capture negate= rx1664_cur."!cursor_pos"(rx1664_pos) $P10 = rx1664_cur."dotty"() unless $P10, rx1664_fail rx1664_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("dotty") rx1664_pos = $P10."pos"() # rx subrule "O" subtype=capture negate= rx1664_cur."!cursor_pos"(rx1664_pos) $P10 = rx1664_cur."O"("%methodop") unless $P10, rx1664_fail rx1664_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1664_pos = $P10."pos"() # rx pass rx1664_cur."!cursor_pass"(rx1664_pos, "postfix:sym<.>") if_null rx1664_debug, debug_843 rx1664_cur."!cursor_debug"("PASS", "postfix:sym<.>", " at pos=", rx1664_pos) debug_843: .return (rx1664_cur) rx1664_restart: .annotate 'line', 4 if_null rx1664_debug, debug_844 rx1664_cur."!cursor_debug"("NEXT", "postfix:sym<.>") debug_844: rx1664_fail: (rx1664_rep, rx1664_pos, $I10, $P10) = rx1664_cur."!mark_fail"(0) lt rx1664_pos, -1, rx1664_done eq rx1664_pos, -1, rx1664_fail jump $I10 rx1664_done: rx1664_cur."!cursor_fail"() if_null rx1664_debug, debug_845 rx1664_cur."!cursor_debug"("FAIL", "postfix:sym<.>") debug_845: .return (rx1664_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__postfix:sym<.>" :subid("259_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("dotty", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "prefix:sym<++>" :subid("260_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1668_tgt .local int rx1668_pos .local int rx1668_off .local int rx1668_eos .local int rx1668_rep .local pmc rx1668_cur .local pmc rx1668_debug (rx1668_cur, rx1668_pos, rx1668_tgt, $I10) = self."!cursor_start"() getattribute rx1668_debug, rx1668_cur, "$!debug" .lex unicode:"$\x{a2}", rx1668_cur .local pmc match .lex "$/", match length rx1668_eos, rx1668_tgt gt rx1668_pos, rx1668_eos, rx1668_done set rx1668_off, 0 lt rx1668_pos, 2, rx1668_start sub rx1668_off, rx1668_pos, 1 substr rx1668_tgt, rx1668_tgt, rx1668_off rx1668_start: eq $I10, 1, rx1668_restart if_null rx1668_debug, debug_846 rx1668_cur."!cursor_debug"("START", "prefix:sym<++>") debug_846: $I10 = self.'from'() ne $I10, -1, rxscan1670_done goto rxscan1670_scan rxscan1670_loop: ($P10) = rx1668_cur."from"() inc $P10 set rx1668_pos, $P10 ge rx1668_pos, rx1668_eos, rxscan1670_done rxscan1670_scan: set_addr $I10, rxscan1670_loop rx1668_cur."!mark_push"(0, rx1668_pos, $I10) rxscan1670_done: .annotate 'line', 499 # rx subcapture "sym" set_addr $I10, rxcap_1671_fail rx1668_cur."!mark_push"(0, rx1668_pos, $I10) # rx literal "++" add $I11, rx1668_pos, 2 gt $I11, rx1668_eos, rx1668_fail sub $I11, rx1668_pos, rx1668_off substr $S10, rx1668_tgt, $I11, 2 ne $S10, "++", rx1668_fail add rx1668_pos, 2 set_addr $I10, rxcap_1671_fail ($I12, $I11) = rx1668_cur."!mark_peek"($I10) rx1668_cur."!cursor_pos"($I11) ($P10) = rx1668_cur."!cursor_start"() $P10."!cursor_pass"(rx1668_pos, "") rx1668_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1671_done rxcap_1671_fail: goto rx1668_fail rxcap_1671_done: # rx subrule "O" subtype=capture negate= rx1668_cur."!cursor_pos"(rx1668_pos) $P10 = rx1668_cur."O"("%autoincrement, :pirop") unless $P10, rx1668_fail rx1668_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1668_pos = $P10."pos"() # rx pass rx1668_cur."!cursor_pass"(rx1668_pos, "prefix:sym<++>") if_null rx1668_debug, debug_847 rx1668_cur."!cursor_debug"("PASS", "prefix:sym<++>", " at pos=", rx1668_pos) debug_847: .return (rx1668_cur) rx1668_restart: .annotate 'line', 4 if_null rx1668_debug, debug_848 rx1668_cur."!cursor_debug"("NEXT", "prefix:sym<++>") debug_848: rx1668_fail: (rx1668_rep, rx1668_pos, $I10, $P10) = rx1668_cur."!mark_fail"(0) lt rx1668_pos, -1, rx1668_done eq rx1668_pos, -1, rx1668_fail jump $I10 rx1668_done: rx1668_cur."!cursor_fail"() if_null rx1668_debug, debug_849 rx1668_cur."!cursor_debug"("FAIL", "prefix:sym<++>") debug_849: .return (rx1668_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__prefix:sym<++>" :subid("261_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "++") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "prefix:sym<-->" :subid("262_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1673_tgt .local int rx1673_pos .local int rx1673_off .local int rx1673_eos .local int rx1673_rep .local pmc rx1673_cur .local pmc rx1673_debug (rx1673_cur, rx1673_pos, rx1673_tgt, $I10) = self."!cursor_start"() getattribute rx1673_debug, rx1673_cur, "$!debug" .lex unicode:"$\x{a2}", rx1673_cur .local pmc match .lex "$/", match length rx1673_eos, rx1673_tgt gt rx1673_pos, rx1673_eos, rx1673_done set rx1673_off, 0 lt rx1673_pos, 2, rx1673_start sub rx1673_off, rx1673_pos, 1 substr rx1673_tgt, rx1673_tgt, rx1673_off rx1673_start: eq $I10, 1, rx1673_restart if_null rx1673_debug, debug_850 rx1673_cur."!cursor_debug"("START", "prefix:sym<-->") debug_850: $I10 = self.'from'() ne $I10, -1, rxscan1675_done goto rxscan1675_scan rxscan1675_loop: ($P10) = rx1673_cur."from"() inc $P10 set rx1673_pos, $P10 ge rx1673_pos, rx1673_eos, rxscan1675_done rxscan1675_scan: set_addr $I10, rxscan1675_loop rx1673_cur."!mark_push"(0, rx1673_pos, $I10) rxscan1675_done: .annotate 'line', 500 # rx subcapture "sym" set_addr $I10, rxcap_1676_fail rx1673_cur."!mark_push"(0, rx1673_pos, $I10) # rx literal "--" add $I11, rx1673_pos, 2 gt $I11, rx1673_eos, rx1673_fail sub $I11, rx1673_pos, rx1673_off substr $S10, rx1673_tgt, $I11, 2 ne $S10, "--", rx1673_fail add rx1673_pos, 2 set_addr $I10, rxcap_1676_fail ($I12, $I11) = rx1673_cur."!mark_peek"($I10) rx1673_cur."!cursor_pos"($I11) ($P10) = rx1673_cur."!cursor_start"() $P10."!cursor_pass"(rx1673_pos, "") rx1673_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1676_done rxcap_1676_fail: goto rx1673_fail rxcap_1676_done: # rx subrule "O" subtype=capture negate= rx1673_cur."!cursor_pos"(rx1673_pos) $P10 = rx1673_cur."O"("%autoincrement, :pirop") unless $P10, rx1673_fail rx1673_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1673_pos = $P10."pos"() # rx pass rx1673_cur."!cursor_pass"(rx1673_pos, "prefix:sym<-->") if_null rx1673_debug, debug_851 rx1673_cur."!cursor_debug"("PASS", "prefix:sym<-->", " at pos=", rx1673_pos) debug_851: .return (rx1673_cur) rx1673_restart: .annotate 'line', 4 if_null rx1673_debug, debug_852 rx1673_cur."!cursor_debug"("NEXT", "prefix:sym<-->") debug_852: rx1673_fail: (rx1673_rep, rx1673_pos, $I10, $P10) = rx1673_cur."!mark_fail"(0) lt rx1673_pos, -1, rx1673_done eq rx1673_pos, -1, rx1673_fail jump $I10 rx1673_done: rx1673_cur."!cursor_fail"() if_null rx1673_debug, debug_853 rx1673_cur."!cursor_debug"("FAIL", "prefix:sym<-->") debug_853: .return (rx1673_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__prefix:sym<-->" :subid("263_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "--") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "postfix:sym<++>" :subid("264_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1678_tgt .local int rx1678_pos .local int rx1678_off .local int rx1678_eos .local int rx1678_rep .local pmc rx1678_cur .local pmc rx1678_debug (rx1678_cur, rx1678_pos, rx1678_tgt, $I10) = self."!cursor_start"() getattribute rx1678_debug, rx1678_cur, "$!debug" .lex unicode:"$\x{a2}", rx1678_cur .local pmc match .lex "$/", match length rx1678_eos, rx1678_tgt gt rx1678_pos, rx1678_eos, rx1678_done set rx1678_off, 0 lt rx1678_pos, 2, rx1678_start sub rx1678_off, rx1678_pos, 1 substr rx1678_tgt, rx1678_tgt, rx1678_off rx1678_start: eq $I10, 1, rx1678_restart if_null rx1678_debug, debug_854 rx1678_cur."!cursor_debug"("START", "postfix:sym<++>") debug_854: $I10 = self.'from'() ne $I10, -1, rxscan1680_done goto rxscan1680_scan rxscan1680_loop: ($P10) = rx1678_cur."from"() inc $P10 set rx1678_pos, $P10 ge rx1678_pos, rx1678_eos, rxscan1680_done rxscan1680_scan: set_addr $I10, rxscan1680_loop rx1678_cur."!mark_push"(0, rx1678_pos, $I10) rxscan1680_done: .annotate 'line', 503 # rx subcapture "sym" set_addr $I10, rxcap_1681_fail rx1678_cur."!mark_push"(0, rx1678_pos, $I10) # rx literal "++" add $I11, rx1678_pos, 2 gt $I11, rx1678_eos, rx1678_fail sub $I11, rx1678_pos, rx1678_off substr $S10, rx1678_tgt, $I11, 2 ne $S10, "++", rx1678_fail add rx1678_pos, 2 set_addr $I10, rxcap_1681_fail ($I12, $I11) = rx1678_cur."!mark_peek"($I10) rx1678_cur."!cursor_pos"($I11) ($P10) = rx1678_cur."!cursor_start"() $P10."!cursor_pass"(rx1678_pos, "") rx1678_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1681_done rxcap_1681_fail: goto rx1678_fail rxcap_1681_done: # rx subrule "O" subtype=capture negate= rx1678_cur."!cursor_pos"(rx1678_pos) $P10 = rx1678_cur."O"("%autoincrement") unless $P10, rx1678_fail rx1678_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1678_pos = $P10."pos"() # rx pass rx1678_cur."!cursor_pass"(rx1678_pos, "postfix:sym<++>") if_null rx1678_debug, debug_855 rx1678_cur."!cursor_debug"("PASS", "postfix:sym<++>", " at pos=", rx1678_pos) debug_855: .return (rx1678_cur) rx1678_restart: .annotate 'line', 4 if_null rx1678_debug, debug_856 rx1678_cur."!cursor_debug"("NEXT", "postfix:sym<++>") debug_856: rx1678_fail: (rx1678_rep, rx1678_pos, $I10, $P10) = rx1678_cur."!mark_fail"(0) lt rx1678_pos, -1, rx1678_done eq rx1678_pos, -1, rx1678_fail jump $I10 rx1678_done: rx1678_cur."!cursor_fail"() if_null rx1678_debug, debug_857 rx1678_cur."!cursor_debug"("FAIL", "postfix:sym<++>") debug_857: .return (rx1678_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__postfix:sym<++>" :subid("265_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "++") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "postfix:sym<-->" :subid("266_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1683_tgt .local int rx1683_pos .local int rx1683_off .local int rx1683_eos .local int rx1683_rep .local pmc rx1683_cur .local pmc rx1683_debug (rx1683_cur, rx1683_pos, rx1683_tgt, $I10) = self."!cursor_start"() getattribute rx1683_debug, rx1683_cur, "$!debug" .lex unicode:"$\x{a2}", rx1683_cur .local pmc match .lex "$/", match length rx1683_eos, rx1683_tgt gt rx1683_pos, rx1683_eos, rx1683_done set rx1683_off, 0 lt rx1683_pos, 2, rx1683_start sub rx1683_off, rx1683_pos, 1 substr rx1683_tgt, rx1683_tgt, rx1683_off rx1683_start: eq $I10, 1, rx1683_restart if_null rx1683_debug, debug_858 rx1683_cur."!cursor_debug"("START", "postfix:sym<-->") debug_858: $I10 = self.'from'() ne $I10, -1, rxscan1685_done goto rxscan1685_scan rxscan1685_loop: ($P10) = rx1683_cur."from"() inc $P10 set rx1683_pos, $P10 ge rx1683_pos, rx1683_eos, rxscan1685_done rxscan1685_scan: set_addr $I10, rxscan1685_loop rx1683_cur."!mark_push"(0, rx1683_pos, $I10) rxscan1685_done: .annotate 'line', 504 # rx subcapture "sym" set_addr $I10, rxcap_1686_fail rx1683_cur."!mark_push"(0, rx1683_pos, $I10) # rx literal "--" add $I11, rx1683_pos, 2 gt $I11, rx1683_eos, rx1683_fail sub $I11, rx1683_pos, rx1683_off substr $S10, rx1683_tgt, $I11, 2 ne $S10, "--", rx1683_fail add rx1683_pos, 2 set_addr $I10, rxcap_1686_fail ($I12, $I11) = rx1683_cur."!mark_peek"($I10) rx1683_cur."!cursor_pos"($I11) ($P10) = rx1683_cur."!cursor_start"() $P10."!cursor_pass"(rx1683_pos, "") rx1683_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1686_done rxcap_1686_fail: goto rx1683_fail rxcap_1686_done: # rx subrule "O" subtype=capture negate= rx1683_cur."!cursor_pos"(rx1683_pos) $P10 = rx1683_cur."O"("%autoincrement") unless $P10, rx1683_fail rx1683_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1683_pos = $P10."pos"() # rx pass rx1683_cur."!cursor_pass"(rx1683_pos, "postfix:sym<-->") if_null rx1683_debug, debug_859 rx1683_cur."!cursor_debug"("PASS", "postfix:sym<-->", " at pos=", rx1683_pos) debug_859: .return (rx1683_cur) rx1683_restart: .annotate 'line', 4 if_null rx1683_debug, debug_860 rx1683_cur."!cursor_debug"("NEXT", "postfix:sym<-->") debug_860: rx1683_fail: (rx1683_rep, rx1683_pos, $I10, $P10) = rx1683_cur."!mark_fail"(0) lt rx1683_pos, -1, rx1683_done eq rx1683_pos, -1, rx1683_fail jump $I10 rx1683_done: rx1683_cur."!cursor_fail"() if_null rx1683_debug, debug_861 rx1683_cur."!cursor_debug"("FAIL", "postfix:sym<-->") debug_861: .return (rx1683_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__postfix:sym<-->" :subid("267_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "--") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<**>" :subid("268_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1688_tgt .local int rx1688_pos .local int rx1688_off .local int rx1688_eos .local int rx1688_rep .local pmc rx1688_cur .local pmc rx1688_debug (rx1688_cur, rx1688_pos, rx1688_tgt, $I10) = self."!cursor_start"() getattribute rx1688_debug, rx1688_cur, "$!debug" .lex unicode:"$\x{a2}", rx1688_cur .local pmc match .lex "$/", match length rx1688_eos, rx1688_tgt gt rx1688_pos, rx1688_eos, rx1688_done set rx1688_off, 0 lt rx1688_pos, 2, rx1688_start sub rx1688_off, rx1688_pos, 1 substr rx1688_tgt, rx1688_tgt, rx1688_off rx1688_start: eq $I10, 1, rx1688_restart if_null rx1688_debug, debug_862 rx1688_cur."!cursor_debug"("START", "infix:sym<**>") debug_862: $I10 = self.'from'() ne $I10, -1, rxscan1690_done goto rxscan1690_scan rxscan1690_loop: ($P10) = rx1688_cur."from"() inc $P10 set rx1688_pos, $P10 ge rx1688_pos, rx1688_eos, rxscan1690_done rxscan1690_scan: set_addr $I10, rxscan1690_loop rx1688_cur."!mark_push"(0, rx1688_pos, $I10) rxscan1690_done: .annotate 'line', 506 # rx subcapture "sym" set_addr $I10, rxcap_1691_fail rx1688_cur."!mark_push"(0, rx1688_pos, $I10) # rx literal "**" add $I11, rx1688_pos, 2 gt $I11, rx1688_eos, rx1688_fail sub $I11, rx1688_pos, rx1688_off substr $S10, rx1688_tgt, $I11, 2 ne $S10, "**", rx1688_fail add rx1688_pos, 2 set_addr $I10, rxcap_1691_fail ($I12, $I11) = rx1688_cur."!mark_peek"($I10) rx1688_cur."!cursor_pos"($I11) ($P10) = rx1688_cur."!cursor_start"() $P10."!cursor_pass"(rx1688_pos, "") rx1688_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1691_done rxcap_1691_fail: goto rx1688_fail rxcap_1691_done: # rx subrule "O" subtype=capture negate= rx1688_cur."!cursor_pos"(rx1688_pos) $P10 = rx1688_cur."O"("%exponentiation, :pirop") unless $P10, rx1688_fail rx1688_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1688_pos = $P10."pos"() # rx pass rx1688_cur."!cursor_pass"(rx1688_pos, "infix:sym<**>") if_null rx1688_debug, debug_863 rx1688_cur."!cursor_debug"("PASS", "infix:sym<**>", " at pos=", rx1688_pos) debug_863: .return (rx1688_cur) rx1688_restart: .annotate 'line', 4 if_null rx1688_debug, debug_864 rx1688_cur."!cursor_debug"("NEXT", "infix:sym<**>") debug_864: rx1688_fail: (rx1688_rep, rx1688_pos, $I10, $P10) = rx1688_cur."!mark_fail"(0) lt rx1688_pos, -1, rx1688_done eq rx1688_pos, -1, rx1688_fail jump $I10 rx1688_done: rx1688_cur."!cursor_fail"() if_null rx1688_debug, debug_865 rx1688_cur."!cursor_debug"("FAIL", "infix:sym<**>") debug_865: .return (rx1688_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<**>" :subid("269_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "**") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "prefix:sym<+>" :subid("270_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1693_tgt .local int rx1693_pos .local int rx1693_off .local int rx1693_eos .local int rx1693_rep .local pmc rx1693_cur .local pmc rx1693_debug (rx1693_cur, rx1693_pos, rx1693_tgt, $I10) = self."!cursor_start"() getattribute rx1693_debug, rx1693_cur, "$!debug" .lex unicode:"$\x{a2}", rx1693_cur .local pmc match .lex "$/", match length rx1693_eos, rx1693_tgt gt rx1693_pos, rx1693_eos, rx1693_done set rx1693_off, 0 lt rx1693_pos, 2, rx1693_start sub rx1693_off, rx1693_pos, 1 substr rx1693_tgt, rx1693_tgt, rx1693_off rx1693_start: eq $I10, 1, rx1693_restart if_null rx1693_debug, debug_866 rx1693_cur."!cursor_debug"("START", "prefix:sym<+>") debug_866: $I10 = self.'from'() ne $I10, -1, rxscan1695_done goto rxscan1695_scan rxscan1695_loop: ($P10) = rx1693_cur."from"() inc $P10 set rx1693_pos, $P10 ge rx1693_pos, rx1693_eos, rxscan1695_done rxscan1695_scan: set_addr $I10, rxscan1695_loop rx1693_cur."!mark_push"(0, rx1693_pos, $I10) rxscan1695_done: .annotate 'line', 508 # rx subcapture "sym" set_addr $I10, rxcap_1696_fail rx1693_cur."!mark_push"(0, rx1693_pos, $I10) # rx literal "+" add $I11, rx1693_pos, 1 gt $I11, rx1693_eos, rx1693_fail sub $I11, rx1693_pos, rx1693_off ord $I11, rx1693_tgt, $I11 ne $I11, 43, rx1693_fail add rx1693_pos, 1 set_addr $I10, rxcap_1696_fail ($I12, $I11) = rx1693_cur."!mark_peek"($I10) rx1693_cur."!cursor_pos"($I11) ($P10) = rx1693_cur."!cursor_start"() $P10."!cursor_pass"(rx1693_pos, "") rx1693_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1696_done rxcap_1696_fail: goto rx1693_fail rxcap_1696_done: # rx subrule "O" subtype=capture negate= rx1693_cur."!cursor_pos"(rx1693_pos) $P10 = rx1693_cur."O"("%symbolic_unary, :pirop") unless $P10, rx1693_fail rx1693_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1693_pos = $P10."pos"() # rx pass rx1693_cur."!cursor_pass"(rx1693_pos, "prefix:sym<+>") if_null rx1693_debug, debug_867 rx1693_cur."!cursor_debug"("PASS", "prefix:sym<+>", " at pos=", rx1693_pos) debug_867: .return (rx1693_cur) rx1693_restart: .annotate 'line', 4 if_null rx1693_debug, debug_868 rx1693_cur."!cursor_debug"("NEXT", "prefix:sym<+>") debug_868: rx1693_fail: (rx1693_rep, rx1693_pos, $I10, $P10) = rx1693_cur."!mark_fail"(0) lt rx1693_pos, -1, rx1693_done eq rx1693_pos, -1, rx1693_fail jump $I10 rx1693_done: rx1693_cur."!cursor_fail"() if_null rx1693_debug, debug_869 rx1693_cur."!cursor_debug"("FAIL", "prefix:sym<+>") debug_869: .return (rx1693_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__prefix:sym<+>" :subid("271_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "+") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "prefix:sym<~>" :subid("272_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1698_tgt .local int rx1698_pos .local int rx1698_off .local int rx1698_eos .local int rx1698_rep .local pmc rx1698_cur .local pmc rx1698_debug (rx1698_cur, rx1698_pos, rx1698_tgt, $I10) = self."!cursor_start"() getattribute rx1698_debug, rx1698_cur, "$!debug" .lex unicode:"$\x{a2}", rx1698_cur .local pmc match .lex "$/", match length rx1698_eos, rx1698_tgt gt rx1698_pos, rx1698_eos, rx1698_done set rx1698_off, 0 lt rx1698_pos, 2, rx1698_start sub rx1698_off, rx1698_pos, 1 substr rx1698_tgt, rx1698_tgt, rx1698_off rx1698_start: eq $I10, 1, rx1698_restart if_null rx1698_debug, debug_870 rx1698_cur."!cursor_debug"("START", "prefix:sym<~>") debug_870: $I10 = self.'from'() ne $I10, -1, rxscan1700_done goto rxscan1700_scan rxscan1700_loop: ($P10) = rx1698_cur."from"() inc $P10 set rx1698_pos, $P10 ge rx1698_pos, rx1698_eos, rxscan1700_done rxscan1700_scan: set_addr $I10, rxscan1700_loop rx1698_cur."!mark_push"(0, rx1698_pos, $I10) rxscan1700_done: .annotate 'line', 509 # rx subcapture "sym" set_addr $I10, rxcap_1701_fail rx1698_cur."!mark_push"(0, rx1698_pos, $I10) # rx literal "~" add $I11, rx1698_pos, 1 gt $I11, rx1698_eos, rx1698_fail sub $I11, rx1698_pos, rx1698_off ord $I11, rx1698_tgt, $I11 ne $I11, 126, rx1698_fail add rx1698_pos, 1 set_addr $I10, rxcap_1701_fail ($I12, $I11) = rx1698_cur."!mark_peek"($I10) rx1698_cur."!cursor_pos"($I11) ($P10) = rx1698_cur."!cursor_start"() $P10."!cursor_pass"(rx1698_pos, "") rx1698_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1701_done rxcap_1701_fail: goto rx1698_fail rxcap_1701_done: # rx subrule "O" subtype=capture negate= rx1698_cur."!cursor_pos"(rx1698_pos) $P10 = rx1698_cur."O"("%symbolic_unary, :pirop") unless $P10, rx1698_fail rx1698_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1698_pos = $P10."pos"() # rx pass rx1698_cur."!cursor_pass"(rx1698_pos, "prefix:sym<~>") if_null rx1698_debug, debug_871 rx1698_cur."!cursor_debug"("PASS", "prefix:sym<~>", " at pos=", rx1698_pos) debug_871: .return (rx1698_cur) rx1698_restart: .annotate 'line', 4 if_null rx1698_debug, debug_872 rx1698_cur."!cursor_debug"("NEXT", "prefix:sym<~>") debug_872: rx1698_fail: (rx1698_rep, rx1698_pos, $I10, $P10) = rx1698_cur."!mark_fail"(0) lt rx1698_pos, -1, rx1698_done eq rx1698_pos, -1, rx1698_fail jump $I10 rx1698_done: rx1698_cur."!cursor_fail"() if_null rx1698_debug, debug_873 rx1698_cur."!cursor_debug"("FAIL", "prefix:sym<~>") debug_873: .return (rx1698_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__prefix:sym<~>" :subid("273_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "~") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "prefix:sym<->" :subid("274_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1703_tgt .local int rx1703_pos .local int rx1703_off .local int rx1703_eos .local int rx1703_rep .local pmc rx1703_cur .local pmc rx1703_debug (rx1703_cur, rx1703_pos, rx1703_tgt, $I10) = self."!cursor_start"() getattribute rx1703_debug, rx1703_cur, "$!debug" .lex unicode:"$\x{a2}", rx1703_cur .local pmc match .lex "$/", match length rx1703_eos, rx1703_tgt gt rx1703_pos, rx1703_eos, rx1703_done set rx1703_off, 0 lt rx1703_pos, 2, rx1703_start sub rx1703_off, rx1703_pos, 1 substr rx1703_tgt, rx1703_tgt, rx1703_off rx1703_start: eq $I10, 1, rx1703_restart if_null rx1703_debug, debug_874 rx1703_cur."!cursor_debug"("START", "prefix:sym<->") debug_874: $I10 = self.'from'() ne $I10, -1, rxscan1705_done goto rxscan1705_scan rxscan1705_loop: ($P10) = rx1703_cur."from"() inc $P10 set rx1703_pos, $P10 ge rx1703_pos, rx1703_eos, rxscan1705_done rxscan1705_scan: set_addr $I10, rxscan1705_loop rx1703_cur."!mark_push"(0, rx1703_pos, $I10) rxscan1705_done: .annotate 'line', 510 # rx subcapture "sym" set_addr $I10, rxcap_1706_fail rx1703_cur."!mark_push"(0, rx1703_pos, $I10) # rx literal "-" add $I11, rx1703_pos, 1 gt $I11, rx1703_eos, rx1703_fail sub $I11, rx1703_pos, rx1703_off ord $I11, rx1703_tgt, $I11 ne $I11, 45, rx1703_fail add rx1703_pos, 1 set_addr $I10, rxcap_1706_fail ($I12, $I11) = rx1703_cur."!mark_peek"($I10) rx1703_cur."!cursor_pos"($I11) ($P10) = rx1703_cur."!cursor_start"() $P10."!cursor_pass"(rx1703_pos, "") rx1703_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1706_done rxcap_1706_fail: goto rx1703_fail rxcap_1706_done: # rx enumcharlist negate=1 zerowidth sub $I10, rx1703_pos, rx1703_off substr $S10, rx1703_tgt, $I10, 1 index $I11, ">", $S10 ge $I11, 0, rx1703_fail # rx subrule "number" subtype=zerowidth negate=1 rx1703_cur."!cursor_pos"(rx1703_pos) $P10 = rx1703_cur."number"() if $P10, rx1703_fail # rx subrule "O" subtype=capture negate= rx1703_cur."!cursor_pos"(rx1703_pos) $P10 = rx1703_cur."O"("%symbolic_unary, :pirop") unless $P10, rx1703_fail rx1703_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1703_pos = $P10."pos"() # rx pass rx1703_cur."!cursor_pass"(rx1703_pos, "prefix:sym<->") if_null rx1703_debug, debug_875 rx1703_cur."!cursor_debug"("PASS", "prefix:sym<->", " at pos=", rx1703_pos) debug_875: .return (rx1703_cur) rx1703_restart: .annotate 'line', 4 if_null rx1703_debug, debug_876 rx1703_cur."!cursor_debug"("NEXT", "prefix:sym<->") debug_876: rx1703_fail: (rx1703_rep, rx1703_pos, $I10, $P10) = rx1703_cur."!mark_fail"(0) lt rx1703_pos, -1, rx1703_done eq rx1703_pos, -1, rx1703_fail jump $I10 rx1703_done: rx1703_cur."!cursor_fail"() if_null rx1703_debug, debug_877 rx1703_cur."!cursor_debug"("FAIL", "prefix:sym<->") debug_877: .return (rx1703_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__prefix:sym<->" :subid("275_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "-" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "prefix:sym" :subid("276_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1708_tgt .local int rx1708_pos .local int rx1708_off .local int rx1708_eos .local int rx1708_rep .local pmc rx1708_cur .local pmc rx1708_debug (rx1708_cur, rx1708_pos, rx1708_tgt, $I10) = self."!cursor_start"() getattribute rx1708_debug, rx1708_cur, "$!debug" .lex unicode:"$\x{a2}", rx1708_cur .local pmc match .lex "$/", match length rx1708_eos, rx1708_tgt gt rx1708_pos, rx1708_eos, rx1708_done set rx1708_off, 0 lt rx1708_pos, 2, rx1708_start sub rx1708_off, rx1708_pos, 1 substr rx1708_tgt, rx1708_tgt, rx1708_off rx1708_start: eq $I10, 1, rx1708_restart if_null rx1708_debug, debug_878 rx1708_cur."!cursor_debug"("START", "prefix:sym") debug_878: $I10 = self.'from'() ne $I10, -1, rxscan1710_done goto rxscan1710_scan rxscan1710_loop: ($P10) = rx1708_cur."from"() inc $P10 set rx1708_pos, $P10 ge rx1708_pos, rx1708_eos, rxscan1710_done rxscan1710_scan: set_addr $I10, rxscan1710_loop rx1708_cur."!mark_push"(0, rx1708_pos, $I10) rxscan1710_done: .annotate 'line', 511 # rx subcapture "sym" set_addr $I10, rxcap_1711_fail rx1708_cur."!mark_push"(0, rx1708_pos, $I10) # rx literal "?" add $I11, rx1708_pos, 1 gt $I11, rx1708_eos, rx1708_fail sub $I11, rx1708_pos, rx1708_off ord $I11, rx1708_tgt, $I11 ne $I11, 63, rx1708_fail add rx1708_pos, 1 set_addr $I10, rxcap_1711_fail ($I12, $I11) = rx1708_cur."!mark_peek"($I10) rx1708_cur."!cursor_pos"($I11) ($P10) = rx1708_cur."!cursor_start"() $P10."!cursor_pass"(rx1708_pos, "") rx1708_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1711_done rxcap_1711_fail: goto rx1708_fail rxcap_1711_done: # rx subrule "O" subtype=capture negate= rx1708_cur."!cursor_pos"(rx1708_pos) $P10 = rx1708_cur."O"("%symbolic_unary, :pirop") unless $P10, rx1708_fail rx1708_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1708_pos = $P10."pos"() # rx pass rx1708_cur."!cursor_pass"(rx1708_pos, "prefix:sym") if_null rx1708_debug, debug_879 rx1708_cur."!cursor_debug"("PASS", "prefix:sym", " at pos=", rx1708_pos) debug_879: .return (rx1708_cur) rx1708_restart: .annotate 'line', 4 if_null rx1708_debug, debug_880 rx1708_cur."!cursor_debug"("NEXT", "prefix:sym") debug_880: rx1708_fail: (rx1708_rep, rx1708_pos, $I10, $P10) = rx1708_cur."!mark_fail"(0) lt rx1708_pos, -1, rx1708_done eq rx1708_pos, -1, rx1708_fail jump $I10 rx1708_done: rx1708_cur."!cursor_fail"() if_null rx1708_debug, debug_881 rx1708_cur."!cursor_debug"("FAIL", "prefix:sym") debug_881: .return (rx1708_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__prefix:sym" :subid("277_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "?") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "prefix:sym" :subid("278_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1713_tgt .local int rx1713_pos .local int rx1713_off .local int rx1713_eos .local int rx1713_rep .local pmc rx1713_cur .local pmc rx1713_debug (rx1713_cur, rx1713_pos, rx1713_tgt, $I10) = self."!cursor_start"() getattribute rx1713_debug, rx1713_cur, "$!debug" .lex unicode:"$\x{a2}", rx1713_cur .local pmc match .lex "$/", match length rx1713_eos, rx1713_tgt gt rx1713_pos, rx1713_eos, rx1713_done set rx1713_off, 0 lt rx1713_pos, 2, rx1713_start sub rx1713_off, rx1713_pos, 1 substr rx1713_tgt, rx1713_tgt, rx1713_off rx1713_start: eq $I10, 1, rx1713_restart if_null rx1713_debug, debug_882 rx1713_cur."!cursor_debug"("START", "prefix:sym") debug_882: $I10 = self.'from'() ne $I10, -1, rxscan1715_done goto rxscan1715_scan rxscan1715_loop: ($P10) = rx1713_cur."from"() inc $P10 set rx1713_pos, $P10 ge rx1713_pos, rx1713_eos, rxscan1715_done rxscan1715_scan: set_addr $I10, rxscan1715_loop rx1713_cur."!mark_push"(0, rx1713_pos, $I10) rxscan1715_done: .annotate 'line', 512 # rx subcapture "sym" set_addr $I10, rxcap_1716_fail rx1713_cur."!mark_push"(0, rx1713_pos, $I10) # rx literal "!" add $I11, rx1713_pos, 1 gt $I11, rx1713_eos, rx1713_fail sub $I11, rx1713_pos, rx1713_off ord $I11, rx1713_tgt, $I11 ne $I11, 33, rx1713_fail add rx1713_pos, 1 set_addr $I10, rxcap_1716_fail ($I12, $I11) = rx1713_cur."!mark_peek"($I10) rx1713_cur."!cursor_pos"($I11) ($P10) = rx1713_cur."!cursor_start"() $P10."!cursor_pass"(rx1713_pos, "") rx1713_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1716_done rxcap_1716_fail: goto rx1713_fail rxcap_1716_done: # rx subrule "O" subtype=capture negate= rx1713_cur."!cursor_pos"(rx1713_pos) $P10 = rx1713_cur."O"("%symbolic_unary, :pirop") unless $P10, rx1713_fail rx1713_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1713_pos = $P10."pos"() # rx pass rx1713_cur."!cursor_pass"(rx1713_pos, "prefix:sym") if_null rx1713_debug, debug_883 rx1713_cur."!cursor_debug"("PASS", "prefix:sym", " at pos=", rx1713_pos) debug_883: .return (rx1713_cur) rx1713_restart: .annotate 'line', 4 if_null rx1713_debug, debug_884 rx1713_cur."!cursor_debug"("NEXT", "prefix:sym") debug_884: rx1713_fail: (rx1713_rep, rx1713_pos, $I10, $P10) = rx1713_cur."!mark_fail"(0) lt rx1713_pos, -1, rx1713_done eq rx1713_pos, -1, rx1713_fail jump $I10 rx1713_done: rx1713_cur."!cursor_fail"() if_null rx1713_debug, debug_885 rx1713_cur."!cursor_debug"("FAIL", "prefix:sym") debug_885: .return (rx1713_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__prefix:sym" :subid("279_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "!") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "prefix:sym<|>" :subid("280_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1718_tgt .local int rx1718_pos .local int rx1718_off .local int rx1718_eos .local int rx1718_rep .local pmc rx1718_cur .local pmc rx1718_debug (rx1718_cur, rx1718_pos, rx1718_tgt, $I10) = self."!cursor_start"() getattribute rx1718_debug, rx1718_cur, "$!debug" .lex unicode:"$\x{a2}", rx1718_cur .local pmc match .lex "$/", match length rx1718_eos, rx1718_tgt gt rx1718_pos, rx1718_eos, rx1718_done set rx1718_off, 0 lt rx1718_pos, 2, rx1718_start sub rx1718_off, rx1718_pos, 1 substr rx1718_tgt, rx1718_tgt, rx1718_off rx1718_start: eq $I10, 1, rx1718_restart if_null rx1718_debug, debug_886 rx1718_cur."!cursor_debug"("START", "prefix:sym<|>") debug_886: $I10 = self.'from'() ne $I10, -1, rxscan1720_done goto rxscan1720_scan rxscan1720_loop: ($P10) = rx1718_cur."from"() inc $P10 set rx1718_pos, $P10 ge rx1718_pos, rx1718_eos, rxscan1720_done rxscan1720_scan: set_addr $I10, rxscan1720_loop rx1718_cur."!mark_push"(0, rx1718_pos, $I10) rxscan1720_done: .annotate 'line', 513 # rx subcapture "sym" set_addr $I10, rxcap_1721_fail rx1718_cur."!mark_push"(0, rx1718_pos, $I10) # rx literal "|" add $I11, rx1718_pos, 1 gt $I11, rx1718_eos, rx1718_fail sub $I11, rx1718_pos, rx1718_off ord $I11, rx1718_tgt, $I11 ne $I11, 124, rx1718_fail add rx1718_pos, 1 set_addr $I10, rxcap_1721_fail ($I12, $I11) = rx1718_cur."!mark_peek"($I10) rx1718_cur."!cursor_pos"($I11) ($P10) = rx1718_cur."!cursor_start"() $P10."!cursor_pass"(rx1718_pos, "") rx1718_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1721_done rxcap_1721_fail: goto rx1718_fail rxcap_1721_done: # rx subrule "O" subtype=capture negate= rx1718_cur."!cursor_pos"(rx1718_pos) $P10 = rx1718_cur."O"("%symbolic_unary") unless $P10, rx1718_fail rx1718_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1718_pos = $P10."pos"() # rx pass rx1718_cur."!cursor_pass"(rx1718_pos, "prefix:sym<|>") if_null rx1718_debug, debug_887 rx1718_cur."!cursor_debug"("PASS", "prefix:sym<|>", " at pos=", rx1718_pos) debug_887: .return (rx1718_cur) rx1718_restart: .annotate 'line', 4 if_null rx1718_debug, debug_888 rx1718_cur."!cursor_debug"("NEXT", "prefix:sym<|>") debug_888: rx1718_fail: (rx1718_rep, rx1718_pos, $I10, $P10) = rx1718_cur."!mark_fail"(0) lt rx1718_pos, -1, rx1718_done eq rx1718_pos, -1, rx1718_fail jump $I10 rx1718_done: rx1718_cur."!cursor_fail"() if_null rx1718_debug, debug_889 rx1718_cur."!cursor_debug"("FAIL", "prefix:sym<|>") debug_889: .return (rx1718_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__prefix:sym<|>" :subid("281_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "|") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<*>" :subid("282_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1723_tgt .local int rx1723_pos .local int rx1723_off .local int rx1723_eos .local int rx1723_rep .local pmc rx1723_cur .local pmc rx1723_debug (rx1723_cur, rx1723_pos, rx1723_tgt, $I10) = self."!cursor_start"() getattribute rx1723_debug, rx1723_cur, "$!debug" .lex unicode:"$\x{a2}", rx1723_cur .local pmc match .lex "$/", match length rx1723_eos, rx1723_tgt gt rx1723_pos, rx1723_eos, rx1723_done set rx1723_off, 0 lt rx1723_pos, 2, rx1723_start sub rx1723_off, rx1723_pos, 1 substr rx1723_tgt, rx1723_tgt, rx1723_off rx1723_start: eq $I10, 1, rx1723_restart if_null rx1723_debug, debug_890 rx1723_cur."!cursor_debug"("START", "infix:sym<*>") debug_890: $I10 = self.'from'() ne $I10, -1, rxscan1725_done goto rxscan1725_scan rxscan1725_loop: ($P10) = rx1723_cur."from"() inc $P10 set rx1723_pos, $P10 ge rx1723_pos, rx1723_eos, rxscan1725_done rxscan1725_scan: set_addr $I10, rxscan1725_loop rx1723_cur."!mark_push"(0, rx1723_pos, $I10) rxscan1725_done: .annotate 'line', 515 # rx subcapture "sym" set_addr $I10, rxcap_1726_fail rx1723_cur."!mark_push"(0, rx1723_pos, $I10) # rx literal "*" add $I11, rx1723_pos, 1 gt $I11, rx1723_eos, rx1723_fail sub $I11, rx1723_pos, rx1723_off ord $I11, rx1723_tgt, $I11 ne $I11, 42, rx1723_fail add rx1723_pos, 1 set_addr $I10, rxcap_1726_fail ($I12, $I11) = rx1723_cur."!mark_peek"($I10) rx1723_cur."!cursor_pos"($I11) ($P10) = rx1723_cur."!cursor_start"() $P10."!cursor_pass"(rx1723_pos, "") rx1723_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1726_done rxcap_1726_fail: goto rx1723_fail rxcap_1726_done: # rx subrule "O" subtype=capture negate= rx1723_cur."!cursor_pos"(rx1723_pos) $P10 = rx1723_cur."O"("%multiplicative, :pirop") unless $P10, rx1723_fail rx1723_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1723_pos = $P10."pos"() # rx pass rx1723_cur."!cursor_pass"(rx1723_pos, "infix:sym<*>") if_null rx1723_debug, debug_891 rx1723_cur."!cursor_debug"("PASS", "infix:sym<*>", " at pos=", rx1723_pos) debug_891: .return (rx1723_cur) rx1723_restart: .annotate 'line', 4 if_null rx1723_debug, debug_892 rx1723_cur."!cursor_debug"("NEXT", "infix:sym<*>") debug_892: rx1723_fail: (rx1723_rep, rx1723_pos, $I10, $P10) = rx1723_cur."!mark_fail"(0) lt rx1723_pos, -1, rx1723_done eq rx1723_pos, -1, rx1723_fail jump $I10 rx1723_done: rx1723_cur."!cursor_fail"() if_null rx1723_debug, debug_893 rx1723_cur."!cursor_debug"("FAIL", "infix:sym<*>") debug_893: .return (rx1723_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<*>" :subid("283_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "*") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym" :subid("284_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1728_tgt .local int rx1728_pos .local int rx1728_off .local int rx1728_eos .local int rx1728_rep .local pmc rx1728_cur .local pmc rx1728_debug (rx1728_cur, rx1728_pos, rx1728_tgt, $I10) = self."!cursor_start"() getattribute rx1728_debug, rx1728_cur, "$!debug" .lex unicode:"$\x{a2}", rx1728_cur .local pmc match .lex "$/", match length rx1728_eos, rx1728_tgt gt rx1728_pos, rx1728_eos, rx1728_done set rx1728_off, 0 lt rx1728_pos, 2, rx1728_start sub rx1728_off, rx1728_pos, 1 substr rx1728_tgt, rx1728_tgt, rx1728_off rx1728_start: eq $I10, 1, rx1728_restart if_null rx1728_debug, debug_894 rx1728_cur."!cursor_debug"("START", "infix:sym") debug_894: $I10 = self.'from'() ne $I10, -1, rxscan1730_done goto rxscan1730_scan rxscan1730_loop: ($P10) = rx1728_cur."from"() inc $P10 set rx1728_pos, $P10 ge rx1728_pos, rx1728_eos, rxscan1730_done rxscan1730_scan: set_addr $I10, rxscan1730_loop rx1728_cur."!mark_push"(0, rx1728_pos, $I10) rxscan1730_done: .annotate 'line', 516 # rx subcapture "sym" set_addr $I10, rxcap_1731_fail rx1728_cur."!mark_push"(0, rx1728_pos, $I10) # rx literal "/" add $I11, rx1728_pos, 1 gt $I11, rx1728_eos, rx1728_fail sub $I11, rx1728_pos, rx1728_off ord $I11, rx1728_tgt, $I11 ne $I11, 47, rx1728_fail add rx1728_pos, 1 set_addr $I10, rxcap_1731_fail ($I12, $I11) = rx1728_cur."!mark_peek"($I10) rx1728_cur."!cursor_pos"($I11) ($P10) = rx1728_cur."!cursor_start"() $P10."!cursor_pass"(rx1728_pos, "") rx1728_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1731_done rxcap_1731_fail: goto rx1728_fail rxcap_1731_done: # rx subrule "O" subtype=capture negate= rx1728_cur."!cursor_pos"(rx1728_pos) $P10 = rx1728_cur."O"("%multiplicative, :pirop
    ") unless $P10, rx1728_fail rx1728_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1728_pos = $P10."pos"() # rx pass rx1728_cur."!cursor_pass"(rx1728_pos, "infix:sym") if_null rx1728_debug, debug_895 rx1728_cur."!cursor_debug"("PASS", "infix:sym", " at pos=", rx1728_pos) debug_895: .return (rx1728_cur) rx1728_restart: .annotate 'line', 4 if_null rx1728_debug, debug_896 rx1728_cur."!cursor_debug"("NEXT", "infix:sym") debug_896: rx1728_fail: (rx1728_rep, rx1728_pos, $I10, $P10) = rx1728_cur."!mark_fail"(0) lt rx1728_pos, -1, rx1728_done eq rx1728_pos, -1, rx1728_fail jump $I10 rx1728_done: rx1728_cur."!cursor_fail"() if_null rx1728_debug, debug_897 rx1728_cur."!cursor_debug"("FAIL", "infix:sym") debug_897: .return (rx1728_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym" :subid("285_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "/") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<%>" :subid("286_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1733_tgt .local int rx1733_pos .local int rx1733_off .local int rx1733_eos .local int rx1733_rep .local pmc rx1733_cur .local pmc rx1733_debug (rx1733_cur, rx1733_pos, rx1733_tgt, $I10) = self."!cursor_start"() getattribute rx1733_debug, rx1733_cur, "$!debug" .lex unicode:"$\x{a2}", rx1733_cur .local pmc match .lex "$/", match length rx1733_eos, rx1733_tgt gt rx1733_pos, rx1733_eos, rx1733_done set rx1733_off, 0 lt rx1733_pos, 2, rx1733_start sub rx1733_off, rx1733_pos, 1 substr rx1733_tgt, rx1733_tgt, rx1733_off rx1733_start: eq $I10, 1, rx1733_restart if_null rx1733_debug, debug_898 rx1733_cur."!cursor_debug"("START", "infix:sym<%>") debug_898: $I10 = self.'from'() ne $I10, -1, rxscan1735_done goto rxscan1735_scan rxscan1735_loop: ($P10) = rx1733_cur."from"() inc $P10 set rx1733_pos, $P10 ge rx1733_pos, rx1733_eos, rxscan1735_done rxscan1735_scan: set_addr $I10, rxscan1735_loop rx1733_cur."!mark_push"(0, rx1733_pos, $I10) rxscan1735_done: .annotate 'line', 517 # rx subcapture "sym" set_addr $I10, rxcap_1736_fail rx1733_cur."!mark_push"(0, rx1733_pos, $I10) # rx literal "%" add $I11, rx1733_pos, 1 gt $I11, rx1733_eos, rx1733_fail sub $I11, rx1733_pos, rx1733_off ord $I11, rx1733_tgt, $I11 ne $I11, 37, rx1733_fail add rx1733_pos, 1 set_addr $I10, rxcap_1736_fail ($I12, $I11) = rx1733_cur."!mark_peek"($I10) rx1733_cur."!cursor_pos"($I11) ($P10) = rx1733_cur."!cursor_start"() $P10."!cursor_pass"(rx1733_pos, "") rx1733_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1736_done rxcap_1736_fail: goto rx1733_fail rxcap_1736_done: # rx subrule "O" subtype=capture negate= rx1733_cur."!cursor_pos"(rx1733_pos) $P10 = rx1733_cur."O"("%multiplicative, :pirop") unless $P10, rx1733_fail rx1733_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1733_pos = $P10."pos"() # rx pass rx1733_cur."!cursor_pass"(rx1733_pos, "infix:sym<%>") if_null rx1733_debug, debug_899 rx1733_cur."!cursor_debug"("PASS", "infix:sym<%>", " at pos=", rx1733_pos) debug_899: .return (rx1733_cur) rx1733_restart: .annotate 'line', 4 if_null rx1733_debug, debug_900 rx1733_cur."!cursor_debug"("NEXT", "infix:sym<%>") debug_900: rx1733_fail: (rx1733_rep, rx1733_pos, $I10, $P10) = rx1733_cur."!mark_fail"(0) lt rx1733_pos, -1, rx1733_done eq rx1733_pos, -1, rx1733_fail jump $I10 rx1733_done: rx1733_cur."!cursor_fail"() if_null rx1733_debug, debug_901 rx1733_cur."!cursor_debug"("FAIL", "infix:sym<%>") debug_901: .return (rx1733_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<%>" :subid("287_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "%") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<+&>" :subid("288_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1738_tgt .local int rx1738_pos .local int rx1738_off .local int rx1738_eos .local int rx1738_rep .local pmc rx1738_cur .local pmc rx1738_debug (rx1738_cur, rx1738_pos, rx1738_tgt, $I10) = self."!cursor_start"() getattribute rx1738_debug, rx1738_cur, "$!debug" .lex unicode:"$\x{a2}", rx1738_cur .local pmc match .lex "$/", match length rx1738_eos, rx1738_tgt gt rx1738_pos, rx1738_eos, rx1738_done set rx1738_off, 0 lt rx1738_pos, 2, rx1738_start sub rx1738_off, rx1738_pos, 1 substr rx1738_tgt, rx1738_tgt, rx1738_off rx1738_start: eq $I10, 1, rx1738_restart if_null rx1738_debug, debug_902 rx1738_cur."!cursor_debug"("START", "infix:sym<+&>") debug_902: $I10 = self.'from'() ne $I10, -1, rxscan1740_done goto rxscan1740_scan rxscan1740_loop: ($P10) = rx1738_cur."from"() inc $P10 set rx1738_pos, $P10 ge rx1738_pos, rx1738_eos, rxscan1740_done rxscan1740_scan: set_addr $I10, rxscan1740_loop rx1738_cur."!mark_push"(0, rx1738_pos, $I10) rxscan1740_done: .annotate 'line', 518 # rx subcapture "sym" set_addr $I10, rxcap_1741_fail rx1738_cur."!mark_push"(0, rx1738_pos, $I10) # rx literal "+&" add $I11, rx1738_pos, 2 gt $I11, rx1738_eos, rx1738_fail sub $I11, rx1738_pos, rx1738_off substr $S10, rx1738_tgt, $I11, 2 ne $S10, "+&", rx1738_fail add rx1738_pos, 2 set_addr $I10, rxcap_1741_fail ($I12, $I11) = rx1738_cur."!mark_peek"($I10) rx1738_cur."!cursor_pos"($I11) ($P10) = rx1738_cur."!cursor_start"() $P10."!cursor_pass"(rx1738_pos, "") rx1738_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1741_done rxcap_1741_fail: goto rx1738_fail rxcap_1741_done: # rx subrule "O" subtype=capture negate= rx1738_cur."!cursor_pos"(rx1738_pos) $P10 = rx1738_cur."O"("%multiplicative, :pirop") unless $P10, rx1738_fail rx1738_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1738_pos = $P10."pos"() # rx pass rx1738_cur."!cursor_pass"(rx1738_pos, "infix:sym<+&>") if_null rx1738_debug, debug_903 rx1738_cur."!cursor_debug"("PASS", "infix:sym<+&>", " at pos=", rx1738_pos) debug_903: .return (rx1738_cur) rx1738_restart: .annotate 'line', 4 if_null rx1738_debug, debug_904 rx1738_cur."!cursor_debug"("NEXT", "infix:sym<+&>") debug_904: rx1738_fail: (rx1738_rep, rx1738_pos, $I10, $P10) = rx1738_cur."!mark_fail"(0) lt rx1738_pos, -1, rx1738_done eq rx1738_pos, -1, rx1738_fail jump $I10 rx1738_done: rx1738_cur."!cursor_fail"() if_null rx1738_debug, debug_905 rx1738_cur."!cursor_debug"("FAIL", "infix:sym<+&>") debug_905: .return (rx1738_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<+&>" :subid("289_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "+&") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<+>" :subid("290_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1743_tgt .local int rx1743_pos .local int rx1743_off .local int rx1743_eos .local int rx1743_rep .local pmc rx1743_cur .local pmc rx1743_debug (rx1743_cur, rx1743_pos, rx1743_tgt, $I10) = self."!cursor_start"() getattribute rx1743_debug, rx1743_cur, "$!debug" .lex unicode:"$\x{a2}", rx1743_cur .local pmc match .lex "$/", match length rx1743_eos, rx1743_tgt gt rx1743_pos, rx1743_eos, rx1743_done set rx1743_off, 0 lt rx1743_pos, 2, rx1743_start sub rx1743_off, rx1743_pos, 1 substr rx1743_tgt, rx1743_tgt, rx1743_off rx1743_start: eq $I10, 1, rx1743_restart if_null rx1743_debug, debug_906 rx1743_cur."!cursor_debug"("START", "infix:sym<+>") debug_906: $I10 = self.'from'() ne $I10, -1, rxscan1745_done goto rxscan1745_scan rxscan1745_loop: ($P10) = rx1743_cur."from"() inc $P10 set rx1743_pos, $P10 ge rx1743_pos, rx1743_eos, rxscan1745_done rxscan1745_scan: set_addr $I10, rxscan1745_loop rx1743_cur."!mark_push"(0, rx1743_pos, $I10) rxscan1745_done: .annotate 'line', 520 # rx subcapture "sym" set_addr $I10, rxcap_1746_fail rx1743_cur."!mark_push"(0, rx1743_pos, $I10) # rx literal "+" add $I11, rx1743_pos, 1 gt $I11, rx1743_eos, rx1743_fail sub $I11, rx1743_pos, rx1743_off ord $I11, rx1743_tgt, $I11 ne $I11, 43, rx1743_fail add rx1743_pos, 1 set_addr $I10, rxcap_1746_fail ($I12, $I11) = rx1743_cur."!mark_peek"($I10) rx1743_cur."!cursor_pos"($I11) ($P10) = rx1743_cur."!cursor_start"() $P10."!cursor_pass"(rx1743_pos, "") rx1743_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1746_done rxcap_1746_fail: goto rx1743_fail rxcap_1746_done: # rx subrule "O" subtype=capture negate= rx1743_cur."!cursor_pos"(rx1743_pos) $P10 = rx1743_cur."O"("%additive, :pirop") unless $P10, rx1743_fail rx1743_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1743_pos = $P10."pos"() # rx pass rx1743_cur."!cursor_pass"(rx1743_pos, "infix:sym<+>") if_null rx1743_debug, debug_907 rx1743_cur."!cursor_debug"("PASS", "infix:sym<+>", " at pos=", rx1743_pos) debug_907: .return (rx1743_cur) rx1743_restart: .annotate 'line', 4 if_null rx1743_debug, debug_908 rx1743_cur."!cursor_debug"("NEXT", "infix:sym<+>") debug_908: rx1743_fail: (rx1743_rep, rx1743_pos, $I10, $P10) = rx1743_cur."!mark_fail"(0) lt rx1743_pos, -1, rx1743_done eq rx1743_pos, -1, rx1743_fail jump $I10 rx1743_done: rx1743_cur."!cursor_fail"() if_null rx1743_debug, debug_909 rx1743_cur."!cursor_debug"("FAIL", "infix:sym<+>") debug_909: .return (rx1743_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<+>" :subid("291_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "+") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<->" :subid("292_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1748_tgt .local int rx1748_pos .local int rx1748_off .local int rx1748_eos .local int rx1748_rep .local pmc rx1748_cur .local pmc rx1748_debug (rx1748_cur, rx1748_pos, rx1748_tgt, $I10) = self."!cursor_start"() getattribute rx1748_debug, rx1748_cur, "$!debug" .lex unicode:"$\x{a2}", rx1748_cur .local pmc match .lex "$/", match length rx1748_eos, rx1748_tgt gt rx1748_pos, rx1748_eos, rx1748_done set rx1748_off, 0 lt rx1748_pos, 2, rx1748_start sub rx1748_off, rx1748_pos, 1 substr rx1748_tgt, rx1748_tgt, rx1748_off rx1748_start: eq $I10, 1, rx1748_restart if_null rx1748_debug, debug_910 rx1748_cur."!cursor_debug"("START", "infix:sym<->") debug_910: $I10 = self.'from'() ne $I10, -1, rxscan1750_done goto rxscan1750_scan rxscan1750_loop: ($P10) = rx1748_cur."from"() inc $P10 set rx1748_pos, $P10 ge rx1748_pos, rx1748_eos, rxscan1750_done rxscan1750_scan: set_addr $I10, rxscan1750_loop rx1748_cur."!mark_push"(0, rx1748_pos, $I10) rxscan1750_done: .annotate 'line', 521 # rx subcapture "sym" set_addr $I10, rxcap_1751_fail rx1748_cur."!mark_push"(0, rx1748_pos, $I10) # rx literal "-" add $I11, rx1748_pos, 1 gt $I11, rx1748_eos, rx1748_fail sub $I11, rx1748_pos, rx1748_off ord $I11, rx1748_tgt, $I11 ne $I11, 45, rx1748_fail add rx1748_pos, 1 set_addr $I10, rxcap_1751_fail ($I12, $I11) = rx1748_cur."!mark_peek"($I10) rx1748_cur."!cursor_pos"($I11) ($P10) = rx1748_cur."!cursor_start"() $P10."!cursor_pass"(rx1748_pos, "") rx1748_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1751_done rxcap_1751_fail: goto rx1748_fail rxcap_1751_done: # rx subrule "O" subtype=capture negate= rx1748_cur."!cursor_pos"(rx1748_pos) $P10 = rx1748_cur."O"("%additive, :pirop") unless $P10, rx1748_fail rx1748_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1748_pos = $P10."pos"() # rx pass rx1748_cur."!cursor_pass"(rx1748_pos, "infix:sym<->") if_null rx1748_debug, debug_911 rx1748_cur."!cursor_debug"("PASS", "infix:sym<->", " at pos=", rx1748_pos) debug_911: .return (rx1748_cur) rx1748_restart: .annotate 'line', 4 if_null rx1748_debug, debug_912 rx1748_cur."!cursor_debug"("NEXT", "infix:sym<->") debug_912: rx1748_fail: (rx1748_rep, rx1748_pos, $I10, $P10) = rx1748_cur."!mark_fail"(0) lt rx1748_pos, -1, rx1748_done eq rx1748_pos, -1, rx1748_fail jump $I10 rx1748_done: rx1748_cur."!cursor_fail"() if_null rx1748_debug, debug_913 rx1748_cur."!cursor_debug"("FAIL", "infix:sym<->") debug_913: .return (rx1748_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<->" :subid("293_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "-") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<+|>" :subid("294_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1753_tgt .local int rx1753_pos .local int rx1753_off .local int rx1753_eos .local int rx1753_rep .local pmc rx1753_cur .local pmc rx1753_debug (rx1753_cur, rx1753_pos, rx1753_tgt, $I10) = self."!cursor_start"() getattribute rx1753_debug, rx1753_cur, "$!debug" .lex unicode:"$\x{a2}", rx1753_cur .local pmc match .lex "$/", match length rx1753_eos, rx1753_tgt gt rx1753_pos, rx1753_eos, rx1753_done set rx1753_off, 0 lt rx1753_pos, 2, rx1753_start sub rx1753_off, rx1753_pos, 1 substr rx1753_tgt, rx1753_tgt, rx1753_off rx1753_start: eq $I10, 1, rx1753_restart if_null rx1753_debug, debug_914 rx1753_cur."!cursor_debug"("START", "infix:sym<+|>") debug_914: $I10 = self.'from'() ne $I10, -1, rxscan1755_done goto rxscan1755_scan rxscan1755_loop: ($P10) = rx1753_cur."from"() inc $P10 set rx1753_pos, $P10 ge rx1753_pos, rx1753_eos, rxscan1755_done rxscan1755_scan: set_addr $I10, rxscan1755_loop rx1753_cur."!mark_push"(0, rx1753_pos, $I10) rxscan1755_done: .annotate 'line', 522 # rx subcapture "sym" set_addr $I10, rxcap_1756_fail rx1753_cur."!mark_push"(0, rx1753_pos, $I10) # rx literal "+|" add $I11, rx1753_pos, 2 gt $I11, rx1753_eos, rx1753_fail sub $I11, rx1753_pos, rx1753_off substr $S10, rx1753_tgt, $I11, 2 ne $S10, "+|", rx1753_fail add rx1753_pos, 2 set_addr $I10, rxcap_1756_fail ($I12, $I11) = rx1753_cur."!mark_peek"($I10) rx1753_cur."!cursor_pos"($I11) ($P10) = rx1753_cur."!cursor_start"() $P10."!cursor_pass"(rx1753_pos, "") rx1753_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1756_done rxcap_1756_fail: goto rx1753_fail rxcap_1756_done: # rx subrule "O" subtype=capture negate= rx1753_cur."!cursor_pos"(rx1753_pos) $P10 = rx1753_cur."O"("%additive, :pirop") unless $P10, rx1753_fail rx1753_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1753_pos = $P10."pos"() # rx pass rx1753_cur."!cursor_pass"(rx1753_pos, "infix:sym<+|>") if_null rx1753_debug, debug_915 rx1753_cur."!cursor_debug"("PASS", "infix:sym<+|>", " at pos=", rx1753_pos) debug_915: .return (rx1753_cur) rx1753_restart: .annotate 'line', 4 if_null rx1753_debug, debug_916 rx1753_cur."!cursor_debug"("NEXT", "infix:sym<+|>") debug_916: rx1753_fail: (rx1753_rep, rx1753_pos, $I10, $P10) = rx1753_cur."!mark_fail"(0) lt rx1753_pos, -1, rx1753_done eq rx1753_pos, -1, rx1753_fail jump $I10 rx1753_done: rx1753_cur."!cursor_fail"() if_null rx1753_debug, debug_917 rx1753_cur."!cursor_debug"("FAIL", "infix:sym<+|>") debug_917: .return (rx1753_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<+|>" :subid("295_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "+|") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<+^>" :subid("296_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1758_tgt .local int rx1758_pos .local int rx1758_off .local int rx1758_eos .local int rx1758_rep .local pmc rx1758_cur .local pmc rx1758_debug (rx1758_cur, rx1758_pos, rx1758_tgt, $I10) = self."!cursor_start"() getattribute rx1758_debug, rx1758_cur, "$!debug" .lex unicode:"$\x{a2}", rx1758_cur .local pmc match .lex "$/", match length rx1758_eos, rx1758_tgt gt rx1758_pos, rx1758_eos, rx1758_done set rx1758_off, 0 lt rx1758_pos, 2, rx1758_start sub rx1758_off, rx1758_pos, 1 substr rx1758_tgt, rx1758_tgt, rx1758_off rx1758_start: eq $I10, 1, rx1758_restart if_null rx1758_debug, debug_918 rx1758_cur."!cursor_debug"("START", "infix:sym<+^>") debug_918: $I10 = self.'from'() ne $I10, -1, rxscan1760_done goto rxscan1760_scan rxscan1760_loop: ($P10) = rx1758_cur."from"() inc $P10 set rx1758_pos, $P10 ge rx1758_pos, rx1758_eos, rxscan1760_done rxscan1760_scan: set_addr $I10, rxscan1760_loop rx1758_cur."!mark_push"(0, rx1758_pos, $I10) rxscan1760_done: .annotate 'line', 523 # rx subcapture "sym" set_addr $I10, rxcap_1761_fail rx1758_cur."!mark_push"(0, rx1758_pos, $I10) # rx literal "+^" add $I11, rx1758_pos, 2 gt $I11, rx1758_eos, rx1758_fail sub $I11, rx1758_pos, rx1758_off substr $S10, rx1758_tgt, $I11, 2 ne $S10, "+^", rx1758_fail add rx1758_pos, 2 set_addr $I10, rxcap_1761_fail ($I12, $I11) = rx1758_cur."!mark_peek"($I10) rx1758_cur."!cursor_pos"($I11) ($P10) = rx1758_cur."!cursor_start"() $P10."!cursor_pass"(rx1758_pos, "") rx1758_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1761_done rxcap_1761_fail: goto rx1758_fail rxcap_1761_done: # rx subrule "O" subtype=capture negate= rx1758_cur."!cursor_pos"(rx1758_pos) $P10 = rx1758_cur."O"("%additive, :pirop") unless $P10, rx1758_fail rx1758_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1758_pos = $P10."pos"() # rx pass rx1758_cur."!cursor_pass"(rx1758_pos, "infix:sym<+^>") if_null rx1758_debug, debug_919 rx1758_cur."!cursor_debug"("PASS", "infix:sym<+^>", " at pos=", rx1758_pos) debug_919: .return (rx1758_cur) rx1758_restart: .annotate 'line', 4 if_null rx1758_debug, debug_920 rx1758_cur."!cursor_debug"("NEXT", "infix:sym<+^>") debug_920: rx1758_fail: (rx1758_rep, rx1758_pos, $I10, $P10) = rx1758_cur."!mark_fail"(0) lt rx1758_pos, -1, rx1758_done eq rx1758_pos, -1, rx1758_fail jump $I10 rx1758_done: rx1758_cur."!cursor_fail"() if_null rx1758_debug, debug_921 rx1758_cur."!cursor_debug"("FAIL", "infix:sym<+^>") debug_921: .return (rx1758_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<+^>" :subid("297_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "+^") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<~>" :subid("298_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1763_tgt .local int rx1763_pos .local int rx1763_off .local int rx1763_eos .local int rx1763_rep .local pmc rx1763_cur .local pmc rx1763_debug (rx1763_cur, rx1763_pos, rx1763_tgt, $I10) = self."!cursor_start"() getattribute rx1763_debug, rx1763_cur, "$!debug" .lex unicode:"$\x{a2}", rx1763_cur .local pmc match .lex "$/", match length rx1763_eos, rx1763_tgt gt rx1763_pos, rx1763_eos, rx1763_done set rx1763_off, 0 lt rx1763_pos, 2, rx1763_start sub rx1763_off, rx1763_pos, 1 substr rx1763_tgt, rx1763_tgt, rx1763_off rx1763_start: eq $I10, 1, rx1763_restart if_null rx1763_debug, debug_922 rx1763_cur."!cursor_debug"("START", "infix:sym<~>") debug_922: $I10 = self.'from'() ne $I10, -1, rxscan1765_done goto rxscan1765_scan rxscan1765_loop: ($P10) = rx1763_cur."from"() inc $P10 set rx1763_pos, $P10 ge rx1763_pos, rx1763_eos, rxscan1765_done rxscan1765_scan: set_addr $I10, rxscan1765_loop rx1763_cur."!mark_push"(0, rx1763_pos, $I10) rxscan1765_done: .annotate 'line', 525 # rx subcapture "sym" set_addr $I10, rxcap_1766_fail rx1763_cur."!mark_push"(0, rx1763_pos, $I10) # rx literal "~" add $I11, rx1763_pos, 1 gt $I11, rx1763_eos, rx1763_fail sub $I11, rx1763_pos, rx1763_off ord $I11, rx1763_tgt, $I11 ne $I11, 126, rx1763_fail add rx1763_pos, 1 set_addr $I10, rxcap_1766_fail ($I12, $I11) = rx1763_cur."!mark_peek"($I10) rx1763_cur."!cursor_pos"($I11) ($P10) = rx1763_cur."!cursor_start"() $P10."!cursor_pass"(rx1763_pos, "") rx1763_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1766_done rxcap_1766_fail: goto rx1763_fail rxcap_1766_done: # rx subrule "O" subtype=capture negate= rx1763_cur."!cursor_pos"(rx1763_pos) $P10 = rx1763_cur."O"("%concatenation , :pirop") unless $P10, rx1763_fail rx1763_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1763_pos = $P10."pos"() # rx pass rx1763_cur."!cursor_pass"(rx1763_pos, "infix:sym<~>") if_null rx1763_debug, debug_923 rx1763_cur."!cursor_debug"("PASS", "infix:sym<~>", " at pos=", rx1763_pos) debug_923: .return (rx1763_cur) rx1763_restart: .annotate 'line', 4 if_null rx1763_debug, debug_924 rx1763_cur."!cursor_debug"("NEXT", "infix:sym<~>") debug_924: rx1763_fail: (rx1763_rep, rx1763_pos, $I10, $P10) = rx1763_cur."!mark_fail"(0) lt rx1763_pos, -1, rx1763_done eq rx1763_pos, -1, rx1763_fail jump $I10 rx1763_done: rx1763_cur."!cursor_fail"() if_null rx1763_debug, debug_925 rx1763_cur."!cursor_debug"("FAIL", "infix:sym<~>") debug_925: .return (rx1763_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<~>" :subid("299_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "~") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<==>" :subid("300_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1768_tgt .local int rx1768_pos .local int rx1768_off .local int rx1768_eos .local int rx1768_rep .local pmc rx1768_cur .local pmc rx1768_debug (rx1768_cur, rx1768_pos, rx1768_tgt, $I10) = self."!cursor_start"() getattribute rx1768_debug, rx1768_cur, "$!debug" .lex unicode:"$\x{a2}", rx1768_cur .local pmc match .lex "$/", match length rx1768_eos, rx1768_tgt gt rx1768_pos, rx1768_eos, rx1768_done set rx1768_off, 0 lt rx1768_pos, 2, rx1768_start sub rx1768_off, rx1768_pos, 1 substr rx1768_tgt, rx1768_tgt, rx1768_off rx1768_start: eq $I10, 1, rx1768_restart if_null rx1768_debug, debug_926 rx1768_cur."!cursor_debug"("START", "infix:sym<==>") debug_926: $I10 = self.'from'() ne $I10, -1, rxscan1770_done goto rxscan1770_scan rxscan1770_loop: ($P10) = rx1768_cur."from"() inc $P10 set rx1768_pos, $P10 ge rx1768_pos, rx1768_eos, rxscan1770_done rxscan1770_scan: set_addr $I10, rxscan1770_loop rx1768_cur."!mark_push"(0, rx1768_pos, $I10) rxscan1770_done: .annotate 'line', 527 # rx subcapture "sym" set_addr $I10, rxcap_1771_fail rx1768_cur."!mark_push"(0, rx1768_pos, $I10) # rx literal "==" add $I11, rx1768_pos, 2 gt $I11, rx1768_eos, rx1768_fail sub $I11, rx1768_pos, rx1768_off substr $S10, rx1768_tgt, $I11, 2 ne $S10, "==", rx1768_fail add rx1768_pos, 2 set_addr $I10, rxcap_1771_fail ($I12, $I11) = rx1768_cur."!mark_peek"($I10) rx1768_cur."!cursor_pos"($I11) ($P10) = rx1768_cur."!cursor_start"() $P10."!cursor_pass"(rx1768_pos, "") rx1768_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1771_done rxcap_1771_fail: goto rx1768_fail rxcap_1771_done: # rx subrule "O" subtype=capture negate= rx1768_cur."!cursor_pos"(rx1768_pos) $P10 = rx1768_cur."O"("%relational, :pirop") unless $P10, rx1768_fail rx1768_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1768_pos = $P10."pos"() # rx pass rx1768_cur."!cursor_pass"(rx1768_pos, "infix:sym<==>") if_null rx1768_debug, debug_927 rx1768_cur."!cursor_debug"("PASS", "infix:sym<==>", " at pos=", rx1768_pos) debug_927: .return (rx1768_cur) rx1768_restart: .annotate 'line', 4 if_null rx1768_debug, debug_928 rx1768_cur."!cursor_debug"("NEXT", "infix:sym<==>") debug_928: rx1768_fail: (rx1768_rep, rx1768_pos, $I10, $P10) = rx1768_cur."!mark_fail"(0) lt rx1768_pos, -1, rx1768_done eq rx1768_pos, -1, rx1768_fail jump $I10 rx1768_done: rx1768_cur."!cursor_fail"() if_null rx1768_debug, debug_929 rx1768_cur."!cursor_debug"("FAIL", "infix:sym<==>") debug_929: .return (rx1768_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<==>" :subid("301_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "==") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym" :subid("302_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1773_tgt .local int rx1773_pos .local int rx1773_off .local int rx1773_eos .local int rx1773_rep .local pmc rx1773_cur .local pmc rx1773_debug (rx1773_cur, rx1773_pos, rx1773_tgt, $I10) = self."!cursor_start"() getattribute rx1773_debug, rx1773_cur, "$!debug" .lex unicode:"$\x{a2}", rx1773_cur .local pmc match .lex "$/", match length rx1773_eos, rx1773_tgt gt rx1773_pos, rx1773_eos, rx1773_done set rx1773_off, 0 lt rx1773_pos, 2, rx1773_start sub rx1773_off, rx1773_pos, 1 substr rx1773_tgt, rx1773_tgt, rx1773_off rx1773_start: eq $I10, 1, rx1773_restart if_null rx1773_debug, debug_930 rx1773_cur."!cursor_debug"("START", "infix:sym") debug_930: $I10 = self.'from'() ne $I10, -1, rxscan1775_done goto rxscan1775_scan rxscan1775_loop: ($P10) = rx1773_cur."from"() inc $P10 set rx1773_pos, $P10 ge rx1773_pos, rx1773_eos, rxscan1775_done rxscan1775_scan: set_addr $I10, rxscan1775_loop rx1773_cur."!mark_push"(0, rx1773_pos, $I10) rxscan1775_done: .annotate 'line', 528 # rx subcapture "sym" set_addr $I10, rxcap_1776_fail rx1773_cur."!mark_push"(0, rx1773_pos, $I10) # rx literal "!=" add $I11, rx1773_pos, 2 gt $I11, rx1773_eos, rx1773_fail sub $I11, rx1773_pos, rx1773_off substr $S10, rx1773_tgt, $I11, 2 ne $S10, "!=", rx1773_fail add rx1773_pos, 2 set_addr $I10, rxcap_1776_fail ($I12, $I11) = rx1773_cur."!mark_peek"($I10) rx1773_cur."!cursor_pos"($I11) ($P10) = rx1773_cur."!cursor_start"() $P10."!cursor_pass"(rx1773_pos, "") rx1773_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1776_done rxcap_1776_fail: goto rx1773_fail rxcap_1776_done: # rx subrule "O" subtype=capture negate= rx1773_cur."!cursor_pos"(rx1773_pos) $P10 = rx1773_cur."O"("%relational, :pirop") unless $P10, rx1773_fail rx1773_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1773_pos = $P10."pos"() # rx pass rx1773_cur."!cursor_pass"(rx1773_pos, "infix:sym") if_null rx1773_debug, debug_931 rx1773_cur."!cursor_debug"("PASS", "infix:sym", " at pos=", rx1773_pos) debug_931: .return (rx1773_cur) rx1773_restart: .annotate 'line', 4 if_null rx1773_debug, debug_932 rx1773_cur."!cursor_debug"("NEXT", "infix:sym") debug_932: rx1773_fail: (rx1773_rep, rx1773_pos, $I10, $P10) = rx1773_cur."!mark_fail"(0) lt rx1773_pos, -1, rx1773_done eq rx1773_pos, -1, rx1773_fail jump $I10 rx1773_done: rx1773_cur."!cursor_fail"() if_null rx1773_debug, debug_933 rx1773_cur."!cursor_debug"("FAIL", "infix:sym") debug_933: .return (rx1773_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym" :subid("303_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "!=") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<<=>" :subid("304_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1778_tgt .local int rx1778_pos .local int rx1778_off .local int rx1778_eos .local int rx1778_rep .local pmc rx1778_cur .local pmc rx1778_debug (rx1778_cur, rx1778_pos, rx1778_tgt, $I10) = self."!cursor_start"() getattribute rx1778_debug, rx1778_cur, "$!debug" .lex unicode:"$\x{a2}", rx1778_cur .local pmc match .lex "$/", match length rx1778_eos, rx1778_tgt gt rx1778_pos, rx1778_eos, rx1778_done set rx1778_off, 0 lt rx1778_pos, 2, rx1778_start sub rx1778_off, rx1778_pos, 1 substr rx1778_tgt, rx1778_tgt, rx1778_off rx1778_start: eq $I10, 1, rx1778_restart if_null rx1778_debug, debug_934 rx1778_cur."!cursor_debug"("START", "infix:sym<<=>") debug_934: $I10 = self.'from'() ne $I10, -1, rxscan1780_done goto rxscan1780_scan rxscan1780_loop: ($P10) = rx1778_cur."from"() inc $P10 set rx1778_pos, $P10 ge rx1778_pos, rx1778_eos, rxscan1780_done rxscan1780_scan: set_addr $I10, rxscan1780_loop rx1778_cur."!mark_push"(0, rx1778_pos, $I10) rxscan1780_done: .annotate 'line', 529 # rx subcapture "sym" set_addr $I10, rxcap_1781_fail rx1778_cur."!mark_push"(0, rx1778_pos, $I10) # rx literal "<=" add $I11, rx1778_pos, 2 gt $I11, rx1778_eos, rx1778_fail sub $I11, rx1778_pos, rx1778_off substr $S10, rx1778_tgt, $I11, 2 ne $S10, "<=", rx1778_fail add rx1778_pos, 2 set_addr $I10, rxcap_1781_fail ($I12, $I11) = rx1778_cur."!mark_peek"($I10) rx1778_cur."!cursor_pos"($I11) ($P10) = rx1778_cur."!cursor_start"() $P10."!cursor_pass"(rx1778_pos, "") rx1778_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1781_done rxcap_1781_fail: goto rx1778_fail rxcap_1781_done: # rx subrule "O" subtype=capture negate= rx1778_cur."!cursor_pos"(rx1778_pos) $P10 = rx1778_cur."O"("%relational, :pirop") unless $P10, rx1778_fail rx1778_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1778_pos = $P10."pos"() # rx pass rx1778_cur."!cursor_pass"(rx1778_pos, "infix:sym<<=>") if_null rx1778_debug, debug_935 rx1778_cur."!cursor_debug"("PASS", "infix:sym<<=>", " at pos=", rx1778_pos) debug_935: .return (rx1778_cur) rx1778_restart: .annotate 'line', 4 if_null rx1778_debug, debug_936 rx1778_cur."!cursor_debug"("NEXT", "infix:sym<<=>") debug_936: rx1778_fail: (rx1778_rep, rx1778_pos, $I10, $P10) = rx1778_cur."!mark_fail"(0) lt rx1778_pos, -1, rx1778_done eq rx1778_pos, -1, rx1778_fail jump $I10 rx1778_done: rx1778_cur."!cursor_fail"() if_null rx1778_debug, debug_937 rx1778_cur."!cursor_debug"("FAIL", "infix:sym<<=>") debug_937: .return (rx1778_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<<=>" :subid("305_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "<=") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<>=>" :subid("306_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1783_tgt .local int rx1783_pos .local int rx1783_off .local int rx1783_eos .local int rx1783_rep .local pmc rx1783_cur .local pmc rx1783_debug (rx1783_cur, rx1783_pos, rx1783_tgt, $I10) = self."!cursor_start"() getattribute rx1783_debug, rx1783_cur, "$!debug" .lex unicode:"$\x{a2}", rx1783_cur .local pmc match .lex "$/", match length rx1783_eos, rx1783_tgt gt rx1783_pos, rx1783_eos, rx1783_done set rx1783_off, 0 lt rx1783_pos, 2, rx1783_start sub rx1783_off, rx1783_pos, 1 substr rx1783_tgt, rx1783_tgt, rx1783_off rx1783_start: eq $I10, 1, rx1783_restart if_null rx1783_debug, debug_938 rx1783_cur."!cursor_debug"("START", "infix:sym<>=>") debug_938: $I10 = self.'from'() ne $I10, -1, rxscan1785_done goto rxscan1785_scan rxscan1785_loop: ($P10) = rx1783_cur."from"() inc $P10 set rx1783_pos, $P10 ge rx1783_pos, rx1783_eos, rxscan1785_done rxscan1785_scan: set_addr $I10, rxscan1785_loop rx1783_cur."!mark_push"(0, rx1783_pos, $I10) rxscan1785_done: .annotate 'line', 530 # rx subcapture "sym" set_addr $I10, rxcap_1786_fail rx1783_cur."!mark_push"(0, rx1783_pos, $I10) # rx literal ">=" add $I11, rx1783_pos, 2 gt $I11, rx1783_eos, rx1783_fail sub $I11, rx1783_pos, rx1783_off substr $S10, rx1783_tgt, $I11, 2 ne $S10, ">=", rx1783_fail add rx1783_pos, 2 set_addr $I10, rxcap_1786_fail ($I12, $I11) = rx1783_cur."!mark_peek"($I10) rx1783_cur."!cursor_pos"($I11) ($P10) = rx1783_cur."!cursor_start"() $P10."!cursor_pass"(rx1783_pos, "") rx1783_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1786_done rxcap_1786_fail: goto rx1783_fail rxcap_1786_done: # rx subrule "O" subtype=capture negate= rx1783_cur."!cursor_pos"(rx1783_pos) $P10 = rx1783_cur."O"("%relational, :pirop") unless $P10, rx1783_fail rx1783_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1783_pos = $P10."pos"() # rx pass rx1783_cur."!cursor_pass"(rx1783_pos, "infix:sym<>=>") if_null rx1783_debug, debug_939 rx1783_cur."!cursor_debug"("PASS", "infix:sym<>=>", " at pos=", rx1783_pos) debug_939: .return (rx1783_cur) rx1783_restart: .annotate 'line', 4 if_null rx1783_debug, debug_940 rx1783_cur."!cursor_debug"("NEXT", "infix:sym<>=>") debug_940: rx1783_fail: (rx1783_rep, rx1783_pos, $I10, $P10) = rx1783_cur."!mark_fail"(0) lt rx1783_pos, -1, rx1783_done eq rx1783_pos, -1, rx1783_fail jump $I10 rx1783_done: rx1783_cur."!cursor_fail"() if_null rx1783_debug, debug_941 rx1783_cur."!cursor_debug"("FAIL", "infix:sym<>=>") debug_941: .return (rx1783_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<>=>" :subid("307_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", ">=") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<<>" :subid("308_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1788_tgt .local int rx1788_pos .local int rx1788_off .local int rx1788_eos .local int rx1788_rep .local pmc rx1788_cur .local pmc rx1788_debug (rx1788_cur, rx1788_pos, rx1788_tgt, $I10) = self."!cursor_start"() getattribute rx1788_debug, rx1788_cur, "$!debug" .lex unicode:"$\x{a2}", rx1788_cur .local pmc match .lex "$/", match length rx1788_eos, rx1788_tgt gt rx1788_pos, rx1788_eos, rx1788_done set rx1788_off, 0 lt rx1788_pos, 2, rx1788_start sub rx1788_off, rx1788_pos, 1 substr rx1788_tgt, rx1788_tgt, rx1788_off rx1788_start: eq $I10, 1, rx1788_restart if_null rx1788_debug, debug_942 rx1788_cur."!cursor_debug"("START", "infix:sym<<>") debug_942: $I10 = self.'from'() ne $I10, -1, rxscan1790_done goto rxscan1790_scan rxscan1790_loop: ($P10) = rx1788_cur."from"() inc $P10 set rx1788_pos, $P10 ge rx1788_pos, rx1788_eos, rxscan1790_done rxscan1790_scan: set_addr $I10, rxscan1790_loop rx1788_cur."!mark_push"(0, rx1788_pos, $I10) rxscan1790_done: .annotate 'line', 531 # rx subcapture "sym" set_addr $I10, rxcap_1791_fail rx1788_cur."!mark_push"(0, rx1788_pos, $I10) # rx literal "<" add $I11, rx1788_pos, 1 gt $I11, rx1788_eos, rx1788_fail sub $I11, rx1788_pos, rx1788_off ord $I11, rx1788_tgt, $I11 ne $I11, 60, rx1788_fail add rx1788_pos, 1 set_addr $I10, rxcap_1791_fail ($I12, $I11) = rx1788_cur."!mark_peek"($I10) rx1788_cur."!cursor_pos"($I11) ($P10) = rx1788_cur."!cursor_start"() $P10."!cursor_pass"(rx1788_pos, "") rx1788_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1791_done rxcap_1791_fail: goto rx1788_fail rxcap_1791_done: # rx subrule "O" subtype=capture negate= rx1788_cur."!cursor_pos"(rx1788_pos) $P10 = rx1788_cur."O"("%relational, :pirop") unless $P10, rx1788_fail rx1788_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1788_pos = $P10."pos"() # rx pass rx1788_cur."!cursor_pass"(rx1788_pos, "infix:sym<<>") if_null rx1788_debug, debug_943 rx1788_cur."!cursor_debug"("PASS", "infix:sym<<>", " at pos=", rx1788_pos) debug_943: .return (rx1788_cur) rx1788_restart: .annotate 'line', 4 if_null rx1788_debug, debug_944 rx1788_cur."!cursor_debug"("NEXT", "infix:sym<<>") debug_944: rx1788_fail: (rx1788_rep, rx1788_pos, $I10, $P10) = rx1788_cur."!mark_fail"(0) lt rx1788_pos, -1, rx1788_done eq rx1788_pos, -1, rx1788_fail jump $I10 rx1788_done: rx1788_cur."!cursor_fail"() if_null rx1788_debug, debug_945 rx1788_cur."!cursor_debug"("FAIL", "infix:sym<<>") debug_945: .return (rx1788_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<<>" :subid("309_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "<") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<>>" :subid("310_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1793_tgt .local int rx1793_pos .local int rx1793_off .local int rx1793_eos .local int rx1793_rep .local pmc rx1793_cur .local pmc rx1793_debug (rx1793_cur, rx1793_pos, rx1793_tgt, $I10) = self."!cursor_start"() getattribute rx1793_debug, rx1793_cur, "$!debug" .lex unicode:"$\x{a2}", rx1793_cur .local pmc match .lex "$/", match length rx1793_eos, rx1793_tgt gt rx1793_pos, rx1793_eos, rx1793_done set rx1793_off, 0 lt rx1793_pos, 2, rx1793_start sub rx1793_off, rx1793_pos, 1 substr rx1793_tgt, rx1793_tgt, rx1793_off rx1793_start: eq $I10, 1, rx1793_restart if_null rx1793_debug, debug_946 rx1793_cur."!cursor_debug"("START", "infix:sym<>>") debug_946: $I10 = self.'from'() ne $I10, -1, rxscan1795_done goto rxscan1795_scan rxscan1795_loop: ($P10) = rx1793_cur."from"() inc $P10 set rx1793_pos, $P10 ge rx1793_pos, rx1793_eos, rxscan1795_done rxscan1795_scan: set_addr $I10, rxscan1795_loop rx1793_cur."!mark_push"(0, rx1793_pos, $I10) rxscan1795_done: .annotate 'line', 532 # rx subcapture "sym" set_addr $I10, rxcap_1796_fail rx1793_cur."!mark_push"(0, rx1793_pos, $I10) # rx literal ">" add $I11, rx1793_pos, 1 gt $I11, rx1793_eos, rx1793_fail sub $I11, rx1793_pos, rx1793_off ord $I11, rx1793_tgt, $I11 ne $I11, 62, rx1793_fail add rx1793_pos, 1 set_addr $I10, rxcap_1796_fail ($I12, $I11) = rx1793_cur."!mark_peek"($I10) rx1793_cur."!cursor_pos"($I11) ($P10) = rx1793_cur."!cursor_start"() $P10."!cursor_pass"(rx1793_pos, "") rx1793_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1796_done rxcap_1796_fail: goto rx1793_fail rxcap_1796_done: # rx subrule "O" subtype=capture negate= rx1793_cur."!cursor_pos"(rx1793_pos) $P10 = rx1793_cur."O"("%relational, :pirop") unless $P10, rx1793_fail rx1793_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1793_pos = $P10."pos"() # rx pass rx1793_cur."!cursor_pass"(rx1793_pos, "infix:sym<>>") if_null rx1793_debug, debug_947 rx1793_cur."!cursor_debug"("PASS", "infix:sym<>>", " at pos=", rx1793_pos) debug_947: .return (rx1793_cur) rx1793_restart: .annotate 'line', 4 if_null rx1793_debug, debug_948 rx1793_cur."!cursor_debug"("NEXT", "infix:sym<>>") debug_948: rx1793_fail: (rx1793_rep, rx1793_pos, $I10, $P10) = rx1793_cur."!mark_fail"(0) lt rx1793_pos, -1, rx1793_done eq rx1793_pos, -1, rx1793_fail jump $I10 rx1793_done: rx1793_cur."!cursor_fail"() if_null rx1793_debug, debug_949 rx1793_cur."!cursor_debug"("FAIL", "infix:sym<>>") debug_949: .return (rx1793_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<>>" :subid("311_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", ">") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym" :subid("312_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1798_tgt .local int rx1798_pos .local int rx1798_off .local int rx1798_eos .local int rx1798_rep .local pmc rx1798_cur .local pmc rx1798_debug (rx1798_cur, rx1798_pos, rx1798_tgt, $I10) = self."!cursor_start"() getattribute rx1798_debug, rx1798_cur, "$!debug" .lex unicode:"$\x{a2}", rx1798_cur .local pmc match .lex "$/", match length rx1798_eos, rx1798_tgt gt rx1798_pos, rx1798_eos, rx1798_done set rx1798_off, 0 lt rx1798_pos, 2, rx1798_start sub rx1798_off, rx1798_pos, 1 substr rx1798_tgt, rx1798_tgt, rx1798_off rx1798_start: eq $I10, 1, rx1798_restart if_null rx1798_debug, debug_950 rx1798_cur."!cursor_debug"("START", "infix:sym") debug_950: $I10 = self.'from'() ne $I10, -1, rxscan1800_done goto rxscan1800_scan rxscan1800_loop: ($P10) = rx1798_cur."from"() inc $P10 set rx1798_pos, $P10 ge rx1798_pos, rx1798_eos, rxscan1800_done rxscan1800_scan: set_addr $I10, rxscan1800_loop rx1798_cur."!mark_push"(0, rx1798_pos, $I10) rxscan1800_done: .annotate 'line', 533 # rx subcapture "sym" set_addr $I10, rxcap_1801_fail rx1798_cur."!mark_push"(0, rx1798_pos, $I10) # rx literal "eq" add $I11, rx1798_pos, 2 gt $I11, rx1798_eos, rx1798_fail sub $I11, rx1798_pos, rx1798_off substr $S10, rx1798_tgt, $I11, 2 ne $S10, "eq", rx1798_fail add rx1798_pos, 2 set_addr $I10, rxcap_1801_fail ($I12, $I11) = rx1798_cur."!mark_peek"($I10) rx1798_cur."!cursor_pos"($I11) ($P10) = rx1798_cur."!cursor_start"() $P10."!cursor_pass"(rx1798_pos, "") rx1798_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1801_done rxcap_1801_fail: goto rx1798_fail rxcap_1801_done: # rx subrule "O" subtype=capture negate= rx1798_cur."!cursor_pos"(rx1798_pos) $P10 = rx1798_cur."O"("%relational, :pirop") unless $P10, rx1798_fail rx1798_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1798_pos = $P10."pos"() # rx pass rx1798_cur."!cursor_pass"(rx1798_pos, "infix:sym") if_null rx1798_debug, debug_951 rx1798_cur."!cursor_debug"("PASS", "infix:sym", " at pos=", rx1798_pos) debug_951: .return (rx1798_cur) rx1798_restart: .annotate 'line', 4 if_null rx1798_debug, debug_952 rx1798_cur."!cursor_debug"("NEXT", "infix:sym") debug_952: rx1798_fail: (rx1798_rep, rx1798_pos, $I10, $P10) = rx1798_cur."!mark_fail"(0) lt rx1798_pos, -1, rx1798_done eq rx1798_pos, -1, rx1798_fail jump $I10 rx1798_done: rx1798_cur."!cursor_fail"() if_null rx1798_debug, debug_953 rx1798_cur."!cursor_debug"("FAIL", "infix:sym") debug_953: .return (rx1798_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym" :subid("313_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "eq") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym" :subid("314_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1803_tgt .local int rx1803_pos .local int rx1803_off .local int rx1803_eos .local int rx1803_rep .local pmc rx1803_cur .local pmc rx1803_debug (rx1803_cur, rx1803_pos, rx1803_tgt, $I10) = self."!cursor_start"() getattribute rx1803_debug, rx1803_cur, "$!debug" .lex unicode:"$\x{a2}", rx1803_cur .local pmc match .lex "$/", match length rx1803_eos, rx1803_tgt gt rx1803_pos, rx1803_eos, rx1803_done set rx1803_off, 0 lt rx1803_pos, 2, rx1803_start sub rx1803_off, rx1803_pos, 1 substr rx1803_tgt, rx1803_tgt, rx1803_off rx1803_start: eq $I10, 1, rx1803_restart if_null rx1803_debug, debug_954 rx1803_cur."!cursor_debug"("START", "infix:sym") debug_954: $I10 = self.'from'() ne $I10, -1, rxscan1805_done goto rxscan1805_scan rxscan1805_loop: ($P10) = rx1803_cur."from"() inc $P10 set rx1803_pos, $P10 ge rx1803_pos, rx1803_eos, rxscan1805_done rxscan1805_scan: set_addr $I10, rxscan1805_loop rx1803_cur."!mark_push"(0, rx1803_pos, $I10) rxscan1805_done: .annotate 'line', 534 # rx subcapture "sym" set_addr $I10, rxcap_1806_fail rx1803_cur."!mark_push"(0, rx1803_pos, $I10) # rx literal "ne" add $I11, rx1803_pos, 2 gt $I11, rx1803_eos, rx1803_fail sub $I11, rx1803_pos, rx1803_off substr $S10, rx1803_tgt, $I11, 2 ne $S10, "ne", rx1803_fail add rx1803_pos, 2 set_addr $I10, rxcap_1806_fail ($I12, $I11) = rx1803_cur."!mark_peek"($I10) rx1803_cur."!cursor_pos"($I11) ($P10) = rx1803_cur."!cursor_start"() $P10."!cursor_pass"(rx1803_pos, "") rx1803_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1806_done rxcap_1806_fail: goto rx1803_fail rxcap_1806_done: # rx subrule "O" subtype=capture negate= rx1803_cur."!cursor_pos"(rx1803_pos) $P10 = rx1803_cur."O"("%relational, :pirop") unless $P10, rx1803_fail rx1803_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1803_pos = $P10."pos"() # rx pass rx1803_cur."!cursor_pass"(rx1803_pos, "infix:sym") if_null rx1803_debug, debug_955 rx1803_cur."!cursor_debug"("PASS", "infix:sym", " at pos=", rx1803_pos) debug_955: .return (rx1803_cur) rx1803_restart: .annotate 'line', 4 if_null rx1803_debug, debug_956 rx1803_cur."!cursor_debug"("NEXT", "infix:sym") debug_956: rx1803_fail: (rx1803_rep, rx1803_pos, $I10, $P10) = rx1803_cur."!mark_fail"(0) lt rx1803_pos, -1, rx1803_done eq rx1803_pos, -1, rx1803_fail jump $I10 rx1803_done: rx1803_cur."!cursor_fail"() if_null rx1803_debug, debug_957 rx1803_cur."!cursor_debug"("FAIL", "infix:sym") debug_957: .return (rx1803_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym" :subid("315_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "ne") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym" :subid("316_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1808_tgt .local int rx1808_pos .local int rx1808_off .local int rx1808_eos .local int rx1808_rep .local pmc rx1808_cur .local pmc rx1808_debug (rx1808_cur, rx1808_pos, rx1808_tgt, $I10) = self."!cursor_start"() getattribute rx1808_debug, rx1808_cur, "$!debug" .lex unicode:"$\x{a2}", rx1808_cur .local pmc match .lex "$/", match length rx1808_eos, rx1808_tgt gt rx1808_pos, rx1808_eos, rx1808_done set rx1808_off, 0 lt rx1808_pos, 2, rx1808_start sub rx1808_off, rx1808_pos, 1 substr rx1808_tgt, rx1808_tgt, rx1808_off rx1808_start: eq $I10, 1, rx1808_restart if_null rx1808_debug, debug_958 rx1808_cur."!cursor_debug"("START", "infix:sym") debug_958: $I10 = self.'from'() ne $I10, -1, rxscan1810_done goto rxscan1810_scan rxscan1810_loop: ($P10) = rx1808_cur."from"() inc $P10 set rx1808_pos, $P10 ge rx1808_pos, rx1808_eos, rxscan1810_done rxscan1810_scan: set_addr $I10, rxscan1810_loop rx1808_cur."!mark_push"(0, rx1808_pos, $I10) rxscan1810_done: .annotate 'line', 535 # rx subcapture "sym" set_addr $I10, rxcap_1811_fail rx1808_cur."!mark_push"(0, rx1808_pos, $I10) # rx literal "le" add $I11, rx1808_pos, 2 gt $I11, rx1808_eos, rx1808_fail sub $I11, rx1808_pos, rx1808_off substr $S10, rx1808_tgt, $I11, 2 ne $S10, "le", rx1808_fail add rx1808_pos, 2 set_addr $I10, rxcap_1811_fail ($I12, $I11) = rx1808_cur."!mark_peek"($I10) rx1808_cur."!cursor_pos"($I11) ($P10) = rx1808_cur."!cursor_start"() $P10."!cursor_pass"(rx1808_pos, "") rx1808_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1811_done rxcap_1811_fail: goto rx1808_fail rxcap_1811_done: # rx subrule "O" subtype=capture negate= rx1808_cur."!cursor_pos"(rx1808_pos) $P10 = rx1808_cur."O"("%relational, :pirop") unless $P10, rx1808_fail rx1808_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1808_pos = $P10."pos"() # rx pass rx1808_cur."!cursor_pass"(rx1808_pos, "infix:sym") if_null rx1808_debug, debug_959 rx1808_cur."!cursor_debug"("PASS", "infix:sym", " at pos=", rx1808_pos) debug_959: .return (rx1808_cur) rx1808_restart: .annotate 'line', 4 if_null rx1808_debug, debug_960 rx1808_cur."!cursor_debug"("NEXT", "infix:sym") debug_960: rx1808_fail: (rx1808_rep, rx1808_pos, $I10, $P10) = rx1808_cur."!mark_fail"(0) lt rx1808_pos, -1, rx1808_done eq rx1808_pos, -1, rx1808_fail jump $I10 rx1808_done: rx1808_cur."!cursor_fail"() if_null rx1808_debug, debug_961 rx1808_cur."!cursor_debug"("FAIL", "infix:sym") debug_961: .return (rx1808_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym" :subid("317_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "le") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym" :subid("318_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1813_tgt .local int rx1813_pos .local int rx1813_off .local int rx1813_eos .local int rx1813_rep .local pmc rx1813_cur .local pmc rx1813_debug (rx1813_cur, rx1813_pos, rx1813_tgt, $I10) = self."!cursor_start"() getattribute rx1813_debug, rx1813_cur, "$!debug" .lex unicode:"$\x{a2}", rx1813_cur .local pmc match .lex "$/", match length rx1813_eos, rx1813_tgt gt rx1813_pos, rx1813_eos, rx1813_done set rx1813_off, 0 lt rx1813_pos, 2, rx1813_start sub rx1813_off, rx1813_pos, 1 substr rx1813_tgt, rx1813_tgt, rx1813_off rx1813_start: eq $I10, 1, rx1813_restart if_null rx1813_debug, debug_962 rx1813_cur."!cursor_debug"("START", "infix:sym") debug_962: $I10 = self.'from'() ne $I10, -1, rxscan1815_done goto rxscan1815_scan rxscan1815_loop: ($P10) = rx1813_cur."from"() inc $P10 set rx1813_pos, $P10 ge rx1813_pos, rx1813_eos, rxscan1815_done rxscan1815_scan: set_addr $I10, rxscan1815_loop rx1813_cur."!mark_push"(0, rx1813_pos, $I10) rxscan1815_done: .annotate 'line', 536 # rx subcapture "sym" set_addr $I10, rxcap_1816_fail rx1813_cur."!mark_push"(0, rx1813_pos, $I10) # rx literal "ge" add $I11, rx1813_pos, 2 gt $I11, rx1813_eos, rx1813_fail sub $I11, rx1813_pos, rx1813_off substr $S10, rx1813_tgt, $I11, 2 ne $S10, "ge", rx1813_fail add rx1813_pos, 2 set_addr $I10, rxcap_1816_fail ($I12, $I11) = rx1813_cur."!mark_peek"($I10) rx1813_cur."!cursor_pos"($I11) ($P10) = rx1813_cur."!cursor_start"() $P10."!cursor_pass"(rx1813_pos, "") rx1813_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1816_done rxcap_1816_fail: goto rx1813_fail rxcap_1816_done: # rx subrule "O" subtype=capture negate= rx1813_cur."!cursor_pos"(rx1813_pos) $P10 = rx1813_cur."O"("%relational, :pirop") unless $P10, rx1813_fail rx1813_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1813_pos = $P10."pos"() # rx pass rx1813_cur."!cursor_pass"(rx1813_pos, "infix:sym") if_null rx1813_debug, debug_963 rx1813_cur."!cursor_debug"("PASS", "infix:sym", " at pos=", rx1813_pos) debug_963: .return (rx1813_cur) rx1813_restart: .annotate 'line', 4 if_null rx1813_debug, debug_964 rx1813_cur."!cursor_debug"("NEXT", "infix:sym") debug_964: rx1813_fail: (rx1813_rep, rx1813_pos, $I10, $P10) = rx1813_cur."!mark_fail"(0) lt rx1813_pos, -1, rx1813_done eq rx1813_pos, -1, rx1813_fail jump $I10 rx1813_done: rx1813_cur."!cursor_fail"() if_null rx1813_debug, debug_965 rx1813_cur."!cursor_debug"("FAIL", "infix:sym") debug_965: .return (rx1813_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym" :subid("319_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "ge") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym" :subid("320_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1818_tgt .local int rx1818_pos .local int rx1818_off .local int rx1818_eos .local int rx1818_rep .local pmc rx1818_cur .local pmc rx1818_debug (rx1818_cur, rx1818_pos, rx1818_tgt, $I10) = self."!cursor_start"() getattribute rx1818_debug, rx1818_cur, "$!debug" .lex unicode:"$\x{a2}", rx1818_cur .local pmc match .lex "$/", match length rx1818_eos, rx1818_tgt gt rx1818_pos, rx1818_eos, rx1818_done set rx1818_off, 0 lt rx1818_pos, 2, rx1818_start sub rx1818_off, rx1818_pos, 1 substr rx1818_tgt, rx1818_tgt, rx1818_off rx1818_start: eq $I10, 1, rx1818_restart if_null rx1818_debug, debug_966 rx1818_cur."!cursor_debug"("START", "infix:sym") debug_966: $I10 = self.'from'() ne $I10, -1, rxscan1820_done goto rxscan1820_scan rxscan1820_loop: ($P10) = rx1818_cur."from"() inc $P10 set rx1818_pos, $P10 ge rx1818_pos, rx1818_eos, rxscan1820_done rxscan1820_scan: set_addr $I10, rxscan1820_loop rx1818_cur."!mark_push"(0, rx1818_pos, $I10) rxscan1820_done: .annotate 'line', 537 # rx subcapture "sym" set_addr $I10, rxcap_1821_fail rx1818_cur."!mark_push"(0, rx1818_pos, $I10) # rx literal "lt" add $I11, rx1818_pos, 2 gt $I11, rx1818_eos, rx1818_fail sub $I11, rx1818_pos, rx1818_off substr $S10, rx1818_tgt, $I11, 2 ne $S10, "lt", rx1818_fail add rx1818_pos, 2 set_addr $I10, rxcap_1821_fail ($I12, $I11) = rx1818_cur."!mark_peek"($I10) rx1818_cur."!cursor_pos"($I11) ($P10) = rx1818_cur."!cursor_start"() $P10."!cursor_pass"(rx1818_pos, "") rx1818_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1821_done rxcap_1821_fail: goto rx1818_fail rxcap_1821_done: # rx subrule "O" subtype=capture negate= rx1818_cur."!cursor_pos"(rx1818_pos) $P10 = rx1818_cur."O"("%relational, :pirop") unless $P10, rx1818_fail rx1818_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1818_pos = $P10."pos"() # rx pass rx1818_cur."!cursor_pass"(rx1818_pos, "infix:sym") if_null rx1818_debug, debug_967 rx1818_cur."!cursor_debug"("PASS", "infix:sym", " at pos=", rx1818_pos) debug_967: .return (rx1818_cur) rx1818_restart: .annotate 'line', 4 if_null rx1818_debug, debug_968 rx1818_cur."!cursor_debug"("NEXT", "infix:sym") debug_968: rx1818_fail: (rx1818_rep, rx1818_pos, $I10, $P10) = rx1818_cur."!mark_fail"(0) lt rx1818_pos, -1, rx1818_done eq rx1818_pos, -1, rx1818_fail jump $I10 rx1818_done: rx1818_cur."!cursor_fail"() if_null rx1818_debug, debug_969 rx1818_cur."!cursor_debug"("FAIL", "infix:sym") debug_969: .return (rx1818_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym" :subid("321_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "lt") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym" :subid("322_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1823_tgt .local int rx1823_pos .local int rx1823_off .local int rx1823_eos .local int rx1823_rep .local pmc rx1823_cur .local pmc rx1823_debug (rx1823_cur, rx1823_pos, rx1823_tgt, $I10) = self."!cursor_start"() getattribute rx1823_debug, rx1823_cur, "$!debug" .lex unicode:"$\x{a2}", rx1823_cur .local pmc match .lex "$/", match length rx1823_eos, rx1823_tgt gt rx1823_pos, rx1823_eos, rx1823_done set rx1823_off, 0 lt rx1823_pos, 2, rx1823_start sub rx1823_off, rx1823_pos, 1 substr rx1823_tgt, rx1823_tgt, rx1823_off rx1823_start: eq $I10, 1, rx1823_restart if_null rx1823_debug, debug_970 rx1823_cur."!cursor_debug"("START", "infix:sym") debug_970: $I10 = self.'from'() ne $I10, -1, rxscan1825_done goto rxscan1825_scan rxscan1825_loop: ($P10) = rx1823_cur."from"() inc $P10 set rx1823_pos, $P10 ge rx1823_pos, rx1823_eos, rxscan1825_done rxscan1825_scan: set_addr $I10, rxscan1825_loop rx1823_cur."!mark_push"(0, rx1823_pos, $I10) rxscan1825_done: .annotate 'line', 538 # rx subcapture "sym" set_addr $I10, rxcap_1826_fail rx1823_cur."!mark_push"(0, rx1823_pos, $I10) # rx literal "gt" add $I11, rx1823_pos, 2 gt $I11, rx1823_eos, rx1823_fail sub $I11, rx1823_pos, rx1823_off substr $S10, rx1823_tgt, $I11, 2 ne $S10, "gt", rx1823_fail add rx1823_pos, 2 set_addr $I10, rxcap_1826_fail ($I12, $I11) = rx1823_cur."!mark_peek"($I10) rx1823_cur."!cursor_pos"($I11) ($P10) = rx1823_cur."!cursor_start"() $P10."!cursor_pass"(rx1823_pos, "") rx1823_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1826_done rxcap_1826_fail: goto rx1823_fail rxcap_1826_done: # rx subrule "O" subtype=capture negate= rx1823_cur."!cursor_pos"(rx1823_pos) $P10 = rx1823_cur."O"("%relational, :pirop") unless $P10, rx1823_fail rx1823_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1823_pos = $P10."pos"() # rx pass rx1823_cur."!cursor_pass"(rx1823_pos, "infix:sym") if_null rx1823_debug, debug_971 rx1823_cur."!cursor_debug"("PASS", "infix:sym", " at pos=", rx1823_pos) debug_971: .return (rx1823_cur) rx1823_restart: .annotate 'line', 4 if_null rx1823_debug, debug_972 rx1823_cur."!cursor_debug"("NEXT", "infix:sym") debug_972: rx1823_fail: (rx1823_rep, rx1823_pos, $I10, $P10) = rx1823_cur."!mark_fail"(0) lt rx1823_pos, -1, rx1823_done eq rx1823_pos, -1, rx1823_fail jump $I10 rx1823_done: rx1823_cur."!cursor_fail"() if_null rx1823_debug, debug_973 rx1823_cur."!cursor_debug"("FAIL", "infix:sym") debug_973: .return (rx1823_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym" :subid("323_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "gt") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<=:=>" :subid("324_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1828_tgt .local int rx1828_pos .local int rx1828_off .local int rx1828_eos .local int rx1828_rep .local pmc rx1828_cur .local pmc rx1828_debug (rx1828_cur, rx1828_pos, rx1828_tgt, $I10) = self."!cursor_start"() getattribute rx1828_debug, rx1828_cur, "$!debug" .lex unicode:"$\x{a2}", rx1828_cur .local pmc match .lex "$/", match length rx1828_eos, rx1828_tgt gt rx1828_pos, rx1828_eos, rx1828_done set rx1828_off, 0 lt rx1828_pos, 2, rx1828_start sub rx1828_off, rx1828_pos, 1 substr rx1828_tgt, rx1828_tgt, rx1828_off rx1828_start: eq $I10, 1, rx1828_restart if_null rx1828_debug, debug_974 rx1828_cur."!cursor_debug"("START", "infix:sym<=:=>") debug_974: $I10 = self.'from'() ne $I10, -1, rxscan1830_done goto rxscan1830_scan rxscan1830_loop: ($P10) = rx1828_cur."from"() inc $P10 set rx1828_pos, $P10 ge rx1828_pos, rx1828_eos, rxscan1830_done rxscan1830_scan: set_addr $I10, rxscan1830_loop rx1828_cur."!mark_push"(0, rx1828_pos, $I10) rxscan1830_done: .annotate 'line', 539 # rx subcapture "sym" set_addr $I10, rxcap_1831_fail rx1828_cur."!mark_push"(0, rx1828_pos, $I10) # rx literal "=:=" add $I11, rx1828_pos, 3 gt $I11, rx1828_eos, rx1828_fail sub $I11, rx1828_pos, rx1828_off substr $S10, rx1828_tgt, $I11, 3 ne $S10, "=:=", rx1828_fail add rx1828_pos, 3 set_addr $I10, rxcap_1831_fail ($I12, $I11) = rx1828_cur."!mark_peek"($I10) rx1828_cur."!cursor_pos"($I11) ($P10) = rx1828_cur."!cursor_start"() $P10."!cursor_pass"(rx1828_pos, "") rx1828_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1831_done rxcap_1831_fail: goto rx1828_fail rxcap_1831_done: # rx subrule "O" subtype=capture negate= rx1828_cur."!cursor_pos"(rx1828_pos) $P10 = rx1828_cur."O"("%relational, :pirop") unless $P10, rx1828_fail rx1828_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1828_pos = $P10."pos"() # rx pass rx1828_cur."!cursor_pass"(rx1828_pos, "infix:sym<=:=>") if_null rx1828_debug, debug_975 rx1828_cur."!cursor_debug"("PASS", "infix:sym<=:=>", " at pos=", rx1828_pos) debug_975: .return (rx1828_cur) rx1828_restart: .annotate 'line', 4 if_null rx1828_debug, debug_976 rx1828_cur."!cursor_debug"("NEXT", "infix:sym<=:=>") debug_976: rx1828_fail: (rx1828_rep, rx1828_pos, $I10, $P10) = rx1828_cur."!mark_fail"(0) lt rx1828_pos, -1, rx1828_done eq rx1828_pos, -1, rx1828_fail jump $I10 rx1828_done: rx1828_cur."!cursor_fail"() if_null rx1828_debug, debug_977 rx1828_cur."!cursor_debug"("FAIL", "infix:sym<=:=>") debug_977: .return (rx1828_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<=:=>" :subid("325_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "=:=") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<~~>" :subid("326_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1833_tgt .local int rx1833_pos .local int rx1833_off .local int rx1833_eos .local int rx1833_rep .local pmc rx1833_cur .local pmc rx1833_debug (rx1833_cur, rx1833_pos, rx1833_tgt, $I10) = self."!cursor_start"() getattribute rx1833_debug, rx1833_cur, "$!debug" .lex unicode:"$\x{a2}", rx1833_cur .local pmc match .lex "$/", match length rx1833_eos, rx1833_tgt gt rx1833_pos, rx1833_eos, rx1833_done set rx1833_off, 0 lt rx1833_pos, 2, rx1833_start sub rx1833_off, rx1833_pos, 1 substr rx1833_tgt, rx1833_tgt, rx1833_off rx1833_start: eq $I10, 1, rx1833_restart if_null rx1833_debug, debug_978 rx1833_cur."!cursor_debug"("START", "infix:sym<~~>") debug_978: $I10 = self.'from'() ne $I10, -1, rxscan1835_done goto rxscan1835_scan rxscan1835_loop: ($P10) = rx1833_cur."from"() inc $P10 set rx1833_pos, $P10 ge rx1833_pos, rx1833_eos, rxscan1835_done rxscan1835_scan: set_addr $I10, rxscan1835_loop rx1833_cur."!mark_push"(0, rx1833_pos, $I10) rxscan1835_done: .annotate 'line', 540 # rx subcapture "sym" set_addr $I10, rxcap_1836_fail rx1833_cur."!mark_push"(0, rx1833_pos, $I10) # rx literal "~~" add $I11, rx1833_pos, 2 gt $I11, rx1833_eos, rx1833_fail sub $I11, rx1833_pos, rx1833_off substr $S10, rx1833_tgt, $I11, 2 ne $S10, "~~", rx1833_fail add rx1833_pos, 2 set_addr $I10, rxcap_1836_fail ($I12, $I11) = rx1833_cur."!mark_peek"($I10) rx1833_cur."!cursor_pos"($I11) ($P10) = rx1833_cur."!cursor_start"() $P10."!cursor_pass"(rx1833_pos, "") rx1833_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1836_done rxcap_1836_fail: goto rx1833_fail rxcap_1836_done: # rx subrule "O" subtype=capture negate= rx1833_cur."!cursor_pos"(rx1833_pos) $P10 = rx1833_cur."O"("%relational, :reducecheck") unless $P10, rx1833_fail rx1833_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1833_pos = $P10."pos"() # rx pass rx1833_cur."!cursor_pass"(rx1833_pos, "infix:sym<~~>") if_null rx1833_debug, debug_979 rx1833_cur."!cursor_debug"("PASS", "infix:sym<~~>", " at pos=", rx1833_pos) debug_979: .return (rx1833_cur) rx1833_restart: .annotate 'line', 4 if_null rx1833_debug, debug_980 rx1833_cur."!cursor_debug"("NEXT", "infix:sym<~~>") debug_980: rx1833_fail: (rx1833_rep, rx1833_pos, $I10, $P10) = rx1833_cur."!mark_fail"(0) lt rx1833_pos, -1, rx1833_done eq rx1833_pos, -1, rx1833_fail jump $I10 rx1833_done: rx1833_cur."!cursor_fail"() if_null rx1833_debug, debug_981 rx1833_cur."!cursor_debug"("FAIL", "infix:sym<~~>") debug_981: .return (rx1833_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<~~>" :subid("327_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "~~") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<&&>" :subid("328_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1838_tgt .local int rx1838_pos .local int rx1838_off .local int rx1838_eos .local int rx1838_rep .local pmc rx1838_cur .local pmc rx1838_debug (rx1838_cur, rx1838_pos, rx1838_tgt, $I10) = self."!cursor_start"() getattribute rx1838_debug, rx1838_cur, "$!debug" .lex unicode:"$\x{a2}", rx1838_cur .local pmc match .lex "$/", match length rx1838_eos, rx1838_tgt gt rx1838_pos, rx1838_eos, rx1838_done set rx1838_off, 0 lt rx1838_pos, 2, rx1838_start sub rx1838_off, rx1838_pos, 1 substr rx1838_tgt, rx1838_tgt, rx1838_off rx1838_start: eq $I10, 1, rx1838_restart if_null rx1838_debug, debug_982 rx1838_cur."!cursor_debug"("START", "infix:sym<&&>") debug_982: $I10 = self.'from'() ne $I10, -1, rxscan1840_done goto rxscan1840_scan rxscan1840_loop: ($P10) = rx1838_cur."from"() inc $P10 set rx1838_pos, $P10 ge rx1838_pos, rx1838_eos, rxscan1840_done rxscan1840_scan: set_addr $I10, rxscan1840_loop rx1838_cur."!mark_push"(0, rx1838_pos, $I10) rxscan1840_done: .annotate 'line', 542 # rx subcapture "sym" set_addr $I10, rxcap_1841_fail rx1838_cur."!mark_push"(0, rx1838_pos, $I10) # rx literal "&&" add $I11, rx1838_pos, 2 gt $I11, rx1838_eos, rx1838_fail sub $I11, rx1838_pos, rx1838_off substr $S10, rx1838_tgt, $I11, 2 ne $S10, "&&", rx1838_fail add rx1838_pos, 2 set_addr $I10, rxcap_1841_fail ($I12, $I11) = rx1838_cur."!mark_peek"($I10) rx1838_cur."!cursor_pos"($I11) ($P10) = rx1838_cur."!cursor_start"() $P10."!cursor_pass"(rx1838_pos, "") rx1838_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1841_done rxcap_1841_fail: goto rx1838_fail rxcap_1841_done: # rx subrule "O" subtype=capture negate= rx1838_cur."!cursor_pos"(rx1838_pos) $P10 = rx1838_cur."O"("%tight_and, :pasttype") unless $P10, rx1838_fail rx1838_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1838_pos = $P10."pos"() # rx pass rx1838_cur."!cursor_pass"(rx1838_pos, "infix:sym<&&>") if_null rx1838_debug, debug_983 rx1838_cur."!cursor_debug"("PASS", "infix:sym<&&>", " at pos=", rx1838_pos) debug_983: .return (rx1838_cur) rx1838_restart: .annotate 'line', 4 if_null rx1838_debug, debug_984 rx1838_cur."!cursor_debug"("NEXT", "infix:sym<&&>") debug_984: rx1838_fail: (rx1838_rep, rx1838_pos, $I10, $P10) = rx1838_cur."!mark_fail"(0) lt rx1838_pos, -1, rx1838_done eq rx1838_pos, -1, rx1838_fail jump $I10 rx1838_done: rx1838_cur."!cursor_fail"() if_null rx1838_debug, debug_985 rx1838_cur."!cursor_debug"("FAIL", "infix:sym<&&>") debug_985: .return (rx1838_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<&&>" :subid("329_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "&&") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<||>" :subid("330_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1843_tgt .local int rx1843_pos .local int rx1843_off .local int rx1843_eos .local int rx1843_rep .local pmc rx1843_cur .local pmc rx1843_debug (rx1843_cur, rx1843_pos, rx1843_tgt, $I10) = self."!cursor_start"() getattribute rx1843_debug, rx1843_cur, "$!debug" .lex unicode:"$\x{a2}", rx1843_cur .local pmc match .lex "$/", match length rx1843_eos, rx1843_tgt gt rx1843_pos, rx1843_eos, rx1843_done set rx1843_off, 0 lt rx1843_pos, 2, rx1843_start sub rx1843_off, rx1843_pos, 1 substr rx1843_tgt, rx1843_tgt, rx1843_off rx1843_start: eq $I10, 1, rx1843_restart if_null rx1843_debug, debug_986 rx1843_cur."!cursor_debug"("START", "infix:sym<||>") debug_986: $I10 = self.'from'() ne $I10, -1, rxscan1845_done goto rxscan1845_scan rxscan1845_loop: ($P10) = rx1843_cur."from"() inc $P10 set rx1843_pos, $P10 ge rx1843_pos, rx1843_eos, rxscan1845_done rxscan1845_scan: set_addr $I10, rxscan1845_loop rx1843_cur."!mark_push"(0, rx1843_pos, $I10) rxscan1845_done: .annotate 'line', 544 # rx subcapture "sym" set_addr $I10, rxcap_1846_fail rx1843_cur."!mark_push"(0, rx1843_pos, $I10) # rx literal "||" add $I11, rx1843_pos, 2 gt $I11, rx1843_eos, rx1843_fail sub $I11, rx1843_pos, rx1843_off substr $S10, rx1843_tgt, $I11, 2 ne $S10, "||", rx1843_fail add rx1843_pos, 2 set_addr $I10, rxcap_1846_fail ($I12, $I11) = rx1843_cur."!mark_peek"($I10) rx1843_cur."!cursor_pos"($I11) ($P10) = rx1843_cur."!cursor_start"() $P10."!cursor_pass"(rx1843_pos, "") rx1843_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1846_done rxcap_1846_fail: goto rx1843_fail rxcap_1846_done: # rx subrule "O" subtype=capture negate= rx1843_cur."!cursor_pos"(rx1843_pos) $P10 = rx1843_cur."O"("%tight_or, :pasttype") unless $P10, rx1843_fail rx1843_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1843_pos = $P10."pos"() # rx pass rx1843_cur."!cursor_pass"(rx1843_pos, "infix:sym<||>") if_null rx1843_debug, debug_987 rx1843_cur."!cursor_debug"("PASS", "infix:sym<||>", " at pos=", rx1843_pos) debug_987: .return (rx1843_cur) rx1843_restart: .annotate 'line', 4 if_null rx1843_debug, debug_988 rx1843_cur."!cursor_debug"("NEXT", "infix:sym<||>") debug_988: rx1843_fail: (rx1843_rep, rx1843_pos, $I10, $P10) = rx1843_cur."!mark_fail"(0) lt rx1843_pos, -1, rx1843_done eq rx1843_pos, -1, rx1843_fail jump $I10 rx1843_done: rx1843_cur."!cursor_fail"() if_null rx1843_debug, debug_989 rx1843_cur."!cursor_debug"("FAIL", "infix:sym<||>") debug_989: .return (rx1843_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<||>" :subid("331_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "||") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym" :subid("332_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1848_tgt .local int rx1848_pos .local int rx1848_off .local int rx1848_eos .local int rx1848_rep .local pmc rx1848_cur .local pmc rx1848_debug (rx1848_cur, rx1848_pos, rx1848_tgt, $I10) = self."!cursor_start"() getattribute rx1848_debug, rx1848_cur, "$!debug" .lex unicode:"$\x{a2}", rx1848_cur .local pmc match .lex "$/", match length rx1848_eos, rx1848_tgt gt rx1848_pos, rx1848_eos, rx1848_done set rx1848_off, 0 lt rx1848_pos, 2, rx1848_start sub rx1848_off, rx1848_pos, 1 substr rx1848_tgt, rx1848_tgt, rx1848_off rx1848_start: eq $I10, 1, rx1848_restart if_null rx1848_debug, debug_990 rx1848_cur."!cursor_debug"("START", "infix:sym") debug_990: $I10 = self.'from'() ne $I10, -1, rxscan1850_done goto rxscan1850_scan rxscan1850_loop: ($P10) = rx1848_cur."from"() inc $P10 set rx1848_pos, $P10 ge rx1848_pos, rx1848_eos, rxscan1850_done rxscan1850_scan: set_addr $I10, rxscan1850_loop rx1848_cur."!mark_push"(0, rx1848_pos, $I10) rxscan1850_done: .annotate 'line', 545 # rx subcapture "sym" set_addr $I10, rxcap_1851_fail rx1848_cur."!mark_push"(0, rx1848_pos, $I10) # rx literal "//" add $I11, rx1848_pos, 2 gt $I11, rx1848_eos, rx1848_fail sub $I11, rx1848_pos, rx1848_off substr $S10, rx1848_tgt, $I11, 2 ne $S10, "//", rx1848_fail add rx1848_pos, 2 set_addr $I10, rxcap_1851_fail ($I12, $I11) = rx1848_cur."!mark_peek"($I10) rx1848_cur."!cursor_pos"($I11) ($P10) = rx1848_cur."!cursor_start"() $P10."!cursor_pass"(rx1848_pos, "") rx1848_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1851_done rxcap_1851_fail: goto rx1848_fail rxcap_1851_done: # rx subrule "O" subtype=capture negate= rx1848_cur."!cursor_pos"(rx1848_pos) $P10 = rx1848_cur."O"("%tight_or, :pasttype") unless $P10, rx1848_fail rx1848_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1848_pos = $P10."pos"() # rx pass rx1848_cur."!cursor_pass"(rx1848_pos, "infix:sym") if_null rx1848_debug, debug_991 rx1848_cur."!cursor_debug"("PASS", "infix:sym", " at pos=", rx1848_pos) debug_991: .return (rx1848_cur) rx1848_restart: .annotate 'line', 4 if_null rx1848_debug, debug_992 rx1848_cur."!cursor_debug"("NEXT", "infix:sym") debug_992: rx1848_fail: (rx1848_rep, rx1848_pos, $I10, $P10) = rx1848_cur."!mark_fail"(0) lt rx1848_pos, -1, rx1848_done eq rx1848_pos, -1, rx1848_fail jump $I10 rx1848_done: rx1848_cur."!cursor_fail"() if_null rx1848_debug, debug_993 rx1848_cur."!cursor_debug"("FAIL", "infix:sym") debug_993: .return (rx1848_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym" :subid("333_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "//") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym" :subid("334_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1853_tgt .local int rx1853_pos .local int rx1853_off .local int rx1853_eos .local int rx1853_rep .local pmc rx1853_cur .local pmc rx1853_debug (rx1853_cur, rx1853_pos, rx1853_tgt, $I10) = self."!cursor_start"() getattribute rx1853_debug, rx1853_cur, "$!debug" .lex unicode:"$\x{a2}", rx1853_cur .local pmc match .lex "$/", match length rx1853_eos, rx1853_tgt gt rx1853_pos, rx1853_eos, rx1853_done set rx1853_off, 0 lt rx1853_pos, 2, rx1853_start sub rx1853_off, rx1853_pos, 1 substr rx1853_tgt, rx1853_tgt, rx1853_off rx1853_start: eq $I10, 1, rx1853_restart if_null rx1853_debug, debug_994 rx1853_cur."!cursor_debug"("START", "infix:sym") debug_994: $I10 = self.'from'() ne $I10, -1, rxscan1855_done goto rxscan1855_scan rxscan1855_loop: ($P10) = rx1853_cur."from"() inc $P10 set rx1853_pos, $P10 ge rx1853_pos, rx1853_eos, rxscan1855_done rxscan1855_scan: set_addr $I10, rxscan1855_loop rx1853_cur."!mark_push"(0, rx1853_pos, $I10) rxscan1855_done: .annotate 'line', 548 # rx literal "??" add $I11, rx1853_pos, 2 gt $I11, rx1853_eos, rx1853_fail sub $I11, rx1853_pos, rx1853_off substr $S10, rx1853_tgt, $I11, 2 ne $S10, "??", rx1853_fail add rx1853_pos, 2 .annotate 'line', 549 # rx subrule "ws" subtype=method negate= rx1853_cur."!cursor_pos"(rx1853_pos) $P10 = rx1853_cur."ws"() unless $P10, rx1853_fail rx1853_pos = $P10."pos"() .annotate 'line', 550 # rx subrule "EXPR" subtype=capture negate= rx1853_cur."!cursor_pos"(rx1853_pos) $P10 = rx1853_cur."EXPR"("i=") unless $P10, rx1853_fail rx1853_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("EXPR") rx1853_pos = $P10."pos"() .annotate 'line', 551 # rx literal "!!" add $I11, rx1853_pos, 2 gt $I11, rx1853_eos, rx1853_fail sub $I11, rx1853_pos, rx1853_off substr $S10, rx1853_tgt, $I11, 2 ne $S10, "!!", rx1853_fail add rx1853_pos, 2 .annotate 'line', 552 # rx subrule "O" subtype=capture negate= rx1853_cur."!cursor_pos"(rx1853_pos) $P10 = rx1853_cur."O"("%conditional, :reducecheck, :pasttype") unless $P10, rx1853_fail rx1853_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1853_pos = $P10."pos"() .annotate 'line', 547 # rx pass rx1853_cur."!cursor_pass"(rx1853_pos, "infix:sym") if_null rx1853_debug, debug_995 rx1853_cur."!cursor_debug"("PASS", "infix:sym", " at pos=", rx1853_pos) debug_995: .return (rx1853_cur) rx1853_restart: .annotate 'line', 4 if_null rx1853_debug, debug_996 rx1853_cur."!cursor_debug"("NEXT", "infix:sym") debug_996: rx1853_fail: (rx1853_rep, rx1853_pos, $I10, $P10) = rx1853_cur."!mark_fail"(0) lt rx1853_pos, -1, rx1853_done eq rx1853_pos, -1, rx1853_fail jump $I10 rx1853_done: rx1853_cur."!cursor_fail"() if_null rx1853_debug, debug_997 rx1853_cur."!cursor_debug"("FAIL", "infix:sym") debug_997: .return (rx1853_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym" :subid("335_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("ws", "??") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<=>" :subid("336_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1857_tgt .local int rx1857_pos .local int rx1857_off .local int rx1857_eos .local int rx1857_rep .local pmc rx1857_cur .local pmc rx1857_debug (rx1857_cur, rx1857_pos, rx1857_tgt, $I10) = self."!cursor_start"() getattribute rx1857_debug, rx1857_cur, "$!debug" .lex unicode:"$\x{a2}", rx1857_cur .local pmc match .lex "$/", match length rx1857_eos, rx1857_tgt gt rx1857_pos, rx1857_eos, rx1857_done set rx1857_off, 0 lt rx1857_pos, 2, rx1857_start sub rx1857_off, rx1857_pos, 1 substr rx1857_tgt, rx1857_tgt, rx1857_off rx1857_start: eq $I10, 1, rx1857_restart if_null rx1857_debug, debug_998 rx1857_cur."!cursor_debug"("START", "infix:sym<=>") debug_998: $I10 = self.'from'() ne $I10, -1, rxscan1859_done goto rxscan1859_scan rxscan1859_loop: ($P10) = rx1857_cur."from"() inc $P10 set rx1857_pos, $P10 ge rx1857_pos, rx1857_eos, rxscan1859_done rxscan1859_scan: set_addr $I10, rxscan1859_loop rx1857_cur."!mark_push"(0, rx1857_pos, $I10) rxscan1859_done: .annotate 'line', 556 # rx subcapture "sym" set_addr $I10, rxcap_1860_fail rx1857_cur."!mark_push"(0, rx1857_pos, $I10) # rx literal "=" add $I11, rx1857_pos, 1 gt $I11, rx1857_eos, rx1857_fail sub $I11, rx1857_pos, rx1857_off ord $I11, rx1857_tgt, $I11 ne $I11, 61, rx1857_fail add rx1857_pos, 1 set_addr $I10, rxcap_1860_fail ($I12, $I11) = rx1857_cur."!mark_peek"($I10) rx1857_cur."!cursor_pos"($I11) ($P10) = rx1857_cur."!cursor_start"() $P10."!cursor_pass"(rx1857_pos, "") rx1857_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1860_done rxcap_1860_fail: goto rx1857_fail rxcap_1860_done: # rx subrule "panic" subtype=method negate= rx1857_cur."!cursor_pos"(rx1857_pos) $P10 = rx1857_cur."panic"("Assignment (\"=\") not supported in NQP, use \":=\" instead") unless $P10, rx1857_fail rx1857_pos = $P10."pos"() .annotate 'line', 555 # rx pass rx1857_cur."!cursor_pass"(rx1857_pos, "infix:sym<=>") if_null rx1857_debug, debug_999 rx1857_cur."!cursor_debug"("PASS", "infix:sym<=>", " at pos=", rx1857_pos) debug_999: .return (rx1857_cur) rx1857_restart: .annotate 'line', 4 if_null rx1857_debug, debug_1000 rx1857_cur."!cursor_debug"("NEXT", "infix:sym<=>") debug_1000: rx1857_fail: (rx1857_rep, rx1857_pos, $I10, $P10) = rx1857_cur."!mark_fail"(0) lt rx1857_pos, -1, rx1857_done eq rx1857_pos, -1, rx1857_fail jump $I10 rx1857_done: rx1857_cur."!cursor_fail"() if_null rx1857_debug, debug_1001 rx1857_cur."!cursor_debug"("FAIL", "infix:sym<=>") debug_1001: .return (rx1857_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<=>" :subid("337_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("panic", "=") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<:=>" :subid("338_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1862_tgt .local int rx1862_pos .local int rx1862_off .local int rx1862_eos .local int rx1862_rep .local pmc rx1862_cur .local pmc rx1862_debug (rx1862_cur, rx1862_pos, rx1862_tgt, $I10) = self."!cursor_start"() getattribute rx1862_debug, rx1862_cur, "$!debug" .lex unicode:"$\x{a2}", rx1862_cur .local pmc match .lex "$/", match length rx1862_eos, rx1862_tgt gt rx1862_pos, rx1862_eos, rx1862_done set rx1862_off, 0 lt rx1862_pos, 2, rx1862_start sub rx1862_off, rx1862_pos, 1 substr rx1862_tgt, rx1862_tgt, rx1862_off rx1862_start: eq $I10, 1, rx1862_restart if_null rx1862_debug, debug_1002 rx1862_cur."!cursor_debug"("START", "infix:sym<:=>") debug_1002: $I10 = self.'from'() ne $I10, -1, rxscan1864_done goto rxscan1864_scan rxscan1864_loop: ($P10) = rx1862_cur."from"() inc $P10 set rx1862_pos, $P10 ge rx1862_pos, rx1862_eos, rxscan1864_done rxscan1864_scan: set_addr $I10, rxscan1864_loop rx1862_cur."!mark_push"(0, rx1862_pos, $I10) rxscan1864_done: .annotate 'line', 558 # rx subcapture "sym" set_addr $I10, rxcap_1865_fail rx1862_cur."!mark_push"(0, rx1862_pos, $I10) # rx literal ":=" add $I11, rx1862_pos, 2 gt $I11, rx1862_eos, rx1862_fail sub $I11, rx1862_pos, rx1862_off substr $S10, rx1862_tgt, $I11, 2 ne $S10, ":=", rx1862_fail add rx1862_pos, 2 set_addr $I10, rxcap_1865_fail ($I12, $I11) = rx1862_cur."!mark_peek"($I10) rx1862_cur."!cursor_pos"($I11) ($P10) = rx1862_cur."!cursor_start"() $P10."!cursor_pass"(rx1862_pos, "") rx1862_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1865_done rxcap_1865_fail: goto rx1862_fail rxcap_1865_done: # rx subrule "O" subtype=capture negate= rx1862_cur."!cursor_pos"(rx1862_pos) $P10 = rx1862_cur."O"("%assignment, :pasttype") unless $P10, rx1862_fail rx1862_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1862_pos = $P10."pos"() # rx pass rx1862_cur."!cursor_pass"(rx1862_pos, "infix:sym<:=>") if_null rx1862_debug, debug_1003 rx1862_cur."!cursor_debug"("PASS", "infix:sym<:=>", " at pos=", rx1862_pos) debug_1003: .return (rx1862_cur) rx1862_restart: .annotate 'line', 4 if_null rx1862_debug, debug_1004 rx1862_cur."!cursor_debug"("NEXT", "infix:sym<:=>") debug_1004: rx1862_fail: (rx1862_rep, rx1862_pos, $I10, $P10) = rx1862_cur."!mark_fail"(0) lt rx1862_pos, -1, rx1862_done eq rx1862_pos, -1, rx1862_fail jump $I10 rx1862_done: rx1862_cur."!cursor_fail"() if_null rx1862_debug, debug_1005 rx1862_cur."!cursor_debug"("FAIL", "infix:sym<:=>") debug_1005: .return (rx1862_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<:=>" :subid("339_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", ":=") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<::=>" :subid("340_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1867_tgt .local int rx1867_pos .local int rx1867_off .local int rx1867_eos .local int rx1867_rep .local pmc rx1867_cur .local pmc rx1867_debug (rx1867_cur, rx1867_pos, rx1867_tgt, $I10) = self."!cursor_start"() getattribute rx1867_debug, rx1867_cur, "$!debug" .lex unicode:"$\x{a2}", rx1867_cur .local pmc match .lex "$/", match length rx1867_eos, rx1867_tgt gt rx1867_pos, rx1867_eos, rx1867_done set rx1867_off, 0 lt rx1867_pos, 2, rx1867_start sub rx1867_off, rx1867_pos, 1 substr rx1867_tgt, rx1867_tgt, rx1867_off rx1867_start: eq $I10, 1, rx1867_restart if_null rx1867_debug, debug_1006 rx1867_cur."!cursor_debug"("START", "infix:sym<::=>") debug_1006: $I10 = self.'from'() ne $I10, -1, rxscan1869_done goto rxscan1869_scan rxscan1869_loop: ($P10) = rx1867_cur."from"() inc $P10 set rx1867_pos, $P10 ge rx1867_pos, rx1867_eos, rxscan1869_done rxscan1869_scan: set_addr $I10, rxscan1869_loop rx1867_cur."!mark_push"(0, rx1867_pos, $I10) rxscan1869_done: .annotate 'line', 559 # rx subcapture "sym" set_addr $I10, rxcap_1870_fail rx1867_cur."!mark_push"(0, rx1867_pos, $I10) # rx literal "::=" add $I11, rx1867_pos, 3 gt $I11, rx1867_eos, rx1867_fail sub $I11, rx1867_pos, rx1867_off substr $S10, rx1867_tgt, $I11, 3 ne $S10, "::=", rx1867_fail add rx1867_pos, 3 set_addr $I10, rxcap_1870_fail ($I12, $I11) = rx1867_cur."!mark_peek"($I10) rx1867_cur."!cursor_pos"($I11) ($P10) = rx1867_cur."!cursor_start"() $P10."!cursor_pass"(rx1867_pos, "") rx1867_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1870_done rxcap_1870_fail: goto rx1867_fail rxcap_1870_done: # rx subrule "O" subtype=capture negate= rx1867_cur."!cursor_pos"(rx1867_pos) $P10 = rx1867_cur."O"("%assignment, :pasttype") unless $P10, rx1867_fail rx1867_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1867_pos = $P10."pos"() # rx pass rx1867_cur."!cursor_pass"(rx1867_pos, "infix:sym<::=>") if_null rx1867_debug, debug_1007 rx1867_cur."!cursor_debug"("PASS", "infix:sym<::=>", " at pos=", rx1867_pos) debug_1007: .return (rx1867_cur) rx1867_restart: .annotate 'line', 4 if_null rx1867_debug, debug_1008 rx1867_cur."!cursor_debug"("NEXT", "infix:sym<::=>") debug_1008: rx1867_fail: (rx1867_rep, rx1867_pos, $I10, $P10) = rx1867_cur."!mark_fail"(0) lt rx1867_pos, -1, rx1867_done eq rx1867_pos, -1, rx1867_fail jump $I10 rx1867_done: rx1867_cur."!cursor_fail"() if_null rx1867_debug, debug_1009 rx1867_cur."!cursor_debug"("FAIL", "infix:sym<::=>") debug_1009: .return (rx1867_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<::=>" :subid("341_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", "::=") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "infix:sym<,>" :subid("342_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1872_tgt .local int rx1872_pos .local int rx1872_off .local int rx1872_eos .local int rx1872_rep .local pmc rx1872_cur .local pmc rx1872_debug (rx1872_cur, rx1872_pos, rx1872_tgt, $I10) = self."!cursor_start"() getattribute rx1872_debug, rx1872_cur, "$!debug" .lex unicode:"$\x{a2}", rx1872_cur .local pmc match .lex "$/", match length rx1872_eos, rx1872_tgt gt rx1872_pos, rx1872_eos, rx1872_done set rx1872_off, 0 lt rx1872_pos, 2, rx1872_start sub rx1872_off, rx1872_pos, 1 substr rx1872_tgt, rx1872_tgt, rx1872_off rx1872_start: eq $I10, 1, rx1872_restart if_null rx1872_debug, debug_1010 rx1872_cur."!cursor_debug"("START", "infix:sym<,>") debug_1010: $I10 = self.'from'() ne $I10, -1, rxscan1874_done goto rxscan1874_scan rxscan1874_loop: ($P10) = rx1872_cur."from"() inc $P10 set rx1872_pos, $P10 ge rx1872_pos, rx1872_eos, rxscan1874_done rxscan1874_scan: set_addr $I10, rxscan1874_loop rx1872_cur."!mark_push"(0, rx1872_pos, $I10) rxscan1874_done: .annotate 'line', 561 # rx subcapture "sym" set_addr $I10, rxcap_1875_fail rx1872_cur."!mark_push"(0, rx1872_pos, $I10) # rx literal "," add $I11, rx1872_pos, 1 gt $I11, rx1872_eos, rx1872_fail sub $I11, rx1872_pos, rx1872_off ord $I11, rx1872_tgt, $I11 ne $I11, 44, rx1872_fail add rx1872_pos, 1 set_addr $I10, rxcap_1875_fail ($I12, $I11) = rx1872_cur."!mark_peek"($I10) rx1872_cur."!cursor_pos"($I11) ($P10) = rx1872_cur."!cursor_start"() $P10."!cursor_pass"(rx1872_pos, "") rx1872_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1875_done rxcap_1875_fail: goto rx1872_fail rxcap_1875_done: # rx subrule "O" subtype=capture negate= rx1872_cur."!cursor_pos"(rx1872_pos) $P10 = rx1872_cur."O"("%comma, :pasttype") unless $P10, rx1872_fail rx1872_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1872_pos = $P10."pos"() # rx pass rx1872_cur."!cursor_pass"(rx1872_pos, "infix:sym<,>") if_null rx1872_debug, debug_1011 rx1872_cur."!cursor_debug"("PASS", "infix:sym<,>", " at pos=", rx1872_pos) debug_1011: .return (rx1872_cur) rx1872_restart: .annotate 'line', 4 if_null rx1872_debug, debug_1012 rx1872_cur."!cursor_debug"("NEXT", "infix:sym<,>") debug_1012: rx1872_fail: (rx1872_rep, rx1872_pos, $I10, $P10) = rx1872_cur."!mark_fail"(0) lt rx1872_pos, -1, rx1872_done eq rx1872_pos, -1, rx1872_fail jump $I10 rx1872_done: rx1872_cur."!cursor_fail"() if_null rx1872_debug, debug_1013 rx1872_cur."!cursor_debug"("FAIL", "infix:sym<,>") debug_1013: .return (rx1872_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__infix:sym<,>" :subid("343_1309998847.42912") :method .annotate 'line', 4 $P100 = self."!PREFIX__!subrule"("O", ",") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "prefix:sym" :subid("344_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1877_tgt .local int rx1877_pos .local int rx1877_off .local int rx1877_eos .local int rx1877_rep .local pmc rx1877_cur .local pmc rx1877_debug (rx1877_cur, rx1877_pos, rx1877_tgt, $I10) = self."!cursor_start"() getattribute rx1877_debug, rx1877_cur, "$!debug" .lex unicode:"$\x{a2}", rx1877_cur .local pmc match .lex "$/", match length rx1877_eos, rx1877_tgt gt rx1877_pos, rx1877_eos, rx1877_done set rx1877_off, 0 lt rx1877_pos, 2, rx1877_start sub rx1877_off, rx1877_pos, 1 substr rx1877_tgt, rx1877_tgt, rx1877_off rx1877_start: eq $I10, 1, rx1877_restart if_null rx1877_debug, debug_1014 rx1877_cur."!cursor_debug"("START", "prefix:sym") debug_1014: $I10 = self.'from'() ne $I10, -1, rxscan1879_done goto rxscan1879_scan rxscan1879_loop: ($P10) = rx1877_cur."from"() inc $P10 set rx1877_pos, $P10 ge rx1877_pos, rx1877_eos, rxscan1879_done rxscan1879_scan: set_addr $I10, rxscan1879_loop rx1877_cur."!mark_push"(0, rx1877_pos, $I10) rxscan1879_done: .annotate 'line', 563 # rx subcapture "sym" set_addr $I10, rxcap_1880_fail rx1877_cur."!mark_push"(0, rx1877_pos, $I10) # rx literal "return" add $I11, rx1877_pos, 6 gt $I11, rx1877_eos, rx1877_fail sub $I11, rx1877_pos, rx1877_off substr $S10, rx1877_tgt, $I11, 6 ne $S10, "return", rx1877_fail add rx1877_pos, 6 set_addr $I10, rxcap_1880_fail ($I12, $I11) = rx1877_cur."!mark_peek"($I10) rx1877_cur."!cursor_pos"($I11) ($P10) = rx1877_cur."!cursor_start"() $P10."!cursor_pass"(rx1877_pos, "") rx1877_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1880_done rxcap_1880_fail: goto rx1877_fail rxcap_1880_done: # rx charclass s ge rx1877_pos, rx1877_eos, rx1877_fail sub $I10, rx1877_pos, rx1877_off is_cclass $I11, 32, rx1877_tgt, $I10 unless $I11, rx1877_fail inc rx1877_pos # rx subrule "O" subtype=capture negate= rx1877_cur."!cursor_pos"(rx1877_pos) $P10 = rx1877_cur."O"("%list_prefix, :pasttype") unless $P10, rx1877_fail rx1877_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1877_pos = $P10."pos"() # rx pass rx1877_cur."!cursor_pass"(rx1877_pos, "prefix:sym") if_null rx1877_debug, debug_1015 rx1877_cur."!cursor_debug"("PASS", "prefix:sym", " at pos=", rx1877_pos) debug_1015: .return (rx1877_cur) rx1877_restart: .annotate 'line', 4 if_null rx1877_debug, debug_1016 rx1877_cur."!cursor_debug"("NEXT", "prefix:sym") debug_1016: rx1877_fail: (rx1877_rep, rx1877_pos, $I10, $P10) = rx1877_cur."!mark_fail"(0) lt rx1877_pos, -1, rx1877_done eq rx1877_pos, -1, rx1877_fail jump $I10 rx1877_done: rx1877_cur."!cursor_fail"() if_null rx1877_debug, debug_1017 rx1877_cur."!cursor_debug"("FAIL", "prefix:sym") debug_1017: .return (rx1877_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__prefix:sym" :subid("345_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "return" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "prefix:sym" :subid("346_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1882_tgt .local int rx1882_pos .local int rx1882_off .local int rx1882_eos .local int rx1882_rep .local pmc rx1882_cur .local pmc rx1882_debug (rx1882_cur, rx1882_pos, rx1882_tgt, $I10) = self."!cursor_start"() getattribute rx1882_debug, rx1882_cur, "$!debug" .lex unicode:"$\x{a2}", rx1882_cur .local pmc match .lex "$/", match length rx1882_eos, rx1882_tgt gt rx1882_pos, rx1882_eos, rx1882_done set rx1882_off, 0 lt rx1882_pos, 2, rx1882_start sub rx1882_off, rx1882_pos, 1 substr rx1882_tgt, rx1882_tgt, rx1882_off rx1882_start: eq $I10, 1, rx1882_restart if_null rx1882_debug, debug_1018 rx1882_cur."!cursor_debug"("START", "prefix:sym") debug_1018: $I10 = self.'from'() ne $I10, -1, rxscan1884_done goto rxscan1884_scan rxscan1884_loop: ($P10) = rx1882_cur."from"() inc $P10 set rx1882_pos, $P10 ge rx1882_pos, rx1882_eos, rxscan1884_done rxscan1884_scan: set_addr $I10, rxscan1884_loop rx1882_cur."!mark_push"(0, rx1882_pos, $I10) rxscan1884_done: .annotate 'line', 564 # rx subcapture "sym" set_addr $I10, rxcap_1885_fail rx1882_cur."!mark_push"(0, rx1882_pos, $I10) # rx literal "make" add $I11, rx1882_pos, 4 gt $I11, rx1882_eos, rx1882_fail sub $I11, rx1882_pos, rx1882_off substr $S10, rx1882_tgt, $I11, 4 ne $S10, "make", rx1882_fail add rx1882_pos, 4 set_addr $I10, rxcap_1885_fail ($I12, $I11) = rx1882_cur."!mark_peek"($I10) rx1882_cur."!cursor_pos"($I11) ($P10) = rx1882_cur."!cursor_start"() $P10."!cursor_pass"(rx1882_pos, "") rx1882_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1885_done rxcap_1885_fail: goto rx1882_fail rxcap_1885_done: # rx charclass s ge rx1882_pos, rx1882_eos, rx1882_fail sub $I10, rx1882_pos, rx1882_off is_cclass $I11, 32, rx1882_tgt, $I10 unless $I11, rx1882_fail inc rx1882_pos # rx subrule "O" subtype=capture negate= rx1882_cur."!cursor_pos"(rx1882_pos) $P10 = rx1882_cur."O"("%list_prefix") unless $P10, rx1882_fail rx1882_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("O") rx1882_pos = $P10."pos"() # rx pass rx1882_cur."!cursor_pass"(rx1882_pos, "prefix:sym") if_null rx1882_debug, debug_1019 rx1882_cur."!cursor_debug"("PASS", "prefix:sym", " at pos=", rx1882_pos) debug_1019: .return (rx1882_cur) rx1882_restart: .annotate 'line', 4 if_null rx1882_debug, debug_1020 rx1882_cur."!cursor_debug"("NEXT", "prefix:sym") debug_1020: rx1882_fail: (rx1882_rep, rx1882_pos, $I10, $P10) = rx1882_cur."!mark_fail"(0) lt rx1882_pos, -1, rx1882_done eq rx1882_pos, -1, rx1882_fail jump $I10 rx1882_done: rx1882_cur."!cursor_fail"() if_null rx1882_debug, debug_1021 rx1882_cur."!cursor_debug"("FAIL", "prefix:sym") debug_1021: .return (rx1882_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__prefix:sym" :subid("347_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "make" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("348_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1887_tgt .local int rx1887_pos .local int rx1887_off .local int rx1887_eos .local int rx1887_rep .local pmc rx1887_cur .local pmc rx1887_debug (rx1887_cur, rx1887_pos, rx1887_tgt, $I10) = self."!cursor_start"() getattribute rx1887_debug, rx1887_cur, "$!debug" .lex unicode:"$\x{a2}", rx1887_cur .local pmc match .lex "$/", match length rx1887_eos, rx1887_tgt gt rx1887_pos, rx1887_eos, rx1887_done set rx1887_off, 0 lt rx1887_pos, 2, rx1887_start sub rx1887_off, rx1887_pos, 1 substr rx1887_tgt, rx1887_tgt, rx1887_off rx1887_start: eq $I10, 1, rx1887_restart if_null rx1887_debug, debug_1022 rx1887_cur."!cursor_debug"("START", "term:sym") debug_1022: $I10 = self.'from'() ne $I10, -1, rxscan1889_done goto rxscan1889_scan rxscan1889_loop: ($P10) = rx1887_cur."from"() inc $P10 set rx1887_pos, $P10 ge rx1887_pos, rx1887_eos, rxscan1889_done rxscan1889_scan: set_addr $I10, rxscan1889_loop rx1887_cur."!mark_push"(0, rx1887_pos, $I10) rxscan1889_done: .annotate 'line', 565 # rx subcapture "sym" set_addr $I10, rxcap_1890_fail rx1887_cur."!mark_push"(0, rx1887_pos, $I10) # rx literal "last" add $I11, rx1887_pos, 4 gt $I11, rx1887_eos, rx1887_fail sub $I11, rx1887_pos, rx1887_off substr $S10, rx1887_tgt, $I11, 4 ne $S10, "last", rx1887_fail add rx1887_pos, 4 set_addr $I10, rxcap_1890_fail ($I12, $I11) = rx1887_cur."!mark_peek"($I10) rx1887_cur."!cursor_pos"($I11) ($P10) = rx1887_cur."!cursor_start"() $P10."!cursor_pass"(rx1887_pos, "") rx1887_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1890_done rxcap_1890_fail: goto rx1887_fail rxcap_1890_done: # rx pass rx1887_cur."!cursor_pass"(rx1887_pos, "term:sym") if_null rx1887_debug, debug_1023 rx1887_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1887_pos) debug_1023: .return (rx1887_cur) rx1887_restart: .annotate 'line', 4 if_null rx1887_debug, debug_1024 rx1887_cur."!cursor_debug"("NEXT", "term:sym") debug_1024: rx1887_fail: (rx1887_rep, rx1887_pos, $I10, $P10) = rx1887_cur."!mark_fail"(0) lt rx1887_pos, -1, rx1887_done eq rx1887_pos, -1, rx1887_fail jump $I10 rx1887_done: rx1887_cur."!cursor_fail"() if_null rx1887_debug, debug_1025 rx1887_cur."!cursor_debug"("FAIL", "term:sym") debug_1025: .return (rx1887_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("349_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "last" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("350_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1892_tgt .local int rx1892_pos .local int rx1892_off .local int rx1892_eos .local int rx1892_rep .local pmc rx1892_cur .local pmc rx1892_debug (rx1892_cur, rx1892_pos, rx1892_tgt, $I10) = self."!cursor_start"() getattribute rx1892_debug, rx1892_cur, "$!debug" .lex unicode:"$\x{a2}", rx1892_cur .local pmc match .lex "$/", match length rx1892_eos, rx1892_tgt gt rx1892_pos, rx1892_eos, rx1892_done set rx1892_off, 0 lt rx1892_pos, 2, rx1892_start sub rx1892_off, rx1892_pos, 1 substr rx1892_tgt, rx1892_tgt, rx1892_off rx1892_start: eq $I10, 1, rx1892_restart if_null rx1892_debug, debug_1026 rx1892_cur."!cursor_debug"("START", "term:sym") debug_1026: $I10 = self.'from'() ne $I10, -1, rxscan1894_done goto rxscan1894_scan rxscan1894_loop: ($P10) = rx1892_cur."from"() inc $P10 set rx1892_pos, $P10 ge rx1892_pos, rx1892_eos, rxscan1894_done rxscan1894_scan: set_addr $I10, rxscan1894_loop rx1892_cur."!mark_push"(0, rx1892_pos, $I10) rxscan1894_done: .annotate 'line', 566 # rx subcapture "sym" set_addr $I10, rxcap_1895_fail rx1892_cur."!mark_push"(0, rx1892_pos, $I10) # rx literal "next" add $I11, rx1892_pos, 4 gt $I11, rx1892_eos, rx1892_fail sub $I11, rx1892_pos, rx1892_off substr $S10, rx1892_tgt, $I11, 4 ne $S10, "next", rx1892_fail add rx1892_pos, 4 set_addr $I10, rxcap_1895_fail ($I12, $I11) = rx1892_cur."!mark_peek"($I10) rx1892_cur."!cursor_pos"($I11) ($P10) = rx1892_cur."!cursor_start"() $P10."!cursor_pass"(rx1892_pos, "") rx1892_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1895_done rxcap_1895_fail: goto rx1892_fail rxcap_1895_done: # rx pass rx1892_cur."!cursor_pass"(rx1892_pos, "term:sym") if_null rx1892_debug, debug_1027 rx1892_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1892_pos) debug_1027: .return (rx1892_cur) rx1892_restart: .annotate 'line', 4 if_null rx1892_debug, debug_1028 rx1892_cur."!cursor_debug"("NEXT", "term:sym") debug_1028: rx1892_fail: (rx1892_rep, rx1892_pos, $I10, $P10) = rx1892_cur."!mark_fail"(0) lt rx1892_pos, -1, rx1892_done eq rx1892_pos, -1, rx1892_fail jump $I10 rx1892_done: rx1892_cur."!cursor_fail"() if_null rx1892_debug, debug_1029 rx1892_cur."!cursor_debug"("FAIL", "term:sym") debug_1029: .return (rx1892_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("351_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "next" .return ($P100) .end .namespace ["NQP";"Grammar"] .sub "term:sym" :subid("352_1309998847.42912") :method :outer("11_1309998847.42912") .annotate 'line', 4 .local string rx1897_tgt .local int rx1897_pos .local int rx1897_off .local int rx1897_eos .local int rx1897_rep .local pmc rx1897_cur .local pmc rx1897_debug (rx1897_cur, rx1897_pos, rx1897_tgt, $I10) = self."!cursor_start"() getattribute rx1897_debug, rx1897_cur, "$!debug" .lex unicode:"$\x{a2}", rx1897_cur .local pmc match .lex "$/", match length rx1897_eos, rx1897_tgt gt rx1897_pos, rx1897_eos, rx1897_done set rx1897_off, 0 lt rx1897_pos, 2, rx1897_start sub rx1897_off, rx1897_pos, 1 substr rx1897_tgt, rx1897_tgt, rx1897_off rx1897_start: eq $I10, 1, rx1897_restart if_null rx1897_debug, debug_1030 rx1897_cur."!cursor_debug"("START", "term:sym") debug_1030: $I10 = self.'from'() ne $I10, -1, rxscan1899_done goto rxscan1899_scan rxscan1899_loop: ($P10) = rx1897_cur."from"() inc $P10 set rx1897_pos, $P10 ge rx1897_pos, rx1897_eos, rxscan1899_done rxscan1899_scan: set_addr $I10, rxscan1899_loop rx1897_cur."!mark_push"(0, rx1897_pos, $I10) rxscan1899_done: .annotate 'line', 567 # rx subcapture "sym" set_addr $I10, rxcap_1900_fail rx1897_cur."!mark_push"(0, rx1897_pos, $I10) # rx literal "redo" add $I11, rx1897_pos, 4 gt $I11, rx1897_eos, rx1897_fail sub $I11, rx1897_pos, rx1897_off substr $S10, rx1897_tgt, $I11, 4 ne $S10, "redo", rx1897_fail add rx1897_pos, 4 set_addr $I10, rxcap_1900_fail ($I12, $I11) = rx1897_cur."!mark_peek"($I10) rx1897_cur."!cursor_pos"($I11) ($P10) = rx1897_cur."!cursor_start"() $P10."!cursor_pass"(rx1897_pos, "") rx1897_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("sym") goto rxcap_1900_done rxcap_1900_fail: goto rx1897_fail rxcap_1900_done: # rx pass rx1897_cur."!cursor_pass"(rx1897_pos, "term:sym") if_null rx1897_debug, debug_1031 rx1897_cur."!cursor_debug"("PASS", "term:sym", " at pos=", rx1897_pos) debug_1031: .return (rx1897_cur) rx1897_restart: .annotate 'line', 4 if_null rx1897_debug, debug_1032 rx1897_cur."!cursor_debug"("NEXT", "term:sym") debug_1032: rx1897_fail: (rx1897_rep, rx1897_pos, $I10, $P10) = rx1897_cur."!mark_fail"(0) lt rx1897_pos, -1, rx1897_done eq rx1897_pos, -1, rx1897_fail jump $I10 rx1897_done: rx1897_cur."!cursor_fail"() if_null rx1897_debug, debug_1033 rx1897_cur."!cursor_debug"("FAIL", "term:sym") debug_1033: .return (rx1897_cur) .return () .end .namespace ["NQP";"Grammar"] .sub "!PREFIX__term:sym" :subid("353_1309998847.42912") :method .annotate 'line', 4 new $P100, "ResizablePMCArray" push $P100, "redo" .return ($P100) .end .namespace ["NQP";"Grammar"] .include "except_types.pasm" .sub "smartmatch" :subid("354_1309998847.42912") :method :outer("11_1309998847.42912") .param pmc param_1904 .annotate 'line', 569 new $P1903, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1903, control_1902 push_eh $P1903 .lex "self", self .lex "$/", param_1904 .annotate 'line', 571 new $P100, "Undef" set $P1905, $P100 .lex "$t", $P1905 find_lex $P1906, "$/" unless_null $P1906, vivify_1034 $P1906 = root_new ['parrot';'ResizablePMCArray'] vivify_1034: set $P101, $P1906[0] unless_null $P101, vivify_1035 new $P101, "Undef" vivify_1035: store_lex "$t", $P101 find_lex $P1907, "$/" unless_null $P1907, vivify_1036 $P1907 = root_new ['parrot';'ResizablePMCArray'] vivify_1036: set $P101, $P1907[1] unless_null $P101, vivify_1037 new $P101, "Undef" vivify_1037: find_lex $P1908, "$/" unless_null $P1908, vivify_1038 $P1908 = root_new ['parrot';'ResizablePMCArray'] store_lex "$/", $P1908 vivify_1038: set $P1908[0], $P101 find_lex $P101, "$t" find_lex $P1909, "$/" unless_null $P1909, vivify_1039 $P1909 = root_new ['parrot';'ResizablePMCArray'] store_lex "$/", $P1909 vivify_1039: set $P1909[1], $P101 .annotate 'line', 569 .return ($P101) control_1902: .local pmc exception .get_results (exception) getattribute $P102, exception, "payload" .return ($P102) .end .namespace ["NQP";"Regex"] .sub "_block1910" :subid("355_1309998847.42912") :outer("11_1309998847.42912") .annotate 'line', 575 .const 'Sub' $P1959 = "374_1309998847.42912" capture_lex $P1959 .const 'Sub' $P1955 = "372_1309998847.42912" capture_lex $P1955 .const 'Sub' $P1945 = "369_1309998847.42912" capture_lex $P1945 .const 'Sub' $P1936 = "366_1309998847.42912" capture_lex $P1936 .const 'Sub' $P1932 = "364_1309998847.42912" capture_lex $P1932 .const 'Sub' $P1924 = "361_1309998847.42912" capture_lex $P1924 .const 'Sub' $P1920 = "359_1309998847.42912" capture_lex $P1920 .const 'Sub' $P1912 = "356_1309998847.42912" capture_lex $P1912 .const 'Sub' $P1959 = "374_1309998847.42912" capture_lex $P1959 .return ($P1959) .end .namespace ["NQP";"Regex"] .sub "metachar:sym<:my>" :subid("356_1309998847.42912") :method :outer("355_1309998847.42912") .annotate 'line', 575 .const 'Sub' $P1917 = "358_1309998847.42912" capture_lex $P1917 .local string rx1913_tgt .local int rx1913_pos .local int rx1913_off .local int rx1913_eos .local int rx1913_rep .local pmc rx1913_cur .local pmc rx1913_debug (rx1913_cur, rx1913_pos, rx1913_tgt, $I10) = self."!cursor_start"() getattribute rx1913_debug, rx1913_cur, "$!debug" .lex unicode:"$\x{a2}", rx1913_cur .local pmc match .lex "$/", match length rx1913_eos, rx1913_tgt gt rx1913_pos, rx1913_eos, rx1913_done set rx1913_off, 0 lt rx1913_pos, 2, rx1913_start sub rx1913_off, rx1913_pos, 1 substr rx1913_tgt, rx1913_tgt, rx1913_off rx1913_start: eq $I10, 1, rx1913_restart if_null rx1913_debug, debug_1040 rx1913_cur."!cursor_debug"("START", "metachar:sym<:my>") debug_1040: $I10 = self.'from'() ne $I10, -1, rxscan1915_done goto rxscan1915_scan rxscan1915_loop: ($P10) = rx1913_cur."from"() inc $P10 set rx1913_pos, $P10 ge rx1913_pos, rx1913_eos, rxscan1915_done rxscan1915_scan: set_addr $I10, rxscan1915_loop rx1913_cur."!mark_push"(0, rx1913_pos, $I10) rxscan1915_done: .annotate 'line', 577 # rx literal ":" add $I11, rx1913_pos, 1 gt $I11, rx1913_eos, rx1913_fail sub $I11, rx1913_pos, rx1913_off ord $I11, rx1913_tgt, $I11 ne $I11, 58, rx1913_fail add rx1913_pos, 1 # rx subrule "before" subtype=zerowidth negate= rx1913_cur."!cursor_pos"(rx1913_pos) .const 'Sub' $P1917 = "358_1309998847.42912" capture_lex $P1917 $P10 = rx1913_cur."before"($P1917) unless $P10, rx1913_fail # rx subrule "LANG" subtype=capture negate= rx1913_cur."!cursor_pos"(rx1913_pos) $P10 = rx1913_cur."LANG"("MAIN", "statement") unless $P10, rx1913_fail rx1913_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("statement") rx1913_pos = $P10."pos"() # rx subrule "ws" subtype=method negate= rx1913_cur."!cursor_pos"(rx1913_pos) $P10 = rx1913_cur."ws"() unless $P10, rx1913_fail rx1913_pos = $P10."pos"() # rx literal ";" add $I11, rx1913_pos, 1 gt $I11, rx1913_eos, rx1913_fail sub $I11, rx1913_pos, rx1913_off ord $I11, rx1913_tgt, $I11 ne $I11, 59, rx1913_fail add rx1913_pos, 1 .annotate 'line', 576 # rx pass rx1913_cur."!cursor_pass"(rx1913_pos, "metachar:sym<:my>") if_null rx1913_debug, debug_1045 rx1913_cur."!cursor_debug"("PASS", "metachar:sym<:my>", " at pos=", rx1913_pos) debug_1045: .return (rx1913_cur) rx1913_restart: .annotate 'line', 575 if_null rx1913_debug, debug_1046 rx1913_cur."!cursor_debug"("NEXT", "metachar:sym<:my>") debug_1046: rx1913_fail: (rx1913_rep, rx1913_pos, $I10, $P10) = rx1913_cur."!mark_fail"(0) lt rx1913_pos, -1, rx1913_done eq rx1913_pos, -1, rx1913_fail jump $I10 rx1913_done: rx1913_cur."!cursor_fail"() if_null rx1913_debug, debug_1047 rx1913_cur."!cursor_debug"("FAIL", "metachar:sym<:my>") debug_1047: .return (rx1913_cur) .return () .end .namespace ["NQP";"Regex"] .sub "!PREFIX__metachar:sym<:my>" :subid("357_1309998847.42912") :method .annotate 'line', 575 new $P100, "ResizablePMCArray" push $P100, ":" .return ($P100) .end .namespace ["NQP";"Regex"] .sub "_block1916" :anon :subid("358_1309998847.42912") :method :outer("356_1309998847.42912") .annotate 'line', 577 .local string rx1918_tgt .local int rx1918_pos .local int rx1918_off .local int rx1918_eos .local int rx1918_rep .local pmc rx1918_cur .local pmc rx1918_debug (rx1918_cur, rx1918_pos, rx1918_tgt, $I10) = self."!cursor_start"() getattribute rx1918_debug, rx1918_cur, "$!debug" .lex unicode:"$\x{a2}", rx1918_cur .local pmc match .lex "$/", match length rx1918_eos, rx1918_tgt gt rx1918_pos, rx1918_eos, rx1918_done set rx1918_off, 0 lt rx1918_pos, 2, rx1918_start sub rx1918_off, rx1918_pos, 1 substr rx1918_tgt, rx1918_tgt, rx1918_off rx1918_start: eq $I10, 1, rx1918_restart if_null rx1918_debug, debug_1041 rx1918_cur."!cursor_debug"("START", "") debug_1041: $I10 = self.'from'() ne $I10, -1, rxscan1919_done goto rxscan1919_scan rxscan1919_loop: ($P10) = rx1918_cur."from"() inc $P10 set rx1918_pos, $P10 ge rx1918_pos, rx1918_eos, rxscan1919_done rxscan1919_scan: set_addr $I10, rxscan1919_loop rx1918_cur."!mark_push"(0, rx1918_pos, $I10) rxscan1919_done: # rx literal "my" add $I11, rx1918_pos, 2 gt $I11, rx1918_eos, rx1918_fail sub $I11, rx1918_pos, rx1918_off substr $S10, rx1918_tgt, $I11, 2 ne $S10, "my", rx1918_fail add rx1918_pos, 2 # rx pass rx1918_cur."!cursor_pass"(rx1918_pos, "") if_null rx1918_debug, debug_1042 rx1918_cur."!cursor_debug"("PASS", "", " at pos=", rx1918_pos) debug_1042: .return (rx1918_cur) rx1918_restart: if_null rx1918_debug, debug_1043 rx1918_cur."!cursor_debug"("NEXT", "") debug_1043: rx1918_fail: (rx1918_rep, rx1918_pos, $I10, $P10) = rx1918_cur."!mark_fail"(0) lt rx1918_pos, -1, rx1918_done eq rx1918_pos, -1, rx1918_fail jump $I10 rx1918_done: rx1918_cur."!cursor_fail"() if_null rx1918_debug, debug_1044 rx1918_cur."!cursor_debug"("FAIL", "") debug_1044: .return (rx1918_cur) .return () .end .namespace ["NQP";"Regex"] .sub "metachar:sym<{ }>" :subid("359_1309998847.42912") :method :outer("355_1309998847.42912") .annotate 'line', 575 .local string rx1921_tgt .local int rx1921_pos .local int rx1921_off .local int rx1921_eos .local int rx1921_rep .local pmc rx1921_cur .local pmc rx1921_debug (rx1921_cur, rx1921_pos, rx1921_tgt, $I10) = self."!cursor_start"() getattribute rx1921_debug, rx1921_cur, "$!debug" .lex unicode:"$\x{a2}", rx1921_cur .local pmc match .lex "$/", match length rx1921_eos, rx1921_tgt gt rx1921_pos, rx1921_eos, rx1921_done set rx1921_off, 0 lt rx1921_pos, 2, rx1921_start sub rx1921_off, rx1921_pos, 1 substr rx1921_tgt, rx1921_tgt, rx1921_off rx1921_start: eq $I10, 1, rx1921_restart if_null rx1921_debug, debug_1048 rx1921_cur."!cursor_debug"("START", "metachar:sym<{ }>") debug_1048: $I10 = self.'from'() ne $I10, -1, rxscan1923_done goto rxscan1923_scan rxscan1923_loop: ($P10) = rx1921_cur."from"() inc $P10 set rx1921_pos, $P10 ge rx1921_pos, rx1921_eos, rxscan1923_done rxscan1923_scan: set_addr $I10, rxscan1923_loop rx1921_cur."!mark_push"(0, rx1921_pos, $I10) rxscan1923_done: .annotate 'line', 581 # rx enumcharlist negate=0 zerowidth sub $I10, rx1921_pos, rx1921_off substr $S10, rx1921_tgt, $I10, 1 index $I11, "{", $S10 lt $I11, 0, rx1921_fail # rx subrule "codeblock" subtype=capture negate= rx1921_cur."!cursor_pos"(rx1921_pos) $P10 = rx1921_cur."codeblock"() unless $P10, rx1921_fail rx1921_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("codeblock") rx1921_pos = $P10."pos"() .annotate 'line', 580 # rx pass rx1921_cur."!cursor_pass"(rx1921_pos, "metachar:sym<{ }>") if_null rx1921_debug, debug_1049 rx1921_cur."!cursor_debug"("PASS", "metachar:sym<{ }>", " at pos=", rx1921_pos) debug_1049: .return (rx1921_cur) rx1921_restart: .annotate 'line', 575 if_null rx1921_debug, debug_1050 rx1921_cur."!cursor_debug"("NEXT", "metachar:sym<{ }>") debug_1050: rx1921_fail: (rx1921_rep, rx1921_pos, $I10, $P10) = rx1921_cur."!mark_fail"(0) lt rx1921_pos, -1, rx1921_done eq rx1921_pos, -1, rx1921_fail jump $I10 rx1921_done: rx1921_cur."!cursor_fail"() if_null rx1921_debug, debug_1051 rx1921_cur."!cursor_debug"("FAIL", "metachar:sym<{ }>") debug_1051: .return (rx1921_cur) .return () .end .namespace ["NQP";"Regex"] .sub "!PREFIX__metachar:sym<{ }>" :subid("360_1309998847.42912") :method .annotate 'line', 575 new $P100, "ResizablePMCArray" push $P100, "{" .return ($P100) .end .namespace ["NQP";"Regex"] .sub "metachar:sym" :subid("361_1309998847.42912") :method :outer("355_1309998847.42912") .annotate 'line', 575 .const 'Sub' $P1929 = "363_1309998847.42912" capture_lex $P1929 .local string rx1925_tgt .local int rx1925_pos .local int rx1925_off .local int rx1925_eos .local int rx1925_rep .local pmc rx1925_cur .local pmc rx1925_debug (rx1925_cur, rx1925_pos, rx1925_tgt, $I10) = self."!cursor_start"() getattribute rx1925_debug, rx1925_cur, "$!debug" .lex unicode:"$\x{a2}", rx1925_cur .local pmc match .lex "$/", match length rx1925_eos, rx1925_tgt gt rx1925_pos, rx1925_eos, rx1925_done set rx1925_off, 0 lt rx1925_pos, 2, rx1925_start sub rx1925_off, rx1925_pos, 1 substr rx1925_tgt, rx1925_tgt, rx1925_off rx1925_start: eq $I10, 1, rx1925_restart if_null rx1925_debug, debug_1052 rx1925_cur."!cursor_debug"("START", "metachar:sym") debug_1052: $I10 = self.'from'() ne $I10, -1, rxscan1927_done goto rxscan1927_scan rxscan1927_loop: ($P10) = rx1925_cur."from"() inc $P10 set rx1925_pos, $P10 ge rx1925_pos, rx1925_eos, rxscan1927_done rxscan1927_scan: set_addr $I10, rxscan1927_loop rx1925_cur."!mark_push"(0, rx1925_pos, $I10) rxscan1927_done: .annotate 'line', 585 # rx enumcharlist negate=0 zerowidth sub $I10, rx1925_pos, rx1925_off substr $S10, rx1925_tgt, $I10, 1 index $I11, "$@", $S10 lt $I11, 0, rx1925_fail # rx subrule "before" subtype=zerowidth negate= rx1925_cur."!cursor_pos"(rx1925_pos) .const 'Sub' $P1929 = "363_1309998847.42912" capture_lex $P1929 $P10 = rx1925_cur."before"($P1929) unless $P10, rx1925_fail # rx subrule "LANG" subtype=capture negate= rx1925_cur."!cursor_pos"(rx1925_pos) $P10 = rx1925_cur."LANG"("MAIN", "variable") unless $P10, rx1925_fail rx1925_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("var") rx1925_pos = $P10."pos"() .annotate 'line', 584 # rx pass rx1925_cur."!cursor_pass"(rx1925_pos, "metachar:sym") if_null rx1925_debug, debug_1057 rx1925_cur."!cursor_debug"("PASS", "metachar:sym", " at pos=", rx1925_pos) debug_1057: .return (rx1925_cur) rx1925_restart: .annotate 'line', 575 if_null rx1925_debug, debug_1058 rx1925_cur."!cursor_debug"("NEXT", "metachar:sym") debug_1058: rx1925_fail: (rx1925_rep, rx1925_pos, $I10, $P10) = rx1925_cur."!mark_fail"(0) lt rx1925_pos, -1, rx1925_done eq rx1925_pos, -1, rx1925_fail jump $I10 rx1925_done: rx1925_cur."!cursor_fail"() if_null rx1925_debug, debug_1059 rx1925_cur."!cursor_debug"("FAIL", "metachar:sym") debug_1059: .return (rx1925_cur) .return () .end .namespace ["NQP";"Regex"] .sub "!PREFIX__metachar:sym" :subid("362_1309998847.42912") :method .annotate 'line', 575 new $P100, "ResizablePMCArray" push $P100, "$" push $P100, "@" .return ($P100) .end .namespace ["NQP";"Regex"] .sub "_block1928" :anon :subid("363_1309998847.42912") :method :outer("361_1309998847.42912") .annotate 'line', 585 .local string rx1930_tgt .local int rx1930_pos .local int rx1930_off .local int rx1930_eos .local int rx1930_rep .local pmc rx1930_cur .local pmc rx1930_debug (rx1930_cur, rx1930_pos, rx1930_tgt, $I10) = self."!cursor_start"() getattribute rx1930_debug, rx1930_cur, "$!debug" .lex unicode:"$\x{a2}", rx1930_cur .local pmc match .lex "$/", match length rx1930_eos, rx1930_tgt gt rx1930_pos, rx1930_eos, rx1930_done set rx1930_off, 0 lt rx1930_pos, 2, rx1930_start sub rx1930_off, rx1930_pos, 1 substr rx1930_tgt, rx1930_tgt, rx1930_off rx1930_start: eq $I10, 1, rx1930_restart if_null rx1930_debug, debug_1053 rx1930_cur."!cursor_debug"("START", "") debug_1053: $I10 = self.'from'() ne $I10, -1, rxscan1931_done goto rxscan1931_scan rxscan1931_loop: ($P10) = rx1930_cur."from"() inc $P10 set rx1930_pos, $P10 ge rx1930_pos, rx1930_eos, rxscan1931_done rxscan1931_scan: set_addr $I10, rxscan1931_loop rx1930_cur."!mark_push"(0, rx1930_pos, $I10) rxscan1931_done: # rx charclass . ge rx1930_pos, rx1930_eos, rx1930_fail inc rx1930_pos # rx charclass w ge rx1930_pos, rx1930_eos, rx1930_fail sub $I10, rx1930_pos, rx1930_off is_cclass $I11, 8192, rx1930_tgt, $I10 unless $I11, rx1930_fail inc rx1930_pos # rx pass rx1930_cur."!cursor_pass"(rx1930_pos, "") if_null rx1930_debug, debug_1054 rx1930_cur."!cursor_debug"("PASS", "", " at pos=", rx1930_pos) debug_1054: .return (rx1930_cur) rx1930_restart: if_null rx1930_debug, debug_1055 rx1930_cur."!cursor_debug"("NEXT", "") debug_1055: rx1930_fail: (rx1930_rep, rx1930_pos, $I10, $P10) = rx1930_cur."!mark_fail"(0) lt rx1930_pos, -1, rx1930_done eq rx1930_pos, -1, rx1930_fail jump $I10 rx1930_done: rx1930_cur."!cursor_fail"() if_null rx1930_debug, debug_1056 rx1930_cur."!cursor_debug"("FAIL", "") debug_1056: .return (rx1930_cur) .return () .end .namespace ["NQP";"Regex"] .sub "assertion:sym<{ }>" :subid("364_1309998847.42912") :method :outer("355_1309998847.42912") .annotate 'line', 575 .local string rx1933_tgt .local int rx1933_pos .local int rx1933_off .local int rx1933_eos .local int rx1933_rep .local pmc rx1933_cur .local pmc rx1933_debug (rx1933_cur, rx1933_pos, rx1933_tgt, $I10) = self."!cursor_start"() getattribute rx1933_debug, rx1933_cur, "$!debug" .lex unicode:"$\x{a2}", rx1933_cur .local pmc match .lex "$/", match length rx1933_eos, rx1933_tgt gt rx1933_pos, rx1933_eos, rx1933_done set rx1933_off, 0 lt rx1933_pos, 2, rx1933_start sub rx1933_off, rx1933_pos, 1 substr rx1933_tgt, rx1933_tgt, rx1933_off rx1933_start: eq $I10, 1, rx1933_restart if_null rx1933_debug, debug_1060 rx1933_cur."!cursor_debug"("START", "assertion:sym<{ }>") debug_1060: $I10 = self.'from'() ne $I10, -1, rxscan1935_done goto rxscan1935_scan rxscan1935_loop: ($P10) = rx1933_cur."from"() inc $P10 set rx1933_pos, $P10 ge rx1933_pos, rx1933_eos, rxscan1935_done rxscan1935_scan: set_addr $I10, rxscan1935_loop rx1933_cur."!mark_push"(0, rx1933_pos, $I10) rxscan1935_done: .annotate 'line', 589 # rx enumcharlist negate=0 zerowidth sub $I10, rx1933_pos, rx1933_off substr $S10, rx1933_tgt, $I10, 1 index $I11, "{", $S10 lt $I11, 0, rx1933_fail # rx subrule "codeblock" subtype=capture negate= rx1933_cur."!cursor_pos"(rx1933_pos) $P10 = rx1933_cur."codeblock"() unless $P10, rx1933_fail rx1933_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("codeblock") rx1933_pos = $P10."pos"() .annotate 'line', 588 # rx pass rx1933_cur."!cursor_pass"(rx1933_pos, "assertion:sym<{ }>") if_null rx1933_debug, debug_1061 rx1933_cur."!cursor_debug"("PASS", "assertion:sym<{ }>", " at pos=", rx1933_pos) debug_1061: .return (rx1933_cur) rx1933_restart: .annotate 'line', 575 if_null rx1933_debug, debug_1062 rx1933_cur."!cursor_debug"("NEXT", "assertion:sym<{ }>") debug_1062: rx1933_fail: (rx1933_rep, rx1933_pos, $I10, $P10) = rx1933_cur."!mark_fail"(0) lt rx1933_pos, -1, rx1933_done eq rx1933_pos, -1, rx1933_fail jump $I10 rx1933_done: rx1933_cur."!cursor_fail"() if_null rx1933_debug, debug_1063 rx1933_cur."!cursor_debug"("FAIL", "assertion:sym<{ }>") debug_1063: .return (rx1933_cur) .return () .end .namespace ["NQP";"Regex"] .sub "!PREFIX__assertion:sym<{ }>" :subid("365_1309998847.42912") :method .annotate 'line', 575 new $P100, "ResizablePMCArray" push $P100, "{" .return ($P100) .end .namespace ["NQP";"Regex"] .sub "assertion:sym" :subid("366_1309998847.42912") :method :outer("355_1309998847.42912") .annotate 'line', 575 .const 'Sub' $P1941 = "368_1309998847.42912" capture_lex $P1941 .local string rx1937_tgt .local int rx1937_pos .local int rx1937_off .local int rx1937_eos .local int rx1937_rep .local pmc rx1937_cur .local pmc rx1937_debug (rx1937_cur, rx1937_pos, rx1937_tgt, $I10) = self."!cursor_start"() getattribute rx1937_debug, rx1937_cur, "$!debug" .lex unicode:"$\x{a2}", rx1937_cur .local pmc match .lex "$/", match length rx1937_eos, rx1937_tgt gt rx1937_pos, rx1937_eos, rx1937_done set rx1937_off, 0 lt rx1937_pos, 2, rx1937_start sub rx1937_off, rx1937_pos, 1 substr rx1937_tgt, rx1937_tgt, rx1937_off rx1937_start: eq $I10, 1, rx1937_restart if_null rx1937_debug, debug_1064 rx1937_cur."!cursor_debug"("START", "assertion:sym") debug_1064: $I10 = self.'from'() ne $I10, -1, rxscan1939_done goto rxscan1939_scan rxscan1939_loop: ($P10) = rx1937_cur."from"() inc $P10 set rx1937_pos, $P10 ge rx1937_pos, rx1937_eos, rxscan1939_done rxscan1939_scan: set_addr $I10, rxscan1939_loop rx1937_cur."!mark_push"(0, rx1937_pos, $I10) rxscan1939_done: .annotate 'line', 593 # rx subcapture "zw" set_addr $I10, rxcap_1944_fail rx1937_cur."!mark_push"(0, rx1937_pos, $I10) # rx enumcharlist negate=0 ge rx1937_pos, rx1937_eos, rx1937_fail sub $I10, rx1937_pos, rx1937_off substr $S10, rx1937_tgt, $I10, 1 index $I11, "?!", $S10 lt $I11, 0, rx1937_fail inc rx1937_pos # rx subrule "before" subtype=zerowidth negate= rx1937_cur."!cursor_pos"(rx1937_pos) .const 'Sub' $P1941 = "368_1309998847.42912" capture_lex $P1941 $P10 = rx1937_cur."before"($P1941) unless $P10, rx1937_fail set_addr $I10, rxcap_1944_fail ($I12, $I11) = rx1937_cur."!mark_peek"($I10) rx1937_cur."!cursor_pos"($I11) ($P10) = rx1937_cur."!cursor_start"() $P10."!cursor_pass"(rx1937_pos, "") rx1937_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("zw") goto rxcap_1944_done rxcap_1944_fail: goto rx1937_fail rxcap_1944_done: # rx subrule "codeblock" subtype=capture negate= rx1937_cur."!cursor_pos"(rx1937_pos) $P10 = rx1937_cur."codeblock"() unless $P10, rx1937_fail rx1937_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("codeblock") rx1937_pos = $P10."pos"() .annotate 'line', 592 # rx pass rx1937_cur."!cursor_pass"(rx1937_pos, "assertion:sym") if_null rx1937_debug, debug_1069 rx1937_cur."!cursor_debug"("PASS", "assertion:sym", " at pos=", rx1937_pos) debug_1069: .return (rx1937_cur) rx1937_restart: .annotate 'line', 575 if_null rx1937_debug, debug_1070 rx1937_cur."!cursor_debug"("NEXT", "assertion:sym") debug_1070: rx1937_fail: (rx1937_rep, rx1937_pos, $I10, $P10) = rx1937_cur."!mark_fail"(0) lt rx1937_pos, -1, rx1937_done eq rx1937_pos, -1, rx1937_fail jump $I10 rx1937_done: rx1937_cur."!cursor_fail"() if_null rx1937_debug, debug_1071 rx1937_cur."!cursor_debug"("FAIL", "assertion:sym") debug_1071: .return (rx1937_cur) .return () .end .namespace ["NQP";"Regex"] .sub "!PREFIX__assertion:sym" :subid("367_1309998847.42912") :method .annotate 'line', 575 new $P100, "ResizablePMCArray" push $P100, "!" push $P100, "?" .return ($P100) .end .namespace ["NQP";"Regex"] .sub "_block1940" :anon :subid("368_1309998847.42912") :method :outer("366_1309998847.42912") .annotate 'line', 593 .local string rx1942_tgt .local int rx1942_pos .local int rx1942_off .local int rx1942_eos .local int rx1942_rep .local pmc rx1942_cur .local pmc rx1942_debug (rx1942_cur, rx1942_pos, rx1942_tgt, $I10) = self."!cursor_start"() getattribute rx1942_debug, rx1942_cur, "$!debug" .lex unicode:"$\x{a2}", rx1942_cur .local pmc match .lex "$/", match length rx1942_eos, rx1942_tgt gt rx1942_pos, rx1942_eos, rx1942_done set rx1942_off, 0 lt rx1942_pos, 2, rx1942_start sub rx1942_off, rx1942_pos, 1 substr rx1942_tgt, rx1942_tgt, rx1942_off rx1942_start: eq $I10, 1, rx1942_restart if_null rx1942_debug, debug_1065 rx1942_cur."!cursor_debug"("START", "") debug_1065: $I10 = self.'from'() ne $I10, -1, rxscan1943_done goto rxscan1943_scan rxscan1943_loop: ($P10) = rx1942_cur."from"() inc $P10 set rx1942_pos, $P10 ge rx1942_pos, rx1942_eos, rxscan1943_done rxscan1943_scan: set_addr $I10, rxscan1943_loop rx1942_cur."!mark_push"(0, rx1942_pos, $I10) rxscan1943_done: # rx literal "{" add $I11, rx1942_pos, 1 gt $I11, rx1942_eos, rx1942_fail sub $I11, rx1942_pos, rx1942_off ord $I11, rx1942_tgt, $I11 ne $I11, 123, rx1942_fail add rx1942_pos, 1 # rx pass rx1942_cur."!cursor_pass"(rx1942_pos, "") if_null rx1942_debug, debug_1066 rx1942_cur."!cursor_debug"("PASS", "", " at pos=", rx1942_pos) debug_1066: .return (rx1942_cur) rx1942_restart: if_null rx1942_debug, debug_1067 rx1942_cur."!cursor_debug"("NEXT", "") debug_1067: rx1942_fail: (rx1942_rep, rx1942_pos, $I10, $P10) = rx1942_cur."!mark_fail"(0) lt rx1942_pos, -1, rx1942_done eq rx1942_pos, -1, rx1942_fail jump $I10 rx1942_done: rx1942_cur."!cursor_fail"() if_null rx1942_debug, debug_1068 rx1942_cur."!cursor_debug"("FAIL", "") debug_1068: .return (rx1942_cur) .return () .end .namespace ["NQP";"Regex"] .sub "assertion:sym" :subid("369_1309998847.42912") :method :outer("355_1309998847.42912") .annotate 'line', 575 .const 'Sub' $P1952 = "371_1309998847.42912" capture_lex $P1952 .local string rx1946_tgt .local int rx1946_pos .local int rx1946_off .local int rx1946_eos .local int rx1946_rep .local pmc rx1946_cur .local pmc rx1946_debug (rx1946_cur, rx1946_pos, rx1946_tgt, $I10) = self."!cursor_start"() rx1946_cur."!cursor_caparray"("assertion", "arglist", "nibbler") getattribute rx1946_debug, rx1946_cur, "$!debug" .lex unicode:"$\x{a2}", rx1946_cur .local pmc match .lex "$/", match length rx1946_eos, rx1946_tgt gt rx1946_pos, rx1946_eos, rx1946_done set rx1946_off, 0 lt rx1946_pos, 2, rx1946_start sub rx1946_off, rx1946_pos, 1 substr rx1946_tgt, rx1946_tgt, rx1946_off rx1946_start: eq $I10, 1, rx1946_restart if_null rx1946_debug, debug_1072 rx1946_cur."!cursor_debug"("START", "assertion:sym") debug_1072: $I10 = self.'from'() ne $I10, -1, rxscan1948_done goto rxscan1948_scan rxscan1948_loop: ($P10) = rx1946_cur."from"() inc $P10 set rx1946_pos, $P10 ge rx1946_pos, rx1946_eos, rxscan1948_done rxscan1948_scan: set_addr $I10, rxscan1948_loop rx1946_cur."!mark_push"(0, rx1946_pos, $I10) rxscan1948_done: .annotate 'line', 597 # rx subrule "identifier" subtype=capture negate= rx1946_cur."!cursor_pos"(rx1946_pos) $P10 = rx1946_cur."identifier"() unless $P10, rx1946_fail rx1946_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("longname") rx1946_pos = $P10."pos"() .annotate 'line', 604 # rx rxquantr1949 ** 0..1 set_addr $I10, rxquantr1949_done rx1946_cur."!mark_push"(0, rx1946_pos, $I10) rxquantr1949_loop: alt1950_0: .annotate 'line', 598 set_addr $I10, alt1950_1 rx1946_cur."!mark_push"(0, rx1946_pos, $I10) .annotate 'line', 599 # rx subrule "before" subtype=zerowidth negate= rx1946_cur."!cursor_pos"(rx1946_pos) .const 'Sub' $P1952 = "371_1309998847.42912" capture_lex $P1952 $P10 = rx1946_cur."before"($P1952) unless $P10, rx1946_fail goto alt1950_end alt1950_1: set_addr $I10, alt1950_2 rx1946_cur."!mark_push"(0, rx1946_pos, $I10) .annotate 'line', 600 # rx literal "=" add $I11, rx1946_pos, 1 gt $I11, rx1946_eos, rx1946_fail sub $I11, rx1946_pos, rx1946_off ord $I11, rx1946_tgt, $I11 ne $I11, 61, rx1946_fail add rx1946_pos, 1 # rx subrule "assertion" subtype=capture negate= rx1946_cur."!cursor_pos"(rx1946_pos) $P10 = rx1946_cur."assertion"() unless $P10, rx1946_fail rx1946_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("assertion") rx1946_pos = $P10."pos"() goto alt1950_end alt1950_2: set_addr $I10, alt1950_3 rx1946_cur."!mark_push"(0, rx1946_pos, $I10) .annotate 'line', 601 # rx literal ":" add $I11, rx1946_pos, 1 gt $I11, rx1946_eos, rx1946_fail sub $I11, rx1946_pos, rx1946_off ord $I11, rx1946_tgt, $I11 ne $I11, 58, rx1946_fail add rx1946_pos, 1 # rx subrule "arglist" subtype=capture negate= rx1946_cur."!cursor_pos"(rx1946_pos) $P10 = rx1946_cur."arglist"() unless $P10, rx1946_fail rx1946_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("arglist") rx1946_pos = $P10."pos"() goto alt1950_end alt1950_3: set_addr $I10, alt1950_4 rx1946_cur."!mark_push"(0, rx1946_pos, $I10) .annotate 'line', 602 # rx literal "(" add $I11, rx1946_pos, 1 gt $I11, rx1946_eos, rx1946_fail sub $I11, rx1946_pos, rx1946_off ord $I11, rx1946_tgt, $I11 ne $I11, 40, rx1946_fail add rx1946_pos, 1 # rx subrule "LANG" subtype=capture negate= rx1946_cur."!cursor_pos"(rx1946_pos) $P10 = rx1946_cur."LANG"("MAIN", "arglist") unless $P10, rx1946_fail rx1946_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("arglist") rx1946_pos = $P10."pos"() # rx literal ")" add $I11, rx1946_pos, 1 gt $I11, rx1946_eos, rx1946_fail sub $I11, rx1946_pos, rx1946_off ord $I11, rx1946_tgt, $I11 ne $I11, 41, rx1946_fail add rx1946_pos, 1 goto alt1950_end alt1950_4: .annotate 'line', 603 # rx subrule "normspace" subtype=method negate= rx1946_cur."!cursor_pos"(rx1946_pos) $P10 = rx1946_cur."normspace"() unless $P10, rx1946_fail rx1946_pos = $P10."pos"() # rx subrule "nibbler" subtype=capture negate= rx1946_cur."!cursor_pos"(rx1946_pos) $P10 = rx1946_cur."nibbler"() unless $P10, rx1946_fail rx1946_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("nibbler") rx1946_pos = $P10."pos"() alt1950_end: .annotate 'line', 604 set_addr $I10, rxquantr1949_done (rx1946_rep) = rx1946_cur."!mark_commit"($I10) rxquantr1949_done: .annotate 'line', 596 # rx pass rx1946_cur."!cursor_pass"(rx1946_pos, "assertion:sym") if_null rx1946_debug, debug_1077 rx1946_cur."!cursor_debug"("PASS", "assertion:sym", " at pos=", rx1946_pos) debug_1077: .return (rx1946_cur) rx1946_restart: .annotate 'line', 575 if_null rx1946_debug, debug_1078 rx1946_cur."!cursor_debug"("NEXT", "assertion:sym") debug_1078: rx1946_fail: (rx1946_rep, rx1946_pos, $I10, $P10) = rx1946_cur."!mark_fail"(0) lt rx1946_pos, -1, rx1946_done eq rx1946_pos, -1, rx1946_fail jump $I10 rx1946_done: rx1946_cur."!cursor_fail"() if_null rx1946_debug, debug_1079 rx1946_cur."!cursor_debug"("FAIL", "assertion:sym") debug_1079: .return (rx1946_cur) .return () .end .namespace ["NQP";"Regex"] .sub "!PREFIX__assertion:sym" :subid("370_1309998847.42912") :method .annotate 'line', 575 $P100 = self."!PREFIX__!subrule"("identifier", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Regex"] .sub "_block1951" :anon :subid("371_1309998847.42912") :method :outer("369_1309998847.42912") .annotate 'line', 599 .local string rx1953_tgt .local int rx1953_pos .local int rx1953_off .local int rx1953_eos .local int rx1953_rep .local pmc rx1953_cur .local pmc rx1953_debug (rx1953_cur, rx1953_pos, rx1953_tgt, $I10) = self."!cursor_start"() getattribute rx1953_debug, rx1953_cur, "$!debug" .lex unicode:"$\x{a2}", rx1953_cur .local pmc match .lex "$/", match length rx1953_eos, rx1953_tgt gt rx1953_pos, rx1953_eos, rx1953_done set rx1953_off, 0 lt rx1953_pos, 2, rx1953_start sub rx1953_off, rx1953_pos, 1 substr rx1953_tgt, rx1953_tgt, rx1953_off rx1953_start: eq $I10, 1, rx1953_restart if_null rx1953_debug, debug_1073 rx1953_cur."!cursor_debug"("START", "") debug_1073: $I10 = self.'from'() ne $I10, -1, rxscan1954_done goto rxscan1954_scan rxscan1954_loop: ($P10) = rx1953_cur."from"() inc $P10 set rx1953_pos, $P10 ge rx1953_pos, rx1953_eos, rxscan1954_done rxscan1954_scan: set_addr $I10, rxscan1954_loop rx1953_cur."!mark_push"(0, rx1953_pos, $I10) rxscan1954_done: # rx literal ">" add $I11, rx1953_pos, 1 gt $I11, rx1953_eos, rx1953_fail sub $I11, rx1953_pos, rx1953_off ord $I11, rx1953_tgt, $I11 ne $I11, 62, rx1953_fail add rx1953_pos, 1 # rx pass rx1953_cur."!cursor_pass"(rx1953_pos, "") if_null rx1953_debug, debug_1074 rx1953_cur."!cursor_debug"("PASS", "", " at pos=", rx1953_pos) debug_1074: .return (rx1953_cur) rx1953_restart: if_null rx1953_debug, debug_1075 rx1953_cur."!cursor_debug"("NEXT", "") debug_1075: rx1953_fail: (rx1953_rep, rx1953_pos, $I10, $P10) = rx1953_cur."!mark_fail"(0) lt rx1953_pos, -1, rx1953_done eq rx1953_pos, -1, rx1953_fail jump $I10 rx1953_done: rx1953_cur."!cursor_fail"() if_null rx1953_debug, debug_1076 rx1953_cur."!cursor_debug"("FAIL", "") debug_1076: .return (rx1953_cur) .return () .end .namespace ["NQP";"Regex"] .sub "assertion:sym" :subid("372_1309998847.42912") :method :outer("355_1309998847.42912") .annotate 'line', 575 .local string rx1956_tgt .local int rx1956_pos .local int rx1956_off .local int rx1956_eos .local int rx1956_rep .local pmc rx1956_cur .local pmc rx1956_debug (rx1956_cur, rx1956_pos, rx1956_tgt, $I10) = self."!cursor_start"() getattribute rx1956_debug, rx1956_cur, "$!debug" .lex unicode:"$\x{a2}", rx1956_cur .local pmc match .lex "$/", match length rx1956_eos, rx1956_tgt gt rx1956_pos, rx1956_eos, rx1956_done set rx1956_off, 0 lt rx1956_pos, 2, rx1956_start sub rx1956_off, rx1956_pos, 1 substr rx1956_tgt, rx1956_tgt, rx1956_off rx1956_start: eq $I10, 1, rx1956_restart if_null rx1956_debug, debug_1080 rx1956_cur."!cursor_debug"("START", "assertion:sym") debug_1080: $I10 = self.'from'() ne $I10, -1, rxscan1958_done goto rxscan1958_scan rxscan1958_loop: ($P10) = rx1956_cur."from"() inc $P10 set rx1956_pos, $P10 ge rx1956_pos, rx1956_eos, rxscan1958_done rxscan1958_scan: set_addr $I10, rxscan1958_loop rx1956_cur."!mark_push"(0, rx1956_pos, $I10) rxscan1958_done: .annotate 'line', 608 # rx enumcharlist negate=0 zerowidth sub $I10, rx1956_pos, rx1956_off substr $S10, rx1956_tgt, $I10, 1 index $I11, "$@", $S10 lt $I11, 0, rx1956_fail # rx subrule "LANG" subtype=capture negate= rx1956_cur."!cursor_pos"(rx1956_pos) $P10 = rx1956_cur."LANG"("MAIN", "variable") unless $P10, rx1956_fail rx1956_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("var") rx1956_pos = $P10."pos"() .annotate 'line', 607 # rx pass rx1956_cur."!cursor_pass"(rx1956_pos, "assertion:sym") if_null rx1956_debug, debug_1081 rx1956_cur."!cursor_debug"("PASS", "assertion:sym", " at pos=", rx1956_pos) debug_1081: .return (rx1956_cur) rx1956_restart: .annotate 'line', 575 if_null rx1956_debug, debug_1082 rx1956_cur."!cursor_debug"("NEXT", "assertion:sym") debug_1082: rx1956_fail: (rx1956_rep, rx1956_pos, $I10, $P10) = rx1956_cur."!mark_fail"(0) lt rx1956_pos, -1, rx1956_done eq rx1956_pos, -1, rx1956_fail jump $I10 rx1956_done: rx1956_cur."!cursor_fail"() if_null rx1956_debug, debug_1083 rx1956_cur."!cursor_debug"("FAIL", "assertion:sym") debug_1083: .return (rx1956_cur) .return () .end .namespace ["NQP";"Regex"] .sub "!PREFIX__assertion:sym" :subid("373_1309998847.42912") :method .annotate 'line', 575 new $P100, "ResizablePMCArray" push $P100, "$" push $P100, "@" .return ($P100) .end .namespace ["NQP";"Regex"] .sub "codeblock" :subid("374_1309998847.42912") :method :outer("355_1309998847.42912") .annotate 'line', 575 .local string rx1960_tgt .local int rx1960_pos .local int rx1960_off .local int rx1960_eos .local int rx1960_rep .local pmc rx1960_cur .local pmc rx1960_debug (rx1960_cur, rx1960_pos, rx1960_tgt, $I10) = self."!cursor_start"() getattribute rx1960_debug, rx1960_cur, "$!debug" .lex unicode:"$\x{a2}", rx1960_cur .local pmc match .lex "$/", match length rx1960_eos, rx1960_tgt gt rx1960_pos, rx1960_eos, rx1960_done set rx1960_off, 0 lt rx1960_pos, 2, rx1960_start sub rx1960_off, rx1960_pos, 1 substr rx1960_tgt, rx1960_tgt, rx1960_off rx1960_start: eq $I10, 1, rx1960_restart if_null rx1960_debug, debug_1084 rx1960_cur."!cursor_debug"("START", "codeblock") debug_1084: $I10 = self.'from'() ne $I10, -1, rxscan1962_done goto rxscan1962_scan rxscan1962_loop: ($P10) = rx1960_cur."from"() inc $P10 set rx1960_pos, $P10 ge rx1960_pos, rx1960_eos, rxscan1962_done rxscan1962_scan: set_addr $I10, rxscan1962_loop rx1960_cur."!mark_push"(0, rx1960_pos, $I10) rxscan1962_done: .annotate 'line', 612 # rx subrule "LANG" subtype=capture negate= rx1960_cur."!cursor_pos"(rx1960_pos) $P10 = rx1960_cur."LANG"("MAIN", "pblock") unless $P10, rx1960_fail rx1960_cur."!mark_push"(0, -1, 0, $P10) $P10."!cursor_names"("block") rx1960_pos = $P10."pos"() .annotate 'line', 611 # rx pass rx1960_cur."!cursor_pass"(rx1960_pos, "codeblock") if_null rx1960_debug, debug_1085 rx1960_cur."!cursor_debug"("PASS", "codeblock", " at pos=", rx1960_pos) debug_1085: .return (rx1960_cur) rx1960_restart: .annotate 'line', 575 if_null rx1960_debug, debug_1086 rx1960_cur."!cursor_debug"("NEXT", "codeblock") debug_1086: rx1960_fail: (rx1960_rep, rx1960_pos, $I10, $P10) = rx1960_cur."!mark_fail"(0) lt rx1960_pos, -1, rx1960_done eq rx1960_pos, -1, rx1960_fail jump $I10 rx1960_done: rx1960_cur."!cursor_fail"() if_null rx1960_debug, debug_1087 rx1960_cur."!cursor_debug"("FAIL", "codeblock") debug_1087: .return (rx1960_cur) .return () .end .namespace ["NQP";"Regex"] .sub "!PREFIX__codeblock" :subid("375_1309998847.42912") :method .annotate 'line', 575 $P100 = self."!PREFIX__!subrule"("LANG", "") new $P101, "ResizablePMCArray" push $P101, $P100 .return ($P101) .end .namespace ["NQP";"Grammar"] .sub "_block1963" :load :anon :subid("376_1309998847.42912") .annotate 'line', 4 .const 'Sub' $P1965 = "11_1309998847.42912" $P101 = $P1965() .return ($P101) .end .namespace [] .sub "_block1967" :load :anon :subid("377_1309998847.42912") .annotate 'line', 1 .const 'Sub' $P1969 = "10_1309998847.42912" $P100 = $P1969() .return ($P100) .end ### .include 'gen/nqp-actions.pir' .namespace [] .sub "_block1000" :anon :subid("10_1309998850.8808") .annotate 'line', 0 .const 'Sub' $P1003 = "11_1309998850.8808" capture_lex $P1003 .annotate 'line', 1 $P0 = find_dynamic_lex "$*CTXSAVE" if null $P0 goto ctxsave_done $I0 = can $P0, "ctxsave" unless $I0 goto ctxsave_done $P0."ctxsave"() ctxsave_done: .annotate 'line', 3 .const 'Sub' $P1003 = "11_1309998850.8808" capture_lex $P1003 $P112 = $P1003() .annotate 'line', 1 .return ($P112) .const 'Sub' $P2014 = "149_1309998850.8808" .return ($P2014) .end .namespace [] .sub "" :load :init :subid("post150") :outer("10_1309998850.8808") .annotate 'line', 0 .const 'Sub' $P1001 = "10_1309998850.8808" .local pmc block set block, $P1001 $P2016 = get_root_global ["parrot"], "P6metaclass" $P2016."new_class"("NQP::Actions", "HLL::Actions" :named("parent")) .end .namespace ["NQP";"Actions"] .sub "_block1002" :subid("11_1309998850.8808") :outer("10_1309998850.8808") .annotate 'line', 3 .const 'Sub' $P2009 = "148_1309998850.8808" capture_lex $P2009 .const 'Sub' $P1964 = "139_1309998850.8808" capture_lex $P1964 .const 'Sub' $P1959 = "138_1309998850.8808" capture_lex $P1959 .const 'Sub' $P1955 = "137_1309998850.8808" capture_lex $P1955 .const 'Sub' $P1951 = "136_1309998850.8808" capture_lex $P1951 .const 'Sub' $P1947 = "135_1309998850.8808" capture_lex $P1947 .const 'Sub' $P1943 = "134_1309998850.8808" capture_lex $P1943 .const 'Sub' $P1939 = "133_1309998850.8808" capture_lex $P1939 .const 'Sub' $P1935 = "132_1309998850.8808" capture_lex $P1935 .const 'Sub' $P1930 = "131_1309998850.8808" capture_lex $P1930 .const 'Sub' $P1926 = "130_1309998850.8808" capture_lex $P1926 .const 'Sub' $P1921 = "129_1309998850.8808" capture_lex $P1921 .const 'Sub' $P1916 = "128_1309998850.8808" capture_lex $P1916 .const 'Sub' $P1904 = "127_1309998850.8808" capture_lex $P1904 .const 'Sub' $P1899 = "126_1309998850.8808" capture_lex $P1899 .const 'Sub' $P1894 = "125_1309998850.8808" capture_lex $P1894 .const 'Sub' $P1889 = "124_1309998850.8808" capture_lex $P1889 .const 'Sub' $P1884 = "123_1309998850.8808" capture_lex $P1884 .const 'Sub' $P1879 = "122_1309998850.8808" capture_lex $P1879 .const 'Sub' $P1874 = "121_1309998850.8808" capture_lex $P1874 .const 'Sub' $P1863 = "120_1309998850.8808" capture_lex $P1863 .const 'Sub' $P1855 = "119_1309998850.8808" capture_lex $P1855 .const 'Sub' $P1850 = "118_1309998850.8808" capture_lex $P1850 .const 'Sub' $P1845 = "117_1309998850.8808" capture_lex $P1845 .const 'Sub' $P1840 = "116_1309998850.8808" capture_lex $P1840 .const 'Sub' $P1835 = "115_1309998850.8808" capture_lex $P1835 .const 'Sub' $P1830 = "114_1309998850.8808" capture_lex $P1830 .const 'Sub' $P1820 = "113_1309998850.8808" capture_lex $P1820 .const 'Sub' $P1808 = "112_1309998850.8808" capture_lex $P1808 .const 'Sub' $P1803 = "111_1309998850.8808" capture_lex $P1803 .const 'Sub' $P1798 = "110_1309998850.8808" capture_lex $P1798 .const 'Sub' $P1788 = "109_1309998850.8808" capture_lex $P1788 .const 'Sub' $P1780 = "108_1309998850.8808" capture_lex $P1780 .const 'Sub' $P1775 = "107_1309998850.8808" capture_lex $P1775 .const 'Sub' $P1743 = "104_1309998850.8808" capture_lex $P1743 .const 'Sub' $P1738 = "103_1309998850.8808" capture_lex $P1738 .const 'Sub' $P1726 = "102_1309998850.8808" capture_lex $P1726 .const 'Sub' $P1708 = "101_1309998850.8808" capture_lex $P1708 .const 'Sub' $P1701 = "100_1309998850.8808" capture_lex $P1701 .const 'Sub' $P1697 = "99_1309998850.8808" capture_lex $P1697 .const 'Sub' $P1684 = "98_1309998850.8808" capture_lex $P1684 .const 'Sub' $P1652 = "95_1309998850.8808" capture_lex $P1652 .const 'Sub' $P1637 = "93_1309998850.8808" capture_lex $P1637 .const 'Sub' $P1632 = "92_1309998850.8808" capture_lex $P1632 .const 'Sub' $P1624 = "91_1309998850.8808" capture_lex $P1624 .const 'Sub' $P1617 = "90_1309998850.8808" capture_lex $P1617 .const 'Sub' $P1572 = "87_1309998850.8808" capture_lex $P1572 .const 'Sub' $P1544 = "83_1309998850.8808" capture_lex $P1544 .const 'Sub' $P1520 = "80_1309998850.8808" capture_lex $P1520 .const 'Sub' $P1492 = "77_1309998850.8808" capture_lex $P1492 .const 'Sub' $P1487 = "76_1309998850.8808" capture_lex $P1487 .const 'Sub' $P1482 = "75_1309998850.8808" capture_lex $P1482 .const 'Sub' $P1458 = "73_1309998850.8808" capture_lex $P1458 .const 'Sub' $P1453 = "72_1309998850.8808" capture_lex $P1453 .const 'Sub' $P1445 = "71_1309998850.8808" capture_lex $P1445 .const 'Sub' $P1437 = "70_1309998850.8808" capture_lex $P1437 .const 'Sub' $P1429 = "69_1309998850.8808" capture_lex $P1429 .const 'Sub' $P1424 = "68_1309998850.8808" capture_lex $P1424 .const 'Sub' $P1419 = "67_1309998850.8808" capture_lex $P1419 .const 'Sub' $P1414 = "66_1309998850.8808" capture_lex $P1414 .const 'Sub' $P1403 = "65_1309998850.8808" capture_lex $P1403 .const 'Sub' $P1382 = "64_1309998850.8808" capture_lex $P1382 .const 'Sub' $P1377 = "63_1309998850.8808" capture_lex $P1377 .const 'Sub' $P1352 = "61_1309998850.8808" capture_lex $P1352 .const 'Sub' $P1341 = "60_1309998850.8808" capture_lex $P1341 .const 'Sub' $P1334 = "59_1309998850.8808" capture_lex $P1334 .const 'Sub' $P1329 = "58_1309998850.8808" capture_lex $P1329 .const 'Sub' $P1324 = "57_1309998850.8808" capture_lex $P1324 .const 'Sub' $P1319 = "56_1309998850.8808" capture_lex $P1319 .const 'Sub' $P1314 = "55_1309998850.8808" capture_lex $P1314 .const 'Sub' $P1309 = "54_1309998850.8808" capture_lex $P1309 .const 'Sub' $P1304 = "53_1309998850.8808" capture_lex $P1304 .const 'Sub' $P1299 = "52_1309998850.8808" capture_lex $P1299 .const 'Sub' $P1294 = "51_1309998850.8808" capture_lex $P1294 .const 'Sub' $P1289 = "50_1309998850.8808" capture_lex $P1289 .const 'Sub' $P1284 = "49_1309998850.8808" capture_lex $P1284 .const 'Sub' $P1279 = "48_1309998850.8808" capture_lex $P1279 .const 'Sub' $P1274 = "47_1309998850.8808" capture_lex $P1274 .const 'Sub' $P1269 = "46_1309998850.8808" capture_lex $P1269 .const 'Sub' $P1264 = "45_1309998850.8808" capture_lex $P1264 .const 'Sub' $P1256 = "44_1309998850.8808" capture_lex $P1256 .const 'Sub' $P1248 = "43_1309998850.8808" capture_lex $P1248 .const 'Sub' $P1242 = "42_1309998850.8808" capture_lex $P1242 .const 'Sub' $P1235 = "41_1309998850.8808" capture_lex $P1235 .const 'Sub' $P1228 = "40_1309998850.8808" capture_lex $P1228 .const 'Sub' $P1223 = "39_1309998850.8808" capture_lex $P1223 .const 'Sub' $P1213 = "38_1309998850.8808" capture_lex $P1213 .const 'Sub' $P1201 = "37_1309998850.8808" capture_lex $P1201 .const 'Sub' $P1194 = "36_1309998850.8808" capture_lex $P1194 .const 'Sub' $P1188 = "35_1309998850.8808" capture_lex $P1188 .const 'Sub' $P1168 = "33_1309998850.8808" capture_lex $P1168 .const 'Sub' $P1162 = "32_1309998850.8808" capture_lex $P1162 .const 'Sub' $P1157 = "31_1309998850.8808" capture_lex $P1157 .const 'Sub' $P1150 = "30_1309998850.8808" capture_lex $P1150 .const 'Sub' $P1145 = "29_1309998850.8808" capture_lex $P1145 .const 'Sub' $P1140 = "28_1309998850.8808" capture_lex $P1140 .const 'Sub' $P1134 = "27_1309998850.8808" capture_lex $P1134 .const 'Sub' $P1104 = "25_1309998850.8808" capture_lex $P1104 .const 'Sub' $P1085 = "23_1309998850.8808" capture_lex $P1085 .const 'Sub' $P1078 = "22_1309998850.8808" capture_lex $P1078 .const 'Sub' $P1067 = "21_1309998850.8808" capture_lex $P1067 .const 'Sub' $P1062 = "20_1309998850.8808" capture_lex $P1062 .const 'Sub' $P1056 = "19_1309998850.8808" capture_lex $P1056 .const 'Sub' $P1044 = "18_1309998850.8808" capture_lex $P1044 .const 'Sub' $P1037 = "17_1309998850.8808" capture_lex $P1037 .const 'Sub' $P1029 = "16_1309998850.8808" capture_lex $P1029 .const 'Sub' $P1014 = "13_1309998850.8808" capture_lex $P1014 .const 'Sub' $P1006 = "12_1309998850.8808" capture_lex $P1006 get_global $P1004, "@BLOCK" unless_null $P1004, vivify_153 $P1004 = root_new ['parrot';'ResizablePMCArray'] set_global "@BLOCK", $P1004 vivify_153: .annotate 'line', 9 .const 'Sub' $P1006 = "12_1309998850.8808" newclosure $P1012, $P1006 set $P1005, $P1012 .lex "xblock_immediate", $P1005 .annotate 'line', 14 .const 'Sub' $P1014 = "13_1309998850.8808" newclosure $P1027, $P1014 set $P1013, $P1027 .lex "block_immediate", $P1013 .annotate 'line', 24 .const 'Sub' $P1029 = "16_1309998850.8808" newclosure $P1035, $P1029 set $P1028, $P1035 .lex "vivitype", $P1028 .annotate 'line', 43 .const 'Sub' $P1037 = "17_1309998850.8808" newclosure $P1042, $P1037 set $P1036, $P1042 .lex "colonpair_str", $P1036 .annotate 'line', 224 .const 'Sub' $P1044 = "18_1309998850.8808" newclosure $P1054, $P1044 set $P1043, $P1054 .lex "push_block_handler", $P1043 .annotate 'line', 863 .const 'Sub' $P1056 = "19_1309998850.8808" newclosure $P1061, $P1056 set $P1055, $P1061 .lex "control", $P1055 .annotate 'line', 3 $P0 = find_dynamic_lex "$*CTXSAVE" if null $P0 goto ctxsave_done $I0 = can $P0, "ctxsave" unless $I0 goto ctxsave_done $P0."ctxsave"() ctxsave_done: get_global $P110, "@BLOCK" find_lex $P110, "xblock_immediate" find_lex $P110, "block_immediate" find_lex $P110, "vivitype" find_lex $P110, "colonpair_str" find_lex $P110, "push_block_handler" find_lex $P110, "control" .annotate 'line', 881 .const 'Sub' $P1964 = "139_1309998850.8808" capture_lex $P1964 $P110 = $P1964() .annotate 'line', 3 .return ($P110) .const 'Sub' $P2006 = "147_1309998850.8808" .return ($P2006) .end .namespace ["NQP";"Actions"] .sub "" :load :init :subid("post151") :outer("11_1309998850.8808") .annotate 'line', 3 .const 'Sub' $P1003 = "11_1309998850.8808" .local pmc block set block, $P1003 .annotate 'line', 5 .const 'Sub' $P2009 = "148_1309998850.8808" capture_lex $P2009 $P2009() $P2012 = get_root_global ["parrot"], "P6metaclass" $P2012."new_class"("NQP::RegexActions", "Regex::P6Regex::Actions" :named("parent")) .end .namespace ["NQP";"Actions"] .sub "_block2008" :anon :subid("148_1309998850.8808") :outer("11_1309998850.8808") .annotate 'line', 6 get_global $P2010, "@BLOCK" unless_null $P2010, vivify_152 $P2010 = root_new ['parrot';'ResizablePMCArray'] set_global "@BLOCK", $P2010 vivify_152: $P2011 = new ['ResizablePMCArray'] set_global "@BLOCK", $P2011 .annotate 'line', 5 .return ($P2011) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "xblock_immediate" :subid("12_1309998850.8808") :outer("11_1309998850.8808") .param pmc param_1009 .annotate 'line', 9 new $P1008, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1008, control_1007 push_eh $P1008 .lex "$xblock", param_1009 .annotate 'line', 10 find_lex $P1010, "$xblock" unless_null $P1010, vivify_154 $P1010 = root_new ['parrot';'ResizablePMCArray'] vivify_154: set $P100, $P1010[1] unless_null $P100, vivify_155 new $P100, "Undef" vivify_155: $P101 = "block_immediate"($P100) find_lex $P1011, "$xblock" unless_null $P1011, vivify_156 $P1011 = root_new ['parrot';'ResizablePMCArray'] store_lex "$xblock", $P1011 vivify_156: set $P1011[1], $P101 .annotate 'line', 9 find_lex $P100, "$xblock" .return ($P100) control_1007: .local pmc exception .get_results (exception) getattribute $P101, exception, "payload" .return ($P101) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "block_immediate" :subid("13_1309998850.8808") :outer("11_1309998850.8808") .param pmc param_1017 .annotate 'line', 14 .const 'Sub' $P1021 = "14_1309998850.8808" capture_lex $P1021 new $P1016, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1016, control_1015 push_eh $P1016 .lex "$block", param_1017 .annotate 'line', 15 find_lex $P102, "$block" $P102."blocktype"("immediate") .annotate 'line', 16 find_lex $P103, "$block" $P104 = $P103."symtable"() unless $P104, unless_1019 set $P102, $P104 goto unless_1019_end unless_1019: find_lex $P105, "$block" $P106 = $P105."handlers"() set $P102, $P106 unless_1019_end: if $P102, unless_1018_end .const 'Sub' $P1021 = "14_1309998850.8808" capture_lex $P1021 $P1021() unless_1018_end: .annotate 'line', 14 find_lex $P102, "$block" .return ($P102) control_1015: .local pmc exception .get_results (exception) getattribute $P103, exception, "payload" .return ($P103) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "_block1020" :anon :subid("14_1309998850.8808") :outer("13_1309998850.8808") .annotate 'line', 16 .const 'Sub' $P1024 = "15_1309998850.8808" capture_lex $P1024 .annotate 'line', 17 new $P107, "Undef" set $P1022, $P107 .lex "$stmts", $P1022 get_hll_global $P108, ["PAST"], "Stmts" find_lex $P109, "$block" $P110 = $P108."new"($P109 :named("node")) store_lex "$stmts", $P110 .annotate 'line', 18 find_lex $P109, "$block" $P110 = $P109."list"() defined $I100, $P110 unless $I100, for_undef_157 iter $P108, $P110 new $P112, 'ExceptionHandler' set_label $P112, loop1026_handler $P112."handle_types"(.CONTROL_LOOP_NEXT, .CONTROL_LOOP_REDO, .CONTROL_LOOP_LAST) push_eh $P112 loop1026_test: unless $P108, loop1026_done shift $P111, $P108 loop1026_redo: .const 'Sub' $P1024 = "15_1309998850.8808" capture_lex $P1024 $P1024($P111) loop1026_next: goto loop1026_test loop1026_handler: .local pmc exception .get_results (exception) getattribute $P113, exception, 'type' eq $P113, .CONTROL_LOOP_NEXT, loop1026_next eq $P113, .CONTROL_LOOP_REDO, loop1026_redo loop1026_done: pop_eh for_undef_157: .annotate 'line', 19 find_lex $P108, "$stmts" store_lex "$block", $P108 .annotate 'line', 16 .return ($P108) .end .namespace ["NQP";"Actions"] .sub "_block1023" :anon :subid("15_1309998850.8808") :outer("14_1309998850.8808") .param pmc param_1025 .annotate 'line', 18 .lex "$_", param_1025 find_lex $P112, "$stmts" find_lex $P113, "$_" $P114 = $P112."push"($P113) .return ($P114) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "vivitype" :subid("16_1309998850.8808") :outer("11_1309998850.8808") .param pmc param_1032 .annotate 'line', 24 new $P1031, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1031, control_1030 push_eh $P1031 .lex "$sigil", param_1032 .annotate 'line', 25 find_lex $P105, "$sigil" set $S100, $P105 iseq $I100, $S100, "%" if $I100, if_1033 .annotate 'line', 27 find_lex $P109, "$sigil" set $S101, $P109 iseq $I101, $S101, "@" if $I101, if_1034 new $P112, "String" assign $P112, "Undef" set $P108, $P112 goto if_1034_end if_1034: .annotate 'line', 28 get_hll_global $P110, ["PAST"], "Op" $P111 = $P110."new"(" %r = root_new ['parrot';'ResizablePMCArray']" :named("inline")) set $P108, $P111 if_1034_end: set $P104, $P108 .annotate 'line', 25 goto if_1033_end if_1033: .annotate 'line', 26 get_hll_global $P106, ["PAST"], "Op" $P107 = $P106."new"(" %r = root_new ['parrot';'Hash']" :named("inline")) set $P104, $P107 if_1033_end: .annotate 'line', 24 .return ($P104) control_1030: .local pmc exception .get_results (exception) getattribute $P105, exception, "payload" .return ($P105) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "colonpair_str" :subid("17_1309998850.8808") :outer("11_1309998850.8808") .param pmc param_1040 .annotate 'line', 43 new $P1039, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1039, control_1038 push_eh $P1039 .lex "$ast", param_1040 .annotate 'line', 44 get_hll_global $P107, ["PAST"], "Op" find_lex $P108, "$ast" $P109 = $P107."ACCEPTS"($P108) if $P109, if_1041 .annotate 'line', 46 find_lex $P112, "$ast" $P113 = $P112."value"() set $P106, $P113 .annotate 'line', 44 goto if_1041_end if_1041: .annotate 'line', 45 find_lex $P110, "$ast" $P111 = $P110."list"() join $S100, " ", $P111 new $P106, 'String' set $P106, $S100 if_1041_end: .annotate 'line', 43 .return ($P106) control_1038: .local pmc exception .get_results (exception) getattribute $P107, exception, "payload" .return ($P107) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "push_block_handler" :subid("18_1309998850.8808") :outer("11_1309998850.8808") .param pmc param_1047 .param pmc param_1048 .annotate 'line', 224 new $P1046, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1046, control_1045 push_eh $P1046 .lex "$/", param_1047 .lex "$block", param_1048 .annotate 'line', 225 get_global $P1050, "@BLOCK" unless_null $P1050, vivify_158 $P1050 = root_new ['parrot';'ResizablePMCArray'] vivify_158: set $P108, $P1050[0] unless_null $P108, vivify_159 new $P108, "Undef" vivify_159: $P109 = $P108."handlers"() if $P109, unless_1049_end .annotate 'line', 226 get_global $P1051, "@BLOCK" unless_null $P1051, vivify_160 $P1051 = root_new ['parrot';'ResizablePMCArray'] vivify_160: set $P110, $P1051[0] unless_null $P110, vivify_161 new $P110, "Undef" vivify_161: new $P111, "ResizablePMCArray" $P110."handlers"($P111) unless_1049_end: .annotate 'line', 228 find_lex $P108, "$block" $P109 = $P108."arity"() if $P109, unless_1052_end .annotate 'line', 229 find_lex $P110, "$block" .annotate 'line', 230 get_hll_global $P111, ["PAST"], "Op" .annotate 'line', 231 get_hll_global $P112, ["PAST"], "Var" $P113 = $P112."new"("lexical" :named("scope"), "$!" :named("name"), 1 :named("isdecl")) .annotate 'line', 232 get_hll_global $P114, ["PAST"], "Var" $P115 = $P114."new"("lexical" :named("scope"), "$_" :named("name")) $P116 = $P111."new"($P113, $P115, "bind" :named("pasttype")) .annotate 'line', 230 $P110."unshift"($P116) .annotate 'line', 235 find_lex $P110, "$block" get_hll_global $P111, ["PAST"], "Var" $P112 = $P111."new"("$_" :named("name"), "parameter" :named("scope")) $P110."unshift"($P112) .annotate 'line', 236 find_lex $P110, "$block" $P110."symbol"("$_", "lexical" :named("scope")) .annotate 'line', 237 find_lex $P110, "$block" $P110."symbol"("$!", "lexical" :named("scope")) .annotate 'line', 238 find_lex $P110, "$block" $P110."arity"(1) unless_1052_end: .annotate 'line', 240 find_lex $P108, "$block" $P108."blocktype"("declaration") .annotate 'line', 241 get_global $P1053, "@BLOCK" unless_null $P1053, vivify_162 $P1053 = root_new ['parrot';'ResizablePMCArray'] vivify_162: set $P108, $P1053[0] unless_null $P108, vivify_163 new $P108, "Undef" vivify_163: $P109 = $P108."handlers"() .annotate 'line', 242 get_hll_global $P110, ["PAST"], "Control" find_lex $P111, "$/" .annotate 'line', 244 get_hll_global $P112, ["PAST"], "Stmts" .annotate 'line', 245 get_hll_global $P113, ["PAST"], "Op" find_lex $P114, "$block" .annotate 'line', 247 get_hll_global $P115, ["PAST"], "Var" $P116 = $P115."new"("register" :named("scope"), "exception" :named("name")) $P117 = $P113."new"($P114, $P116, "call" :named("pasttype")) .annotate 'line', 249 get_hll_global $P118, ["PAST"], "Op" .annotate 'line', 250 get_hll_global $P119, ["PAST"], "Var" .annotate 'line', 251 get_hll_global $P120, ["PAST"], "Var" $P121 = $P120."new"("register" :named("scope"), "exception" :named("name")) $P122 = $P119."new"($P121, "handled", "keyed" :named("scope")) .annotate 'line', 250 $P123 = $P118."new"($P122, 1, "bind" :named("pasttype")) .annotate 'line', 249 $P124 = $P112."new"($P117, $P123) .annotate 'line', 244 $P125 = $P110."new"($P124, $P111 :named("node")) .annotate 'line', 242 $P126 = $P109."unshift"($P125) .annotate 'line', 224 .return ($P126) control_1045: .local pmc exception .get_results (exception) getattribute $P108, exception, "payload" .return ($P108) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "control" :subid("19_1309998850.8808") :outer("11_1309998850.8808") .param pmc param_1059 .param pmc param_1060 .annotate 'line', 863 new $P1058, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1058, control_1057 push_eh $P1058 .lex "$/", param_1059 .lex "$type", param_1060 .annotate 'line', 864 find_lex $P109, "$/" get_hll_global $P110, ["PAST"], "Op" find_lex $P111, "$/" .annotate 'line', 868 get_hll_global $P112, ["PAST"], "Val" find_lex $P113, "$type" $P114 = $P112."new"($P113 :named("value"), "!except_types" :named("returns")) $P115 = $P110."new"(0, $P114, $P111 :named("node"), "die__vii" :named("pirop")) .annotate 'line', 864 $P116 = $P109."!make"($P115) .annotate 'line', 863 .return ($P116) control_1057: .local pmc exception .get_results (exception) getattribute $P109, exception, "payload" .return ($P109) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "TOP" :subid("20_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1065 .annotate 'line', 33 new $P1064, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1064, control_1063 push_eh $P1064 .lex "self", self .lex "$/", param_1065 find_lex $P110, "$/" find_lex $P1066, "$/" unless_null $P1066, vivify_164 $P1066 = root_new ['parrot';'Hash'] vivify_164: set $P111, $P1066["comp_unit"] unless_null $P111, vivify_165 new $P111, "Undef" vivify_165: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1063: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "deflongname" :subid("21_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1070 .annotate 'line', 35 new $P1069, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1069, control_1068 push_eh $P1069 .lex "self", self .lex "$/", param_1070 .annotate 'line', 36 find_lex $P110, "$/" .annotate 'line', 37 find_lex $P1072, "$/" unless_null $P1072, vivify_166 $P1072 = root_new ['parrot';'Hash'] vivify_166: set $P112, $P1072["colonpair"] unless_null $P112, vivify_167 new $P112, "Undef" vivify_167: if $P112, if_1071 .annotate 'line', 39 find_lex $P125, "$/" set $S103, $P125 new $P111, 'String' set $P111, $S103 .annotate 'line', 37 goto if_1071_end if_1071: find_lex $P1073, "$/" unless_null $P1073, vivify_168 $P1073 = root_new ['parrot';'Hash'] vivify_168: set $P113, $P1073["identifier"] unless_null $P113, vivify_169 new $P113, "Undef" vivify_169: set $S100, $P113 new $P114, 'String' set $P114, $S100 concat $P115, $P114, ":" find_lex $P1074, "$/" unless_null $P1074, vivify_170 $P1074 = root_new ['parrot';'Hash'] vivify_170: set $P1075, $P1074["colonpair"] unless_null $P1075, vivify_171 $P1075 = root_new ['parrot';'ResizablePMCArray'] vivify_171: set $P117, $P1075[0] unless_null $P117, vivify_172 new $P117, "Undef" vivify_172: $P118 = $P117."ast"() $S101 = $P118."named"() concat $P119, $P115, $S101 concat $P120, $P119, "<" .annotate 'line', 38 find_lex $P1076, "$/" unless_null $P1076, vivify_173 $P1076 = root_new ['parrot';'Hash'] vivify_173: set $P1077, $P1076["colonpair"] unless_null $P1077, vivify_174 $P1077 = root_new ['parrot';'ResizablePMCArray'] vivify_174: set $P121, $P1077[0] unless_null $P121, vivify_175 new $P121, "Undef" vivify_175: $P122 = $P121."ast"() $S102 = "colonpair_str"($P122) concat $P123, $P120, $S102 concat $P124, $P123, ">" set $P111, $P124 if_1071_end: .annotate 'line', 37 $P127 = $P110."!make"($P111) .annotate 'line', 35 .return ($P127) control_1068: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "comp_unit" :subid("22_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1081 .annotate 'line', 49 new $P1080, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1080, control_1079 push_eh $P1080 .lex "self", self .lex "$/", param_1081 .annotate 'line', 50 new $P110, "Undef" set $P1082, $P110 .lex "$mainline", $P1082 .annotate 'line', 51 new $P111, "Undef" set $P1083, $P111 .lex "$unit", $P1083 .annotate 'line', 50 find_lex $P1084, "$/" unless_null $P1084, vivify_176 $P1084 = root_new ['parrot';'Hash'] vivify_176: set $P112, $P1084["statementlist"] unless_null $P112, vivify_177 new $P112, "Undef" vivify_177: $P113 = $P112."ast"() store_lex "$mainline", $P113 .annotate 'line', 51 get_global $P112, "@BLOCK" $P113 = $P112."shift"() store_lex "$unit", $P113 .annotate 'line', 55 find_lex $P112, "$unit" find_lex $P113, "self" $P114 = $P113."CTXSAVE"() $P112."push"($P114) .annotate 'line', 60 find_lex $P112, "$unit" .annotate 'line', 61 get_hll_global $P113, ["PAST"], "Op" find_lex $P114, "$mainline" $P115 = $P113."new"($P114, "return" :named("pirop")) $P112."push"($P115) .annotate 'line', 66 find_lex $P112, "$unit" .annotate 'line', 67 get_hll_global $P113, ["PAST"], "Block" .annotate 'line', 69 get_hll_global $P114, ["PAST"], "Op" get_hll_global $P115, ["PAST"], "Val" find_lex $P117, "$unit" $P118 = $P115."new"($P117 :named("value")) $P119 = $P114."new"($P118, "call" :named("pasttype")) $P120 = $P113."new"($P119, ":load" :named("pirflags"), 0 :named("lexical"), "" :named("namespace")) .annotate 'line', 67 $P112."push"($P120) .annotate 'line', 72 find_lex $P112, "$unit" find_lex $P113, "$/" $P112."node"($P113) .annotate 'line', 73 find_lex $P112, "$/" find_lex $P113, "$unit" $P114 = $P112."!make"($P113) .annotate 'line', 49 .return ($P114) control_1079: .local pmc exception .get_results (exception) getattribute $P112, exception, "payload" .return ($P112) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statementlist" :subid("23_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1088 .annotate 'line', 76 .const 'Sub' $P1094 = "24_1309998850.8808" capture_lex $P1094 new $P1087, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1087, control_1086 push_eh $P1087 .lex "self", self .lex "$/", param_1088 .annotate 'line', 77 new $P110, "Undef" set $P1089, $P110 .lex "$past", $P1089 get_hll_global $P111, ["PAST"], "Stmts" find_lex $P112, "$/" $P113 = $P111."new"($P112 :named("node")) store_lex "$past", $P113 .annotate 'line', 78 find_lex $P1091, "$/" unless_null $P1091, vivify_178 $P1091 = root_new ['parrot';'Hash'] vivify_178: set $P111, $P1091["statement"] unless_null $P111, vivify_179 new $P111, "Undef" vivify_179: unless $P111, if_1090_end .annotate 'line', 79 find_lex $P1092, "$/" unless_null $P1092, vivify_180 $P1092 = root_new ['parrot';'Hash'] vivify_180: set $P113, $P1092["statement"] unless_null $P113, vivify_181 new $P113, "Undef" vivify_181: defined $I100, $P113 unless $I100, for_undef_182 iter $P112, $P113 new $P117, 'ExceptionHandler' set_label $P117, loop1103_handler $P117."handle_types"(.CONTROL_LOOP_NEXT, .CONTROL_LOOP_REDO, .CONTROL_LOOP_LAST) push_eh $P117 loop1103_test: unless $P112, loop1103_done shift $P114, $P112 loop1103_redo: .const 'Sub' $P1094 = "24_1309998850.8808" capture_lex $P1094 $P1094($P114) loop1103_next: goto loop1103_test loop1103_handler: .local pmc exception .get_results (exception) getattribute $P118, exception, 'type' eq $P118, .CONTROL_LOOP_NEXT, loop1103_next eq $P118, .CONTROL_LOOP_REDO, loop1103_redo loop1103_done: pop_eh for_undef_182: if_1090_end: .annotate 'line', 87 find_lex $P111, "$/" find_lex $P112, "$past" $P113 = $P111."!make"($P112) .annotate 'line', 76 .return ($P113) control_1086: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .sub "_block1093" :anon :subid("24_1309998850.8808") :outer("23_1309998850.8808") .param pmc param_1096 .annotate 'line', 80 new $P115, "Undef" set $P1095, $P115 .lex "$ast", $P1095 .lex "$_", param_1096 find_lex $P117, "$_" $P118 = $P117."ast"() store_lex "$ast", $P118 .annotate 'line', 81 find_lex $P1098, "$ast" unless_null $P1098, vivify_183 $P1098 = root_new ['parrot';'Hash'] vivify_183: set $P117, $P1098["sink"] unless_null $P117, vivify_184 new $P117, "Undef" vivify_184: defined $I101, $P117 unless $I101, if_1097_end find_lex $P1099, "$ast" unless_null $P1099, vivify_185 $P1099 = root_new ['parrot';'Hash'] vivify_185: set $P118, $P1099["sink"] unless_null $P118, vivify_186 new $P118, "Undef" vivify_186: store_lex "$ast", $P118 if_1097_end: .annotate 'line', 82 find_lex $P1101, "$ast" unless_null $P1101, vivify_187 $P1101 = root_new ['parrot';'Hash'] vivify_187: set $P117, $P1101["bareblock"] unless_null $P117, vivify_188 new $P117, "Undef" vivify_188: unless $P117, if_1100_end find_lex $P118, "$ast" $P119 = "block_immediate"($P118) store_lex "$ast", $P119 if_1100_end: .annotate 'line', 83 get_hll_global $P117, ["PAST"], "Node" find_lex $P118, "$ast" $P119 = $P117."ACCEPTS"($P118) unless $P119, if_1102_end get_hll_global $P120, ["PAST"], "Stmt" find_lex $P121, "$ast" $P122 = $P120."new"($P121) store_lex "$ast", $P122 if_1102_end: .annotate 'line', 84 find_lex $P117, "$past" find_lex $P118, "$ast" $P119 = $P117."push"($P118) .annotate 'line', 79 .return ($P119) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement" :subid("25_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1107 .param pmc param_1108 :optional .param int has_param_1108 :opt_flag .annotate 'line', 90 .const 'Sub' $P1113 = "26_1309998850.8808" capture_lex $P1113 new $P1106, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1106, control_1105 push_eh $P1106 .lex "self", self .lex "$/", param_1107 if has_param_1108, optparam_189 new $P110, "Undef" set param_1108, $P110 optparam_189: .lex "$key", param_1108 .annotate 'line', 91 new $P111, "Undef" set $P1109, $P111 .lex "$past", $P1109 .annotate 'line', 90 find_lex $P112, "$past" .annotate 'line', 92 find_lex $P1111, "$/" unless_null $P1111, vivify_190 $P1111 = root_new ['parrot';'Hash'] vivify_190: set $P112, $P1111["EXPR"] unless_null $P112, vivify_191 new $P112, "Undef" vivify_191: if $P112, if_1110 .annotate 'line', 113 find_lex $P1132, "$/" unless_null $P1132, vivify_192 $P1132 = root_new ['parrot';'Hash'] vivify_192: set $P117, $P1132["statement_control"] unless_null $P117, vivify_193 new $P117, "Undef" vivify_193: if $P117, if_1131 .annotate 'line', 114 new $P118, "Integer" assign $P118, 0 store_lex "$past", $P118 goto if_1131_end if_1131: .annotate 'line', 113 find_lex $P1133, "$/" unless_null $P1133, vivify_194 $P1133 = root_new ['parrot';'Hash'] vivify_194: set $P118, $P1133["statement_control"] unless_null $P118, vivify_195 new $P118, "Undef" vivify_195: $P119 = $P118."ast"() store_lex "$past", $P119 if_1131_end: goto if_1110_end if_1110: .annotate 'line', 92 .const 'Sub' $P1113 = "26_1309998850.8808" capture_lex $P1113 $P1113() if_1110_end: .annotate 'line', 115 find_lex $P112, "$/" find_lex $P113, "$past" $P114 = $P112."!make"($P113) .annotate 'line', 90 .return ($P114) control_1105: .local pmc exception .get_results (exception) getattribute $P112, exception, "payload" .return ($P112) .end .namespace ["NQP";"Actions"] .sub "_block1112" :anon :subid("26_1309998850.8808") :outer("25_1309998850.8808") .annotate 'line', 93 new $P113, "Undef" set $P1114, $P113 .lex "$mc", $P1114 .annotate 'line', 94 new $P114, "Undef" set $P1115, $P114 .lex "$ml", $P1115 .annotate 'line', 93 find_lex $P1116, "$/" unless_null $P1116, vivify_196 $P1116 = root_new ['parrot';'Hash'] vivify_196: set $P1117, $P1116["statement_mod_cond"] unless_null $P1117, vivify_197 $P1117 = root_new ['parrot';'ResizablePMCArray'] vivify_197: set $P115, $P1117[0] unless_null $P115, vivify_198 new $P115, "Undef" vivify_198: store_lex "$mc", $P115 .annotate 'line', 94 find_lex $P1118, "$/" unless_null $P1118, vivify_199 $P1118 = root_new ['parrot';'Hash'] vivify_199: set $P1119, $P1118["statement_mod_loop"] unless_null $P1119, vivify_200 $P1119 = root_new ['parrot';'ResizablePMCArray'] vivify_200: set $P115, $P1119[0] unless_null $P115, vivify_201 new $P115, "Undef" vivify_201: store_lex "$ml", $P115 .annotate 'line', 95 find_lex $P1120, "$/" unless_null $P1120, vivify_202 $P1120 = root_new ['parrot';'Hash'] vivify_202: set $P115, $P1120["EXPR"] unless_null $P115, vivify_203 new $P115, "Undef" vivify_203: $P117 = $P115."ast"() store_lex "$past", $P117 .annotate 'line', 96 find_lex $P115, "$mc" unless $P115, if_1121_end .annotate 'line', 97 get_hll_global $P117, ["PAST"], "Op" find_lex $P1122, "$mc" unless_null $P1122, vivify_204 $P1122 = root_new ['parrot';'Hash'] vivify_204: set $P118, $P1122["cond"] unless_null $P118, vivify_205 new $P118, "Undef" vivify_205: $P119 = $P118."ast"() find_lex $P120, "$past" find_lex $P1123, "$mc" unless_null $P1123, vivify_206 $P1123 = root_new ['parrot';'Hash'] vivify_206: set $P121, $P1123["sym"] unless_null $P121, vivify_207 new $P121, "Undef" vivify_207: set $S100, $P121 find_lex $P122, "$/" $P123 = $P117."new"($P119, $P120, $S100 :named("pasttype"), $P122 :named("node")) store_lex "$past", $P123 if_1121_end: .annotate 'line', 99 find_lex $P117, "$ml" if $P117, if_1124 set $P115, $P117 goto if_1124_end if_1124: .annotate 'line', 100 find_lex $P1126, "$ml" unless_null $P1126, vivify_208 $P1126 = root_new ['parrot';'Hash'] vivify_208: set $P119, $P1126["sym"] unless_null $P119, vivify_209 new $P119, "Undef" vivify_209: set $S100, $P119 iseq $I100, $S100, "for" if $I100, if_1125 .annotate 'line', 109 get_hll_global $P120, ["PAST"], "Op" find_lex $P1129, "$ml" unless_null $P1129, vivify_210 $P1129 = root_new ['parrot';'Hash'] vivify_210: set $P121, $P1129["cond"] unless_null $P121, vivify_211 new $P121, "Undef" vivify_211: $P122 = $P121."ast"() find_lex $P123, "$past" find_lex $P1130, "$ml" unless_null $P1130, vivify_212 $P1130 = root_new ['parrot';'Hash'] vivify_212: set $P124, $P1130["sym"] unless_null $P124, vivify_213 new $P124, "Undef" vivify_213: set $S101, $P124 find_lex $P125, "$/" $P128 = $P120."new"($P122, $P123, $S101 :named("pasttype"), $P125 :named("node")) store_lex "$past", $P128 .annotate 'line', 108 set $P118, $P128 .annotate 'line', 100 goto if_1125_end if_1125: .annotate 'line', 101 get_hll_global $P120, ["PAST"], "Block" .annotate 'line', 102 get_hll_global $P121, ["PAST"], "Var" $P122 = $P121."new"("$_" :named("name"), "parameter" :named("scope"), 1 :named("isdecl")) find_lex $P123, "$past" $P124 = $P120."new"($P122, $P123, "immediate" :named("blocktype")) .annotate 'line', 101 store_lex "$past", $P124 .annotate 'line', 104 find_lex $P120, "$past" $P120."symbol"("$_", "lexical" :named("scope")) .annotate 'line', 105 find_lex $P120, "$past" $P120."arity"(1) .annotate 'line', 106 get_hll_global $P120, ["PAST"], "Op" find_lex $P1127, "$ml" unless_null $P1127, vivify_214 $P1127 = root_new ['parrot';'Hash'] vivify_214: set $P121, $P1127["cond"] unless_null $P121, vivify_215 new $P121, "Undef" vivify_215: $P122 = $P121."ast"() find_lex $P123, "$past" find_lex $P1128, "$ml" unless_null $P1128, vivify_216 $P1128 = root_new ['parrot';'Hash'] vivify_216: set $P124, $P1128["sym"] unless_null $P124, vivify_217 new $P124, "Undef" vivify_217: set $S101, $P124 find_lex $P125, "$/" $P127 = $P120."new"($P122, $P123, $S101 :named("pasttype"), $P125 :named("node")) store_lex "$past", $P127 .annotate 'line', 100 set $P118, $P127 if_1125_end: .annotate 'line', 99 set $P115, $P118 if_1124_end: .annotate 'line', 92 .return ($P115) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "xblock" :subid("27_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1137 .annotate 'line', 118 new $P1136, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1136, control_1135 push_eh $P1136 .lex "self", self .lex "$/", param_1137 .annotate 'line', 119 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Op" find_lex $P1138, "$/" unless_null $P1138, vivify_218 $P1138 = root_new ['parrot';'Hash'] vivify_218: set $P112, $P1138["EXPR"] unless_null $P112, vivify_219 new $P112, "Undef" vivify_219: $P113 = $P112."ast"() find_lex $P1139, "$/" unless_null $P1139, vivify_220 $P1139 = root_new ['parrot';'Hash'] vivify_220: set $P114, $P1139["pblock"] unless_null $P114, vivify_221 new $P114, "Undef" vivify_221: $P115 = $P114."ast"() find_lex $P117, "$/" $P118 = $P111."new"($P113, $P115, "if" :named("pasttype"), $P117 :named("node")) $P119 = $P110."!make"($P118) .annotate 'line', 118 .return ($P119) control_1135: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "pblock" :subid("28_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1143 .annotate 'line', 122 new $P1142, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1142, control_1141 push_eh $P1142 .lex "self", self .lex "$/", param_1143 .annotate 'line', 123 find_lex $P110, "$/" find_lex $P1144, "$/" unless_null $P1144, vivify_222 $P1144 = root_new ['parrot';'Hash'] vivify_222: set $P111, $P1144["blockoid"] unless_null $P111, vivify_223 new $P111, "Undef" vivify_223: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .annotate 'line', 122 .return ($P113) control_1141: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "block" :subid("29_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1148 .annotate 'line', 126 new $P1147, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1147, control_1146 push_eh $P1147 .lex "self", self .lex "$/", param_1148 .annotate 'line', 127 find_lex $P110, "$/" find_lex $P1149, "$/" unless_null $P1149, vivify_224 $P1149 = root_new ['parrot';'Hash'] vivify_224: set $P111, $P1149["blockoid"] unless_null $P111, vivify_225 new $P111, "Undef" vivify_225: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .annotate 'line', 126 .return ($P113) control_1146: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "blockoid" :subid("30_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1153 .annotate 'line', 130 new $P1152, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1152, control_1151 push_eh $P1152 .lex "self", self .lex "$/", param_1153 .annotate 'line', 131 new $P110, "Undef" set $P1154, $P110 .lex "$past", $P1154 .annotate 'line', 132 new $P111, "Undef" set $P1155, $P111 .lex "$BLOCK", $P1155 .annotate 'line', 131 find_lex $P1156, "$/" unless_null $P1156, vivify_226 $P1156 = root_new ['parrot';'Hash'] vivify_226: set $P112, $P1156["statementlist"] unless_null $P112, vivify_227 new $P112, "Undef" vivify_227: $P113 = $P112."ast"() store_lex "$past", $P113 .annotate 'line', 132 get_global $P112, "@BLOCK" $P113 = $P112."shift"() store_lex "$BLOCK", $P113 .annotate 'line', 133 find_lex $P112, "$BLOCK" find_lex $P113, "$past" $P112."push"($P113) .annotate 'line', 134 find_lex $P112, "$BLOCK" find_lex $P113, "$/" $P112."node"($P113) .annotate 'line', 135 find_lex $P112, "$BLOCK" $P112."closure"(1) .annotate 'line', 136 find_lex $P112, "$/" find_lex $P113, "$BLOCK" $P114 = $P112."!make"($P113) .annotate 'line', 130 .return ($P114) control_1151: .local pmc exception .get_results (exception) getattribute $P112, exception, "payload" .return ($P112) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "newpad" :subid("31_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1160 .annotate 'line', 139 new $P1159, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1159, control_1158 push_eh $P1159 .lex "self", self .lex "$/", param_1160 .annotate 'line', 140 get_global $P1161, "@BLOCK" unless_null $P1161, vivify_228 $P1161 = root_new ['parrot';'ResizablePMCArray'] set_global "@BLOCK", $P1161 vivify_228: .annotate 'line', 139 get_global $P110, "@BLOCK" .annotate 'line', 141 get_global $P110, "@BLOCK" get_hll_global $P111, ["PAST"], "Block" get_hll_global $P112, ["PAST"], "Stmts" $P113 = $P112."new"() $P114 = $P111."new"($P113) $P115 = $P110."unshift"($P114) .annotate 'line', 139 .return ($P115) control_1158: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "outerctx" :subid("32_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1165 .annotate 'line', 144 new $P1164, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1164, control_1163 push_eh $P1164 .lex "self", self .lex "$/", param_1165 .annotate 'line', 145 get_global $P1166, "@BLOCK" unless_null $P1166, vivify_229 $P1166 = root_new ['parrot';'ResizablePMCArray'] set_global "@BLOCK", $P1166 vivify_229: .annotate 'line', 144 get_global $P110, "@BLOCK" .annotate 'line', 146 find_lex $P110, "self" get_global $P1167, "@BLOCK" unless_null $P1167, vivify_230 $P1167 = root_new ['parrot';'ResizablePMCArray'] vivify_230: set $P111, $P1167[0] unless_null $P111, vivify_231 new $P111, "Undef" vivify_231: $P112 = $P110."SET_BLOCK_OUTER_CTX"($P111) .annotate 'line', 144 .return ($P112) control_1163: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement_control:sym" :subid("33_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1171 .annotate 'line', 151 .const 'Sub' $P1182 = "34_1309998850.8808" capture_lex $P1182 new $P1170, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1170, control_1169 push_eh $P1170 .lex "self", self .lex "$/", param_1171 .annotate 'line', 152 new $P110, "Undef" set $P1172, $P110 .lex "$count", $P1172 .annotate 'line', 153 new $P111, "Undef" set $P1173, $P111 .lex "$past", $P1173 .annotate 'line', 152 find_lex $P1174, "$/" unless_null $P1174, vivify_232 $P1174 = root_new ['parrot';'Hash'] vivify_232: set $P112, $P1174["xblock"] unless_null $P112, vivify_233 new $P112, "Undef" vivify_233: set $N100, $P112 new $P113, 'Float' set $P113, $N100 sub $P114, $P113, 1 store_lex "$count", $P114 .annotate 'line', 153 find_lex $P112, "$count" set $I100, $P112 find_lex $P1175, "$/" unless_null $P1175, vivify_234 $P1175 = root_new ['parrot';'Hash'] vivify_234: set $P1176, $P1175["xblock"] unless_null $P1176, vivify_235 $P1176 = root_new ['parrot';'ResizablePMCArray'] vivify_235: set $P113, $P1176[$I100] unless_null $P113, vivify_236 new $P113, "Undef" vivify_236: $P114 = $P113."ast"() $P115 = "xblock_immediate"($P114) store_lex "$past", $P115 .annotate 'line', 154 find_lex $P1178, "$/" unless_null $P1178, vivify_237 $P1178 = root_new ['parrot';'Hash'] vivify_237: set $P112, $P1178["else"] unless_null $P112, vivify_238 new $P112, "Undef" vivify_238: unless $P112, if_1177_end .annotate 'line', 155 find_lex $P113, "$past" find_lex $P1179, "$/" unless_null $P1179, vivify_239 $P1179 = root_new ['parrot';'Hash'] vivify_239: set $P1180, $P1179["else"] unless_null $P1180, vivify_240 $P1180 = root_new ['parrot';'ResizablePMCArray'] vivify_240: set $P114, $P1180[0] unless_null $P114, vivify_241 new $P114, "Undef" vivify_241: $P115 = $P114."ast"() $P117 = "block_immediate"($P115) $P113."push"($P117) if_1177_end: .annotate 'line', 158 new $P114, 'ExceptionHandler' set_label $P114, loop1187_handler $P114."handle_types"(.CONTROL_LOOP_NEXT, .CONTROL_LOOP_REDO, .CONTROL_LOOP_LAST) push_eh $P114 loop1187_test: find_lex $P112, "$count" set $N100, $P112 isgt $I100, $N100, 0.0 unless $I100, loop1187_done loop1187_redo: .const 'Sub' $P1182 = "34_1309998850.8808" capture_lex $P1182 $P1182() loop1187_next: goto loop1187_test loop1187_handler: .local pmc exception .get_results (exception) getattribute $P115, exception, 'type' eq $P115, .CONTROL_LOOP_NEXT, loop1187_next eq $P115, .CONTROL_LOOP_REDO, loop1187_redo loop1187_done: pop_eh .annotate 'line', 164 find_lex $P112, "$/" find_lex $P113, "$past" $P114 = $P112."!make"($P113) .annotate 'line', 151 .return ($P114) control_1169: .local pmc exception .get_results (exception) getattribute $P112, exception, "payload" .return ($P112) .end .namespace ["NQP";"Actions"] .sub "_block1181" :anon :subid("34_1309998850.8808") :outer("33_1309998850.8808") .annotate 'line', 160 new $P113, "Undef" set $P1183, $P113 .lex "$else", $P1183 .annotate 'line', 158 find_lex $P114, "$count" clone $P1184, $P114 dec $P114 .annotate 'line', 160 find_lex $P114, "$past" store_lex "$else", $P114 .annotate 'line', 161 find_lex $P114, "$count" set $I101, $P114 find_lex $P1185, "$/" unless_null $P1185, vivify_242 $P1185 = root_new ['parrot';'Hash'] vivify_242: set $P1186, $P1185["xblock"] unless_null $P1186, vivify_243 $P1186 = root_new ['parrot';'ResizablePMCArray'] vivify_243: set $P115, $P1186[$I101] unless_null $P115, vivify_244 new $P115, "Undef" vivify_244: $P117 = $P115."ast"() $P118 = "xblock_immediate"($P117) store_lex "$past", $P118 .annotate 'line', 162 find_lex $P114, "$past" find_lex $P115, "$else" $P117 = $P114."push"($P115) .annotate 'line', 158 .return ($P117) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement_control:sym" :subid("35_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1191 .annotate 'line', 167 new $P1190, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1190, control_1189 push_eh $P1190 .lex "self", self .lex "$/", param_1191 .annotate 'line', 168 new $P110, "Undef" set $P1192, $P110 .lex "$past", $P1192 find_lex $P1193, "$/" unless_null $P1193, vivify_245 $P1193 = root_new ['parrot';'Hash'] vivify_245: set $P111, $P1193["xblock"] unless_null $P111, vivify_246 new $P111, "Undef" vivify_246: $P112 = $P111."ast"() $P113 = "xblock_immediate"($P112) store_lex "$past", $P113 .annotate 'line', 169 find_lex $P111, "$past" $P111."pasttype"("unless") .annotate 'line', 170 find_lex $P111, "$/" find_lex $P112, "$past" $P113 = $P111."!make"($P112) .annotate 'line', 167 .return ($P113) control_1189: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement_control:sym" :subid("36_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1197 .annotate 'line', 173 new $P1196, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1196, control_1195 push_eh $P1196 .lex "self", self .lex "$/", param_1197 .annotate 'line', 174 new $P110, "Undef" set $P1198, $P110 .lex "$past", $P1198 find_lex $P1199, "$/" unless_null $P1199, vivify_247 $P1199 = root_new ['parrot';'Hash'] vivify_247: set $P111, $P1199["xblock"] unless_null $P111, vivify_248 new $P111, "Undef" vivify_248: $P112 = $P111."ast"() $P113 = "xblock_immediate"($P112) store_lex "$past", $P113 .annotate 'line', 175 find_lex $P111, "$past" find_lex $P1200, "$/" unless_null $P1200, vivify_249 $P1200 = root_new ['parrot';'Hash'] vivify_249: set $P112, $P1200["sym"] unless_null $P112, vivify_250 new $P112, "Undef" vivify_250: set $S100, $P112 $P111."pasttype"($S100) .annotate 'line', 176 find_lex $P111, "$/" find_lex $P112, "$past" $P113 = $P111."!make"($P112) .annotate 'line', 173 .return ($P113) control_1195: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement_control:sym" :subid("37_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1204 .annotate 'line', 179 new $P1203, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1203, control_1202 push_eh $P1203 .lex "self", self .lex "$/", param_1204 .annotate 'line', 180 new $P110, "Undef" set $P1205, $P110 .lex "$pasttype", $P1205 .annotate 'line', 181 new $P111, "Undef" set $P1206, $P111 .lex "$past", $P1206 .annotate 'line', 180 new $P112, "String" assign $P112, "repeat_" find_lex $P1207, "$/" unless_null $P1207, vivify_251 $P1207 = root_new ['parrot';'Hash'] vivify_251: set $P113, $P1207["wu"] unless_null $P113, vivify_252 new $P113, "Undef" vivify_252: set $S100, $P113 concat $P114, $P112, $S100 store_lex "$pasttype", $P114 .annotate 'line', 179 find_lex $P112, "$past" .annotate 'line', 182 find_lex $P1209, "$/" unless_null $P1209, vivify_253 $P1209 = root_new ['parrot';'Hash'] vivify_253: set $P112, $P1209["xblock"] unless_null $P112, vivify_254 new $P112, "Undef" vivify_254: if $P112, if_1208 .annotate 'line', 187 get_hll_global $P113, ["PAST"], "Op" find_lex $P1211, "$/" unless_null $P1211, vivify_255 $P1211 = root_new ['parrot';'Hash'] vivify_255: set $P114, $P1211["EXPR"] unless_null $P114, vivify_256 new $P114, "Undef" vivify_256: $P115 = $P114."ast"() find_lex $P1212, "$/" unless_null $P1212, vivify_257 $P1212 = root_new ['parrot';'Hash'] vivify_257: set $P117, $P1212["pblock"] unless_null $P117, vivify_258 new $P117, "Undef" vivify_258: $P118 = $P117."ast"() $P119 = "block_immediate"($P118) find_lex $P120, "$pasttype" find_lex $P121, "$/" $P122 = $P113."new"($P115, $P119, $P120 :named("pasttype"), $P121 :named("node")) store_lex "$past", $P122 .annotate 'line', 186 goto if_1208_end if_1208: .annotate 'line', 183 find_lex $P1210, "$/" unless_null $P1210, vivify_259 $P1210 = root_new ['parrot';'Hash'] vivify_259: set $P113, $P1210["xblock"] unless_null $P113, vivify_260 new $P113, "Undef" vivify_260: $P114 = $P113."ast"() $P115 = "xblock_immediate"($P114) store_lex "$past", $P115 .annotate 'line', 184 find_lex $P113, "$past" find_lex $P114, "$pasttype" $P113."pasttype"($P114) if_1208_end: .annotate 'line', 190 find_lex $P112, "$/" find_lex $P113, "$past" $P114 = $P112."!make"($P113) .annotate 'line', 179 .return ($P114) control_1202: .local pmc exception .get_results (exception) getattribute $P112, exception, "payload" .return ($P112) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement_control:sym" :subid("38_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1216 .annotate 'line', 193 new $P1215, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1215, control_1214 push_eh $P1215 .lex "self", self .lex "$/", param_1216 .annotate 'line', 194 new $P110, "Undef" set $P1217, $P110 .lex "$past", $P1217 .annotate 'line', 196 new $P111, "Undef" set $P1218, $P111 .lex "$block", $P1218 .annotate 'line', 194 find_lex $P1219, "$/" unless_null $P1219, vivify_261 $P1219 = root_new ['parrot';'Hash'] vivify_261: set $P112, $P1219["xblock"] unless_null $P112, vivify_262 new $P112, "Undef" vivify_262: $P113 = $P112."ast"() store_lex "$past", $P113 .annotate 'line', 195 find_lex $P112, "$past" $P112."pasttype"("for") .annotate 'line', 196 find_lex $P1220, "$past" unless_null $P1220, vivify_263 $P1220 = root_new ['parrot';'ResizablePMCArray'] vivify_263: set $P112, $P1220[1] unless_null $P112, vivify_264 new $P112, "Undef" vivify_264: store_lex "$block", $P112 .annotate 'line', 197 find_lex $P112, "$block" $P113 = $P112."arity"() if $P113, unless_1221_end .annotate 'line', 198 find_lex $P1222, "$block" unless_null $P1222, vivify_265 $P1222 = root_new ['parrot';'ResizablePMCArray'] vivify_265: set $P114, $P1222[0] unless_null $P114, vivify_266 new $P114, "Undef" vivify_266: get_hll_global $P115, ["PAST"], "Var" $P117 = $P115."new"("$_" :named("name"), "parameter" :named("scope")) $P114."push"($P117) .annotate 'line', 199 find_lex $P114, "$block" $P114."symbol"("$_", "lexical" :named("scope")) .annotate 'line', 200 find_lex $P114, "$block" $P114."arity"(1) unless_1221_end: .annotate 'line', 202 find_lex $P112, "$block" $P112."blocktype"("immediate") .annotate 'line', 203 find_lex $P112, "$/" find_lex $P113, "$past" $P114 = $P112."!make"($P113) .annotate 'line', 193 .return ($P114) control_1214: .local pmc exception .get_results (exception) getattribute $P112, exception, "payload" .return ($P112) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement_control:sym" :subid("39_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1226 .annotate 'line', 206 new $P1225, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1225, control_1224 push_eh $P1225 .lex "self", self .lex "$/", param_1226 .annotate 'line', 207 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Op" find_lex $P1227, "$/" unless_null $P1227, vivify_267 $P1227 = root_new ['parrot';'Hash'] vivify_267: set $P112, $P1227["EXPR"] unless_null $P112, vivify_268 new $P112, "Undef" vivify_268: $P113 = $P112."ast"() find_lex $P114, "$/" $P115 = $P111."new"($P113, "return" :named("pasttype"), $P114 :named("node")) $P117 = $P110."!make"($P115) .annotate 'line', 206 .return ($P117) control_1224: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement_control:sym" :subid("40_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1231 .annotate 'line', 210 new $P1230, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1230, control_1229 push_eh $P1230 .lex "self", self .lex "$/", param_1231 .annotate 'line', 211 new $P110, "Undef" set $P1232, $P110 .lex "$block", $P1232 find_lex $P1233, "$/" unless_null $P1233, vivify_269 $P1233 = root_new ['parrot';'Hash'] vivify_269: set $P111, $P1233["block"] unless_null $P111, vivify_270 new $P111, "Undef" vivify_270: $P112 = $P111."ast"() store_lex "$block", $P112 .annotate 'line', 212 find_lex $P111, "$/" find_lex $P112, "$block" "push_block_handler"($P111, $P112) .annotate 'line', 213 get_global $P1234, "@BLOCK" unless_null $P1234, vivify_271 $P1234 = root_new ['parrot';'ResizablePMCArray'] vivify_271: set $P111, $P1234[0] unless_null $P111, vivify_272 new $P111, "Undef" vivify_272: $P112 = $P111."handlers"() set $P113, $P112[0] unless_null $P113, vivify_273 new $P113, "Undef" vivify_273: $P113."handle_types_except"("CONTROL") .annotate 'line', 214 find_lex $P111, "$/" get_hll_global $P112, ["PAST"], "Stmts" find_lex $P113, "$/" $P114 = $P112."new"($P113 :named("node")) $P115 = $P111."!make"($P114) .annotate 'line', 210 .return ($P115) control_1229: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement_control:sym" :subid("41_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1238 .annotate 'line', 217 new $P1237, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1237, control_1236 push_eh $P1237 .lex "self", self .lex "$/", param_1238 .annotate 'line', 218 new $P110, "Undef" set $P1239, $P110 .lex "$block", $P1239 find_lex $P1240, "$/" unless_null $P1240, vivify_274 $P1240 = root_new ['parrot';'Hash'] vivify_274: set $P111, $P1240["block"] unless_null $P111, vivify_275 new $P111, "Undef" vivify_275: $P112 = $P111."ast"() store_lex "$block", $P112 .annotate 'line', 219 find_lex $P111, "$/" find_lex $P112, "$block" "push_block_handler"($P111, $P112) .annotate 'line', 220 get_global $P1241, "@BLOCK" unless_null $P1241, vivify_276 $P1241 = root_new ['parrot';'ResizablePMCArray'] vivify_276: set $P111, $P1241[0] unless_null $P111, vivify_277 new $P111, "Undef" vivify_277: $P112 = $P111."handlers"() set $P113, $P112[0] unless_null $P113, vivify_278 new $P113, "Undef" vivify_278: $P113."handle_types"("CONTROL") .annotate 'line', 221 find_lex $P111, "$/" get_hll_global $P112, ["PAST"], "Stmts" find_lex $P113, "$/" $P114 = $P112."new"($P113 :named("node")) $P115 = $P111."!make"($P114) .annotate 'line', 217 .return ($P115) control_1236: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement_prefix:sym" :subid("42_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1245 .annotate 'line', 261 new $P1244, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1244, control_1243 push_eh $P1244 .lex "self", self .lex "$/", param_1245 .annotate 'line', 262 get_global $P1246, "@BLOCK" unless_null $P1246, vivify_279 $P1246 = root_new ['parrot';'ResizablePMCArray'] vivify_279: set $P110, $P1246[0] unless_null $P110, vivify_280 new $P110, "Undef" vivify_280: $P111 = $P110."loadinit"() find_lex $P1247, "$/" unless_null $P1247, vivify_281 $P1247 = root_new ['parrot';'Hash'] vivify_281: set $P112, $P1247["blorst"] unless_null $P112, vivify_282 new $P112, "Undef" vivify_282: $P113 = $P112."ast"() $P111."push"($P113) .annotate 'line', 263 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Stmts" find_lex $P112, "$/" $P113 = $P111."new"($P112 :named("node")) $P114 = $P110."!make"($P113) .annotate 'line', 261 .return ($P114) control_1243: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement_prefix:sym" :subid("43_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1251 .annotate 'line', 266 new $P1250, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1250, control_1249 push_eh $P1250 .lex "self", self .lex "$/", param_1251 .annotate 'line', 267 new $P110, "Undef" set $P1252, $P110 .lex "$past", $P1252 find_lex $P1253, "$/" unless_null $P1253, vivify_283 $P1253 = root_new ['parrot';'Hash'] vivify_283: set $P111, $P1253["blorst"] unless_null $P111, vivify_284 new $P111, "Undef" vivify_284: $P112 = $P111."ast"() store_lex "$past", $P112 .annotate 'line', 268 find_lex $P111, "$past" $S100 = $P111."WHAT"() isne $I100, $S100, "PAST::Block()" unless $I100, if_1254_end .annotate 'line', 269 get_hll_global $P112, ["PAST"], "Block" find_lex $P113, "$past" find_lex $P114, "$/" $P115 = $P112."new"($P113, "immediate" :named("blocktype"), $P114 :named("node")) store_lex "$past", $P115 if_1254_end: .annotate 'line', 271 find_lex $P111, "$past" $P112 = $P111."handlers"() if $P112, unless_1255_end .annotate 'line', 272 find_lex $P113, "$past" get_hll_global $P114, ["PAST"], "Control" .annotate 'line', 274 get_hll_global $P115, ["PAST"], "Stmts" .annotate 'line', 275 get_hll_global $P117, ["PAST"], "Op" .annotate 'line', 276 get_hll_global $P118, ["PAST"], "Var" .annotate 'line', 277 get_hll_global $P119, ["PAST"], "Var" $P120 = $P119."new"("register" :named("scope"), "exception" :named("name")) $P121 = $P118."new"($P120, "handled", "keyed" :named("scope")) .annotate 'line', 276 $P122 = $P117."new"($P121, 1, "bind" :named("pasttype")) .annotate 'line', 275 $P123 = $P115."new"($P122) .annotate 'line', 274 $P124 = $P114."new"($P123, "CONTROL" :named("handle_types_except")) .annotate 'line', 272 new $P125, "ResizablePMCArray" push $P125, $P124 $P113."handlers"($P125) unless_1255_end: .annotate 'line', 286 find_lex $P111, "$/" find_lex $P112, "$past" $P113 = $P111."!make"($P112) .annotate 'line', 266 .return ($P113) control_1249: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "blorst" :subid("44_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1259 .annotate 'line', 289 new $P1258, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1258, control_1257 push_eh $P1258 .lex "self", self .lex "$/", param_1259 .annotate 'line', 290 find_lex $P110, "$/" .annotate 'line', 291 find_lex $P1261, "$/" unless_null $P1261, vivify_285 $P1261 = root_new ['parrot';'Hash'] vivify_285: set $P112, $P1261["block"] unless_null $P112, vivify_286 new $P112, "Undef" vivify_286: if $P112, if_1260 .annotate 'line', 292 find_lex $P1263, "$/" unless_null $P1263, vivify_287 $P1263 = root_new ['parrot';'Hash'] vivify_287: set $P117, $P1263["statement"] unless_null $P117, vivify_288 new $P117, "Undef" vivify_288: $P118 = $P117."ast"() set $P111, $P118 .annotate 'line', 291 goto if_1260_end if_1260: find_lex $P1262, "$/" unless_null $P1262, vivify_289 $P1262 = root_new ['parrot';'Hash'] vivify_289: set $P113, $P1262["block"] unless_null $P113, vivify_290 new $P113, "Undef" vivify_290: $P114 = $P113."ast"() $P115 = "block_immediate"($P114) set $P111, $P115 if_1260_end: $P119 = $P110."!make"($P111) .annotate 'line', 289 .return ($P119) control_1257: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement_mod_cond:sym" :subid("45_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1267 .annotate 'line', 297 new $P1266, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1266, control_1265 push_eh $P1266 .lex "self", self .lex "$/", param_1267 find_lex $P110, "$/" find_lex $P1268, "$/" unless_null $P1268, vivify_291 $P1268 = root_new ['parrot';'Hash'] vivify_291: set $P111, $P1268["cond"] unless_null $P111, vivify_292 new $P111, "Undef" vivify_292: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1265: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement_mod_cond:sym" :subid("46_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1272 .annotate 'line', 298 new $P1271, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1271, control_1270 push_eh $P1271 .lex "self", self .lex "$/", param_1272 find_lex $P110, "$/" find_lex $P1273, "$/" unless_null $P1273, vivify_293 $P1273 = root_new ['parrot';'Hash'] vivify_293: set $P111, $P1273["cond"] unless_null $P111, vivify_294 new $P111, "Undef" vivify_294: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1270: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement_mod_loop:sym" :subid("47_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1277 .annotate 'line', 300 new $P1276, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1276, control_1275 push_eh $P1276 .lex "self", self .lex "$/", param_1277 find_lex $P110, "$/" find_lex $P1278, "$/" unless_null $P1278, vivify_295 $P1278 = root_new ['parrot';'Hash'] vivify_295: set $P111, $P1278["cond"] unless_null $P111, vivify_296 new $P111, "Undef" vivify_296: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1275: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "statement_mod_loop:sym" :subid("48_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1282 .annotate 'line', 301 new $P1281, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1281, control_1280 push_eh $P1281 .lex "self", self .lex "$/", param_1282 find_lex $P110, "$/" find_lex $P1283, "$/" unless_null $P1283, vivify_297 $P1283 = root_new ['parrot';'Hash'] vivify_297: set $P111, $P1283["cond"] unless_null $P111, vivify_298 new $P111, "Undef" vivify_298: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1280: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("49_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1287 .annotate 'line', 305 new $P1286, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1286, control_1285 push_eh $P1286 .lex "self", self .lex "$/", param_1287 find_lex $P110, "$/" find_lex $P1288, "$/" unless_null $P1288, vivify_299 $P1288 = root_new ['parrot';'Hash'] vivify_299: set $P111, $P1288["fatarrow"] unless_null $P111, vivify_300 new $P111, "Undef" vivify_300: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1285: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("50_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1292 .annotate 'line', 306 new $P1291, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1291, control_1290 push_eh $P1291 .lex "self", self .lex "$/", param_1292 find_lex $P110, "$/" find_lex $P1293, "$/" unless_null $P1293, vivify_301 $P1293 = root_new ['parrot';'Hash'] vivify_301: set $P111, $P1293["colonpair"] unless_null $P111, vivify_302 new $P111, "Undef" vivify_302: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1290: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("51_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1297 .annotate 'line', 307 new $P1296, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1296, control_1295 push_eh $P1296 .lex "self", self .lex "$/", param_1297 find_lex $P110, "$/" find_lex $P1298, "$/" unless_null $P1298, vivify_303 $P1298 = root_new ['parrot';'Hash'] vivify_303: set $P111, $P1298["variable"] unless_null $P111, vivify_304 new $P111, "Undef" vivify_304: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1295: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("52_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1302 .annotate 'line', 308 new $P1301, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1301, control_1300 push_eh $P1301 .lex "self", self .lex "$/", param_1302 find_lex $P110, "$/" find_lex $P1303, "$/" unless_null $P1303, vivify_305 $P1303 = root_new ['parrot';'Hash'] vivify_305: set $P111, $P1303["package_declarator"] unless_null $P111, vivify_306 new $P111, "Undef" vivify_306: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1300: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("53_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1307 .annotate 'line', 309 new $P1306, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1306, control_1305 push_eh $P1306 .lex "self", self .lex "$/", param_1307 find_lex $P110, "$/" find_lex $P1308, "$/" unless_null $P1308, vivify_307 $P1308 = root_new ['parrot';'Hash'] vivify_307: set $P111, $P1308["scope_declarator"] unless_null $P111, vivify_308 new $P111, "Undef" vivify_308: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1305: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("54_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1312 .annotate 'line', 310 new $P1311, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1311, control_1310 push_eh $P1311 .lex "self", self .lex "$/", param_1312 find_lex $P110, "$/" find_lex $P1313, "$/" unless_null $P1313, vivify_309 $P1313 = root_new ['parrot';'Hash'] vivify_309: set $P111, $P1313["routine_declarator"] unless_null $P111, vivify_310 new $P111, "Undef" vivify_310: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1310: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("55_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1317 .annotate 'line', 311 new $P1316, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1316, control_1315 push_eh $P1316 .lex "self", self .lex "$/", param_1317 find_lex $P110, "$/" find_lex $P1318, "$/" unless_null $P1318, vivify_311 $P1318 = root_new ['parrot';'Hash'] vivify_311: set $P111, $P1318["multi_declarator"] unless_null $P111, vivify_312 new $P111, "Undef" vivify_312: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1315: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("56_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1322 .annotate 'line', 312 new $P1321, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1321, control_1320 push_eh $P1321 .lex "self", self .lex "$/", param_1322 find_lex $P110, "$/" find_lex $P1323, "$/" unless_null $P1323, vivify_313 $P1323 = root_new ['parrot';'Hash'] vivify_313: set $P111, $P1323["regex_declarator"] unless_null $P111, vivify_314 new $P111, "Undef" vivify_314: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1320: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("57_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1327 .annotate 'line', 313 new $P1326, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1326, control_1325 push_eh $P1326 .lex "self", self .lex "$/", param_1327 find_lex $P110, "$/" find_lex $P1328, "$/" unless_null $P1328, vivify_315 $P1328 = root_new ['parrot';'Hash'] vivify_315: set $P111, $P1328["statement_prefix"] unless_null $P111, vivify_316 new $P111, "Undef" vivify_316: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1325: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("58_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1332 .annotate 'line', 314 new $P1331, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1331, control_1330 push_eh $P1331 .lex "self", self .lex "$/", param_1332 find_lex $P110, "$/" find_lex $P1333, "$/" unless_null $P1333, vivify_317 $P1333 = root_new ['parrot';'Hash'] vivify_317: set $P111, $P1333["pblock"] unless_null $P111, vivify_318 new $P111, "Undef" vivify_318: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1330: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "fatarrow" :subid("59_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1337 .annotate 'line', 316 new $P1336, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1336, control_1335 push_eh $P1336 .lex "self", self .lex "$/", param_1337 .annotate 'line', 317 new $P110, "Undef" set $P1338, $P110 .lex "$past", $P1338 find_lex $P1339, "$/" unless_null $P1339, vivify_319 $P1339 = root_new ['parrot';'Hash'] vivify_319: set $P111, $P1339["val"] unless_null $P111, vivify_320 new $P111, "Undef" vivify_320: $P112 = $P111."ast"() store_lex "$past", $P112 .annotate 'line', 318 find_lex $P111, "$past" find_lex $P1340, "$/" unless_null $P1340, vivify_321 $P1340 = root_new ['parrot';'Hash'] vivify_321: set $P112, $P1340["key"] unless_null $P112, vivify_322 new $P112, "Undef" vivify_322: $P113 = $P112."Str"() $P111."named"($P113) .annotate 'line', 319 find_lex $P111, "$/" find_lex $P112, "$past" $P113 = $P111."!make"($P112) .annotate 'line', 316 .return ($P113) control_1335: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "colonpair" :subid("60_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1344 .annotate 'line', 322 new $P1343, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1343, control_1342 push_eh $P1343 .lex "self", self .lex "$/", param_1344 .annotate 'line', 323 new $P110, "Undef" set $P1345, $P110 .lex "$past", $P1345 .annotate 'line', 324 find_lex $P1347, "$/" unless_null $P1347, vivify_323 $P1347 = root_new ['parrot';'Hash'] vivify_323: set $P112, $P1347["circumfix"] unless_null $P112, vivify_324 new $P112, "Undef" vivify_324: if $P112, if_1346 .annotate 'line', 325 get_hll_global $P115, ["PAST"], "Val" find_lex $P1350, "$/" unless_null $P1350, vivify_325 $P1350 = root_new ['parrot';'Hash'] vivify_325: set $P117, $P1350["not"] unless_null $P117, vivify_326 new $P117, "Undef" vivify_326: isfalse $I100, $P117 $P118 = $P115."new"($I100 :named("value")) set $P111, $P118 .annotate 'line', 324 goto if_1346_end if_1346: find_lex $P1348, "$/" unless_null $P1348, vivify_327 $P1348 = root_new ['parrot';'Hash'] vivify_327: set $P1349, $P1348["circumfix"] unless_null $P1349, vivify_328 $P1349 = root_new ['parrot';'ResizablePMCArray'] vivify_328: set $P113, $P1349[0] unless_null $P113, vivify_329 new $P113, "Undef" vivify_329: $P114 = $P113."ast"() set $P111, $P114 if_1346_end: store_lex "$past", $P111 .annotate 'line', 326 find_lex $P111, "$past" find_lex $P1351, "$/" unless_null $P1351, vivify_330 $P1351 = root_new ['parrot';'Hash'] vivify_330: set $P112, $P1351["identifier"] unless_null $P112, vivify_331 new $P112, "Undef" vivify_331: set $S100, $P112 $P111."named"($S100) .annotate 'line', 327 find_lex $P111, "$/" find_lex $P112, "$past" $P113 = $P111."!make"($P112) .annotate 'line', 322 .return ($P113) control_1342: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "variable" :subid("61_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1355 .annotate 'line', 330 .const 'Sub' $P1361 = "62_1309998850.8808" capture_lex $P1361 new $P1354, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1354, control_1353 push_eh $P1354 .lex "self", self .lex "$/", param_1355 .annotate 'line', 331 new $P110, "Undef" set $P1356, $P110 .lex "$past", $P1356 .annotate 'line', 330 find_lex $P111, "$past" .annotate 'line', 332 find_lex $P1358, "$/" unless_null $P1358, vivify_332 $P1358 = root_new ['parrot';'Hash'] vivify_332: set $P111, $P1358["postcircumfix"] unless_null $P111, vivify_333 new $P111, "Undef" vivify_333: if $P111, if_1357 .annotate 'line', 336 .const 'Sub' $P1361 = "62_1309998850.8808" capture_lex $P1361 $P1361() goto if_1357_end if_1357: .annotate 'line', 333 find_lex $P1359, "$/" unless_null $P1359, vivify_350 $P1359 = root_new ['parrot';'Hash'] vivify_350: set $P112, $P1359["postcircumfix"] unless_null $P112, vivify_351 new $P112, "Undef" vivify_351: $P113 = $P112."ast"() store_lex "$past", $P113 .annotate 'line', 334 find_lex $P112, "$past" get_hll_global $P113, ["PAST"], "Var" $P114 = $P113."new"("$/" :named("name")) $P112."unshift"($P114) if_1357_end: .annotate 'line', 365 find_lex $P111, "$/" find_lex $P112, "$past" $P113 = $P111."!make"($P112) .annotate 'line', 330 .return ($P113) control_1353: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .sub "_block1360" :anon :subid("62_1309998850.8808") :outer("61_1309998850.8808") .annotate 'line', 337 $P1363 = root_new ['parrot';'ResizablePMCArray'] set $P1362, $P1363 .lex "@name", $P1362 get_hll_global $P112, ["NQP"], "Compiler" find_lex $P113, "$/" set $S100, $P113 $P114 = $P112."parse_name"($S100) store_lex "@name", $P114 .annotate 'line', 338 get_hll_global $P112, ["PAST"], "Var" find_lex $P113, "@name" $P114 = $P113."pop"() set $S100, $P114 $P115 = $P112."new"($S100 :named("name")) store_lex "$past", $P115 .annotate 'line', 339 find_lex $P112, "@name" unless $P112, if_1364_end .annotate 'line', 340 find_lex $P1366, "@name" unless_null $P1366, vivify_334 $P1366 = root_new ['parrot';'ResizablePMCArray'] vivify_334: set $P113, $P1366[0] unless_null $P113, vivify_335 new $P113, "Undef" vivify_335: set $S100, $P113 iseq $I100, $S100, "GLOBAL" unless $I100, if_1365_end find_lex $P114, "@name" $P114."shift"() if_1365_end: .annotate 'line', 341 find_lex $P113, "$past" find_lex $P114, "@name" $P113."namespace"($P114) .annotate 'line', 342 find_lex $P113, "$past" $P113."scope"("package") .annotate 'line', 343 find_lex $P113, "$past" find_lex $P1367, "$/" unless_null $P1367, vivify_336 $P1367 = root_new ['parrot';'Hash'] vivify_336: set $P114, $P1367["sigil"] unless_null $P114, vivify_337 new $P114, "Undef" vivify_337: $P115 = "vivitype"($P114) $P113."viviself"($P115) .annotate 'line', 344 find_lex $P113, "$past" $P113."lvalue"(1) if_1364_end: .annotate 'line', 346 find_lex $P1369, "$/" unless_null $P1369, vivify_338 $P1369 = root_new ['parrot';'Hash'] vivify_338: set $P1370, $P1369["twigil"] unless_null $P1370, vivify_339 $P1370 = root_new ['parrot';'ResizablePMCArray'] vivify_339: set $P113, $P1370[0] unless_null $P113, vivify_340 new $P113, "Undef" vivify_340: set $S100, $P113 iseq $I100, $S100, "*" if $I100, if_1368 .annotate 'line', 359 find_lex $P1374, "$/" unless_null $P1374, vivify_341 $P1374 = root_new ['parrot';'Hash'] vivify_341: set $P1375, $P1374["twigil"] unless_null $P1375, vivify_342 $P1375 = root_new ['parrot';'ResizablePMCArray'] vivify_342: set $P115, $P1375[0] unless_null $P115, vivify_343 new $P115, "Undef" vivify_343: set $S101, $P115 iseq $I101, $S101, "!" if $I101, if_1373 new $P114, 'Integer' set $P114, $I101 goto if_1373_end if_1373: .annotate 'line', 360 find_lex $P117, "$past" get_hll_global $P118, ["PAST"], "Var" $P119 = $P118."new"("self" :named("name")) $P117."push"($P119) .annotate 'line', 361 find_lex $P117, "$past" $P117."scope"("attribute") .annotate 'line', 362 find_lex $P117, "$past" find_lex $P1376, "$/" unless_null $P1376, vivify_344 $P1376 = root_new ['parrot';'Hash'] vivify_344: set $P118, $P1376["sigil"] unless_null $P118, vivify_345 new $P118, "Undef" vivify_345: $P119 = "vivitype"($P118) $P120 = $P117."viviself"($P119) .annotate 'line', 359 set $P114, $P120 if_1373_end: set $P112, $P114 .annotate 'line', 346 goto if_1368_end if_1368: .annotate 'line', 347 find_lex $P114, "$past" $P114."scope"("contextual") .annotate 'line', 348 find_lex $P114, "$past" .annotate 'line', 349 get_hll_global $P115, ["PAST"], "Var" .annotate 'line', 351 find_lex $P1371, "$/" unless_null $P1371, vivify_346 $P1371 = root_new ['parrot';'Hash'] vivify_346: set $P117, $P1371["sigil"] unless_null $P117, vivify_347 new $P117, "Undef" vivify_347: set $S101, $P117 new $P118, 'String' set $P118, $S101 find_lex $P1372, "$/" unless_null $P1372, vivify_348 $P1372 = root_new ['parrot';'Hash'] vivify_348: set $P119, $P1372["desigilname"] unless_null $P119, vivify_349 new $P119, "Undef" vivify_349: concat $P120, $P118, $P119 .annotate 'line', 353 get_hll_global $P121, ["PAST"], "Op" new $P122, "String" assign $P122, "Contextual " find_lex $P123, "$/" set $S102, $P123 concat $P124, $P122, $S102 concat $P125, $P124, " not found" $P127 = $P121."new"($P125, "die" :named("pirop")) .annotate 'line', 349 $P128 = $P115."new"("package" :named("scope"), "" :named("namespace"), $P120 :named("name"), $P127 :named("viviself")) $P129 = $P114."viviself"($P128) .annotate 'line', 346 set $P112, $P129 if_1368_end: .annotate 'line', 336 .return ($P112) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "package_declarator:sym" :subid("63_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1380 .annotate 'line', 368 new $P1379, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1379, control_1378 push_eh $P1379 .lex "self", self .lex "$/", param_1380 find_lex $P110, "$/" find_lex $P1381, "$/" unless_null $P1381, vivify_352 $P1381 = root_new ['parrot';'Hash'] vivify_352: set $P111, $P1381["package_def"] unless_null $P111, vivify_353 new $P111, "Undef" vivify_353: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1378: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "package_declarator:sym" :subid("64_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1385 .annotate 'line', 369 new $P1384, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1384, control_1383 push_eh $P1384 .lex "self", self .lex "$/", param_1385 .annotate 'line', 370 new $P110, "Undef" set $P1386, $P110 .lex "$past", $P1386 .annotate 'line', 371 new $P111, "Undef" set $P1387, $P111 .lex "$classinit", $P1387 .annotate 'line', 380 new $P112, "Undef" set $P1388, $P112 .lex "$parent", $P1388 .annotate 'line', 370 find_lex $P1389, "$/" unless_null $P1389, vivify_354 $P1389 = root_new ['parrot';'Hash'] vivify_354: set $P113, $P1389["package_def"] unless_null $P113, vivify_355 new $P113, "Undef" vivify_355: $P114 = $P113."ast"() store_lex "$past", $P114 .annotate 'line', 372 get_hll_global $P113, ["PAST"], "Op" .annotate 'line', 373 get_hll_global $P114, ["PAST"], "Op" $P115 = $P114."new"(" %r = get_root_global [\"parrot\"], \"P6metaclass\"" :named("inline")) .annotate 'line', 376 find_lex $P1390, "$/" unless_null $P1390, vivify_356 $P1390 = root_new ['parrot';'Hash'] vivify_356: set $P1391, $P1390["package_def"] unless_null $P1391, vivify_357 $P1391 = root_new ['parrot';'Hash'] vivify_357: set $P117, $P1391["name"] unless_null $P117, vivify_358 new $P117, "Undef" vivify_358: set $S100, $P117 $P118 = $P113."new"($P115, $S100, "new_class" :named("name"), "callmethod" :named("pasttype")) .annotate 'line', 372 store_lex "$classinit", $P118 .annotate 'line', 380 find_lex $P1393, "$/" unless_null $P1393, vivify_359 $P1393 = root_new ['parrot';'Hash'] vivify_359: set $P1394, $P1393["package_def"] unless_null $P1394, vivify_360 $P1394 = root_new ['parrot';'Hash'] vivify_360: set $P1395, $P1394["parent"] unless_null $P1395, vivify_361 $P1395 = root_new ['parrot';'ResizablePMCArray'] vivify_361: set $P114, $P1395[0] unless_null $P114, vivify_362 new $P114, "Undef" vivify_362: set $S100, $P114 unless $S100, unless_1392 new $P113, 'String' set $P113, $S100 goto unless_1392_end unless_1392: .annotate 'line', 381 find_lex $P1397, "$/" unless_null $P1397, vivify_363 $P1397 = root_new ['parrot';'Hash'] vivify_363: set $P117, $P1397["sym"] unless_null $P117, vivify_364 new $P117, "Undef" vivify_364: set $S101, $P117 iseq $I100, $S101, "grammar" if $I100, if_1396 new $P119, "String" assign $P119, "" set $P115, $P119 goto if_1396_end if_1396: new $P118, "String" assign $P118, "Regex::Cursor" set $P115, $P118 if_1396_end: set $P113, $P115 unless_1392_end: store_lex "$parent", $P113 .annotate 'line', 382 find_lex $P113, "$parent" unless $P113, if_1398_end .annotate 'line', 383 find_lex $P114, "$classinit" get_hll_global $P115, ["PAST"], "Val" find_lex $P117, "$parent" $P118 = $P115."new"($P117 :named("value"), "parent" :named("named")) $P114."push"($P118) if_1398_end: .annotate 'line', 385 find_lex $P1400, "$past" unless_null $P1400, vivify_365 $P1400 = root_new ['parrot';'Hash'] vivify_365: set $P113, $P1400["attributes"] unless_null $P113, vivify_366 new $P113, "Undef" vivify_366: unless $P113, if_1399_end .annotate 'line', 386 find_lex $P114, "$classinit" find_lex $P1401, "$past" unless_null $P1401, vivify_367 $P1401 = root_new ['parrot';'Hash'] vivify_367: set $P115, $P1401["attributes"] unless_null $P115, vivify_368 new $P115, "Undef" vivify_368: $P114."push"($P115) if_1399_end: .annotate 'line', 388 get_global $P1402, "@BLOCK" unless_null $P1402, vivify_369 $P1402 = root_new ['parrot';'ResizablePMCArray'] vivify_369: set $P113, $P1402[0] unless_null $P113, vivify_370 new $P113, "Undef" vivify_370: $P114 = $P113."loadinit"() find_lex $P115, "$classinit" $P114."push"($P115) .annotate 'line', 389 find_lex $P113, "$/" find_lex $P114, "$past" $P115 = $P113."!make"($P114) .annotate 'line', 369 .return ($P115) control_1383: .local pmc exception .get_results (exception) getattribute $P113, exception, "payload" .return ($P113) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "package_def" :subid("65_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1406 .annotate 'line', 392 new $P1405, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1405, control_1404 push_eh $P1405 .lex "self", self .lex "$/", param_1406 .annotate 'line', 393 new $P110, "Undef" set $P1407, $P110 .lex "$past", $P1407 find_lex $P1409, "$/" unless_null $P1409, vivify_371 $P1409 = root_new ['parrot';'Hash'] vivify_371: set $P112, $P1409["block"] unless_null $P112, vivify_372 new $P112, "Undef" vivify_372: if $P112, if_1408 find_lex $P1411, "$/" unless_null $P1411, vivify_373 $P1411 = root_new ['parrot';'Hash'] vivify_373: set $P115, $P1411["comp_unit"] unless_null $P115, vivify_374 new $P115, "Undef" vivify_374: $P117 = $P115."ast"() set $P111, $P117 goto if_1408_end if_1408: find_lex $P1410, "$/" unless_null $P1410, vivify_375 $P1410 = root_new ['parrot';'Hash'] vivify_375: set $P113, $P1410["block"] unless_null $P113, vivify_376 new $P113, "Undef" vivify_376: $P114 = $P113."ast"() set $P111, $P114 if_1408_end: store_lex "$past", $P111 .annotate 'line', 394 find_lex $P111, "$past" find_lex $P1412, "$/" unless_null $P1412, vivify_377 $P1412 = root_new ['parrot';'Hash'] vivify_377: set $P1413, $P1412["name"] unless_null $P1413, vivify_378 $P1413 = root_new ['parrot';'Hash'] vivify_378: set $P112, $P1413["identifier"] unless_null $P112, vivify_379 new $P112, "Undef" vivify_379: $P111."namespace"($P112) .annotate 'line', 395 find_lex $P111, "$past" $P111."blocktype"("immediate") .annotate 'line', 396 find_lex $P111, "$/" find_lex $P112, "$past" $P113 = $P111."!make"($P112) .annotate 'line', 392 .return ($P113) control_1404: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "scope_declarator:sym" :subid("66_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1417 .annotate 'line', 399 new $P1416, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1416, control_1415 push_eh $P1416 .lex "self", self .lex "$/", param_1417 find_lex $P110, "$/" find_lex $P1418, "$/" unless_null $P1418, vivify_380 $P1418 = root_new ['parrot';'Hash'] vivify_380: set $P111, $P1418["scoped"] unless_null $P111, vivify_381 new $P111, "Undef" vivify_381: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1415: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "scope_declarator:sym" :subid("67_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1422 .annotate 'line', 400 new $P1421, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1421, control_1420 push_eh $P1421 .lex "self", self .lex "$/", param_1422 find_lex $P110, "$/" find_lex $P1423, "$/" unless_null $P1423, vivify_382 $P1423 = root_new ['parrot';'Hash'] vivify_382: set $P111, $P1423["scoped"] unless_null $P111, vivify_383 new $P111, "Undef" vivify_383: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1420: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "scope_declarator:sym" :subid("68_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1427 .annotate 'line', 401 new $P1426, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1426, control_1425 push_eh $P1426 .lex "self", self .lex "$/", param_1427 find_lex $P110, "$/" find_lex $P1428, "$/" unless_null $P1428, vivify_384 $P1428 = root_new ['parrot';'Hash'] vivify_384: set $P111, $P1428["scoped"] unless_null $P111, vivify_385 new $P111, "Undef" vivify_385: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1425: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "scoped" :subid("69_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1432 .annotate 'line', 403 new $P1431, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1431, control_1430 push_eh $P1431 .lex "self", self .lex "$/", param_1432 .annotate 'line', 404 find_lex $P110, "$/" .annotate 'line', 405 find_lex $P1434, "$/" unless_null $P1434, vivify_386 $P1434 = root_new ['parrot';'Hash'] vivify_386: set $P112, $P1434["declarator"] unless_null $P112, vivify_387 new $P112, "Undef" vivify_387: if $P112, if_1433 .annotate 'line', 406 find_lex $P1436, "$/" unless_null $P1436, vivify_388 $P1436 = root_new ['parrot';'Hash'] vivify_388: set $P115, $P1436["multi_declarator"] unless_null $P115, vivify_389 new $P115, "Undef" vivify_389: $P117 = $P115."ast"() set $P111, $P117 .annotate 'line', 405 goto if_1433_end if_1433: find_lex $P1435, "$/" unless_null $P1435, vivify_390 $P1435 = root_new ['parrot';'Hash'] vivify_390: set $P113, $P1435["declarator"] unless_null $P113, vivify_391 new $P113, "Undef" vivify_391: $P114 = $P113."ast"() set $P111, $P114 if_1433_end: $P118 = $P110."!make"($P111) .annotate 'line', 403 .return ($P118) control_1430: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "declarator" :subid("70_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1440 .annotate 'line', 409 new $P1439, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1439, control_1438 push_eh $P1439 .lex "self", self .lex "$/", param_1440 .annotate 'line', 410 find_lex $P110, "$/" .annotate 'line', 411 find_lex $P1442, "$/" unless_null $P1442, vivify_392 $P1442 = root_new ['parrot';'Hash'] vivify_392: set $P112, $P1442["routine_declarator"] unless_null $P112, vivify_393 new $P112, "Undef" vivify_393: if $P112, if_1441 .annotate 'line', 412 find_lex $P1444, "$/" unless_null $P1444, vivify_394 $P1444 = root_new ['parrot';'Hash'] vivify_394: set $P115, $P1444["variable_declarator"] unless_null $P115, vivify_395 new $P115, "Undef" vivify_395: $P117 = $P115."ast"() set $P111, $P117 .annotate 'line', 411 goto if_1441_end if_1441: find_lex $P1443, "$/" unless_null $P1443, vivify_396 $P1443 = root_new ['parrot';'Hash'] vivify_396: set $P113, $P1443["routine_declarator"] unless_null $P113, vivify_397 new $P113, "Undef" vivify_397: $P114 = $P113."ast"() set $P111, $P114 if_1441_end: $P118 = $P110."!make"($P111) .annotate 'line', 409 .return ($P118) control_1438: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "multi_declarator:sym" :subid("71_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1448 .annotate 'line', 415 new $P1447, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1447, control_1446 push_eh $P1447 .lex "self", self .lex "$/", param_1448 find_lex $P110, "$/" find_lex $P1450, "$/" unless_null $P1450, vivify_398 $P1450 = root_new ['parrot';'Hash'] vivify_398: set $P112, $P1450["declarator"] unless_null $P112, vivify_399 new $P112, "Undef" vivify_399: if $P112, if_1449 find_lex $P1452, "$/" unless_null $P1452, vivify_400 $P1452 = root_new ['parrot';'Hash'] vivify_400: set $P115, $P1452["routine_def"] unless_null $P115, vivify_401 new $P115, "Undef" vivify_401: $P117 = $P115."ast"() set $P111, $P117 goto if_1449_end if_1449: find_lex $P1451, "$/" unless_null $P1451, vivify_402 $P1451 = root_new ['parrot';'Hash'] vivify_402: set $P113, $P1451["declarator"] unless_null $P113, vivify_403 new $P113, "Undef" vivify_403: $P114 = $P113."ast"() set $P111, $P114 if_1449_end: $P118 = $P110."!make"($P111) .return ($P118) control_1446: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "multi_declarator:sym" :subid("72_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1456 .annotate 'line', 416 new $P1455, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1455, control_1454 push_eh $P1455 .lex "self", self .lex "$/", param_1456 find_lex $P110, "$/" find_lex $P1457, "$/" unless_null $P1457, vivify_404 $P1457 = root_new ['parrot';'Hash'] vivify_404: set $P111, $P1457["declarator"] unless_null $P111, vivify_405 new $P111, "Undef" vivify_405: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1454: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "variable_declarator" :subid("73_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1461 .annotate 'line', 419 .const 'Sub' $P1477 = "74_1309998850.8808" capture_lex $P1477 new $P1460, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1460, control_1459 push_eh $P1460 .lex "self", self .lex "$/", param_1461 .annotate 'line', 420 new $P110, "Undef" set $P1462, $P110 .lex "$past", $P1462 .annotate 'line', 421 new $P111, "Undef" set $P1463, $P111 .lex "$sigil", $P1463 .annotate 'line', 422 new $P112, "Undef" set $P1464, $P112 .lex "$name", $P1464 .annotate 'line', 423 new $P113, "Undef" set $P1465, $P113 .lex "$BLOCK", $P1465 .annotate 'line', 420 find_lex $P1466, "$/" unless_null $P1466, vivify_406 $P1466 = root_new ['parrot';'Hash'] vivify_406: set $P114, $P1466["variable"] unless_null $P114, vivify_407 new $P114, "Undef" vivify_407: $P115 = $P114."ast"() store_lex "$past", $P115 .annotate 'line', 421 find_lex $P1467, "$/" unless_null $P1467, vivify_408 $P1467 = root_new ['parrot';'Hash'] vivify_408: set $P1468, $P1467["variable"] unless_null $P1468, vivify_409 $P1468 = root_new ['parrot';'Hash'] vivify_409: set $P114, $P1468["sigil"] unless_null $P114, vivify_410 new $P114, "Undef" vivify_410: store_lex "$sigil", $P114 .annotate 'line', 422 find_lex $P114, "$past" $P115 = $P114."name"() store_lex "$name", $P115 .annotate 'line', 423 get_global $P1469, "@BLOCK" unless_null $P1469, vivify_411 $P1469 = root_new ['parrot';'ResizablePMCArray'] vivify_411: set $P114, $P1469[0] unless_null $P114, vivify_412 new $P114, "Undef" vivify_412: store_lex "$BLOCK", $P114 .annotate 'line', 424 find_lex $P114, "$BLOCK" find_lex $P115, "$name" $P117 = $P114."symbol"($P115) unless $P117, if_1470_end .annotate 'line', 425 find_lex $P118, "$/" $P119 = $P118."CURSOR"() find_lex $P120, "$name" $P119."panic"("Redeclaration of symbol ", $P120) if_1470_end: .annotate 'line', 427 find_dynamic_lex $P114, "$*SCOPE" unless_null $P114, vivify_413 get_hll_global $P114, "$SCOPE" unless_null $P114, vivify_414 die "Contextual $*SCOPE not found" vivify_414: vivify_413: set $S100, $P114 iseq $I100, $S100, "has" if $I100, if_1471 .annotate 'line', 436 .const 'Sub' $P1477 = "74_1309998850.8808" capture_lex $P1477 $P1477() goto if_1471_end if_1471: .annotate 'line', 428 find_lex $P115, "$BLOCK" find_lex $P117, "$name" $P115."symbol"($P117, "attribute" :named("scope")) .annotate 'line', 429 find_lex $P1473, "$BLOCK" unless_null $P1473, vivify_419 $P1473 = root_new ['parrot';'Hash'] vivify_419: set $P115, $P1473["attributes"] unless_null $P115, vivify_420 new $P115, "Undef" vivify_420: if $P115, unless_1472_end .annotate 'line', 431 get_hll_global $P117, ["PAST"], "Op" $P118 = $P117."new"("list" :named("pasttype"), "attr" :named("named")) find_lex $P1474, "$BLOCK" unless_null $P1474, vivify_421 $P1474 = root_new ['parrot';'Hash'] store_lex "$BLOCK", $P1474 vivify_421: set $P1474["attributes"], $P118 unless_1472_end: .annotate 'line', 433 find_lex $P1475, "$BLOCK" unless_null $P1475, vivify_422 $P1475 = root_new ['parrot';'Hash'] vivify_422: set $P115, $P1475["attributes"] unless_null $P115, vivify_423 new $P115, "Undef" vivify_423: find_lex $P117, "$name" $P115."push"($P117) .annotate 'line', 434 get_hll_global $P115, ["PAST"], "Stmts" $P117 = $P115."new"() store_lex "$past", $P117 if_1471_end: .annotate 'line', 444 find_lex $P114, "$/" find_lex $P115, "$past" $P117 = $P114."!make"($P115) .annotate 'line', 419 .return ($P117) control_1459: .local pmc exception .get_results (exception) getattribute $P114, exception, "payload" .return ($P114) .end .namespace ["NQP";"Actions"] .sub "_block1476" :anon :subid("74_1309998850.8808") :outer("73_1309998850.8808") .annotate 'line', 437 new $P115, "Undef" set $P1478, $P115 .lex "$scope", $P1478 .annotate 'line', 438 new $P117, "Undef" set $P1479, $P117 .lex "$decl", $P1479 .annotate 'line', 437 find_dynamic_lex $P119, "$*SCOPE" unless_null $P119, vivify_415 get_hll_global $P119, "$SCOPE" unless_null $P119, vivify_416 die "Contextual $*SCOPE not found" vivify_416: vivify_415: set $S101, $P119 iseq $I101, $S101, "our" if $I101, if_1480 new $P121, "String" assign $P121, "lexical" set $P118, $P121 goto if_1480_end if_1480: new $P120, "String" assign $P120, "package" set $P118, $P120 if_1480_end: store_lex "$scope", $P118 .annotate 'line', 438 get_hll_global $P118, ["PAST"], "Var" find_lex $P119, "$name" find_lex $P120, "$scope" .annotate 'line', 439 find_lex $P121, "$sigil" $P122 = "vivitype"($P121) .annotate 'line', 438 find_lex $P123, "$/" $P124 = $P118."new"($P119 :named("name"), $P120 :named("scope"), 1 :named("isdecl"), 1 :named("lvalue"), $P122 :named("viviself"), $P123 :named("node")) store_lex "$decl", $P124 .annotate 'line', 441 find_lex $P118, "$BLOCK" find_lex $P119, "$name" find_lex $P120, "$scope" $P118."symbol"($P119, $P120 :named("scope")) .annotate 'line', 442 find_lex $P1481, "$BLOCK" unless_null $P1481, vivify_417 $P1481 = root_new ['parrot';'ResizablePMCArray'] vivify_417: set $P118, $P1481[0] unless_null $P118, vivify_418 new $P118, "Undef" vivify_418: find_lex $P119, "$decl" $P120 = $P118."push"($P119) .annotate 'line', 436 .return ($P120) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "routine_declarator:sym" :subid("75_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1485 .annotate 'line', 447 new $P1484, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1484, control_1483 push_eh $P1484 .lex "self", self .lex "$/", param_1485 find_lex $P110, "$/" find_lex $P1486, "$/" unless_null $P1486, vivify_424 $P1486 = root_new ['parrot';'Hash'] vivify_424: set $P111, $P1486["routine_def"] unless_null $P111, vivify_425 new $P111, "Undef" vivify_425: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1483: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "routine_declarator:sym" :subid("76_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1490 .annotate 'line', 448 new $P1489, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1489, control_1488 push_eh $P1489 .lex "self", self .lex "$/", param_1490 find_lex $P110, "$/" find_lex $P1491, "$/" unless_null $P1491, vivify_426 $P1491 = root_new ['parrot';'Hash'] vivify_426: set $P111, $P1491["method_def"] unless_null $P111, vivify_427 new $P111, "Undef" vivify_427: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1488: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "routine_def" :subid("77_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1495 .annotate 'line', 450 .const 'Sub' $P1517 = "79_1309998850.8808" capture_lex $P1517 .const 'Sub' $P1502 = "78_1309998850.8808" capture_lex $P1502 new $P1494, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1494, control_1493 push_eh $P1494 .lex "self", self .lex "$/", param_1495 .annotate 'line', 451 new $P110, "Undef" set $P1496, $P110 .lex "$block", $P1496 .annotate 'line', 454 new $P111, "Undef" set $P1497, $P111 .lex "$past", $P1497 .annotate 'line', 451 find_lex $P1498, "$/" unless_null $P1498, vivify_428 $P1498 = root_new ['parrot';'Hash'] vivify_428: set $P112, $P1498["blockoid"] unless_null $P112, vivify_429 new $P112, "Undef" vivify_429: $P113 = $P112."ast"() store_lex "$block", $P113 .annotate 'line', 452 find_lex $P112, "$block" $P112."blocktype"("declaration") .annotate 'line', 453 find_lex $P112, "$block" $P112."control"("return_pir") .annotate 'line', 454 find_lex $P112, "$block" store_lex "$past", $P112 .annotate 'line', 455 find_lex $P1500, "$/" unless_null $P1500, vivify_430 $P1500 = root_new ['parrot';'Hash'] vivify_430: set $P112, $P1500["deflongname"] unless_null $P112, vivify_431 new $P112, "Undef" vivify_431: unless $P112, if_1499_end .const 'Sub' $P1502 = "78_1309998850.8808" capture_lex $P1502 $P1502() if_1499_end: .annotate 'line', 465 find_lex $P112, "$block" find_lex $P1512, "$past" unless_null $P1512, vivify_445 $P1512 = root_new ['parrot';'Hash'] store_lex "$past", $P1512 vivify_445: set $P1512["block_past"], $P112 .annotate 'line', 466 find_lex $P112, "$/" find_lex $P113, "$past" $P112."!make"($P113) .annotate 'line', 467 find_lex $P1514, "$/" unless_null $P1514, vivify_446 $P1514 = root_new ['parrot';'Hash'] vivify_446: set $P113, $P1514["trait"] unless_null $P113, vivify_447 new $P113, "Undef" vivify_447: if $P113, if_1513 set $P112, $P113 goto if_1513_end if_1513: .annotate 'line', 468 find_lex $P1515, "$/" unless_null $P1515, vivify_448 $P1515 = root_new ['parrot';'Hash'] vivify_448: set $P115, $P1515["trait"] unless_null $P115, vivify_449 new $P115, "Undef" vivify_449: defined $I100, $P115 unless $I100, for_undef_450 iter $P114, $P115 new $P118, 'ExceptionHandler' set_label $P118, loop1519_handler $P118."handle_types"(.CONTROL_LOOP_NEXT, .CONTROL_LOOP_REDO, .CONTROL_LOOP_LAST) push_eh $P118 loop1519_test: unless $P114, loop1519_done shift $P117, $P114 loop1519_redo: .const 'Sub' $P1517 = "79_1309998850.8808" capture_lex $P1517 $P1517($P117) loop1519_next: goto loop1519_test loop1519_handler: .local pmc exception .get_results (exception) getattribute $P119, exception, 'type' eq $P119, .CONTROL_LOOP_NEXT, loop1519_next eq $P119, .CONTROL_LOOP_REDO, loop1519_redo loop1519_done: pop_eh for_undef_450: .annotate 'line', 467 set $P112, $P114 if_1513_end: .annotate 'line', 450 .return ($P112) control_1493: .local pmc exception .get_results (exception) getattribute $P113, exception, "payload" .return ($P113) .end .namespace ["NQP";"Actions"] .sub "_block1501" :anon :subid("78_1309998850.8808") :outer("77_1309998850.8808") .annotate 'line', 456 new $P113, "Undef" set $P1503, $P113 .lex "$name", $P1503 find_lex $P1504, "$/" unless_null $P1504, vivify_432 $P1504 = root_new ['parrot';'Hash'] vivify_432: set $P1505, $P1504["sigil"] unless_null $P1505, vivify_433 $P1505 = root_new ['parrot';'ResizablePMCArray'] vivify_433: set $P114, $P1505[0] unless_null $P114, vivify_434 new $P114, "Undef" vivify_434: set $S100, $P114 new $P115, 'String' set $P115, $S100 find_lex $P1506, "$/" unless_null $P1506, vivify_435 $P1506 = root_new ['parrot';'Hash'] vivify_435: set $P1507, $P1506["deflongname"] unless_null $P1507, vivify_436 $P1507 = root_new ['parrot';'ResizablePMCArray'] vivify_436: set $P117, $P1507[0] unless_null $P117, vivify_437 new $P117, "Undef" vivify_437: $S101 = $P117."ast"() concat $P118, $P115, $S101 store_lex "$name", $P118 .annotate 'line', 457 find_lex $P114, "$past" find_lex $P115, "$name" $P114."name"($P115) .annotate 'line', 458 find_dynamic_lex $P115, "$*SCOPE" unless_null $P115, vivify_438 get_hll_global $P115, "$SCOPE" unless_null $P115, vivify_439 die "Contextual $*SCOPE not found" vivify_439: vivify_438: set $S100, $P115 isne $I100, $S100, "our" if $I100, if_1508 new $P114, 'Integer' set $P114, $I100 goto if_1508_end if_1508: .annotate 'line', 459 get_global $P1509, "@BLOCK" unless_null $P1509, vivify_440 $P1509 = root_new ['parrot';'ResizablePMCArray'] vivify_440: set $P1510, $P1509[0] unless_null $P1510, vivify_441 $P1510 = root_new ['parrot';'ResizablePMCArray'] vivify_441: set $P117, $P1510[0] unless_null $P117, vivify_442 new $P117, "Undef" vivify_442: get_hll_global $P118, ["PAST"], "Var" find_lex $P119, "$name" find_lex $P120, "$past" $P121 = $P118."new"($P119 :named("name"), 1 :named("isdecl"), $P120 :named("viviself"), "lexical" :named("scope")) $P117."push"($P121) .annotate 'line', 461 get_global $P1511, "@BLOCK" unless_null $P1511, vivify_443 $P1511 = root_new ['parrot';'ResizablePMCArray'] vivify_443: set $P117, $P1511[0] unless_null $P117, vivify_444 new $P117, "Undef" vivify_444: find_lex $P118, "$name" $P117."symbol"($P118, "lexical" :named("scope")) .annotate 'line', 462 get_hll_global $P117, ["PAST"], "Var" find_lex $P118, "$name" $P119 = $P117."new"($P118 :named("name")) store_lex "$past", $P119 .annotate 'line', 458 set $P114, $P119 if_1508_end: .annotate 'line', 455 .return ($P114) .end .namespace ["NQP";"Actions"] .sub "_block1516" :anon :subid("79_1309998850.8808") :outer("77_1309998850.8808") .param pmc param_1518 .annotate 'line', 468 .lex "$_", param_1518 find_lex $P118, "$_" $P119 = $P118."ast"() find_lex $P120, "$/" $P121 = $P119($P120) .return ($P121) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "method_def" :subid("80_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1523 .annotate 'line', 473 .const 'Sub' $P1541 = "82_1309998850.8808" capture_lex $P1541 .const 'Sub' $P1531 = "81_1309998850.8808" capture_lex $P1531 new $P1522, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1522, control_1521 push_eh $P1522 .lex "self", self .lex "$/", param_1523 .annotate 'line', 474 new $P110, "Undef" set $P1524, $P110 .lex "$past", $P1524 find_lex $P1525, "$/" unless_null $P1525, vivify_451 $P1525 = root_new ['parrot';'Hash'] vivify_451: set $P111, $P1525["blockoid"] unless_null $P111, vivify_452 new $P111, "Undef" vivify_452: $P112 = $P111."ast"() store_lex "$past", $P112 .annotate 'line', 475 find_lex $P111, "$past" $P111."blocktype"("method") .annotate 'line', 476 find_dynamic_lex $P111, "$*SCOPE" unless_null $P111, vivify_453 get_hll_global $P111, "$SCOPE" unless_null $P111, vivify_454 die "Contextual $*SCOPE not found" vivify_454: vivify_453: set $S100, $P111 iseq $I100, $S100, "our" unless $I100, if_1526_end .annotate 'line', 477 find_lex $P112, "$past" $P112."pirflags"(":nsentry") if_1526_end: .annotate 'line', 479 find_lex $P111, "$past" $P111."control"("return_pir") .annotate 'line', 480 find_lex $P1527, "$past" unless_null $P1527, vivify_455 $P1527 = root_new ['parrot';'ResizablePMCArray'] vivify_455: set $P111, $P1527[0] unless_null $P111, vivify_456 new $P111, "Undef" vivify_456: get_hll_global $P112, ["PAST"], "Op" $P113 = $P112."new"(" .lex \"self\", self" :named("inline")) $P111."unshift"($P113) .annotate 'line', 481 find_lex $P111, "$past" $P111."symbol"("self", "lexical" :named("scope")) .annotate 'line', 482 find_lex $P1529, "$/" unless_null $P1529, vivify_457 $P1529 = root_new ['parrot';'Hash'] vivify_457: set $P111, $P1529["deflongname"] unless_null $P111, vivify_458 new $P111, "Undef" vivify_458: unless $P111, if_1528_end .const 'Sub' $P1531 = "81_1309998850.8808" capture_lex $P1531 $P1531() if_1528_end: .annotate 'line', 486 find_dynamic_lex $P111, "$*MULTINESS" unless_null $P111, vivify_462 get_hll_global $P111, "$MULTINESS" unless_null $P111, vivify_463 die "Contextual $*MULTINESS not found" vivify_463: vivify_462: set $S100, $P111 iseq $I100, $S100, "multi" unless $I100, if_1535_end find_lex $P112, "$past" $P113 = $P112."multi"() $P113."unshift"("_") if_1535_end: .annotate 'line', 487 find_lex $P111, "$past" find_lex $P1536, "$past" unless_null $P1536, vivify_464 $P1536 = root_new ['parrot';'Hash'] store_lex "$past", $P1536 vivify_464: set $P1536["block_past"], $P111 .annotate 'line', 488 find_lex $P111, "$/" find_lex $P112, "$past" $P111."!make"($P112) .annotate 'line', 489 find_lex $P1538, "$/" unless_null $P1538, vivify_465 $P1538 = root_new ['parrot';'Hash'] vivify_465: set $P112, $P1538["trait"] unless_null $P112, vivify_466 new $P112, "Undef" vivify_466: if $P112, if_1537 set $P111, $P112 goto if_1537_end if_1537: .annotate 'line', 490 find_lex $P1539, "$/" unless_null $P1539, vivify_467 $P1539 = root_new ['parrot';'Hash'] vivify_467: set $P114, $P1539["trait"] unless_null $P114, vivify_468 new $P114, "Undef" vivify_468: defined $I100, $P114 unless $I100, for_undef_469 iter $P113, $P114 new $P117, 'ExceptionHandler' set_label $P117, loop1543_handler $P117."handle_types"(.CONTROL_LOOP_NEXT, .CONTROL_LOOP_REDO, .CONTROL_LOOP_LAST) push_eh $P117 loop1543_test: unless $P113, loop1543_done shift $P115, $P113 loop1543_redo: .const 'Sub' $P1541 = "82_1309998850.8808" capture_lex $P1541 $P1541($P115) loop1543_next: goto loop1543_test loop1543_handler: .local pmc exception .get_results (exception) getattribute $P118, exception, 'type' eq $P118, .CONTROL_LOOP_NEXT, loop1543_next eq $P118, .CONTROL_LOOP_REDO, loop1543_redo loop1543_done: pop_eh for_undef_469: .annotate 'line', 489 set $P111, $P113 if_1537_end: .annotate 'line', 473 .return ($P111) control_1521: .local pmc exception .get_results (exception) getattribute $P112, exception, "payload" .return ($P112) .end .namespace ["NQP";"Actions"] .sub "_block1530" :anon :subid("81_1309998850.8808") :outer("80_1309998850.8808") .annotate 'line', 483 new $P112, "Undef" set $P1532, $P112 .lex "$name", $P1532 find_lex $P1533, "$/" unless_null $P1533, vivify_459 $P1533 = root_new ['parrot';'Hash'] vivify_459: set $P1534, $P1533["deflongname"] unless_null $P1534, vivify_460 $P1534 = root_new ['parrot';'ResizablePMCArray'] vivify_460: set $P113, $P1534[0] unless_null $P113, vivify_461 new $P113, "Undef" vivify_461: $P114 = $P113."ast"() set $S100, $P114 new $P115, 'String' set $P115, $S100 store_lex "$name", $P115 .annotate 'line', 484 find_lex $P113, "$past" find_lex $P114, "$name" $P115 = $P113."name"($P114) .annotate 'line', 482 .return ($P115) .end .namespace ["NQP";"Actions"] .sub "_block1540" :anon :subid("82_1309998850.8808") :outer("80_1309998850.8808") .param pmc param_1542 .annotate 'line', 490 .lex "$_", param_1542 find_lex $P117, "$_" $P118 = $P117."ast"() find_lex $P119, "$/" $P120 = $P118($P119) .return ($P120) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "signature" :subid("83_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1547 .annotate 'line', 495 .const 'Sub' $P1558 = "85_1309998850.8808" capture_lex $P1558 .const 'Sub' $P1553 = "84_1309998850.8808" capture_lex $P1553 new $P1546, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1546, control_1545 push_eh $P1546 .lex "self", self .lex "$/", param_1547 .annotate 'line', 496 new $P110, "Undef" set $P1548, $P110 .lex "$BLOCKINIT", $P1548 get_global $P1549, "@BLOCK" unless_null $P1549, vivify_470 $P1549 = root_new ['parrot';'ResizablePMCArray'] vivify_470: set $P1550, $P1549[0] unless_null $P1550, vivify_471 $P1550 = root_new ['parrot';'ResizablePMCArray'] vivify_471: set $P111, $P1550[0] unless_null $P111, vivify_472 new $P111, "Undef" vivify_472: store_lex "$BLOCKINIT", $P111 .annotate 'line', 498 find_lex $P1551, "$/" unless_null $P1551, vivify_473 $P1551 = root_new ['parrot';'Hash'] vivify_473: set $P112, $P1551["parameter"] unless_null $P112, vivify_474 new $P112, "Undef" vivify_474: defined $I100, $P112 unless $I100, for_undef_475 iter $P111, $P112 new $P114, 'ExceptionHandler' set_label $P114, loop1555_handler $P114."handle_types"(.CONTROL_LOOP_NEXT, .CONTROL_LOOP_REDO, .CONTROL_LOOP_LAST) push_eh $P114 loop1555_test: unless $P111, loop1555_done shift $P113, $P111 loop1555_redo: .const 'Sub' $P1553 = "84_1309998850.8808" capture_lex $P1553 $P1553($P113) loop1555_next: goto loop1555_test loop1555_handler: .local pmc exception .get_results (exception) getattribute $P115, exception, 'type' eq $P115, .CONTROL_LOOP_NEXT, loop1555_next eq $P115, .CONTROL_LOOP_REDO, loop1555_redo loop1555_done: pop_eh for_undef_475: .annotate 'line', 501 find_dynamic_lex $P112, "$*MULTINESS" unless_null $P112, vivify_476 get_hll_global $P112, "$MULTINESS" unless_null $P112, vivify_477 die "Contextual $*MULTINESS not found" vivify_477: vivify_476: set $S100, $P112 iseq $I100, $S100, "multi" if $I100, if_1556 new $P111, 'Integer' set $P111, $I100 goto if_1556_end if_1556: .const 'Sub' $P1558 = "85_1309998850.8808" capture_lex $P1558 $P113 = $P1558() set $P111, $P113 if_1556_end: .annotate 'line', 495 .return ($P111) control_1545: .local pmc exception .get_results (exception) getattribute $P112, exception, "payload" .return ($P112) .end .namespace ["NQP";"Actions"] .sub "_block1552" :anon :subid("84_1309998850.8808") :outer("83_1309998850.8808") .param pmc param_1554 .annotate 'line', 498 .lex "$_", param_1554 find_lex $P114, "$BLOCKINIT" find_lex $P115, "$_" $P117 = $P115."ast"() $P118 = $P114."push"($P117) .return ($P118) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "_block1557" :anon :subid("85_1309998850.8808") :outer("83_1309998850.8808") .annotate 'line', 501 .const 'Sub' $P1562 = "86_1309998850.8808" capture_lex $P1562 .annotate 'line', 502 $P1560 = root_new ['parrot';'ResizablePMCArray'] set $P1559, $P1560 .lex "@params", $P1559 .annotate 'line', 501 find_lex $P113, "@params" .annotate 'line', 503 find_lex $P114, "$BLOCKINIT" $P115 = $P114."list"() defined $I101, $P115 unless $I101, for_undef_478 iter $P113, $P115 new $P119, 'ExceptionHandler' set_label $P119, loop1570_handler $P119."handle_types"(.CONTROL_LOOP_NEXT, .CONTROL_LOOP_REDO, .CONTROL_LOOP_LAST) push_eh $P119 loop1570_test: unless $P113, loop1570_done shift $P117, $P113 loop1570_redo: .const 'Sub' $P1562 = "86_1309998850.8808" capture_lex $P1562 $P1562($P117) loop1570_next: goto loop1570_test loop1570_handler: .local pmc exception .get_results (exception) getattribute $P120, exception, 'type' eq $P120, .CONTROL_LOOP_NEXT, loop1570_next eq $P120, .CONTROL_LOOP_REDO, loop1570_redo loop1570_done: pop_eh for_undef_478: .annotate 'line', 507 get_global $P1571, "@BLOCK" unless_null $P1571, vivify_479 $P1571 = root_new ['parrot';'ResizablePMCArray'] vivify_479: set $P113, $P1571[0] unless_null $P113, vivify_480 new $P113, "Undef" vivify_480: find_lex $P114, "@params" $P115 = $P113."multi"($P114) .annotate 'line', 501 .return ($P115) .end .namespace ["NQP";"Actions"] .sub "_block1561" :anon :subid("86_1309998850.8808") :outer("85_1309998850.8808") .param pmc param_1563 .annotate 'line', 503 .lex "$_", param_1563 .annotate 'line', 505 find_lex $P121, "$_" $P122 = $P121."slurpy"() unless $P122, unless_1566 set $P120, $P122 goto unless_1566_end unless_1566: find_lex $P123, "$_" $P124 = $P123."named"() set $P120, $P124 unless_1566_end: unless $P120, unless_1565 set $P119, $P120 goto unless_1565_end unless_1565: find_lex $P125, "$_" $P127 = $P125."viviself"() set $P119, $P127 unless_1565_end: unless $P119, unless_1564 set $P118, $P119 goto unless_1564_end unless_1564: .annotate 'line', 504 find_lex $P128, "@params" find_lex $P129, "$_" $P130 = $P129."multitype"() set $P1567, $P130 defined $I1569, $P1567 if $I1569, default_1568 new $P131, "String" assign $P131, "_" set $P1567, $P131 default_1568: $P132 = $P128."push"($P1567) set $P118, $P132 unless_1564_end: .annotate 'line', 503 .return ($P118) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "parameter" :subid("87_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1575 .annotate 'line', 511 .const 'Sub' $P1606 = "88_1309998850.8808" capture_lex $P1606 new $P1574, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1574, control_1573 push_eh $P1574 .lex "self", self .lex "$/", param_1575 .annotate 'line', 512 new $P110, "Undef" set $P1576, $P110 .lex "$quant", $P1576 .annotate 'line', 513 new $P111, "Undef" set $P1577, $P111 .lex "$past", $P1577 .annotate 'line', 512 find_lex $P1578, "$/" unless_null $P1578, vivify_481 $P1578 = root_new ['parrot';'Hash'] vivify_481: set $P112, $P1578["quant"] unless_null $P112, vivify_482 new $P112, "Undef" vivify_482: store_lex "$quant", $P112 .annotate 'line', 511 find_lex $P112, "$past" .annotate 'line', 514 find_lex $P1580, "$/" unless_null $P1580, vivify_483 $P1580 = root_new ['parrot';'Hash'] vivify_483: set $P112, $P1580["named_param"] unless_null $P112, vivify_484 new $P112, "Undef" vivify_484: if $P112, if_1579 .annotate 'line', 521 find_lex $P1586, "$/" unless_null $P1586, vivify_485 $P1586 = root_new ['parrot';'Hash'] vivify_485: set $P113, $P1586["param_var"] unless_null $P113, vivify_486 new $P113, "Undef" vivify_486: $P114 = $P113."ast"() store_lex "$past", $P114 .annotate 'line', 522 find_lex $P113, "$quant" set $S100, $P113 iseq $I100, $S100, "*" if $I100, if_1587 .annotate 'line', 526 find_lex $P114, "$quant" set $S101, $P114 iseq $I101, $S101, "?" unless $I101, if_1590_end .annotate 'line', 527 find_lex $P115, "$past" find_lex $P1591, "$/" unless_null $P1591, vivify_487 $P1591 = root_new ['parrot';'Hash'] vivify_487: set $P1592, $P1591["param_var"] unless_null $P1592, vivify_488 $P1592 = root_new ['parrot';'Hash'] vivify_488: set $P117, $P1592["sigil"] unless_null $P117, vivify_489 new $P117, "Undef" vivify_489: $P118 = "vivitype"($P117) $P115."viviself"($P118) if_1590_end: .annotate 'line', 526 goto if_1587_end if_1587: .annotate 'line', 523 find_lex $P114, "$past" $P114."slurpy"(1) .annotate 'line', 524 find_lex $P114, "$past" find_lex $P1588, "$/" unless_null $P1588, vivify_490 $P1588 = root_new ['parrot';'Hash'] vivify_490: set $P1589, $P1588["param_var"] unless_null $P1589, vivify_491 $P1589 = root_new ['parrot';'Hash'] vivify_491: set $P115, $P1589["sigil"] unless_null $P115, vivify_492 new $P115, "Undef" vivify_492: set $S101, $P115 iseq $I101, $S101, "%" $P114."named"($I101) if_1587_end: .annotate 'line', 520 goto if_1579_end if_1579: .annotate 'line', 515 find_lex $P1581, "$/" unless_null $P1581, vivify_493 $P1581 = root_new ['parrot';'Hash'] vivify_493: set $P113, $P1581["named_param"] unless_null $P113, vivify_494 new $P113, "Undef" vivify_494: $P114 = $P113."ast"() store_lex "$past", $P114 .annotate 'line', 516 find_lex $P113, "$quant" set $S100, $P113 isne $I100, $S100, "!" unless $I100, if_1582_end .annotate 'line', 517 find_lex $P114, "$past" find_lex $P1583, "$/" unless_null $P1583, vivify_495 $P1583 = root_new ['parrot';'Hash'] vivify_495: set $P1584, $P1583["named_param"] unless_null $P1584, vivify_496 $P1584 = root_new ['parrot';'Hash'] vivify_496: set $P1585, $P1584["param_var"] unless_null $P1585, vivify_497 $P1585 = root_new ['parrot';'Hash'] vivify_497: set $P115, $P1585["sigil"] unless_null $P115, vivify_498 new $P115, "Undef" vivify_498: $P117 = "vivitype"($P115) $P114."viviself"($P117) if_1582_end: if_1579_end: .annotate 'line', 530 find_lex $P1594, "$/" unless_null $P1594, vivify_499 $P1594 = root_new ['parrot';'Hash'] vivify_499: set $P112, $P1594["default_value"] unless_null $P112, vivify_500 new $P112, "Undef" vivify_500: unless $P112, if_1593_end .annotate 'line', 531 find_lex $P113, "$quant" set $S100, $P113 iseq $I100, $S100, "*" unless $I100, if_1595_end .annotate 'line', 532 find_lex $P114, "$/" $P115 = $P114."CURSOR"() $P115."panic"("Can't put default on slurpy parameter") if_1595_end: .annotate 'line', 534 find_lex $P113, "$quant" set $S100, $P113 iseq $I100, $S100, "!" unless $I100, if_1596_end .annotate 'line', 535 find_lex $P114, "$/" $P115 = $P114."CURSOR"() $P115."panic"("Can't put default on required parameter") if_1596_end: .annotate 'line', 537 find_lex $P113, "$past" find_lex $P1597, "$/" unless_null $P1597, vivify_501 $P1597 = root_new ['parrot';'Hash'] vivify_501: set $P1598, $P1597["default_value"] unless_null $P1598, vivify_502 $P1598 = root_new ['parrot';'ResizablePMCArray'] vivify_502: set $P1599, $P1598[0] unless_null $P1599, vivify_503 $P1599 = root_new ['parrot';'Hash'] vivify_503: set $P114, $P1599["EXPR"] unless_null $P114, vivify_504 new $P114, "Undef" vivify_504: $P115 = $P114."ast"() $P113."viviself"($P115) if_1593_end: .annotate 'line', 539 find_lex $P112, "$past" $P113 = $P112."viviself"() if $P113, unless_1600_end get_global $P1601, "@BLOCK" unless_null $P1601, vivify_505 $P1601 = root_new ['parrot';'ResizablePMCArray'] vivify_505: set $P114, $P1601[0] unless_null $P114, vivify_506 new $P114, "Undef" vivify_506: get_global $P1602, "@BLOCK" unless_null $P1602, vivify_507 $P1602 = root_new ['parrot';'ResizablePMCArray'] vivify_507: set $P115, $P1602[0] unless_null $P115, vivify_508 new $P115, "Undef" vivify_508: $P117 = $P115."arity"() set $N100, $P117 new $P118, 'Float' set $P118, $N100 add $P119, $P118, 1 $P114."arity"($P119) unless_1600_end: .annotate 'line', 542 find_lex $P1604, "$/" unless_null $P1604, vivify_509 $P1604 = root_new ['parrot';'Hash'] vivify_509: set $P112, $P1604["typename"] unless_null $P112, vivify_510 new $P112, "Undef" vivify_510: unless $P112, if_1603_end .const 'Sub' $P1606 = "88_1309998850.8808" capture_lex $P1606 $P1606() if_1603_end: .annotate 'line', 548 find_lex $P112, "$/" find_lex $P113, "$past" $P114 = $P112."!make"($P113) .annotate 'line', 511 .return ($P114) control_1573: .local pmc exception .get_results (exception) getattribute $P112, exception, "payload" .return ($P112) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "_block1605" :anon :subid("88_1309998850.8808") :outer("87_1309998850.8808") .annotate 'line', 542 .const 'Sub' $P1614 = "89_1309998850.8808" capture_lex $P1614 .annotate 'line', 543 $P1608 = root_new ['parrot';'ResizablePMCArray'] set $P1607, $P1608 .lex "@multitype", $P1607 .annotate 'line', 542 find_lex $P113, "@multitype" .annotate 'line', 544 find_lex $P1609, "$/" unless_null $P1609, vivify_511 $P1609 = root_new ['parrot';'Hash'] vivify_511: set $P1610, $P1609["typename"] unless_null $P1610, vivify_512 $P1610 = root_new ['parrot';'ResizablePMCArray'] vivify_512: set $P1611, $P1610[0] unless_null $P1611, vivify_513 $P1611 = root_new ['parrot';'Hash'] vivify_513: set $P1612, $P1611["name"] unless_null $P1612, vivify_514 $P1612 = root_new ['parrot';'Hash'] vivify_514: set $P114, $P1612["identifier"] unless_null $P114, vivify_515 new $P114, "Undef" vivify_515: defined $I100, $P114 unless $I100, for_undef_516 iter $P113, $P114 new $P117, 'ExceptionHandler' set_label $P117, loop1616_handler $P117."handle_types"(.CONTROL_LOOP_NEXT, .CONTROL_LOOP_REDO, .CONTROL_LOOP_LAST) push_eh $P117 loop1616_test: unless $P113, loop1616_done shift $P115, $P113 loop1616_redo: .const 'Sub' $P1614 = "89_1309998850.8808" capture_lex $P1614 $P1614($P115) loop1616_next: goto loop1616_test loop1616_handler: .local pmc exception .get_results (exception) getattribute $P118, exception, 'type' eq $P118, .CONTROL_LOOP_NEXT, loop1616_next eq $P118, .CONTROL_LOOP_REDO, loop1616_redo loop1616_done: pop_eh for_undef_516: .annotate 'line', 545 find_lex $P113, "$past" find_lex $P114, "@multitype" $P115 = $P113."multitype"($P114) .annotate 'line', 542 .return ($P115) .end .namespace ["NQP";"Actions"] .sub "_block1613" :anon :subid("89_1309998850.8808") :outer("88_1309998850.8808") .param pmc param_1615 .annotate 'line', 544 .lex "$_", param_1615 find_lex $P117, "@multitype" find_lex $P118, "$_" set $S100, $P118 $P119 = $P117."push"($S100) .return ($P119) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "param_var" :subid("90_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1620 .annotate 'line', 551 new $P1619, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1619, control_1618 push_eh $P1619 .lex "self", self .lex "$/", param_1620 .annotate 'line', 552 new $P110, "Undef" set $P1621, $P110 .lex "$name", $P1621 .annotate 'line', 553 new $P111, "Undef" set $P1622, $P111 .lex "$past", $P1622 .annotate 'line', 552 find_lex $P112, "$/" set $S100, $P112 new $P113, 'String' set $P113, $S100 store_lex "$name", $P113 .annotate 'line', 553 get_hll_global $P112, ["PAST"], "Var" find_lex $P113, "$name" find_lex $P114, "$/" $P115 = $P112."new"($P113 :named("name"), "parameter" :named("scope"), 1 :named("isdecl"), $P114 :named("node")) store_lex "$past", $P115 .annotate 'line', 555 get_global $P1623, "@BLOCK" unless_null $P1623, vivify_517 $P1623 = root_new ['parrot';'ResizablePMCArray'] vivify_517: set $P112, $P1623[0] unless_null $P112, vivify_518 new $P112, "Undef" vivify_518: find_lex $P113, "$name" $P112."symbol"($P113, "lexical" :named("scope")) .annotate 'line', 556 find_lex $P112, "$/" find_lex $P113, "$past" $P114 = $P112."!make"($P113) .annotate 'line', 551 .return ($P114) control_1618: .local pmc exception .get_results (exception) getattribute $P112, exception, "payload" .return ($P112) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "named_param" :subid("91_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1627 .annotate 'line', 559 new $P1626, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1626, control_1625 push_eh $P1626 .lex "self", self .lex "$/", param_1627 .annotate 'line', 560 new $P110, "Undef" set $P1628, $P110 .lex "$past", $P1628 find_lex $P1629, "$/" unless_null $P1629, vivify_519 $P1629 = root_new ['parrot';'Hash'] vivify_519: set $P111, $P1629["param_var"] unless_null $P111, vivify_520 new $P111, "Undef" vivify_520: $P112 = $P111."ast"() store_lex "$past", $P112 .annotate 'line', 561 find_lex $P111, "$past" find_lex $P1630, "$/" unless_null $P1630, vivify_521 $P1630 = root_new ['parrot';'Hash'] vivify_521: set $P1631, $P1630["param_var"] unless_null $P1631, vivify_522 $P1631 = root_new ['parrot';'Hash'] vivify_522: set $P112, $P1631["name"] unless_null $P112, vivify_523 new $P112, "Undef" vivify_523: set $S100, $P112 $P111."named"($S100) .annotate 'line', 562 find_lex $P111, "$/" find_lex $P112, "$past" $P113 = $P111."!make"($P112) .annotate 'line', 559 .return ($P113) control_1625: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "trait" :subid("92_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1635 .annotate 'line', 565 new $P1634, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1634, control_1633 push_eh $P1634 .lex "self", self .lex "$/", param_1635 .annotate 'line', 566 find_lex $P110, "$/" find_lex $P1636, "$/" unless_null $P1636, vivify_524 $P1636 = root_new ['parrot';'Hash'] vivify_524: set $P111, $P1636["trait_mod"] unless_null $P111, vivify_525 new $P111, "Undef" vivify_525: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .annotate 'line', 565 .return ($P113) control_1633: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "trait_mod:sym" :subid("93_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1640 .annotate 'line', 569 .const 'Sub' $P1648 = "94_1309998850.8808" capture_lex $P1648 new $P1639, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1639, control_1638 push_eh $P1639 .lex "self", self .lex "$/", param_1640 .annotate 'line', 570 new $P110, "Undef" set $P1641, $P110 .lex "$cpast", $P1641 find_lex $P1642, "$/" unless_null $P1642, vivify_526 $P1642 = root_new ['parrot';'Hash'] vivify_526: set $P1643, $P1642["circumfix"] unless_null $P1643, vivify_527 $P1643 = root_new ['parrot';'ResizablePMCArray'] vivify_527: set $P111, $P1643[0] unless_null $P111, vivify_528 new $P111, "Undef" vivify_528: $P112 = $P111."ast"() store_lex "$cpast", $P112 .annotate 'line', 571 find_lex $P1645, "$/" unless_null $P1645, vivify_529 $P1645 = root_new ['parrot';'Hash'] vivify_529: set $P112, $P1645["longname"] unless_null $P112, vivify_530 new $P112, "Undef" vivify_530: set $S100, $P112 iseq $I100, $S100, "pirflags" if $I100, if_1644 .annotate 'line', 577 find_lex $P113, "$/" $P115 = $P113."CURSOR"() new $P117, 'String' set $P117, "Trait '" find_lex $P1651, "$/" unless_null $P1651, vivify_531 $P1651 = root_new ['parrot';'Hash'] vivify_531: set $P118, $P1651["longname"] unless_null $P118, vivify_532 new $P118, "Undef" vivify_532: concat $P119, $P117, $P118 concat $P120, $P119, "' not implemented" $P121 = $P115."panic"($P120) .annotate 'line', 576 set $P111, $P121 .annotate 'line', 571 goto if_1644_end if_1644: .annotate 'line', 573 get_hll_global $P113, ["PAST"], "Val" find_lex $P114, "$cpast" $P115 = $P113."ACCEPTS"($P114) if $P115, unless_1646_end .annotate 'line', 572 find_lex $P117, "$/" $P118 = $P117."CURSOR"() $P118."panic"("Trait 'pirflags' requires constant scalar argument") unless_1646_end: .annotate 'line', 574 find_lex $P113, "$/" .const 'Sub' $P1648 = "94_1309998850.8808" newclosure $P1650, $P1648 $P114 = $P113."!make"($P1650) .annotate 'line', 571 set $P111, $P114 if_1644_end: .annotate 'line', 569 .return ($P111) control_1638: .local pmc exception .get_results (exception) getattribute $P112, exception, "payload" .return ($P112) .end .namespace ["NQP";"Actions"] .sub "_block1647" :anon :subid("94_1309998850.8808") :outer("93_1309998850.8808") .param pmc param_1649 .annotate 'line', 574 .lex "$match", param_1649 find_lex $P114, "$match" $P115 = $P114."ast"() set $P117, $P115["block_past"] unless_null $P117, vivify_533 new $P117, "Undef" vivify_533: find_lex $P118, "$cpast" $P119 = $P118."value"() $P120 = $P117."pirflags"($P119) .return ($P120) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "regex_declarator" :subid("95_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1655 .param pmc param_1656 :optional .param int has_param_1656 :opt_flag .annotate 'line', 581 .const 'Sub' $P1680 = "97_1309998850.8808" capture_lex $P1680 .const 'Sub' $P1667 = "96_1309998850.8808" capture_lex $P1667 new $P1654, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1654, control_1653 push_eh $P1654 .lex "self", self .lex "$/", param_1655 if has_param_1656, optparam_534 new $P110, "Undef" set param_1656, $P110 optparam_534: .lex "$key", param_1656 .annotate 'line', 582 $P1658 = root_new ['parrot';'ResizablePMCArray'] set $P1657, $P1658 .lex "@MODIFIERS", $P1657 .annotate 'line', 585 new $P111, "Undef" set $P1659, $P111 .lex "$name", $P1659 .annotate 'line', 586 new $P112, "Undef" set $P1660, $P112 .lex "$past", $P1660 .annotate 'line', 582 $P1661 = get_hll_global ['Regex';'P6Regex';'Actions'], '@MODIFIERS' store_lex "@MODIFIERS", $P1661 .annotate 'line', 585 find_lex $P1662, "$/" unless_null $P1662, vivify_535 $P1662 = root_new ['parrot';'Hash'] vivify_535: set $P113, $P1662["deflongname"] unless_null $P113, vivify_536 new $P113, "Undef" vivify_536: $P114 = $P113."ast"() set $S100, $P114 new $P115, 'String' set $P115, $S100 store_lex "$name", $P115 .annotate 'line', 581 find_lex $P113, "$past" .annotate 'line', 587 find_lex $P1664, "$/" unless_null $P1664, vivify_537 $P1664 = root_new ['parrot';'Hash'] vivify_537: set $P113, $P1664["proto"] unless_null $P113, vivify_538 new $P113, "Undef" vivify_538: if $P113, if_1663 .annotate 'line', 614 find_lex $P114, "$key" set $S100, $P114 iseq $I100, $S100, "open" if $I100, if_1665 .annotate 'line', 627 .const 'Sub' $P1680 = "97_1309998850.8808" capture_lex $P1680 $P1680() goto if_1665_end if_1665: .annotate 'line', 614 .const 'Sub' $P1667 = "96_1309998850.8808" capture_lex $P1667 $P1667() if_1665_end: goto if_1663_end if_1663: .annotate 'line', 589 get_hll_global $P114, ["PAST"], "Stmts" .annotate 'line', 590 get_hll_global $P115, ["PAST"], "Block" find_lex $P117, "$name" .annotate 'line', 591 get_hll_global $P118, ["PAST"], "Op" .annotate 'line', 592 get_hll_global $P119, ["PAST"], "Var" $P120 = $P119."new"("self" :named("name"), "register" :named("scope")) find_lex $P121, "$name" $P122 = $P118."new"($P120, $P121, "!protoregex" :named("name"), "callmethod" :named("pasttype")) .annotate 'line', 591 find_lex $P123, "$/" $P124 = $P115."new"($P122, $P117 :named("name"), "method" :named("blocktype"), 0 :named("lexical"), $P123 :named("node")) .annotate 'line', 601 get_hll_global $P125, ["PAST"], "Block" new $P127, "String" assign $P127, "!PREFIX__" find_lex $P128, "$name" concat $P129, $P127, $P128 .annotate 'line', 602 get_hll_global $P130, ["PAST"], "Op" .annotate 'line', 603 get_hll_global $P131, ["PAST"], "Var" $P132 = $P131."new"("self" :named("name"), "register" :named("scope")) find_lex $P133, "$name" $P134 = $P130."new"($P132, $P133, "!PREFIX__!protoregex" :named("name"), "callmethod" :named("pasttype")) .annotate 'line', 602 find_lex $P135, "$/" $P136 = $P125."new"($P134, $P129 :named("name"), "method" :named("blocktype"), 0 :named("lexical"), $P135 :named("node")) .annotate 'line', 601 $P137 = $P114."new"($P124, $P136) .annotate 'line', 589 store_lex "$past", $P137 if_1663_end: .annotate 'line', 641 find_lex $P113, "$/" find_lex $P114, "$past" $P115 = $P113."!make"($P114) .annotate 'line', 581 .return ($P115) control_1653: .local pmc exception .get_results (exception) getattribute $P113, exception, "payload" .return ($P113) .end .namespace ["NQP";"Actions"] .sub "_block1679" :anon :subid("97_1309998850.8808") :outer("95_1309998850.8808") .annotate 'line', 628 new $P115, "Undef" set $P1681, $P115 .lex "$regex", $P1681 .annotate 'line', 629 get_hll_global $P117, ["Regex";"P6Regex";"Actions"], "buildsub" find_lex $P1682, "$/" unless_null $P1682, vivify_539 $P1682 = root_new ['parrot';'Hash'] vivify_539: set $P118, $P1682["p6regex"] unless_null $P118, vivify_540 new $P118, "Undef" vivify_540: $P119 = $P118."ast"() get_global $P120, "@BLOCK" $P121 = $P120."shift"() $P122 = $P117($P119, $P121) store_lex "$regex", $P122 .annotate 'line', 630 find_lex $P117, "$regex" find_lex $P118, "$name" $P117."name"($P118) .annotate 'line', 632 get_hll_global $P117, ["PAST"], "Op" .annotate 'line', 634 get_hll_global $P118, ["PAST"], "Var" new $P119, "ResizablePMCArray" push $P119, "Regex" $P120 = $P118."new"("Method" :named("name"), $P119 :named("namespace"), "package" :named("scope")) find_lex $P121, "$regex" $P122 = $P117."new"($P120, $P121, "callmethod" :named("pasttype"), "new" :named("name")) .annotate 'line', 632 store_lex "$past", $P122 .annotate 'line', 638 find_lex $P117, "$regex" find_lex $P1683, "$past" unless_null $P1683, vivify_541 $P1683 = root_new ['parrot';'Hash'] store_lex "$past", $P1683 vivify_541: set $P1683["sink"], $P117 .annotate 'line', 639 find_lex $P117, "@MODIFIERS" $P118 = $P117."shift"() .annotate 'line', 627 .return ($P118) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "_block1666" :anon :subid("96_1309998850.8808") :outer("95_1309998850.8808") .annotate 'line', 615 $P1669 = root_new ['parrot';'Hash'] set $P1668, $P1669 .lex "%h", $P1668 .annotate 'line', 614 find_lex $P115, "%h" .annotate 'line', 616 find_lex $P1671, "$/" unless_null $P1671, vivify_542 $P1671 = root_new ['parrot';'Hash'] vivify_542: set $P115, $P1671["sym"] unless_null $P115, vivify_543 new $P115, "Undef" vivify_543: set $S101, $P115 iseq $I101, $S101, "token" unless $I101, if_1670_end new $P117, "Integer" assign $P117, 1 find_lex $P1672, "%h" unless_null $P1672, vivify_544 $P1672 = root_new ['parrot';'Hash'] store_lex "%h", $P1672 vivify_544: set $P1672["r"], $P117 if_1670_end: .annotate 'line', 617 find_lex $P1674, "$/" unless_null $P1674, vivify_545 $P1674 = root_new ['parrot';'Hash'] vivify_545: set $P115, $P1674["sym"] unless_null $P115, vivify_546 new $P115, "Undef" vivify_546: set $S101, $P115 iseq $I101, $S101, "rule" unless $I101, if_1673_end new $P117, "Integer" assign $P117, 1 find_lex $P1675, "%h" unless_null $P1675, vivify_547 $P1675 = root_new ['parrot';'Hash'] store_lex "%h", $P1675 vivify_547: set $P1675["r"], $P117 new $P117, "Integer" assign $P117, 1 find_lex $P1676, "%h" unless_null $P1676, vivify_548 $P1676 = root_new ['parrot';'Hash'] store_lex "%h", $P1676 vivify_548: set $P1676["s"], $P117 if_1673_end: .annotate 'line', 618 find_lex $P115, "@MODIFIERS" find_lex $P117, "%h" $P115."unshift"($P117) .annotate 'line', 619 $P0 = find_lex '$name' set_hll_global ['Regex';'P6Regex';'Actions'], '$REGEXNAME', $P0 .annotate 'line', 623 get_global $P1677, "@BLOCK" unless_null $P1677, vivify_549 $P1677 = root_new ['parrot';'ResizablePMCArray'] vivify_549: set $P115, $P1677[0] unless_null $P115, vivify_550 new $P115, "Undef" vivify_550: $P115."symbol"(unicode:"$\x{a2}", "lexical" :named("scope")) .annotate 'line', 624 get_global $P1678, "@BLOCK" unless_null $P1678, vivify_551 $P1678 = root_new ['parrot';'ResizablePMCArray'] vivify_551: set $P115, $P1678[0] unless_null $P115, vivify_552 new $P115, "Undef" vivify_552: $P115."symbol"("$/", "lexical" :named("scope")) .annotate 'line', 625 new $P115, "Exception" set $P115['type'], .CONTROL_RETURN new $P117, "Integer" assign $P117, 0 setattribute $P115, 'payload', $P117 throw $P115 .annotate 'line', 614 .return () .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "dotty" :subid("98_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1687 .annotate 'line', 645 new $P1686, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1686, control_1685 push_eh $P1686 .lex "self", self .lex "$/", param_1687 .annotate 'line', 646 new $P110, "Undef" set $P1688, $P110 .lex "$past", $P1688 find_lex $P1690, "$/" unless_null $P1690, vivify_553 $P1690 = root_new ['parrot';'Hash'] vivify_553: set $P112, $P1690["args"] unless_null $P112, vivify_554 new $P112, "Undef" vivify_554: if $P112, if_1689 get_hll_global $P115, ["PAST"], "Op" find_lex $P117, "$/" $P118 = $P115."new"($P117 :named("node")) set $P111, $P118 goto if_1689_end if_1689: find_lex $P1691, "$/" unless_null $P1691, vivify_555 $P1691 = root_new ['parrot';'Hash'] vivify_555: set $P1692, $P1691["args"] unless_null $P1692, vivify_556 $P1692 = root_new ['parrot';'ResizablePMCArray'] vivify_556: set $P113, $P1692[0] unless_null $P113, vivify_557 new $P113, "Undef" vivify_557: $P114 = $P113."ast"() set $P111, $P114 if_1689_end: store_lex "$past", $P111 .annotate 'line', 647 find_lex $P111, "$past" find_lex $P1694, "$/" unless_null $P1694, vivify_558 $P1694 = root_new ['parrot';'Hash'] vivify_558: set $P113, $P1694["quote"] unless_null $P113, vivify_559 new $P113, "Undef" vivify_559: if $P113, if_1693 find_lex $P1696, "$/" unless_null $P1696, vivify_560 $P1696 = root_new ['parrot';'Hash'] vivify_560: set $P117, $P1696["longname"] unless_null $P117, vivify_561 new $P117, "Undef" vivify_561: set $S100, $P117 new $P112, 'String' set $P112, $S100 goto if_1693_end if_1693: find_lex $P1695, "$/" unless_null $P1695, vivify_562 $P1695 = root_new ['parrot';'Hash'] vivify_562: set $P114, $P1695["quote"] unless_null $P114, vivify_563 new $P114, "Undef" vivify_563: $P115 = $P114."ast"() set $P112, $P115 if_1693_end: $P111."name"($P112) .annotate 'line', 648 find_lex $P111, "$past" $P111."pasttype"("callmethod") .annotate 'line', 649 find_lex $P111, "$/" find_lex $P112, "$past" $P113 = $P111."!make"($P112) .annotate 'line', 645 .return ($P113) control_1685: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("99_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1700 .annotate 'line', 654 new $P1699, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1699, control_1698 push_eh $P1699 .lex "self", self .lex "$/", param_1700 .annotate 'line', 655 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Var" $P112 = $P111."new"("self" :named("name")) $P113 = $P110."!make"($P112) .annotate 'line', 654 .return ($P113) control_1698: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("100_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1704 .annotate 'line', 658 new $P1703, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1703, control_1702 push_eh $P1703 .lex "self", self .lex "$/", param_1704 .annotate 'line', 659 new $P110, "Undef" set $P1705, $P110 .lex "$past", $P1705 find_lex $P1706, "$/" unless_null $P1706, vivify_564 $P1706 = root_new ['parrot';'Hash'] vivify_564: set $P111, $P1706["args"] unless_null $P111, vivify_565 new $P111, "Undef" vivify_565: $P112 = $P111."ast"() store_lex "$past", $P112 .annotate 'line', 660 find_lex $P111, "$past" find_lex $P1707, "$/" unless_null $P1707, vivify_566 $P1707 = root_new ['parrot';'Hash'] vivify_566: set $P112, $P1707["deflongname"] unless_null $P112, vivify_567 new $P112, "Undef" vivify_567: set $S100, $P112 $P111."name"($S100) .annotate 'line', 661 find_lex $P111, "$/" find_lex $P112, "$past" $P113 = $P111."!make"($P112) .annotate 'line', 658 .return ($P113) control_1702: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("101_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1711 .annotate 'line', 664 new $P1710, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1710, control_1709 push_eh $P1710 .lex "self", self .lex "$/", param_1711 .annotate 'line', 665 $P1713 = root_new ['parrot';'ResizablePMCArray'] set $P1712, $P1713 .lex "@ns", $P1712 .annotate 'line', 666 new $P110, "Undef" set $P1714, $P110 .lex "$name", $P1714 .annotate 'line', 668 new $P111, "Undef" set $P1715, $P111 .lex "$var", $P1715 .annotate 'line', 670 new $P112, "Undef" set $P1716, $P112 .lex "$past", $P1716 .annotate 'line', 665 find_lex $P1717, "$/" unless_null $P1717, vivify_568 $P1717 = root_new ['parrot';'Hash'] vivify_568: set $P1718, $P1717["name"] unless_null $P1718, vivify_569 $P1718 = root_new ['parrot';'Hash'] vivify_569: set $P113, $P1718["identifier"] unless_null $P113, vivify_570 new $P113, "Undef" vivify_570: clone $P114, $P113 store_lex "@ns", $P114 .annotate 'line', 666 find_lex $P113, "@ns" $P114 = $P113."pop"() store_lex "$name", $P114 .annotate 'line', 667 find_lex $P114, "@ns" if $P114, if_1720 set $P113, $P114 goto if_1720_end if_1720: find_lex $P1721, "@ns" unless_null $P1721, vivify_571 $P1721 = root_new ['parrot';'ResizablePMCArray'] vivify_571: set $P115, $P1721[0] unless_null $P115, vivify_572 new $P115, "Undef" vivify_572: set $S100, $P115 iseq $I100, $S100, "GLOBAL" new $P113, 'Integer' set $P113, $I100 if_1720_end: unless $P113, if_1719_end find_lex $P117, "@ns" $P117."shift"() if_1719_end: .annotate 'line', 669 get_hll_global $P113, ["PAST"], "Var" find_lex $P114, "$name" set $S100, $P114 find_lex $P115, "@ns" $P117 = $P113."new"($S100 :named("name"), $P115 :named("namespace"), "package" :named("scope")) store_lex "$var", $P117 .annotate 'line', 670 find_lex $P113, "$var" store_lex "$past", $P113 .annotate 'line', 671 find_lex $P1723, "$/" unless_null $P1723, vivify_573 $P1723 = root_new ['parrot';'Hash'] vivify_573: set $P113, $P1723["args"] unless_null $P113, vivify_574 new $P113, "Undef" vivify_574: unless $P113, if_1722_end .annotate 'line', 672 find_lex $P1724, "$/" unless_null $P1724, vivify_575 $P1724 = root_new ['parrot';'Hash'] vivify_575: set $P1725, $P1724["args"] unless_null $P1725, vivify_576 $P1725 = root_new ['parrot';'ResizablePMCArray'] vivify_576: set $P114, $P1725[0] unless_null $P114, vivify_577 new $P114, "Undef" vivify_577: $P115 = $P114."ast"() store_lex "$past", $P115 .annotate 'line', 673 find_lex $P114, "$past" find_lex $P115, "$var" $P114."unshift"($P115) if_1722_end: .annotate 'line', 675 find_lex $P113, "$/" find_lex $P114, "$past" $P115 = $P113."!make"($P114) .annotate 'line', 664 .return ($P115) control_1709: .local pmc exception .get_results (exception) getattribute $P113, exception, "payload" .return ($P113) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("102_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1729 .annotate 'line', 678 new $P1728, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1728, control_1727 push_eh $P1728 .lex "self", self .lex "$/", param_1729 .annotate 'line', 679 new $P110, "Undef" set $P1730, $P110 .lex "$past", $P1730 .annotate 'line', 680 new $P111, "Undef" set $P1731, $P111 .lex "$pirop", $P1731 .annotate 'line', 679 find_lex $P1733, "$/" unless_null $P1733, vivify_578 $P1733 = root_new ['parrot';'Hash'] vivify_578: set $P113, $P1733["args"] unless_null $P113, vivify_579 new $P113, "Undef" vivify_579: if $P113, if_1732 get_hll_global $P117, ["PAST"], "Op" find_lex $P118, "$/" $P119 = $P117."new"($P118 :named("node")) set $P112, $P119 goto if_1732_end if_1732: find_lex $P1734, "$/" unless_null $P1734, vivify_580 $P1734 = root_new ['parrot';'Hash'] vivify_580: set $P1735, $P1734["args"] unless_null $P1735, vivify_581 $P1735 = root_new ['parrot';'ResizablePMCArray'] vivify_581: set $P114, $P1735[0] unless_null $P114, vivify_582 new $P114, "Undef" vivify_582: $P115 = $P114."ast"() set $P112, $P115 if_1732_end: store_lex "$past", $P112 .annotate 'line', 680 find_lex $P1736, "$/" unless_null $P1736, vivify_583 $P1736 = root_new ['parrot';'Hash'] vivify_583: set $P112, $P1736["op"] unless_null $P112, vivify_584 new $P112, "Undef" vivify_584: set $S100, $P112 new $P113, 'String' set $P113, $S100 store_lex "$pirop", $P113 .annotate 'line', 681 $P0 = find_lex '$pirop' $S0 = $P0 $P0 = split '__', $S0 $S0 = join ' ', $P0 $P1737 = box $S0 store_lex "$pirop", $P1737 .annotate 'line', 688 find_lex $P112, "$past" find_lex $P113, "$pirop" $P112."pirop"($P113) .annotate 'line', 689 find_lex $P112, "$past" $P112."pasttype"("pirop") .annotate 'line', 690 find_lex $P112, "$/" find_lex $P113, "$past" $P114 = $P112."!make"($P113) .annotate 'line', 678 .return ($P114) control_1727: .local pmc exception .get_results (exception) getattribute $P112, exception, "payload" .return ($P112) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "args" :subid("103_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1741 .annotate 'line', 693 new $P1740, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1740, control_1739 push_eh $P1740 .lex "self", self .lex "$/", param_1741 find_lex $P110, "$/" find_lex $P1742, "$/" unless_null $P1742, vivify_585 $P1742 = root_new ['parrot';'Hash'] vivify_585: set $P111, $P1742["arglist"] unless_null $P111, vivify_586 new $P111, "Undef" vivify_586: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1739: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "arglist" :subid("104_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1746 .annotate 'line', 695 .const 'Sub' $P1753 = "105_1309998850.8808" capture_lex $P1753 new $P1745, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1745, control_1744 push_eh $P1745 .lex "self", self .lex "$/", param_1746 .annotate 'line', 696 new $P110, "Undef" set $P1747, $P110 .lex "$past", $P1747 .annotate 'line', 704 new $P111, "Undef" set $P1748, $P111 .lex "$i", $P1748 .annotate 'line', 705 new $P112, "Undef" set $P1749, $P112 .lex "$n", $P1749 .annotate 'line', 696 get_hll_global $P113, ["PAST"], "Op" find_lex $P114, "$/" $P115 = $P113."new"("call" :named("pasttype"), $P114 :named("node")) store_lex "$past", $P115 .annotate 'line', 697 find_lex $P1751, "$/" unless_null $P1751, vivify_587 $P1751 = root_new ['parrot';'Hash'] vivify_587: set $P113, $P1751["EXPR"] unless_null $P113, vivify_588 new $P113, "Undef" vivify_588: unless $P113, if_1750_end .const 'Sub' $P1753 = "105_1309998850.8808" capture_lex $P1753 $P1753() if_1750_end: .annotate 'line', 704 new $P113, "Integer" assign $P113, 0 store_lex "$i", $P113 .annotate 'line', 705 find_lex $P113, "$past" $P114 = $P113."list"() set $N100, $P114 new $P115, 'Float' set $P115, $N100 store_lex "$n", $P115 .annotate 'line', 706 new $P115, 'ExceptionHandler' set_label $P115, loop1774_handler $P115."handle_types"(.CONTROL_LOOP_NEXT, .CONTROL_LOOP_REDO, .CONTROL_LOOP_LAST) push_eh $P115 loop1774_test: find_lex $P113, "$i" set $N100, $P113 find_lex $P114, "$n" set $N101, $P114 islt $I100, $N100, $N101 unless $I100, loop1774_done loop1774_redo: .annotate 'line', 707 find_lex $P115, "$i" set $I101, $P115 find_lex $P1763, "$past" unless_null $P1763, vivify_592 $P1763 = root_new ['parrot';'ResizablePMCArray'] vivify_592: set $P117, $P1763[$I101] unless_null $P117, vivify_593 new $P117, "Undef" vivify_593: $S100 = $P117."name"() iseq $I102, $S100, "&prefix:<|>" unless $I102, if_1762_end .annotate 'line', 708 find_lex $P118, "$i" set $I103, $P118 find_lex $P1764, "$past" unless_null $P1764, vivify_594 $P1764 = root_new ['parrot';'ResizablePMCArray'] vivify_594: set $P1765, $P1764[$I103] unless_null $P1765, vivify_595 $P1765 = root_new ['parrot';'ResizablePMCArray'] vivify_595: set $P119, $P1765[0] unless_null $P119, vivify_596 new $P119, "Undef" vivify_596: find_lex $P120, "$i" set $I104, $P120 find_lex $P1766, "$past" unless_null $P1766, vivify_597 $P1766 = root_new ['parrot';'ResizablePMCArray'] store_lex "$past", $P1766 vivify_597: set $P1766[$I104], $P119 .annotate 'line', 709 find_lex $P118, "$i" set $I103, $P118 find_lex $P1767, "$past" unless_null $P1767, vivify_598 $P1767 = root_new ['parrot';'ResizablePMCArray'] vivify_598: set $P119, $P1767[$I103] unless_null $P119, vivify_599 new $P119, "Undef" vivify_599: $P119."flat"(1) .annotate 'line', 710 find_lex $P119, "$i" set $I103, $P119 find_lex $P1770, "$past" unless_null $P1770, vivify_600 $P1770 = root_new ['parrot';'ResizablePMCArray'] vivify_600: set $P120, $P1770[$I103] unless_null $P120, vivify_601 new $P120, "Undef" vivify_601: get_hll_global $P121, ["PAST"], "Val" $P122 = $P120."isa"($P121) if $P122, if_1769 set $P118, $P122 goto if_1769_end if_1769: .annotate 'line', 711 find_lex $P123, "$i" set $I104, $P123 find_lex $P1771, "$past" unless_null $P1771, vivify_602 $P1771 = root_new ['parrot';'ResizablePMCArray'] vivify_602: set $P124, $P1771[$I104] unless_null $P124, vivify_603 new $P124, "Undef" vivify_603: $S101 = $P124."name"() substr $S102, $S101, 0, 1 iseq $I105, $S102, "%" new $P118, 'Integer' set $P118, $I105 if_1769_end: unless $P118, if_1768_end .annotate 'line', 712 find_lex $P125, "$i" set $I106, $P125 find_lex $P1772, "$past" unless_null $P1772, vivify_604 $P1772 = root_new ['parrot';'ResizablePMCArray'] vivify_604: set $P127, $P1772[$I106] unless_null $P127, vivify_605 new $P127, "Undef" vivify_605: $P127."named"(1) if_1768_end: if_1762_end: .annotate 'line', 706 find_lex $P115, "$i" clone $P1773, $P115 inc $P115 loop1774_next: goto loop1774_test loop1774_handler: .local pmc exception .get_results (exception) getattribute $P117, exception, 'type' eq $P117, .CONTROL_LOOP_NEXT, loop1774_next eq $P117, .CONTROL_LOOP_REDO, loop1774_redo loop1774_done: pop_eh .annotate 'line', 717 find_lex $P113, "$/" find_lex $P114, "$past" $P115 = $P113."!make"($P114) .annotate 'line', 695 .return ($P115) control_1744: .local pmc exception .get_results (exception) getattribute $P113, exception, "payload" .return ($P113) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "_block1752" :anon :subid("105_1309998850.8808") :outer("104_1309998850.8808") .annotate 'line', 697 .const 'Sub' $P1759 = "106_1309998850.8808" capture_lex $P1759 .annotate 'line', 698 new $P114, "Undef" set $P1754, $P114 .lex "$expr", $P1754 find_lex $P1755, "$/" unless_null $P1755, vivify_589 $P1755 = root_new ['parrot';'Hash'] vivify_589: set $P115, $P1755["EXPR"] unless_null $P115, vivify_590 new $P115, "Undef" vivify_590: $P117 = $P115."ast"() store_lex "$expr", $P117 .annotate 'line', 699 find_lex $P118, "$expr" $S100 = $P118."name"() iseq $I100, $S100, "&infix:<,>" if $I100, if_1757 new $P117, 'Integer' set $P117, $I100 goto if_1757_end if_1757: find_lex $P119, "$expr" $P120 = $P119."named"() isfalse $I101, $P120 new $P117, 'Integer' set $P117, $I101 if_1757_end: if $P117, if_1756 .annotate 'line', 702 find_lex $P122, "$past" find_lex $P123, "$expr" $P124 = $P122."push"($P123) set $P115, $P124 .annotate 'line', 699 goto if_1756_end if_1756: .annotate 'line', 700 find_lex $P122, "$expr" $P123 = $P122."list"() defined $I102, $P123 unless $I102, for_undef_591 iter $P121, $P123 new $P125, 'ExceptionHandler' set_label $P125, loop1761_handler $P125."handle_types"(.CONTROL_LOOP_NEXT, .CONTROL_LOOP_REDO, .CONTROL_LOOP_LAST) push_eh $P125 loop1761_test: unless $P121, loop1761_done shift $P124, $P121 loop1761_redo: .const 'Sub' $P1759 = "106_1309998850.8808" capture_lex $P1759 $P1759($P124) loop1761_next: goto loop1761_test loop1761_handler: .local pmc exception .get_results (exception) getattribute $P127, exception, 'type' eq $P127, .CONTROL_LOOP_NEXT, loop1761_next eq $P127, .CONTROL_LOOP_REDO, loop1761_redo loop1761_done: pop_eh for_undef_591: .annotate 'line', 699 set $P115, $P121 if_1756_end: .annotate 'line', 697 .return ($P115) .end .namespace ["NQP";"Actions"] .sub "_block1758" :anon :subid("106_1309998850.8808") :outer("105_1309998850.8808") .param pmc param_1760 .annotate 'line', 700 .lex "$_", param_1760 find_lex $P125, "$past" find_lex $P127, "$_" $P128 = $P125."push"($P127) .return ($P128) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("107_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1778 .annotate 'line', 721 new $P1777, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1777, control_1776 push_eh $P1777 .lex "self", self .lex "$/", param_1778 find_lex $P110, "$/" find_lex $P1779, "$/" unless_null $P1779, vivify_606 $P1779 = root_new ['parrot';'Hash'] vivify_606: set $P111, $P1779["value"] unless_null $P111, vivify_607 new $P111, "Undef" vivify_607: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1776: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "circumfix:sym<( )>" :subid("108_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1783 .annotate 'line', 723 new $P1782, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1782, control_1781 push_eh $P1782 .lex "self", self .lex "$/", param_1783 .annotate 'line', 724 find_lex $P110, "$/" .annotate 'line', 725 find_lex $P1785, "$/" unless_null $P1785, vivify_608 $P1785 = root_new ['parrot';'Hash'] vivify_608: set $P112, $P1785["EXPR"] unless_null $P112, vivify_609 new $P112, "Undef" vivify_609: if $P112, if_1784 .annotate 'line', 726 get_hll_global $P115, ["PAST"], "Op" find_lex $P117, "$/" $P118 = $P115."new"("list" :named("pasttype"), $P117 :named("node")) set $P111, $P118 .annotate 'line', 725 goto if_1784_end if_1784: find_lex $P1786, "$/" unless_null $P1786, vivify_610 $P1786 = root_new ['parrot';'Hash'] vivify_610: set $P1787, $P1786["EXPR"] unless_null $P1787, vivify_611 $P1787 = root_new ['parrot';'ResizablePMCArray'] vivify_611: set $P113, $P1787[0] unless_null $P113, vivify_612 new $P113, "Undef" vivify_612: $P114 = $P113."ast"() set $P111, $P114 if_1784_end: $P119 = $P110."!make"($P111) .annotate 'line', 723 .return ($P119) control_1781: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "circumfix:sym<[ ]>" :subid("109_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1791 .annotate 'line', 729 new $P1790, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1790, control_1789 push_eh $P1790 .lex "self", self .lex "$/", param_1791 .annotate 'line', 730 new $P110, "Undef" set $P1792, $P110 .lex "$past", $P1792 .annotate 'line', 729 find_lex $P111, "$past" .annotate 'line', 731 find_lex $P1794, "$/" unless_null $P1794, vivify_613 $P1794 = root_new ['parrot';'Hash'] vivify_613: set $P111, $P1794["EXPR"] unless_null $P111, vivify_614 new $P111, "Undef" vivify_614: if $P111, if_1793 .annotate 'line', 738 get_hll_global $P112, ["PAST"], "Op" $P113 = $P112."new"("list" :named("pasttype")) store_lex "$past", $P113 .annotate 'line', 737 goto if_1793_end if_1793: .annotate 'line', 732 find_lex $P1795, "$/" unless_null $P1795, vivify_615 $P1795 = root_new ['parrot';'Hash'] vivify_615: set $P1796, $P1795["EXPR"] unless_null $P1796, vivify_616 $P1796 = root_new ['parrot';'ResizablePMCArray'] vivify_616: set $P112, $P1796[0] unless_null $P112, vivify_617 new $P112, "Undef" vivify_617: $P113 = $P112."ast"() store_lex "$past", $P113 .annotate 'line', 733 find_lex $P112, "$past" $S100 = $P112."name"() isne $I100, $S100, "&infix:<,>" unless $I100, if_1797_end .annotate 'line', 734 get_hll_global $P113, ["PAST"], "Op" find_lex $P114, "$past" $P115 = $P113."new"($P114, "list" :named("pasttype")) store_lex "$past", $P115 if_1797_end: if_1793_end: .annotate 'line', 740 find_lex $P111, "$past" $P111."name"("&circumfix:<[ ]>") .annotate 'line', 741 find_lex $P111, "$/" find_lex $P112, "$past" $P113 = $P111."!make"($P112) .annotate 'line', 729 .return ($P113) control_1789: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "circumfix:sym" :subid("110_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1801 .annotate 'line', 744 new $P1800, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1800, control_1799 push_eh $P1800 .lex "self", self .lex "$/", param_1801 find_lex $P110, "$/" find_lex $P1802, "$/" unless_null $P1802, vivify_618 $P1802 = root_new ['parrot';'Hash'] vivify_618: set $P111, $P1802["quote_EXPR"] unless_null $P111, vivify_619 new $P111, "Undef" vivify_619: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1799: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub unicode:"circumfix:sym<\x{ab} \x{bb}>" :subid("111_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1806 .annotate 'line', 745 new $P1805, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1805, control_1804 push_eh $P1805 .lex "self", self .lex "$/", param_1806 find_lex $P110, "$/" find_lex $P1807, "$/" unless_null $P1807, vivify_620 $P1807 = root_new ['parrot';'Hash'] vivify_620: set $P111, $P1807["quote_EXPR"] unless_null $P111, vivify_621 new $P111, "Undef" vivify_621: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1804: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "circumfix:sym<{ }>" :subid("112_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1811 .annotate 'line', 747 new $P1810, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1810, control_1809 push_eh $P1810 .lex "self", self .lex "$/", param_1811 .annotate 'line', 748 new $P110, "Undef" set $P1812, $P110 .lex "$past", $P1812 find_lex $P1814, "$/" unless_null $P1814, vivify_622 $P1814 = root_new ['parrot';'Hash'] vivify_622: set $P1815, $P1814["pblock"] unless_null $P1815, vivify_623 $P1815 = root_new ['parrot';'Hash'] vivify_623: set $P1816, $P1815["blockoid"] unless_null $P1816, vivify_624 $P1816 = root_new ['parrot';'Hash'] vivify_624: set $P1817, $P1816["statementlist"] unless_null $P1817, vivify_625 $P1817 = root_new ['parrot';'Hash'] vivify_625: set $P112, $P1817["statement"] unless_null $P112, vivify_626 new $P112, "Undef" vivify_626: set $N100, $P112 isgt $I100, $N100, 0.0 if $I100, if_1813 .annotate 'line', 750 $P115 = "vivitype"("%") set $P111, $P115 .annotate 'line', 748 goto if_1813_end if_1813: .annotate 'line', 749 find_lex $P1818, "$/" unless_null $P1818, vivify_627 $P1818 = root_new ['parrot';'Hash'] vivify_627: set $P113, $P1818["pblock"] unless_null $P113, vivify_628 new $P113, "Undef" vivify_628: $P114 = $P113."ast"() set $P111, $P114 if_1813_end: store_lex "$past", $P111 .annotate 'line', 751 new $P111, "Integer" assign $P111, 1 find_lex $P1819, "$past" unless_null $P1819, vivify_629 $P1819 = root_new ['parrot';'Hash'] store_lex "$past", $P1819 vivify_629: set $P1819["bareblock"], $P111 .annotate 'line', 752 find_lex $P111, "$/" find_lex $P112, "$past" $P113 = $P111."!make"($P112) .annotate 'line', 747 .return ($P113) control_1809: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "circumfix:sym" :subid("113_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1823 .annotate 'line', 755 new $P1822, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1822, control_1821 push_eh $P1822 .lex "self", self .lex "$/", param_1823 .annotate 'line', 756 new $P110, "Undef" set $P1824, $P110 .lex "$name", $P1824 find_lex $P1826, "$/" unless_null $P1826, vivify_630 $P1826 = root_new ['parrot';'Hash'] vivify_630: set $P112, $P1826["sigil"] unless_null $P112, vivify_631 new $P112, "Undef" vivify_631: set $S100, $P112 iseq $I100, $S100, "@" if $I100, if_1825 .annotate 'line', 757 find_lex $P1828, "$/" unless_null $P1828, vivify_632 $P1828 = root_new ['parrot';'Hash'] vivify_632: set $P115, $P1828["sigil"] unless_null $P115, vivify_633 new $P115, "Undef" vivify_633: set $S101, $P115 iseq $I101, $S101, "%" if $I101, if_1827 new $P118, "String" assign $P118, "item" set $P114, $P118 goto if_1827_end if_1827: new $P117, "String" assign $P117, "hash" set $P114, $P117 if_1827_end: set $P111, $P114 .annotate 'line', 756 goto if_1825_end if_1825: new $P113, "String" assign $P113, "list" set $P111, $P113 if_1825_end: store_lex "$name", $P111 .annotate 'line', 759 find_lex $P111, "$/" get_hll_global $P112, ["PAST"], "Op" find_lex $P113, "$name" find_lex $P1829, "$/" unless_null $P1829, vivify_634 $P1829 = root_new ['parrot';'Hash'] vivify_634: set $P114, $P1829["semilist"] unless_null $P114, vivify_635 new $P114, "Undef" vivify_635: $P115 = $P114."ast"() $P117 = $P112."new"($P115, "callmethod" :named("pasttype"), $P113 :named("name")) $P118 = $P111."!make"($P117) .annotate 'line', 755 .return ($P118) control_1821: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "semilist" :subid("114_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1833 .annotate 'line', 762 new $P1832, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1832, control_1831 push_eh $P1832 .lex "self", self .lex "$/", param_1833 find_lex $P110, "$/" find_lex $P1834, "$/" unless_null $P1834, vivify_636 $P1834 = root_new ['parrot';'Hash'] vivify_636: set $P111, $P1834["statement"] unless_null $P111, vivify_637 new $P111, "Undef" vivify_637: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1831: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "postcircumfix:sym<[ ]>" :subid("115_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1838 .annotate 'line', 764 new $P1837, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1837, control_1836 push_eh $P1837 .lex "self", self .lex "$/", param_1838 .annotate 'line', 765 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Var" find_lex $P1839, "$/" unless_null $P1839, vivify_638 $P1839 = root_new ['parrot';'Hash'] vivify_638: set $P112, $P1839["EXPR"] unless_null $P112, vivify_639 new $P112, "Undef" vivify_639: $P113 = $P112."ast"() .annotate 'line', 767 $P114 = "vivitype"("@") .annotate 'line', 765 $P115 = $P111."new"($P113, "keyed_int" :named("scope"), "Undef" :named("viviself"), $P114 :named("vivibase")) $P117 = $P110."!make"($P115) .annotate 'line', 764 .return ($P117) control_1836: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "postcircumfix:sym<{ }>" :subid("116_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1843 .annotate 'line', 770 new $P1842, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1842, control_1841 push_eh $P1842 .lex "self", self .lex "$/", param_1843 .annotate 'line', 771 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Var" find_lex $P1844, "$/" unless_null $P1844, vivify_640 $P1844 = root_new ['parrot';'Hash'] vivify_640: set $P112, $P1844["EXPR"] unless_null $P112, vivify_641 new $P112, "Undef" vivify_641: $P113 = $P112."ast"() .annotate 'line', 773 $P114 = "vivitype"("%") .annotate 'line', 771 $P115 = $P111."new"($P113, "keyed" :named("scope"), "Undef" :named("viviself"), $P114 :named("vivibase")) $P117 = $P110."!make"($P115) .annotate 'line', 770 .return ($P117) control_1841: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "postcircumfix:sym" :subid("117_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1848 .annotate 'line', 776 new $P1847, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1847, control_1846 push_eh $P1847 .lex "self", self .lex "$/", param_1848 .annotate 'line', 777 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Var" find_lex $P1849, "$/" unless_null $P1849, vivify_642 $P1849 = root_new ['parrot';'Hash'] vivify_642: set $P112, $P1849["quote_EXPR"] unless_null $P112, vivify_643 new $P112, "Undef" vivify_643: $P113 = $P112."ast"() .annotate 'line', 779 $P114 = "vivitype"("%") .annotate 'line', 777 $P115 = $P111."new"($P113, "keyed" :named("scope"), "Undef" :named("viviself"), $P114 :named("vivibase")) $P117 = $P110."!make"($P115) .annotate 'line', 776 .return ($P117) control_1846: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "postcircumfix:sym<( )>" :subid("118_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1853 .annotate 'line', 782 new $P1852, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1852, control_1851 push_eh $P1852 .lex "self", self .lex "$/", param_1853 .annotate 'line', 783 find_lex $P110, "$/" find_lex $P1854, "$/" unless_null $P1854, vivify_644 $P1854 = root_new ['parrot';'Hash'] vivify_644: set $P111, $P1854["arglist"] unless_null $P111, vivify_645 new $P111, "Undef" vivify_645: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .annotate 'line', 782 .return ($P113) control_1851: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "value" :subid("119_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1858 .annotate 'line', 786 new $P1857, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1857, control_1856 push_eh $P1857 .lex "self", self .lex "$/", param_1858 .annotate 'line', 787 find_lex $P110, "$/" find_lex $P1860, "$/" unless_null $P1860, vivify_646 $P1860 = root_new ['parrot';'Hash'] vivify_646: set $P112, $P1860["quote"] unless_null $P112, vivify_647 new $P112, "Undef" vivify_647: if $P112, if_1859 find_lex $P1862, "$/" unless_null $P1862, vivify_648 $P1862 = root_new ['parrot';'Hash'] vivify_648: set $P115, $P1862["number"] unless_null $P115, vivify_649 new $P115, "Undef" vivify_649: $P117 = $P115."ast"() set $P111, $P117 goto if_1859_end if_1859: find_lex $P1861, "$/" unless_null $P1861, vivify_650 $P1861 = root_new ['parrot';'Hash'] vivify_650: set $P113, $P1861["quote"] unless_null $P113, vivify_651 new $P113, "Undef" vivify_651: $P114 = $P113."ast"() set $P111, $P114 if_1859_end: $P118 = $P110."!make"($P111) .annotate 'line', 786 .return ($P118) control_1856: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "number" :subid("120_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1866 .annotate 'line', 790 new $P1865, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1865, control_1864 push_eh $P1865 .lex "self", self .lex "$/", param_1866 .annotate 'line', 791 new $P110, "Undef" set $P1867, $P110 .lex "$value", $P1867 find_lex $P1869, "$/" unless_null $P1869, vivify_652 $P1869 = root_new ['parrot';'Hash'] vivify_652: set $P112, $P1869["dec_number"] unless_null $P112, vivify_653 new $P112, "Undef" vivify_653: if $P112, if_1868 find_lex $P1871, "$/" unless_null $P1871, vivify_654 $P1871 = root_new ['parrot';'Hash'] vivify_654: set $P115, $P1871["integer"] unless_null $P115, vivify_655 new $P115, "Undef" vivify_655: $P117 = $P115."ast"() set $P111, $P117 goto if_1868_end if_1868: find_lex $P1870, "$/" unless_null $P1870, vivify_656 $P1870 = root_new ['parrot';'Hash'] vivify_656: set $P113, $P1870["dec_number"] unless_null $P113, vivify_657 new $P113, "Undef" vivify_657: $P114 = $P113."ast"() set $P111, $P114 if_1868_end: store_lex "$value", $P111 .annotate 'line', 792 find_lex $P1873, "$/" unless_null $P1873, vivify_658 $P1873 = root_new ['parrot';'Hash'] vivify_658: set $P111, $P1873["sign"] unless_null $P111, vivify_659 new $P111, "Undef" vivify_659: set $S100, $P111 iseq $I100, $S100, "-" unless $I100, if_1872_end find_lex $P112, "$value" neg $P113, $P112 store_lex "$value", $P113 if_1872_end: .annotate 'line', 793 find_lex $P111, "$/" get_hll_global $P112, ["PAST"], "Val" find_lex $P113, "$value" $P114 = $P112."new"($P113 :named("value")) $P115 = $P111."!make"($P114) .annotate 'line', 790 .return ($P115) control_1864: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "quote:sym" :subid("121_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1877 .annotate 'line', 796 new $P1876, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1876, control_1875 push_eh $P1876 .lex "self", self .lex "$/", param_1877 find_lex $P110, "$/" find_lex $P1878, "$/" unless_null $P1878, vivify_660 $P1878 = root_new ['parrot';'Hash'] vivify_660: set $P111, $P1878["quote_EXPR"] unless_null $P111, vivify_661 new $P111, "Undef" vivify_661: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1875: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "quote:sym" :subid("122_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1882 .annotate 'line', 797 new $P1881, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1881, control_1880 push_eh $P1881 .lex "self", self .lex "$/", param_1882 find_lex $P110, "$/" find_lex $P1883, "$/" unless_null $P1883, vivify_662 $P1883 = root_new ['parrot';'Hash'] vivify_662: set $P111, $P1883["quote_EXPR"] unless_null $P111, vivify_663 new $P111, "Undef" vivify_663: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1880: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "quote:sym" :subid("123_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1887 .annotate 'line', 798 new $P1886, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1886, control_1885 push_eh $P1886 .lex "self", self .lex "$/", param_1887 find_lex $P110, "$/" find_lex $P1888, "$/" unless_null $P1888, vivify_664 $P1888 = root_new ['parrot';'Hash'] vivify_664: set $P111, $P1888["quote_EXPR"] unless_null $P111, vivify_665 new $P111, "Undef" vivify_665: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1885: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "quote:sym" :subid("124_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1892 .annotate 'line', 799 new $P1891, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1891, control_1890 push_eh $P1891 .lex "self", self .lex "$/", param_1892 find_lex $P110, "$/" find_lex $P1893, "$/" unless_null $P1893, vivify_666 $P1893 = root_new ['parrot';'Hash'] vivify_666: set $P111, $P1893["quote_EXPR"] unless_null $P111, vivify_667 new $P111, "Undef" vivify_667: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1890: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "quote:sym" :subid("125_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1897 .annotate 'line', 800 new $P1896, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1896, control_1895 push_eh $P1896 .lex "self", self .lex "$/", param_1897 find_lex $P110, "$/" find_lex $P1898, "$/" unless_null $P1898, vivify_668 $P1898 = root_new ['parrot';'Hash'] vivify_668: set $P111, $P1898["quote_EXPR"] unless_null $P111, vivify_669 new $P111, "Undef" vivify_669: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1895: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "quote:sym" :subid("126_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1902 .annotate 'line', 801 new $P1901, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1901, control_1900 push_eh $P1901 .lex "self", self .lex "$/", param_1902 .annotate 'line', 802 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Op" find_lex $P1903, "$/" unless_null $P1903, vivify_670 $P1903 = root_new ['parrot';'Hash'] vivify_670: set $P112, $P1903["quote_EXPR"] unless_null $P112, vivify_671 new $P112, "Undef" vivify_671: $P113 = $P112."ast"() $P114 = $P113."value"() find_lex $P115, "$/" $P117 = $P111."new"($P114 :named("inline"), "inline" :named("pasttype"), $P115 :named("node")) $P118 = $P110."!make"($P117) .annotate 'line', 801 .return ($P118) control_1900: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "quote:sym" :subid("127_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1907 .param pmc param_1908 :optional .param int has_param_1908 :opt_flag .annotate 'line', 807 new $P1906, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1906, control_1905 push_eh $P1906 .lex "self", self .lex "$/", param_1907 if has_param_1908, optparam_672 new $P110, "Undef" set param_1908, $P110 optparam_672: .lex "$key", param_1908 .annotate 'line', 817 new $P111, "Undef" set $P1909, $P111 .lex "$regex", $P1909 .annotate 'line', 819 new $P112, "Undef" set $P1910, $P112 .lex "$past", $P1910 .annotate 'line', 808 find_lex $P113, "$key" set $S100, $P113 iseq $I100, $S100, "open" unless $I100, if_1911_end .annotate 'line', 809 null $P0 set_hll_global ['Regex';'P6Regex';'Actions'], '$REGEXNAME', $P0 .annotate 'line', 813 get_global $P1912, "@BLOCK" unless_null $P1912, vivify_673 $P1912 = root_new ['parrot';'ResizablePMCArray'] vivify_673: set $P114, $P1912[0] unless_null $P114, vivify_674 new $P114, "Undef" vivify_674: $P114."symbol"(unicode:"$\x{a2}", "lexical" :named("scope")) .annotate 'line', 814 get_global $P1913, "@BLOCK" unless_null $P1913, vivify_675 $P1913 = root_new ['parrot';'ResizablePMCArray'] vivify_675: set $P114, $P1913[0] unless_null $P114, vivify_676 new $P114, "Undef" vivify_676: $P114."symbol"("$/", "lexical" :named("scope")) .annotate 'line', 815 new $P114, "Exception" set $P114['type'], .CONTROL_RETURN new $P115, "Integer" assign $P115, 0 setattribute $P114, 'payload', $P115 throw $P114 if_1911_end: .annotate 'line', 818 get_hll_global $P113, ["Regex";"P6Regex";"Actions"], "buildsub" find_lex $P1914, "$/" unless_null $P1914, vivify_677 $P1914 = root_new ['parrot';'Hash'] vivify_677: set $P114, $P1914["p6regex"] unless_null $P114, vivify_678 new $P114, "Undef" vivify_678: $P115 = $P114."ast"() get_global $P117, "@BLOCK" $P118 = $P117."shift"() $P119 = $P113($P115, $P118) store_lex "$regex", $P119 .annotate 'line', 820 get_hll_global $P113, ["PAST"], "Op" .annotate 'line', 822 get_hll_global $P114, ["PAST"], "Var" new $P115, "ResizablePMCArray" push $P115, "Regex" $P117 = $P114."new"("Regex" :named("name"), $P115 :named("namespace"), "package" :named("scope")) find_lex $P118, "$regex" $P119 = $P113."new"($P117, $P118, "callmethod" :named("pasttype"), "new" :named("name")) .annotate 'line', 820 store_lex "$past", $P119 .annotate 'line', 826 find_lex $P113, "$regex" find_lex $P1915, "$past" unless_null $P1915, vivify_679 $P1915 = root_new ['parrot';'Hash'] store_lex "$past", $P1915 vivify_679: set $P1915["sink"], $P113 .annotate 'line', 827 find_lex $P113, "$/" find_lex $P114, "$past" $P115 = $P113."!make"($P114) .annotate 'line', 807 .return ($P115) control_1905: .local pmc exception .get_results (exception) getattribute $P113, exception, "payload" .return ($P113) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "quote_escape:sym<$>" :subid("128_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1919 .annotate 'line', 830 new $P1918, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1918, control_1917 push_eh $P1918 .lex "self", self .lex "$/", param_1919 find_lex $P110, "$/" find_lex $P1920, "$/" unless_null $P1920, vivify_680 $P1920 = root_new ['parrot';'Hash'] vivify_680: set $P111, $P1920["variable"] unless_null $P111, vivify_681 new $P111, "Undef" vivify_681: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1917: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "quote_escape:sym<{ }>" :subid("129_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1924 .annotate 'line', 831 new $P1923, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1923, control_1922 push_eh $P1923 .lex "self", self .lex "$/", param_1924 .annotate 'line', 832 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Op" .annotate 'line', 833 find_lex $P1925, "$/" unless_null $P1925, vivify_682 $P1925 = root_new ['parrot';'Hash'] vivify_682: set $P112, $P1925["block"] unless_null $P112, vivify_683 new $P112, "Undef" vivify_683: $P113 = $P112."ast"() $P114 = "block_immediate"($P113) find_lex $P115, "$/" $P117 = $P111."new"($P114, "set S*" :named("pirop"), $P115 :named("node")) .annotate 'line', 832 $P118 = $P110."!make"($P117) .annotate 'line', 831 .return ($P118) control_1922: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "quote_escape:sym" :subid("130_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1929 .annotate 'line', 836 new $P1928, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1928, control_1927 push_eh $P1928 .lex "self", self .lex "$/", param_1929 find_lex $P110, "$/" $P111 = $P110."!make"("\e") .return ($P111) control_1927: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "postfix:sym<.>" :subid("131_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1933 .annotate 'line', 840 new $P1932, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1932, control_1931 push_eh $P1932 .lex "self", self .lex "$/", param_1933 find_lex $P110, "$/" find_lex $P1934, "$/" unless_null $P1934, vivify_684 $P1934 = root_new ['parrot';'Hash'] vivify_684: set $P111, $P1934["dotty"] unless_null $P111, vivify_685 new $P111, "Undef" vivify_685: $P112 = $P111."ast"() $P113 = $P110."!make"($P112) .return ($P113) control_1931: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "postfix:sym<++>" :subid("132_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1938 .annotate 'line', 842 new $P1937, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1937, control_1936 push_eh $P1937 .lex "self", self .lex "$/", param_1938 .annotate 'line', 843 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Op" .annotate 'line', 844 new $P112, "ResizablePMCArray" push $P112, " clone %r, %0" push $P112, " inc %0" .annotate 'line', 843 $P113 = $P111."new"("postfix:<++>" :named("name"), $P112 :named("inline"), "inline" :named("pasttype")) $P114 = $P110."!make"($P113) .annotate 'line', 842 .return ($P114) control_1936: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "postfix:sym<-->" :subid("133_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1942 .annotate 'line', 848 new $P1941, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1941, control_1940 push_eh $P1941 .lex "self", self .lex "$/", param_1942 .annotate 'line', 849 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Op" .annotate 'line', 850 new $P112, "ResizablePMCArray" push $P112, " clone %r, %0" push $P112, " dec %0" .annotate 'line', 849 $P113 = $P111."new"("postfix:<-->" :named("name"), $P112 :named("inline"), "inline" :named("pasttype")) $P114 = $P110."!make"($P113) .annotate 'line', 848 .return ($P114) control_1940: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "prefix:sym" :subid("134_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1946 .annotate 'line', 854 new $P1945, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1945, control_1944 push_eh $P1945 .lex "self", self .lex "$/", param_1946 .annotate 'line', 855 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Op" .annotate 'line', 856 get_hll_global $P112, ["PAST"], "Var" $P113 = $P112."new"("$/" :named("name"), "contextual" :named("scope")) find_lex $P114, "$/" $P115 = $P111."new"($P113, "callmethod" :named("pasttype"), "!make" :named("name"), $P114 :named("node")) .annotate 'line', 855 $P117 = $P110."!make"($P115) .annotate 'line', 854 .return ($P117) control_1944: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("135_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1950 .annotate 'line', 872 new $P1949, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1949, control_1948 push_eh $P1949 .lex "self", self .lex "$/", param_1950 find_lex $P110, "$/" $P111 = "control"($P110, "CONTROL_LOOP_NEXT") .return ($P111) control_1948: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("136_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1954 .annotate 'line', 873 new $P1953, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1953, control_1952 push_eh $P1953 .lex "self", self .lex "$/", param_1954 find_lex $P110, "$/" $P111 = "control"($P110, "CONTROL_LOOP_LAST") .return ($P111) control_1952: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "term:sym" :subid("137_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1958 .annotate 'line', 874 new $P1957, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1957, control_1956 push_eh $P1957 .lex "self", self .lex "$/", param_1958 find_lex $P110, "$/" $P111 = "control"($P110, "CONTROL_LOOP_REDO") .return ($P111) control_1956: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"Actions"] .include "except_types.pasm" .sub "infix:sym<~~>" :subid("138_1309998850.8808") :method :outer("11_1309998850.8808") .param pmc param_1962 .annotate 'line', 876 new $P1961, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1961, control_1960 push_eh $P1961 .lex "self", self .lex "$/", param_1962 .annotate 'line', 877 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Op" find_lex $P112, "$/" $P113 = $P111."new"("callmethod" :named("pasttype"), "ACCEPTS" :named("name"), $P112 :named("node")) $P114 = $P110."!make"($P113) .annotate 'line', 876 .return ($P114) control_1960: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"RegexActions"] .sub "_block1963" :subid("139_1309998850.8808") :outer("11_1309998850.8808") .annotate 'line', 881 .const 'Sub' $P1997 = "146_1309998850.8808" capture_lex $P1997 .const 'Sub' $P1992 = "145_1309998850.8808" capture_lex $P1992 .const 'Sub' $P1986 = "144_1309998850.8808" capture_lex $P1986 .const 'Sub' $P1981 = "143_1309998850.8808" capture_lex $P1981 .const 'Sub' $P1976 = "142_1309998850.8808" capture_lex $P1976 .const 'Sub' $P1971 = "141_1309998850.8808" capture_lex $P1971 .const 'Sub' $P1965 = "140_1309998850.8808" capture_lex $P1965 .annotate 'line', 915 .const 'Sub' $P1997 = "146_1309998850.8808" newclosure $P2004, $P1997 .annotate 'line', 881 .return ($P2004) .end .namespace ["NQP";"RegexActions"] .include "except_types.pasm" .sub "metachar:sym<:my>" :subid("140_1309998850.8808") :method :outer("139_1309998850.8808") .param pmc param_1968 .annotate 'line', 883 new $P1967, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1967, control_1966 push_eh $P1967 .lex "self", self .lex "$/", param_1968 .annotate 'line', 884 new $P110, "Undef" set $P1969, $P110 .lex "$past", $P1969 find_lex $P1970, "$/" unless_null $P1970, vivify_686 $P1970 = root_new ['parrot';'Hash'] vivify_686: set $P111, $P1970["statement"] unless_null $P111, vivify_687 new $P111, "Undef" vivify_687: $P112 = $P111."ast"() store_lex "$past", $P112 .annotate 'line', 885 find_lex $P111, "$/" get_hll_global $P112, ["PAST"], "Regex" find_lex $P113, "$past" find_lex $P114, "$/" $P115 = $P112."new"($P113, "pastnode" :named("pasttype"), "declarative" :named("subtype"), $P114 :named("node")) $P117 = $P111."!make"($P115) .annotate 'line', 883 .return ($P117) control_1966: .local pmc exception .get_results (exception) getattribute $P111, exception, "payload" .return ($P111) .end .namespace ["NQP";"RegexActions"] .include "except_types.pasm" .sub "metachar:sym<{ }>" :subid("141_1309998850.8808") :method :outer("139_1309998850.8808") .param pmc param_1974 .annotate 'line', 889 new $P1973, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1973, control_1972 push_eh $P1973 .lex "self", self .lex "$/", param_1974 .annotate 'line', 890 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Regex" find_lex $P1975, "$/" unless_null $P1975, vivify_688 $P1975 = root_new ['parrot';'Hash'] vivify_688: set $P112, $P1975["codeblock"] unless_null $P112, vivify_689 new $P112, "Undef" vivify_689: $P113 = $P112."ast"() find_lex $P114, "$/" $P115 = $P111."new"($P113, "pastnode" :named("pasttype"), $P114 :named("node")) $P117 = $P110."!make"($P115) .annotate 'line', 889 .return ($P117) control_1972: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"RegexActions"] .include "except_types.pasm" .sub "metachar:sym" :subid("142_1309998850.8808") :method :outer("139_1309998850.8808") .param pmc param_1979 .annotate 'line', 894 new $P1978, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1978, control_1977 push_eh $P1978 .lex "self", self .lex "$/", param_1979 .annotate 'line', 895 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Regex" find_lex $P1980, "$/" unless_null $P1980, vivify_690 $P1980 = root_new ['parrot';'Hash'] vivify_690: set $P112, $P1980["var"] unless_null $P112, vivify_691 new $P112, "Undef" vivify_691: $P113 = $P112."ast"() find_lex $P114, "$/" $P115 = $P111."new"("!INTERPOLATE", $P113, "subrule" :named("pasttype"), "method" :named("subtype"), $P114 :named("node")) $P117 = $P110."!make"($P115) .annotate 'line', 894 .return ($P117) control_1977: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"RegexActions"] .include "except_types.pasm" .sub "assertion:sym<{ }>" :subid("143_1309998850.8808") :method :outer("139_1309998850.8808") .param pmc param_1984 .annotate 'line', 899 new $P1983, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1983, control_1982 push_eh $P1983 .lex "self", self .lex "$/", param_1984 .annotate 'line', 900 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Regex" find_lex $P1985, "$/" unless_null $P1985, vivify_692 $P1985 = root_new ['parrot';'Hash'] vivify_692: set $P112, $P1985["codeblock"] unless_null $P112, vivify_693 new $P112, "Undef" vivify_693: $P113 = $P112."ast"() find_lex $P114, "$/" $P115 = $P111."new"("!INTERPOLATE_REGEX", $P113, "subrule" :named("pasttype"), "method" :named("subtype"), $P114 :named("node")) $P117 = $P110."!make"($P115) .annotate 'line', 899 .return ($P117) control_1982: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"RegexActions"] .include "except_types.pasm" .sub "assertion:sym" :subid("144_1309998850.8808") :method :outer("139_1309998850.8808") .param pmc param_1989 .annotate 'line', 904 new $P1988, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1988, control_1987 push_eh $P1988 .lex "self", self .lex "$/", param_1989 .annotate 'line', 905 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Regex" find_lex $P1990, "$/" unless_null $P1990, vivify_694 $P1990 = root_new ['parrot';'Hash'] vivify_694: set $P112, $P1990["codeblock"] unless_null $P112, vivify_695 new $P112, "Undef" vivify_695: $P113 = $P112."ast"() .annotate 'line', 906 find_lex $P1991, "$/" unless_null $P1991, vivify_696 $P1991 = root_new ['parrot';'Hash'] vivify_696: set $P114, $P1991["zw"] unless_null $P114, vivify_697 new $P114, "Undef" vivify_697: set $S100, $P114 iseq $I100, $S100, "!" .annotate 'line', 905 find_lex $P115, "$/" $P117 = $P111."new"($P113, "zerowidth" :named("subtype"), $I100 :named("negate"), "pastnode" :named("pasttype"), $P115 :named("node")) $P118 = $P110."!make"($P117) .annotate 'line', 904 .return ($P118) control_1987: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"RegexActions"] .include "except_types.pasm" .sub "assertion:sym" :subid("145_1309998850.8808") :method :outer("139_1309998850.8808") .param pmc param_1995 .annotate 'line', 910 new $P1994, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1994, control_1993 push_eh $P1994 .lex "self", self .lex "$/", param_1995 .annotate 'line', 911 find_lex $P110, "$/" get_hll_global $P111, ["PAST"], "Regex" find_lex $P1996, "$/" unless_null $P1996, vivify_698 $P1996 = root_new ['parrot';'Hash'] vivify_698: set $P112, $P1996["var"] unless_null $P112, vivify_699 new $P112, "Undef" vivify_699: $P113 = $P112."ast"() find_lex $P114, "$/" $P115 = $P111."new"("!INTERPOLATE_REGEX", $P113, "subrule" :named("pasttype"), "method" :named("subtype"), $P114 :named("node")) $P117 = $P110."!make"($P115) .annotate 'line', 910 .return ($P117) control_1993: .local pmc exception .get_results (exception) getattribute $P110, exception, "payload" .return ($P110) .end .namespace ["NQP";"RegexActions"] .include "except_types.pasm" .sub "codeblock" :subid("146_1309998850.8808") :method :outer("139_1309998850.8808") .param pmc param_2000 .annotate 'line', 915 new $P1999, ['ExceptionHandler'], .CONTROL_RETURN set_label $P1999, control_1998 push_eh $P1999 .lex "self", self .lex "$/", param_2000 .annotate 'line', 916 new $P110, "Undef" set $P2001, $P110 .lex "$block", $P2001 .annotate 'line', 918 new $P111, "Undef" set $P2002, $P111 .lex "$past", $P2002 .annotate 'line', 916 find_lex $P2003, "$/" unless_null $P2003, vivify_700 $P2003 = root_new ['parrot';'Hash'] vivify_700: set $P112, $P2003["block"] unless_null $P112, vivify_701 new $P112, "Undef" vivify_701: $P113 = $P112."ast"() store_lex "$block", $P113 .annotate 'line', 917 find_lex $P112, "$block" $P112."blocktype"("immediate") .annotate 'line', 919 get_hll_global $P112, ["PAST"], "Stmts" .annotate 'line', 920 get_hll_global $P113, ["PAST"], "Op" .annotate 'line', 921 get_hll_global $P114, ["PAST"], "Var" $P115 = $P114."new"("$/" :named("name")) .annotate 'line', 922 get_hll_global $P117, ["PAST"], "Op" .annotate 'line', 923 get_hll_global $P118, ["PAST"], "Var" $P119 = $P118."new"(unicode:"$\x{a2}" :named("name")) $P120 = $P117."new"($P119, "MATCH" :named("name"), "callmethod" :named("pasttype")) .annotate 'line', 922 $P121 = $P113."new"($P115, $P120, "bind" :named("pasttype")) .annotate 'line', 920 find_lex $P122, "$block" $P123 = $P112."new"($P121, $P122) .annotate 'line', 919 store_lex "$past", $P123 .annotate 'line', 931 find_lex $P112, "$/" find_lex $P113, "$past" $P114 = $P112."!make"($P113) .annotate 'line', 915 .return ($P114) control_1998: .local pmc exception .get_results (exception) getattribute $P112, exception, "payload" .return ($P112) .end .namespace ["NQP";"Actions"] .sub "_block2005" :load :anon :subid("147_1309998850.8808") .annotate 'line', 3 .const 'Sub' $P2007 = "11_1309998850.8808" $P111 = $P2007() .return ($P111) .end .namespace [] .sub "_block2013" :load :anon :subid("149_1309998850.8808") .annotate 'line', 1 .const 'Sub' $P2015 = "10_1309998850.8808" $P100 = $P2015() .return ($P100) .end ### .include 'src/cheats/nqp-builtins.pir' .namespace [] .sub 'print' .param pmc list :slurpy .local pmc list_it list_it = iter list list_loop: unless list_it goto list_done $P0 = shift list_it print $P0 goto list_loop list_done: .return (1) .end .sub 'say' .param pmc list :slurpy .tailcall 'print'(list :flat, "\n") .end .sub 'ok' .param pmc condition .param string description :optional .param int has_desc :opt_flag if condition goto it_was_ok print "not " it_was_ok: print "ok " $P0 = get_global "$test_counter" $P0 += 1 print $P0 unless has_desc goto no_description print " # " print description no_description: print "\n" .return (1) .end .sub 'plan' .param int quantity print "1.." print quantity print "\n" .end .sub '' :anon :init :load $P0 = box 0 set_global '$test_counter', $P0 .end .namespace ['NQP';'Compiler'] .sub '' :anon :load :init .local pmc p6meta, nqpproto p6meta = get_hll_global 'P6metaclass' nqpproto = p6meta.'new_class'('NQP::Compiler', 'parent'=>'HLL::Compiler') nqpproto.'language'('NQP-rx') $P0 = get_hll_global ['NQP'], 'Grammar' nqpproto.'parsegrammar'($P0) $P0 = get_hll_global ['NQP'], 'Actions' nqpproto.'parseactions'($P0) $P0 = getattribute nqpproto, '@cmdoptions' push $P0, 'parsetrace' .end .sub 'main' :main .param pmc args_str $P0 = compreg 'NQP-rx' $P1 = $P0.'command_line'(args_str, 'encoding'=>'utf8', 'transcode'=>'ascii iso-8859-1') exit 0 .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: sparc.h000644000765000765 504212101554067 20202 0ustar00brucebruce000000000000parrot-5.9.0/include/parrot/atomic/* atomic/sparc.h * Copyright (C) 2006-2008, Parrot Foundation. * Overview: * This header provides an implementation of atomic * operations on Sparc V8plus and better platforms. * It relies on an assembler file. * Data Structure and Algorithms: * History: * Notes: * References: */ #ifndef PARROT_ATOMIC_SPARC_H_GUARD #define PARROT_ATOMIC_SPARC_H_GUARD extern int parrot_sparc_cas32(Parrot_UInt4 *value, Parrot_UInt4 old, Parrot_UInt4 new); /* NB cas64 _will_ be broken when PTR_SIZE == 4 */ #if PTR_SIZE == 8 # if INTVAL_SIZE != 8 # error Expected 8-byte wide INTVAL. # endif extern int parrot_sparc_cas64(INTVAL *value, INTVAL old, INTVAL new); #endif typedef struct Parrot_atomic_pointer { void * volatile val; } Parrot_atomic_pointer; #define PARROT_ATOMIC_PTR_GET(result, a) ((result) = (a).val) #define PARROT_ATOMIC_PTR_SET(a, b) ((a).val = (b)) #if PTR_SIZE == 8 # define PARROT_ATOMIC_PTR_CAS(result, a, expect, update) \ do { \ (result) = parrot_sparc_cas64((INTVAL *) &(a).val, \ (INTVAL) (expect), (INTVAL) (update)); \ } while (0) #else # define PARROT_ATOMIC_PTR_CAS(result, a, expect, update) \ do { \ (result) = parrot_sparc_cas32((Parrot_UInt4 *) &(a).val, \ (Parrot_UInt4) (expect), (Parrot_UInt4) (update)); \ } while (0) #endif #define PARROT_ATOMIC_PTR_INIT(a) #define PARROT_ATOMIC_PTR_DESTROY(a) typedef struct Parrot_atomic_integer { volatile Parrot_Int4 val; } Parrot_atomic_integer; #define PARROT_ATOMIC_INT_INIT(a) #define PARROT_ATOMIC_INT_DESTROY(a) #define PARROT_ATOMIC_INT_GET(result, a) ((result) = (a).val) #define PARROT_ATOMIC_INT_SET(a, b) ((a).val = (b)) #define PARROT_ATOMIC_INT_CAS(result, a, expect, update) \ do { \ (result) = parrot_sparc_cas32((Parrot_UInt4*) &(a).val, \ (Parrot_UInt4) (expect), (Parrot_UInt4) (update)); \ } while (0) #define parrot_sparc_atomic_int_add(result, a, what) \ do { \ int successp; \ Parrot_Int4 old; \ do { \ old = (a).val; \ PARROT_ATOMIC_INT_CAS(successp, (a), old, old + (what)); \ } while (!successp); \ (result) = (old) + (what); \ } while (0) #define PARROT_ATOMIC_INT_DEC(result, a) parrot_sparc_atomic_int_add((result), (a), -1) #define PARROT_ATOMIC_INT_INC(result, a) parrot_sparc_atomic_int_add((result), (a), 1) #endif /* PARROT_ATOMIC_SPARC_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ pdd25_concurrency.pod000644000765000765 3675312101554066 20465 0ustar00brucebruce000000000000parrot-5.9.0/docs/pdds# Copyright (C) 2001-2012, Parrot Foundation. =head1 PDD 25: Concurrency =head2 Abstract This document defines the requirements and implementation strategy for Parrot's concurrency models. =head2 Description =over 4 =item - Parrot supports multiple concurrency models, including green threads, Windows threads, POSIX threads, event-based programming, and asynchronous I/O. =item - A concurrency scheduler manages all concurrent tasks. =item - Each interpreter has its own concurrency scheduler. =item - Concurrency schedulers for different interpreters communicate and can share tasks. =item - A concurrency scheduler may link to other schedulers as a parent, a child, or an equal. =item - A task is a concurrent unit of work. =item - All tasks support a standard interface used by the concurrency scheduler, but otherwise have a great deal of flexibility in their implementation. =item - Tasks can share PMC variables. =back =head2 Definitions Concurrency is a parallel execution of units of code (on multiprocessor machines), or a flexible ordering of serial units of code (on single processor machines). For certain problem spaces, concurrency offers significant speed gains by parceling out processor-intensive activity or by ensuring that a wait for input or system resources doesn't hold up the entire application. A task is a unit of code that can be executed concurrently. =head2 Implementation Rather than defining a single canonical threading model, Parrot defines an infrastructure that supports multiple concurrency models and provides for interaction between the various models. Parrot already uses multiple concurrency models for events, threads, async I/O, and exceptions, a trend that will only continue as we support multiple HLLs and external threading libraries. Designing for multiple concurrency models also gives Parrot more room to grow as future models are researched and developed. To avoid conflicts between concurrency models, Parrot provides a single central concurrency scheduler for each interpreter instance. Each concurrency model defines a Task PMC that supports a standard minimal interface. The scheduler can interact with tasks from different models without direct access to the details of each model. On multiprocessor systems, the scheduler is responsible for allocating tasks to processors by delegating that allocation to native OS threads. For the most part, when we talk about concurrency, we mean concurrency across an interpreter pool. An interpreter pool is a set of interpreter instances that share common resources: the memory pools, arenas, and global namespace--pretty much everything except what's in the interpreter structure itself. They're essentially threads in the OS sense and implemented as OS threads. Another form of concurrency is between completely independent interpreter instances, each with their own memory pools, arenas, namespaces, etc. Independent interpreters may run as separate processes on the same machine, or even as separate processes on different machines (in a clustering environment, for example). The concerns of shared-interpreter concurrency and independent-interpreter concurrency are similar, and in Parrot both use the same central concurrency scheduler. This PDD doesn't directly address independent-interpreter concurrency, but does include occasional notes on how it integrates with shared-interpreter concurrency. =head3 Supported Concurrency Models The following are a few of the concurrency models Parrot intends to support. The biggest differences between them are in how they handle variables shared across concurrent tasks. But the design is such that each of the different models can run simultaneously, coordinated through the central concurrency scheduler. =head4 Mutex/Lock Concurrency In this model, before performing an operation on a shared variable, you must first acquire a lock on it. Once a lock is acquired, any other concurrent tasks that attempt to acquire a lock on that variable will block until the existing lock is released. A mutex is a thing that can be locked. They are not directly exposed to users. They're non-recursive, non-read/write, exclusive things. When a concurrent task gets a mutex, any other attempt to get that mutex will block until the owning task releases the mutex. Mutexes are implemented using the platform-native lock construct. The first thing that any vtable function of a shared PMC must do is to acquire the mutex of the PMCs in its parameter list (in ascending address order). In this model only PMCs can be shared. =head4 STM Concurrency Older Parrot's preferred a model of concurrency based on Software Transactional Memory. In this model, rather than locking a shared variable while performing a series of operations on it, the changes are bundled into a transaction that acts as an atomic unit. Within the transaction, STM creates a "hypothetical" copy of the variable, logs the changes made to that copy, and at the end of the transaction performs some validation steps to decide whether to save the hypothetical value back to the real variable (a commit) or discard the hypothetical value (a roll back). One common validation step is to check whether the value of the real variable was changed during the execution of the transaction (possibly by another concurrent task). STM tasks can read/write shared variables from mutex/lock tasks, as they appear to the mutex/lock task as a single atomic operation. Mutex/lock tasks can read shared variables from STM tasks, but they cannot write them, as the STM tasks will not respect the lock and may commit a new value in the middle of a complex operation that requires the lock. As a safety mode, STM tasks may be configured to fail validation on any transaction attempting to commit to a variable locked by a mutex/lock task. =head4 Intel Threading Building Blocks Threading Building Blocks (TBB) is a library of tools for data-parallel programming, dividing large data sets into small pieces so that operations on those data-sets can be parallelized across multiple processors. Parrot might provide two levels of integration with TBB: an interface for TBB's scheduling to interact with the central concurrency scheduler, and an interface for developers to access the TBB routines from within PIR/PASM. Like Parrot, TBB is task-based. Since TBB performs its own scheduling, TBB tasks in Parrot will be given a lightweight scheduler that only has the responsibility of passing messages, events, etc, back and forth between the TBB task and the central scheduler. TBB tasks will not share variables with any other types of concurrent tasks in Parrot. Note that since TBB is a C++ library, it is only available when Parrot is compiled with a C++ compiler. =head4 POSIX Concurrency This is the POSIX "share-everything" style of threading, such as is used in Perl 5's "pthread" model, as well as the thread models for Ruby and Python. [Recommended reading: "Programming with POSIX Threads" by Dave Butenhof.] =head4 Process-type Concurrency This is the Perl 5 "iThreads" threading model. In this model no data is shared implicitly, and all sharing must be done on purpose and explicitly. It resembles the Unix fork process with shared memory segment model, not a surprise as it was originally developed with emulation of Unix's fork system in mind. =head4 Hybrid-thread Concurrency (current) Lightweight "green" threads (i.e. Task) are used as messages in a system where reading shared variables is allowed but only the one owner thread may write to it. With our current hybrid threads model all data sharing is implemented through Proxy PMCs. Reading foreign data is transparent, writing must be done via writer subs scheduled in the owners Task. To reduce latency, the task is flagged to run immediately. The data-owning interpreter will preempt the currently running task and process the new write task. Thus proxies allow a nearly lock-free multithreading implementation. Each task is assigned a fixed amount of execution time. After this time is up a timer callback sets a flag which is checked at execution of every branch operation. Since the interpreter's state is well defined at this point, its internal consistency is guaranteed. The same holds for the GC. Since task preemption is only done while executing user-level code, the GC can do its work undisturbed and without the need for measures like locking. Since user-level code is allowed to disable the scheduler, it can be guaranteed to run undisturbed through critical sections. =head4 Independent Concurrency Independent tasks have no contact with the internal data of any other task in the current process. These are implemented as STM concurrency but only use transactions for the shared interpreter globals. Note that independent tasks may still communicate back and forth by passing either atomic things (ints, floats, and pointers) or static buffers that can become the property of the destination thread. =head3 Concurrency Scheduler API The concurrency scheduler has two parts, a Scheduler PMC, which has an instance stored in the interpreter struct, and a set of core routines in F. An instance of the Scheduler PMC has 5 internal attributes, which are: =over 4 =item 1 An unique ID for the scheduler =item 2 The current highest assigned task ID =item 3 The task list =item 4 The task priority index =item 5 The list of handlers =back The unique ID of the scheduler is used by other schedulers to pass messages. With a small set of identifying information (including process ID, interpreter ID, scheduler ID, and possibly a URL/hostname) a scheduler can address other schedulers, both local to the current interpreter and remote. The task list is a simple unordered integer indexed data structure, currently implemented as a hash. Each task in the list has an integer ID assigned when it is first inserted into the list. A task retains the same ID throughout its lifetime, and the ID is not reused once a task is finalized. The data structure is currently implemented as pre-allocated array, the number of CPU's plus one, overridable by --numthreads . Currently a task is implemented as OS thread so ranking is done by the OS. Prioritization is done with the interpreter method 'schedule_proxied'. Previous versions used a task rank index, calculated based on the type, priority rating, age of the tasks in the task list. The index is a simple array, and in general the top (zeroth) element in the array is the next one to receive attention. The index is recalculated regularly as new tasks are inserted into the task list, existing tasks are modified or completed, and as time progresses so the age of some tasks pushes them to a higher priority. Because of the regular recalculation, the rank index may cache some frequently-accessed and rarely changing data from the tasks (though it is not required to do so). The list of handlers is a simple stack of handler PMCs currently waiting for an appropriate task (event, exception). See PDD 24 on Events for more details on event handlers. =head4 Flags (old) PMC flags 0-7 are reserved for private use by a PMC. The scheduler uses flag 0 to indicate whether the priority index is currently valid or needs to be recalculated before the next use. =head4 Vtable Functions =over 4 =item push_pmc Add an entry to the task list. =item pop_pmc Pull the next entry (the highest ranked entry in the task priority index) off the task list. If there are no tasks remaining in the task list, return null. =back =head4 Methods =over 4 =item add_handler =begin PIR_FRAGMENT $P1.'add_handler'($P2) =end PIR_FRAGMENT Add an event or exception handler to the scheduler's list of handlers. =item find_handler =begin PIR_FRAGMENT $P1 = $P2.'find_handler'($P3) =end PIR_FRAGMENT Search for an event or exception handler $P1, in scheduler $P2, for the task $P3. Returns a null PMC if an appropriate handler is not found. =back =head3 Task PMC API The interface of the Task PMC is also the minimum required interface for all subclasses, extensions, and alternate implementations of a task. An instance of the Task PMC has 7 internal attributes, which are: =over 4 =item 1 The task ID =item 2 The type of the task =item 3 The subtype of the task =item 4 The priority of the task =item 5 The birthtime stamp of the task =item 6 The status of the task =item 7 The code block of the task (optional) =item 8 An interpreter structure for the task (optional) =back Types of tasks include 'event', 'exception', 'io', and 'code'. The subtype of a task is used by events and exceptions to identify appropriate handlers. Possible status values for tasks include 'created', 'invoked', 'inprocess', and 'completed'. The final state of a task is 'destroyed', but is never marked (the task PMC is removed from the task list and at some later point destroyed by GC). The priority of a task is an integer value between 0 and 100, with 0 as the lowest priority. The birthtime stamp is the point at which the task was inserted into the task list, and is used for calculating the age of tasks. The code block is optional and only for tasks that are associated with a simple code block. The interpreter structure is also optional and only used for thread-like tasks that maintain their own interpreter state. =head4 Vtable Functions =over 4 =item get_attr_str Retrieve an attribute of the task. =item set_attr_str Set an attribute of the task. =back =head3 Opcodes =over 4 =item new =begin PIR_FRAGMENT $P1 = new 'Task' =end PIR_FRAGMENT Creates a new task. (The Scheduler PMC is never instantiated directly, it is only used by Parrot internals.) =item schedule =begin PIR_FRAGMENT $P0 = new 'Task' # set attributes schedule $P0 =end PIR_FRAGMENT Register a task with the concurrency scheduler. Details about the task are stored within the task PMC. =item join =begin PIR_FRAGMENT_INVALID $P0 = new 'Task' # ... schedule the task, etc. join $P0 =end PIR_FRAGMENT_INVALID Wait for a particular task to complete. =item kill =begin PIR_FRAGMENT_INVALID $P0 = new 'Task' # ... schedule the task, etc. kill $P0 =end PIR_FRAGMENT_INVALID Kill a task without waiting for it to complete. =back =head2 References Dec 2003 - (Dan ponders threads based on POSIX and Perl 5 experience) L Dec. 2003 - "threads and shared interpreter data structures" L Jan. 2004 - "Threads Design. A Win32 perspective." L Jan. 2004 - "Start of threads proposal" L Sept. 2005 - "consider using OS threads" L Aug. 2007 - "multi-threading a work in progress" L Aug. 2010 - "GSoC Threads: Chandon's Results" (green threads by Nat Tuck) L Apr. 2012 - (hybrid threads implemented by Stefan Seifert) L L Concurrency as Futures L Io language - L Java memory and concurrency - L =cut __END__ Local Variables: fill-column:100 End: vim: expandtab shiftwidth=4: README.BGR000644000765000765 1655511715102032 17477 0ustar00brucebruce000000000000parrot-5.9.0/docs/translationsТова е Parrot, верÑÐ¸Ñ 3.4.0 ----------------------------- Parrot is Copyright (C) 2001-2010, Parrot Foundation. ЛИЦЕÐЗÐРИÐФОРМÐЦИЯ ------------------- Този код Ñе разпроÑтранÑва под уÑловиÑта на Artistic License 2.0. За повече детайли, вижте Ð¿ÑŠÐ»Ð½Ð¸Ñ Ñ‚ÐµÐºÑÑ‚ на лиценза във файла LICENSE. ПРЕГЛЕД -------- Parrot е виртуално машина, разработена за ефикаÑно компилиране и изпълнение на bytecode за динамични езици. ПРЕДПОСТÐВКИ ------------- ТрÑбва ви компилатор за С, линкер и, разбира Ñе, make програма. Ðко ще линквате Ñ ICU библиотеката, Ñ‚Ñ€Ñбва да Ñ Ñвалите и инÑталирате преди да конфигурирате Parrot. Свалете Ñ Ð¾Ñ‚ http://site.icu-project.org/download Също така ви Ñ‚Ñ€Ñбва Perl 5.8.4 или по-нов, и Storable 2.12 или по-нов за пуÑкане на различни Ñкриптове за конфигуриране и билдване. For most of the platforms that we are supporting initially, Parrot should build out of the box. docs/parrot.pod lists the core platforms. PLATFORMS provides reports on the platforms on which Parrot has been built and tested. КÐК ДРВЗЕМЕТЕ PARROT ОТ GITHUB ----------------------------- I. ИнÑталирайте Git. Linux: Методът завиÑи от диÑтрибуциÑта ви. За да инÑталирате Ñ‚Ñ€Ñбва да изпълните (като root или sudo ): Ðа Ubuntu/Debian (apt-базирани): apt-get install git-core Ðа Red Hat, Fedora (rpm-базирани): yum install git Ðа Gentoo (portage): emerge -av dev-vcs/git Windows: Има 2 Git порта за Windows: msysgit http://code.google.com/p/msysgit/downloads/list TortoiseGit http://code.google.com/p/tortoisegit/downloads/list Macintosh OS X: ТърÑене в интернет ще намери разнообразни git инÑталатори за Mac OS X, включително: http://help.github.com/mac-git-installation/ II. Получаване на Parrot от github.com За да вземете копие Parrot Git хранилището: git clone git://github.com/parrot/parrot.git Това по подразбиране ще провери Ð³Ð»Ð°Ð²Ð½Ð¸Ñ ÐºÐ»Ð¾Ð½ по подразбиране. За да Ñъздадете локален клон който Ñледи клона "some_branch": git checkout -b --track some_branch origin/some_branch Горните URL Ñа Ñамо за четене. Ðко Ñте разработчик на Parrot използвайте URL за четене и запиÑ: git clone git@github.com:parrot/parrot.git Можете да видите ÑпиÑъкът от клони на http://github.com/parrot/parrot ИÐСТРУКЦИИ ------------ За Ñега, разархивирайте Parrot tarball-а, (ако четете това, вече Ñигурно Ñте го направили) и напишете perl Configure.pl за да пуÑнете ÐšÐ¾Ð½Ñ„Ð¸Ð³ÑƒÑ€Ð°Ñ†Ð¸Ð¾Ð½Ð½Ð¸Ñ Ñкрипт. Скриптът Configure.pl извлича конфигурациÑта от работещата perl5 програма. Може да Ñе наложи изрично да кажете на Configure.pl кой компилатор и линкер да използва. Ðапример, за компилиране на C файлове Ñ 'cc', C++ файлове Ñ 'CC', и линкване на вÑичко Ñ 'CC', Ñ‚Ñ€Ñбва да напишете perl Configure.pl --cc=cc --link=CC --ld=CC Вижте "perl Configure.pl --help" за повече опции и docs/configuration.pod за повече детайли. За ÑиÑтеми като HPUX които нÑмат inet_pton Ð¼Ð¾Ð»Ñ Ð¸Ð·Ð¿ÑŠÐ»Ð½ÐµÑ‚Ðµ perl Configure.pl --define=inet_aton ПуÑкането на Configure.pl ще генерира config.h хедър, Parrot::Config модул, платформени файлове и много Make файлове. Файлът "myconfig" Ñъдържа преглед на наÑтройките. След това изпълнете make. (Configure.pl ще ви каже ÐºÐ¾Ñ Ð²ÐµÑ€ÑÐ¸Ñ Ð½Ð° make Ñе препоръчва за ÑиÑтемата ви.) Сега Ñ‚Ñ€Ñбва да Ñе билдне интерпретаторът. Ðко билдвате ICU библиотеката (това е по подразбиране на повечето ÑиÑтеми), Ñ‚Ñ€Ñбва да използвате GNU make (или нещо ÑъвмеÑтимо Ñ Ð½ÐµÐ³Ð¾). Можете да теÑтвате Parrot като изпълните "make test". Можете да изпълнÑвате теÑтовете паралелно Ñ "make TEST_JOBS=3 test". Можете да изпълните Ñ†ÐµÐ»Ð¸Ñ Ñ‚ÐµÑтов пакет Ñ make fulltest Бележка: PLATFORMS Ñъдържа бележки дали теÑтови провали Ñе очакват на ÑиÑтемата ви. Можете да инÑталирате Parrot Ñ: make install По подразбиране Ñе инÑталира в /usr/local, Ñ Parrot executable в /usr/local/bin. Ðко иÑкате да инÑталирате Parrot на друго мÑÑто използвайте: perl Configure.pl --prefix=/home/joe/bird make install Ðо динамичните библиотеки нÑма да бъдат намерени за неÑтандартни меÑÑ‚Ð¾Ð¿Ð¾Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ Ð¾Ñвен ако не наÑтроите LD_LIBRARY_PATH или подобно. Вижте docs/parrot.pod и docs/intro.pod за да разберете на къде да вървите от тук. Ðко имате проблеми, вижте ÑекциÑта "How To Submit A Bug Report" в docs/submissions.pod. Тези документи Ñа в POD формат. Можете да ги видите Ñ ÐºÐ¾Ð¼Ð°Ð½Ð´Ð°Ñ‚Ð°: perldoc -F docs/intro.pod ПРОМЕÐИ ------- За Ð´Ð¾ÐºÑƒÐ¼ÐµÐ½Ñ‚Ð°Ñ†Ð¸Ñ Ð¾Ñ‚Ð½Ð¾Ñно юзър-видимите промени между тази верÑÐ¸Ñ Ð¸ предишните верÑии, вижте NEWS. ПОЩЕÐСКИ СПИСЪЦИ ------------- СпиÑъкът за юзърÑки пиÑма на Parrot е parrot-users@lists.parrot.org. Ðбонирайте Ñе като попълните бланката на http://lists.parrot.org/mailman/listinfo/parrot-users . СпиÑъкът е архивиран на http://lists.parrot.org/pipermail/parrot-users/ . За диÑкуÑии по разработването вижте информациÑта в docs/gettingstarted.pod. ОБРÐТÐРВРЪЗКÐ, ПÐТЧОВЕ И Т.Ð. ----------------------- Вижте docs/submissions.pod за повече Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ð¸Ñ Ð·Ð° докладване на бъгове и Ñъбмитване на патчове. УЕБ СÐЙТОВЕ --------- Тези Ñайтове Ñъдържат вÑичките нужна Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð·Ð° Parrot: http://www.parrot.org/ http://docs.parrot.org/ https://github.com/parrot/parrot/ ЗабавлÑвайте Ñе, Екипът на Parrot. global_setup.h000644000765000765 402411716253437 20305 0ustar00brucebruce000000000000parrot-5.9.0/include/parrot/* global_setup.h * Copyright (C) 2001-2007, Parrot Foundation. * Overview: * Contains declarations of global data and the functions * that initialize that data. * Data Structure and Algorithms: * History: * Notes: * References: */ #ifndef PARROT_GLOBAL_SETUP_H_GUARD #define PARROT_GLOBAL_SETUP_H_GUARD #include "parrot/config.h" #include "parrot/interpreter.h" void Parrot_gbl_register_core_pmcs(PARROT_INTERP, ARGIN(PMC *registry)) __attribute__nonnull__(1) __attribute__nonnull__(2); void Parrot_gbl_initialize_core_pmcs(PARROT_INTERP, int pass) __attribute__nonnull__(1); /* HEADERIZER BEGIN: src/global_setup.c */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ void init_world(PARROT_INTERP) __attribute__nonnull__(1); void Parrot_gbl_init_world_once(PARROT_INTERP) __attribute__nonnull__(1); void Parrot_gbl_set_config_hash_internal( ARGIN(const unsigned char* parrot_config), unsigned int parrot_config_size) __attribute__nonnull__(1); void Parrot_set_config_hash_pmc(PARROT_INTERP, ARGIN(PMC *config)) __attribute__nonnull__(1) __attribute__nonnull__(2); #define ASSERT_ARGS_init_world __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gbl_init_world_once __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_Parrot_gbl_set_config_hash_internal \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(parrot_config)) #define ASSERT_ARGS_Parrot_set_config_hash_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(config)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: src/global_setup.c */ #endif /* PARROT_GLOBAL_SETUP_H_GUARD */ /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ pbc_checker.cpp000644000765000765 6165111533177635 20467 0ustar00brucebruce000000000000parrot-5.9.0/examples/tools/* * Copyright (C) 2009, Parrot Foundation. */ // pbc_checker.cpp // A multiplatform checker for pbc files #include #include #include #include #include #include #include #include // Get most used symbols from std namespace using std::cout; using std::cerr; using std::ifstream; using std::string; using std::hex; using std::dec; using std::setw; using std::setfill; using std::runtime_error; //********************************************************************** // Type used to read parrot opcodes // You can use unsigned long here if your compiler does not support // long long, but in that case the results might not be accurate. typedef unsigned long long opcode; // Constants used in pbc and his descriptions const char unknown[] = "Unknown"; const unsigned char ByteOrderLE = 0, ByteOrderBE = 1; const char * desc_byte_order(unsigned char c) { switch(c) { case ByteOrderLE: return "Little endian"; case ByteOrderBE: return "Big endian"; default: return unknown; } } const unsigned char FpEncodingIEEE_754_8 = 0, FpEncodingIEEE_i386_12 = 1, FpEncodingIEEE_754_16 = 2; const char * desc_fp_encoding(unsigned char c) { switch(c) { case FpEncodingIEEE_754_8: return "IEEE 754 8 byte double"; case FpEncodingIEEE_i386_12: return "i386 little endian 12 byte long double"; case FpEncodingIEEE_754_16: return "IEEE 754 16 byte long double"; default: return unknown; } } const char * desc_uuid_type(unsigned char c) { switch(c) { case 0: return "none"; case 1: return "MD5"; default: return unknown; } } const opcode SegmentTypeDirectory = 0x00, SegmentTypeDefault = 0x01, SegmentTypeFixup = 0x02, SegmentTypeConstantTable = 0x03, SegmentTypeBytecode = 0x04, SegmentTypePIRDebug = 0x05, SegmentTypeAnnotations = 0x06, SegmentTypePICData = 0x07, SegmentTypeDependencies = 0x08; const char * desc_segment_type(opcode t) { switch(t) { case SegmentTypeDirectory: return "Directory"; case SegmentTypeDefault: return "Default"; case SegmentTypeFixup: return "Fixup"; case SegmentTypeConstantTable: return "Constant table"; case SegmentTypeBytecode: return "Bytecode"; case SegmentTypePIRDebug: return "PIR Debug"; case SegmentTypeAnnotations: return "Annotations"; case SegmentTypePICData: return "PIC Data"; case SegmentTypeDependencies: return "Dependencies"; default: return unknown; } } const opcode ConstantTypeNone = 0x00, ConstantTypeNumber = 0x6E, ConstantTypeString = 0x73, ConstantTypePMC = 0x70, ConstantTypeKey = 0x6B; const char * desc_constant_type(opcode t) { switch(t) { case ConstantTypeNone: return "None"; case ConstantTypeNumber: return "Number"; case ConstantTypeString: return "String"; case ConstantTypePMC: return "PMC"; case ConstantTypeKey: return "Key"; default: return unknown; } } const opcode KeyIntegerRegister = 0x00, KeyStringRegister = 0x01, KeyPMCRegister = 0x02, KeyNumberRegister = 0x03, KeyIntegerConstant = 0x10, KeyStringConstant = 0x11, KeyPMCConstant = 0x12, KeyNumberConstant = 0x13; const char * desc_key_type(opcode t) { switch (t) { case KeyIntegerRegister: return "Integer register"; case KeyStringRegister: return "String register"; case KeyPMCRegister: return "PMC register"; case KeyNumberRegister: return "Number register"; case KeyIntegerConstant: return "Integer constant"; case KeyStringConstant: return "String constant"; case KeyPMCConstant: return "PMC constant"; case KeyNumberConstant: return "Number constant"; default: return unknown; } } const opcode AnnotationTypeInteger = 0x00, AnnotationTypeString = 0x01, AnnotationTypeNumber = 0x02, AnnotationTypePMC = 0x03; const char * desc_annotation_type(opcode t) { switch(t) { case AnnotationTypeInteger: return "Integer"; case AnnotationTypeString: return "String"; case AnnotationTypeNumber: return "Number"; case AnnotationTypePMC: return "PMC"; default: return unknown; } } //********************************************************************** class ReadError : public runtime_error { public: ReadError(const string &msg); }; ReadError::ReadError(const string &msg) : runtime_error("Error reading " + msg) { } //********************************************************************** void signature(ifstream &pbcfile) { static const char pbc_signature [] = { 0xFE, 0x50, 0x42, 0x43, 0x0D, 0x0A, 0x1A, 0x0A }; char signature [sizeof (pbc_signature)]; pbcfile.read(signature, sizeof (signature)); if (pbcfile.gcount() != sizeof (signature)) throw ReadError("pbc signature"); if (! std::equal(pbc_signature, pbc_signature + sizeof(pbc_signature), signature)) throw runtime_error("Invalid pbc signature"); } //********************************************************************** // Emit a open tag in the constructor // and his closing in the destructor. class TagEmit { public: TagEmit(const string & name_n, std::ostream &os_n); ~TagEmit(); private: string name; std::ostream &os; }; TagEmit::TagEmit(const string & name_n, std::ostream &os_n) : name(name_n), os(os_n) { os << '<' << name << ">\n"; } TagEmit::~TagEmit() { os << "\n"; } //********************************************************************** class DirEntry { public: DirEntry(string name_n, opcode type_n, opcode offset_n, opcode length_n); string getName() const; opcode getType() const; opcode getOffset() const; opcode getLength() const; private: string name; opcode type; opcode offset; opcode length; }; DirEntry::DirEntry(string name_n, opcode type_n, opcode offset_n, opcode length_n) : name(name_n), type(type_n), offset(offset_n), length(length_n) { } string DirEntry::getName() const { return name; } opcode DirEntry::getType() const { return type; } opcode DirEntry::getOffset() const { return offset; } opcode DirEntry::getLength() const { return length; } bool operator < (const DirEntry & de1, const DirEntry & de2) { return de1.getOffset() < de2.getOffset(); } //********************************************************************** // Check that segments does not overlap void check_overlap(const std::vector & directory) { unsigned int entries = directory.size(); for (unsigned int i= 0; i < entries; ++i) { opcode offset = directory[i].getOffset(); opcode length = directory[i].getLength(); opcode after = offset + length; for (unsigned int j= i + 1; j < entries; ++j) { opcode offset2 = directory[j].getOffset(); if (offset2 >= offset && offset2 < after) throw runtime_error("overlap"); opcode after2 = offset2 + directory[j].getLength(); if (offset >= offset2 && offset < after2) throw runtime_error("overlap"); } } } //********************************************************************** class PbcFile { public: PbcFile(); void read(const char *filename); void read_header(ifstream &pbcfile); void check_directory_format(ifstream &pbcfile); void read_directory(ifstream &pbcfile); void dump_segment(const DirEntry & entry, ifstream &pbcfile); void dump_segment_default(ifstream &pbcfile); void dump_segment_fixup(ifstream &pbcfile); void dump_segment_constant(ifstream &pbcfile); void dump_segment_bytecode(ifstream &pbcfile); void dump_segment_pir_debug(ifstream &pbcfile); void dump_segment_annotations(ifstream &pbcfile); void dump_segment_pic_data(ifstream &pbcfile); void dump_segment_dependencies(ifstream &pbcfile); void dump_constant_string(ifstream &pbcfile); void dump_constant_number(ifstream &pbcfile); void dump_constant_key(ifstream &pbcfile); void dump_bytes_hex(ifstream &pbcfile, opcode length); string read_cstring(ifstream &pbcfile); opcode read_opcode(ifstream &pbcfile); private: unsigned int opcode_size; unsigned int pbc_major; unsigned int pbc_minor; unsigned char byte_order; unsigned char fp_encoding; std::vector directory; }; PbcFile::PbcFile() { opcode_size = 0; } void PbcFile::read(const char *filename) { ifstream pbcfile(filename); if (! pbcfile.is_open()) throw runtime_error("Can't open file"); TagEmit filetag("PbcFile", cout); read_header(pbcfile); check_directory_format(pbcfile); read_directory(pbcfile); check_overlap(directory); std::sort(directory.begin(), directory.end()); TagEmit tag("Segments", cout); for (size_t i= 0; i < directory.size(); ++i) dump_segment(directory[i], pbcfile); } void PbcFile::read_header(ifstream &pbcfile) { TagEmit tag("Header", cout); signature(pbcfile); unsigned char opcode_size = pbcfile.get(); unsigned char byte_order = pbcfile.get(); unsigned char fp_encoding = pbcfile.get(); unsigned char major = pbcfile.get(); unsigned char minor = pbcfile.get(); unsigned char patch = pbcfile.get(); unsigned char pbc_major = pbcfile.get(); unsigned char pbc_minor = pbcfile.get(); if (!pbcfile) throw ReadError("pbc header data"); cout << "Opcode size : " << (int) opcode_size << '\n' << "Byte order : " << desc_byte_order(byte_order) << " (" << (int) byte_order << ")\n" << "Floating point encoding: " << desc_fp_encoding(fp_encoding) << " (" << (int) fp_encoding << ")\n" << "Parrot version : " << (int) major << '.' << (int) minor << '.' << (int) patch << '\n' << "PBC version : " << (int) pbc_major << '.' << (int) pbc_minor << '\n' ; if (opcode_size > sizeof(opcode)) cerr << "*** Warning: opcode size too big for this program ***\n"; this->opcode_size = opcode_size; this->pbc_major = pbc_major; this->pbc_minor = pbc_minor; this->byte_order = byte_order; this->fp_encoding = fp_encoding; if (byte_order != ByteOrderLE && byte_order != ByteOrderBE) throw runtime_error("Invalid byte order"); unsigned char uuid_type = pbcfile.get(); cout << "UUID type : " << desc_uuid_type(uuid_type) << " (" << (int) uuid_type << ")\n" ; unsigned char uuid_length = pbcfile.get(); cout << "UUID length : " << (int) uuid_length << '\n' ; unsigned int curpos = 18 + uuid_length; unsigned int endheader = ((curpos + 15) / 16) * 16; pbcfile.ignore(endheader - 18); } void PbcFile::check_directory_format(ifstream &pbcfile) { TagEmit tag("DirectoryFormat", cout); opcode dir_format = read_opcode(pbcfile); cout << "Directory format: " << dir_format << '\n'; if (dir_format != 1) throw runtime_error("Unknown directory format"); opcode unused = read_opcode(pbcfile); unused = read_opcode(pbcfile); unused = read_opcode(pbcfile); for (opcode n = opcode_size * 4; n % 16; ++n) pbcfile.ignore(1); } void PbcFile::read_directory(ifstream &pbcfile) { TagEmit tag("Directory", cout); opcode size = read_opcode(pbcfile); cout << "Directory segment size: " << size << '\n'; // Must be zero: opcode in_type = read_opcode(pbcfile); opcode in_id = read_opcode(pbcfile); opcode op_size = read_opcode(pbcfile); cout << "Internal type: " << in_type << '\n'; cout << "Internal id: " << in_id << '\n'; cout << "Op table size: " << op_size << '\n'; opcode entries = read_opcode(pbcfile); cout << "Directory entries: " << entries << '\n'; for (unsigned int n= 0; n < entries; ++n) { opcode type = read_opcode(pbcfile); cout << n << ": Type: '" << desc_segment_type(type) << " (" << type << ") " "' Name: '"; string name = read_cstring(pbcfile); cout << name; opcode offset = read_opcode(pbcfile); opcode length = read_opcode(pbcfile); cout << "'\n Offset: " << offset << " Length: " << length << '\n'; DirEntry entry(name, type, offset, length); directory.push_back(entry); } } void PbcFile::dump_segment(const DirEntry &entry, ifstream &pbcfile) { cout << "Segment '" << entry.getName() << "'\n"; opcode const type = entry.getType(); cout << "Type: " << desc_segment_type(type) << " (0x" << hex << type << dec << ")\n"; // Set file read position to segment's start size_t start = entry.getOffset() * opcode_size; cout << "Start: 0x" << hex << setw(6) << start << dec << '\n'; pbcfile.seekg(start); switch(type) { case SegmentTypeDirectory: cout << "*** Unexpected directory segment ***\n"; break; case SegmentTypeDefault: dump_segment_default(pbcfile); break; case SegmentTypeFixup: dump_segment_fixup(pbcfile); break; case SegmentTypeConstantTable: dump_segment_constant(pbcfile); break; case SegmentTypeBytecode: dump_segment_bytecode(pbcfile); break; case SegmentTypePIRDebug: dump_segment_pir_debug(pbcfile); break; case SegmentTypeAnnotations: dump_segment_annotations(pbcfile); break; case SegmentTypePICData: dump_segment_pic_data(pbcfile); break; case SegmentTypeDependencies: dump_segment_dependencies(pbcfile); break; default: cout << "*** Unknown segment type ***\n"; break; } } void PbcFile::dump_segment_default(ifstream &/*pbcfile*/) { TagEmit tag("SegmentDefault", cout); cout << "*** UNIMPLEMENTED ***\n"; } void PbcFile::dump_segment_fixup(ifstream &pbcfile) { TagEmit tag("SegmentFixup", cout); opcode segsize = read_opcode(pbcfile); cout << "Segment size: " << segsize; opcode itype = read_opcode(pbcfile); cout << " itype: " << itype; opcode id = read_opcode(pbcfile); cout << " id: " << id; opcode size = read_opcode(pbcfile); cout << " size: " << size; opcode tablelength = read_opcode(pbcfile); cout << " Number of fixups: " << tablelength << '\n'; for (opcode n= 0; n < tablelength; ++n) { cout << "Fixup " << n; opcode type = read_opcode(pbcfile); cout << " Type: " << " (0x" << hex << type << dec << ')'; switch (type) { case 0x01: { opcode label = read_opcode(pbcfile); cout << " Label: " << label; opcode sub = read_opcode(pbcfile); cout << " Sub: " << sub; } break; case 0x02: { string label = read_cstring(pbcfile); cout << " Label: '" << label << '\''; opcode sub = read_opcode(pbcfile); cout << " Sub: " << sub; } break; case 0x00: cout << " None"; break; default: throw runtime_error("Invalid fixup"); } cout << '\n'; } } void PbcFile::dump_segment_constant(ifstream &pbcfile) { TagEmit tag("SegmentConstantTable", cout); opcode segsize = read_opcode(pbcfile); cout << "Segment size: " << segsize; opcode itype = read_opcode(pbcfile); cout << " itype: " << itype; opcode id = read_opcode(pbcfile); cout << " id: " << id; opcode size = read_opcode(pbcfile); cout << " size: " << size; opcode tablelength = read_opcode(pbcfile); cout << " Number of constants: " << tablelength << '\n'; for (opcode n= 0; n < tablelength; ++n) { cout << "Constant " << n; opcode type = read_opcode(pbcfile); cout << " Type: " << desc_constant_type(type) << " (0x" << hex << type << dec << ") "; switch(type) { case ConstantTypeString: case ConstantTypePMC: dump_constant_string(pbcfile); break; case ConstantTypeNumber: dump_constant_number(pbcfile); break; case ConstantTypeKey: dump_constant_key(pbcfile); break; default: throw runtime_error("Unknown constant type"); } } } void PbcFile::dump_segment_bytecode(ifstream &pbcfile) { TagEmit tag("SegmentBytecode", cout); opcode segsize = read_opcode(pbcfile); cout << "Segment size: " << segsize; opcode itype = read_opcode(pbcfile); cout << " itype: " << itype; opcode id = read_opcode(pbcfile); cout << " id: " << id; opcode size = read_opcode(pbcfile); cout << " size: " << size; cout << hex; for (opcode n= 0; n < size; ++n) { opcode code = read_opcode(pbcfile); if ((n % 8) == 0) cout << '\n' << setfill('0') << setw (7) << n << ':'; else cout << ' '; cout << setfill('0') << setw(opcode_size * 2) << code; } cout << dec << '\n'; } void PbcFile::dump_segment_pir_debug(ifstream &pbcfile) { TagEmit tag("SegmentPIRDebug", cout); opcode segsize = read_opcode(pbcfile); cout << "Segment size: " << segsize; opcode itype = read_opcode(pbcfile); cout << " itype: " << itype; opcode id = read_opcode(pbcfile); cout << " id: " << id; opcode size = read_opcode(pbcfile); cout << " size: " << size; cout << '\n'; opcode tablelength = size; for (opcode n= 0; n < tablelength; ++n) { opcode linenum = read_opcode(pbcfile); cout << " Line: " << linenum; } cout << '\n'; opcode mappings = read_opcode(pbcfile); cout << "Mappings: " << mappings << '\n'; for (opcode n= 0; n < mappings; ++n) { cout << " " << n; opcode offset = read_opcode(pbcfile); cout << " Offset: " << offset; opcode filename = read_opcode(pbcfile); cout << " File: " << filename; cout << '\n'; } } void PbcFile::dump_segment_annotations(ifstream &pbcfile) { TagEmit tag("SegmentAnnotations", cout); opcode segsize = read_opcode(pbcfile); cout << "Segment size: " << segsize; opcode itype = read_opcode(pbcfile); cout << " itype: " << itype; opcode id = read_opcode(pbcfile); cout << " id: " << id; opcode size = read_opcode(pbcfile); cout << " size: " << size; cout << '\n'; opcode tablelength = read_opcode(pbcfile); cout << "Number of annotations: " << tablelength << '\n'; for (opcode i= 0; i < tablelength; ++i) { cout << i; opcode name = read_opcode(pbcfile); cout << " Name: " << name; opcode type = read_opcode(pbcfile); cout << " Type: " << desc_annotation_type(type) << '\n'; } opcode grouplength = read_opcode(pbcfile); cout << "Number of annotation groups: " << grouplength << '\n'; for (opcode i= 0; i < grouplength; ++i) { cout << i; opcode bcpos = read_opcode(pbcfile); cout << " Bytecode offset: " << bcpos; opcode value = read_opcode(pbcfile); cout << " Value: " << value << '\n'; } opcode mappings = read_opcode(pbcfile); cout << "Number of mappings: " << mappings << '\n'; for (opcode i= 0; i < mappings; ++i) { cout << i; opcode bcpos = read_opcode(pbcfile); cout << " Bytecode offset: " << bcpos; opcode annotation = read_opcode(pbcfile); cout << " Annotation key: " << annotation; opcode value = read_opcode(pbcfile); cout << " Value: " << value << '\n'; } } void PbcFile::dump_segment_pic_data(ifstream &/*pbcfile*/) { TagEmit tag("SegmentPICData", cout); cout << "*** UNIMPLEMENTED ***\n"; } void PbcFile::dump_segment_dependencies(ifstream &/*pbcfile*/) { TagEmit tag("SegmentDependencies", cout); cout << "*** UNIMPLEMENTED ***\n"; } void PbcFile::dump_constant_string(ifstream &pbcfile) { opcode flags; opcode charset; const opcode encoding_none = 0xFFFF; opcode encoding = encoding_none; if (pbc_major > 5 && pbc_minor > 11) { opcode flags_charset = read_opcode(pbcfile); flags = flags_charset & 0xFF; charset = flags_charset >> 8; if (pbc_major > 6 || pbc_minor >= 17) { encoding = charset >> 8; charset &= 0xFF; } } else { flags = read_opcode(pbcfile); charset = read_opcode(pbcfile); } cout << "Flags: 0x" << hex << setw(6) << flags << dec; cout << " Charset: " << charset; if (encoding != encoding_none) cout << " Encoding: " << encoding; // Encoding not saved, see TT #468 //opcode encoding = read_opcode(pbcfile); //cout << " Encoding: "<< encoding; opcode length = read_opcode(pbcfile); cout << " Length: "<< length; // Don't dump very long strings at full length. opcode full = length; length = std::min(length, (opcode)512); cout << " \'"; for (opcode i= 0; i < length; ++i) { unsigned char c = pbcfile.get(); if (! pbcfile) throw ReadError("string constant"); if (c >= 32 && c < 128) cout << c; else cout << "\\x" << hex << setw(2) << setfill('0') << (unsigned int) c << dec; } cout << '\''; if (full > length) { cout << "(...)"; pbcfile.ignore(full - length); } cout << '\n'; for (unsigned int i= full; i % opcode_size; ++i) { pbcfile.ignore(1); } } void PbcFile::dump_constant_number(ifstream &pbcfile) { cout << "Number constant: "; switch(fp_encoding) { case FpEncodingIEEE_754_8: dump_bytes_hex(pbcfile, 8); break; case FpEncodingIEEE_i386_12: dump_bytes_hex(pbcfile, 12); break; case FpEncodingIEEE_754_16: dump_bytes_hex(pbcfile, 16); break; default: // This must have been catched before reaching this point throw std::logic_error("Bad number type"); } } void PbcFile::dump_constant_key(ifstream &pbcfile) { opcode components = read_opcode(pbcfile); cout << "Key components: " << components << '\n'; for (opcode i= 0; i < components; ++i) { cout << " " << i << ' '; opcode type = read_opcode(pbcfile); cout << "Type: " << desc_key_type (type) << " (0x" << hex << type << dec << ") "; opcode value = read_opcode(pbcfile); cout << "Value: " << value << '\n'; } } void PbcFile::dump_bytes_hex(ifstream &pbcfile, opcode length) { cout << "0x" << hex; for (opcode i= 0; i < length; ++i) { unsigned char c = pbcfile.get(); cout << setw(2) << setfill('0') << (unsigned int) c; } cout << dec << '\n'; } string PbcFile::read_cstring(ifstream &pbcfile) { string r; char c; while ((c= pbcfile.get())) { r+= c; } // cstrings are padded with trailing zeroes to opcode size for (opcode l = r.size() + 1; l % opcode_size; ++l) pbcfile.ignore(1); if(! pbcfile) throw ReadError("cstring"); return r; } opcode PbcFile::read_opcode(ifstream &pbcfile) { unsigned char buffer [32]; // Allow 256 bits opcode size pbcfile.read((char *)buffer, opcode_size); if (static_cast(pbcfile.gcount()) != opcode_size) throw ReadError("opcode"); opcode result = 0; switch(byte_order) { case ByteOrderLE: for (unsigned int i= 0; i < opcode_size; ++i) { result <<= 8; result += buffer [opcode_size - 1 - i]; } break; case ByteOrderBE: for (unsigned int i= 0; i < opcode_size; ++i) { result <<= 8; result += buffer [i]; } break; default: // This must have been catched before reaching this point throw std::logic_error("Bad byte order"); } return result; } //********************************************************************** void pbc_checker_main(int argc, char **argv) { if (argc < 2) throw runtime_error("Bad args"); PbcFile pbcfile; pbcfile.read(argv[1]); } //********************************************************************** int main(int argc, char **argv) { try { pbc_checker_main(argc, argv); return 0; } catch(std:: exception &e) { cerr << "FAILED: " << e.what() << '\n'; } return 1; } // End of pbc_checker.cpp /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4: */ parrot.pod000644000765000765 604712101554066 15463 0ustar00brucebruce000000000000parrot-5.9.0/docs# Copyright (C) 2001-2012, Parrot Foundation. =head1 NAME docs/parrot.pod - Parrot =head1 DESCRIPTION The Parrot Virtual Machine is a language-agnostic common bytecode format and an interpreter for dynamic languages. =head2 Documentation The Parrot documentation is spread across a wide range of files. Good starting points are: =over 4 =item F An introductory article on what Parrot is and how to do some interesting things with it. =item F An overview of the Parrot architecture and design. =item F Brief descriptions of the different executables and how to run them. =item F The Parrot FAQ. =item F A guide to some of the jargon that crops up repeatedly in Parrot development (and in the documentation...) =back More detailed information on the design and implementation of Parrot can be found in: =over 4 =item F This subdirectory contains all of the current Parrot Design Documents (PDDs). These are intended to be detailed guides to the design of the various Parrot subsystems; for instance, F specifies Parrot's inter-routine calling conventions. =item F This subdirectory contains documentation on several of the PMC types available to Parrot. Currently only a few of the available PMCs have been documented. (Patches welcome!) =item F This subdirectory contains a number of files discussing various implementation decisions made during the course of the development of Parrot. The intent is to keep discussion of implementation-specific issues separate from the basic design issues discussed in the PDDs. =item F A brief introduction to the vtable at the heart of all PMCs, and how to implement your own PMC type. =item F Describes the embedding subsystem in excruciating detail. =item F An introduction to the Parrot GC subsystem =item F The Parrot bytecode format. =item F Hints on writing tests for the Parrot interpreter. =item F A beginner's guide to debugging the Parrot executable. =item F Documentation for C, the Parrot debugger. =back =head2 Supported Platforms Parrot compiles and runs on a large number of platforms, including all common ones. The Parrot team is committed to supporting the following combinations as "core platforms": Linux (x86), Win32 (x86), OS X (x86 and PPC), Cygwin, FreeBSD (x86), NetBSD, OpenBSD, Solaris. Here x86 includes the x86_64 architecture. x86 describes that Parrot is supported to run on a 32-bit and 64-bit (AMD64 and Intel 64) CPU. =head2 Authors Parrot is developed and maintained by the members of the C mailing list. The list is archived at: L Many people have contributed their time and expertise to the Parrot project; see the F file for details. =head2 Web pages See: =over 4 =item * L =item * L =back for more information. =cut test_c.in000644000765000765 41311567202622 17510 0ustar00brucebruce000000000000parrot-5.9.0/config/auto/neg_0/* Copyright (C) 2009-2011, Parrot Foundation. */ #include int main(int argc, char* argv[]) { printf("%.0f", -0.0); return 0; } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ fp_equality.pasm000644000765000765 242011533177636 22344 0ustar00brucebruce000000000000parrot-5.9.0/runtime/parrot/include# Copyright (C) 2004-2009, Parrot Foundation. =head1 NAME fp_equality.pasm - floating point equivalency macros =head1 DESCRIPTION This file provides PIR macros to determine if a pair of floating point numbers are equivalent. The same macros are also provided for PASM. =cut .macro fp_eq ( J, K, L ) set $N10, .J set $N11, .K sub $N12, $N11, $N10 abs $N12, $N12 gt $N12, 0.000001, .$FPEQNOK branch .L .label $FPEQNOK: .endm .macro fp_eq_ok ( J, K, L ) set $N10, .J set $N11, .K sub $N12, $N11, $N10 abs $N12, $N12 set $I0, 0 gt $N12, 0.000001, .$FPEQNOK set $I0, 1 .label $FPEQNOK: ok( $I0, .L ) .endm .macro fp_ne ( J, K, L ) set $N10, .J set $N11, .K sub $N12, $N11, $N10 abs $N12, $N12 lt $N12, 0.000001, .$FPNENOK branch .L .label $FPNENOK: .endm .macro fp_eq_pasm ( J, K, L ) set N10, .J set N11, .K sub N12, N11, N10 abs N12, N12 gt N12, 0.000001, .$FPEQNOK branch .L .label $FPEQNOK: .endm .macro fp_ne_pasm ( J, K, L ) set N10, .J set N11, .K sub N12, N11, N10 abs N12, N12 lt N12, 0.000001, .$FPNENOK branch .L .label $FPNENOK: .endm # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: install.pm000644000765000765 767711533177634 16760 0ustar00brucebruce000000000000parrot-5.9.0/config/init# Copyright (C) 2001-2007, Parrot Foundation. =head1 NAME config/init/install.pm - autoconf compatible installation paths =head1 DESCRIPTION Sets up the installation paths =cut package init::install; use strict; use warnings; use base qw(Parrot::Configure::Step); sub _init { my $self = shift; my %data; $data{description} = q{Set up installation paths}; $data{result} = q{}; return \%data; } sub runstep { my ( $self, $conf ) = @_; my $prefix = $conf->options->get('prefix') || ($^O eq 'MSWin32' ? "C:/Parrot" : "/usr/local"); $prefix =~ s{/\z}{}; my $ep = $conf->options->get('exec-prefix'); $ep =~ s{/\z}{} if defined $ep; my $eprefix = $ep ? $ep : $prefix; # Install in versioned subdirectories, "/usr/lib/parrot/1.5.0/...". Skip # the "/parrot" or "/1.5.0" subdirectories if these are included in the # prefix. my $versiondir = ''; unless ($prefix =~ /parrot/) { $versiondir .= '/parrot'; } my $version = $conf->option_or_data('VERSION'); if ($version && $prefix !~ /$version/) { $versiondir .= "/$version"; $versiondir .= $conf->option_or_data('DEVEL'); } # --bindir=DIR user executables [EPREFIX/bin] my $bindir = assign_dir( $conf, 'bindir', $eprefix, '/bin' ); # --sbindir=DIR system admin executables [EPREFIX/sbin] my $sbindir = assign_dir( $conf, 'sbindir', $eprefix, '/sbin' ); # --libexecdir=DIR program executables [EPREFIX/libexec] my $libexecdir = assign_dir( $conf, 'libexecdir', $eprefix, '/libexec' ); # --datadir=DIR read-only architecture-independent data [PREFIX/share] my $datadir = assign_dir( $conf, 'datadir', $prefix, '/share' ); # --sysconfdir=DIR read-only single-machine data [PREFIX/etc] my $sysconfdir = assign_dir( $conf, 'sysconfdir', $prefix, '/etc' ); # --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] my $sharedstatedir = assign_dir( $conf, 'sharedstatedir', $prefix, '/com' ); # --localstatedir=DIR modifiable single-machine data [PREFIX/var] my $localstatedir = assign_dir( $conf, 'localstatedir', $prefix, '/var' ); # --libdir=DIR object code libraries [EPREFIX/lib] my $libdir = assign_dir( $conf, 'libdir', $eprefix, '/lib' ); # --includedir=DIR C header files [PREFIX/include] my $includedir = assign_dir( $conf, 'includedir', $prefix, '/include' ); # --oldincludedir=DIR C header files f|| non-gcc [/usr/include] my $oldincludedir = assign_dir( $conf, 'oldincludedir', q{}, '/usr/include' ); # --infodir=DIR info documentation [PREFIX/info] my $infodir = assign_dir( $conf, 'infodir', $prefix, '/info' ); # --mandir=DIR man documentation [PREFIX/man] my $mandir = assign_dir( $conf, 'mandir', $prefix, '/man' ); # --srcdir=DIR source code files PREFIX/src] my $srcdir = assign_dir( $conf, 'srcdir', $prefix, '/src' ); $conf->data->set( prefix => $prefix, exec_prefix => $eprefix, bindir => $bindir, sbindir => $sbindir, libexecdir => $libexecdir, datadir => $datadir, sysconfdir => $sysconfdir, sharedstatedir => $sharedstatedir, localstatedir => $localstatedir, libdir => $libdir, includedir => $includedir, oldincludedir => $oldincludedir, infodir => $infodir, mandir => $mandir, srcdir => $srcdir, # parrot internal use only docdir => $datadir . "/doc", versiondir => $versiondir, ); return 1; } sub assign_dir { my ( $conf, $dir_str, $fix, $ext ) = @_; my $d = $conf->options->get($dir_str); return $d ? $d : $fix . $ext; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: threads.t000644000765000765 517412101554067 16126 0ustar00brucebruce000000000000parrot-5.9.0/t/stress#! perl # Copyright (C) 2012-2013, Parrot Foundation. =head1 NAME t/stress/threads.t - Threads with Garbage Collection =head1 SYNOPSIS % prove -v t/stress/threads.t =head1 DESCRIPTION Tests threads stability under garbage collection. Also IO stress: Large -t trace pir output segfaults in GC =cut use strict; use warnings; use lib qw(lib . ../lib ../../lib); use Test::More; use Parrot::Test tests => 2; use Parrot::Config; # Task stress with GC # Segfault #880 { $ENV{TEST_PROG_ARGS} ||= ''; if ($^O eq 'darwin') { my $cwd = `pwd`; chomp($cwd); $ENV{DYLD_LIBRARY_PATH} = $cwd."/blib/lib"; } my $parrot = File::Spec->join( File::Spec->curdir(), 'parrot' . $PConfig{exe} ); my $src = 'examples/threads/chameneos.pir'; my $pbc = 'examples/threads/chameneos.pbc'; system($parrot, '-o', $pbc, $src); my $todo = $PConfig{ccflags} =~ /-DTHREAD_DEBUG/; pbc_exit_code_is( $pbc, 0, 'chameneos', $todo ? (todo => 'GH880 GC walks into thread interp') : ()); unlink $pbc; } # IO stress: trace pir output segfaults # ASSERT src/gc/gc_gms.c:1189: failed assertion '(pmc) == NULL || (pmc)->orig_interp == (interp)' { local $ENV{TEST_PROG_ARGS} .= '-t1'; pir_exit_code_is( << 'CODE', 0, "IO Stress with -t", todo => 'GH875 threads and -t1: gc_gms_mark_pmc_header: self->work_list might be empty' ); .sub test :main load_bytecode "dumper.pbc" load_bytecode 'Test/More.pbc' load_bytecode 'MIME/Base64.pbc' load_bytecode 'PGE.pbc' load_bytecode 'PGE/Util.pbc' load_language 'data_json' .local pmc json json = compreg 'data_json' .local pmc encode_decode_tests, decode_tests encode_decode_tests = json.'compile'( <<'END_JSON' ) [ ["Hello, World!\n","SGVsbG8sIFdvcmxkIQo="], ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", "YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFh\nYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYQ=="] ] END_JSON .local pmc enc_sub enc_sub = get_global [ "MIME"; "Base64" ], 'encode_base64' .local pmc is is = get_hll_global [ 'Test'; 'More' ], 'is' .local pmc test_iterator, test_case encode_decode_tests = encode_decode_tests() test_iterator = iter encode_decode_tests .local string plain, base64, result test_case = shift test_iterator plain = shift test_case base64 = shift test_case result = enc_sub( plain ) is( result, base64 ) .end CODE } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # fill-column: 100 # End: # vim: expandtab shiftwidth=4: imccompiler.pmc000644000765000765 2334512171255037 17115 0ustar00brucebruce000000000000parrot-5.9.0/src/pmc/* Copyright (C) 2011-2012, Parrot Foundation. =head1 NAME src/pmc/imccompiler.pmc - A compiler object to wrap IMCC =head1 DESCRIPTION A compiler object to wrap IMCC =head2 Functions =cut */ #include "imcc/embed.h" #include "imcc/yyscanner.h" #include "pmc/pmc_sub.h" /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT static PMC * get_packfile_eval_pmc(PARROT_INTERP, ARGIN(PMC *pf_pmc), INTVAL current_eval) __attribute__nonnull__(1) __attribute__nonnull__(2); #define ASSERT_ARGS_get_packfile_eval_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(pf_pmc)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: static */ #define BEGIN_IMCC_COMPILE(i) \ do { \ UINTVAL __regs_used[4] = {3, 3, 3, 3}; \ PMC * const __newcontext = Parrot_push_context((i), __regs_used); \ PackFile_ByteCode * const __old_bc = (i)->code; \ Parrot_block_GC_mark((i)); \ Parrot_pcc_set_HLL((i), __newcontext, 0); \ Parrot_pcc_set_sub((i), __newcontext, 0); \ #define END_IMCC_COMPILE(i) \ Parrot_pop_context((i)); \ Parrot_unblock_GC_mark((i)); \ (i)->code = __old_bc; \ } while (0) #define ERROR_IMCC_COMPILE(i) \ Parrot_pop_context((i)); \ Parrot_unblock_GC_mark((i)); \ (i)->code = __old_bc; \ /* =over 4 =item C get eval_pmc info from packfile =cut */ PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT static PMC * get_packfile_eval_pmc(PARROT_INTERP, ARGIN(PMC *pf_pmc), INTVAL current_eval) { ASSERT_ARGS(get_packfile_eval_pmc) PackFile * const pf = (PackFile*)VTABLE_get_pointer(interp, pf_pmc); PMC * const eval_pmc = Parrot_pmc_new(interp, enum_class_Eval); Parrot_Sub_attributes *sub_data; PMC_get_sub(interp, eval_pmc, sub_data); sub_data->seg = pf->cur_cs; sub_data->start_offs = 0; sub_data->end_offs = pf->cur_cs->base.size; sub_data->name = Parrot_sprintf_c(interp, "EVAL_%d", current_eval); Parrot_pf_prepare_packfile_init(interp, eval_pmc); return eval_pmc; } /* HEADERIZER HFILE: none */ pmclass IMCCompiler auto_attrs provides HLLCompiler provide invokable { ATTR void *imcc_info; ATTR INTVAL is_pasm; /* 0 = PIR, 1 = PASM */ ATTR INTVAL current_eval; VTABLE void init() { UNUSED(SELF) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "IMCCompiler: Must initialize with an integer argument 0 (PIR) or 1 (PASM)"); } VTABLE void init_pmc(PMC *init) { const INTVAL type = VTABLE_get_integer(INTERP, init); VTABLE_init_int(INTERP, SELF, type); } VTABLE void init_int(INTVAL is_pasm) { Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF); if (is_pasm != 0 && is_pasm != 1) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "IMCCompiler: Must have type 0 (PIR) or 1 (PASM)"); attrs->is_pasm = is_pasm; attrs->imcc_info = (void*) imcc_new(INTERP); attrs->current_eval = 0; } /* provided to emulate the current NCI compreg */ /* DEPRECATED. See TT #1967 */ VTABLE opcode_t* invoke(void* next) { Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF); imc_info_t * const imcc = (imc_info_t*) attrs->imcc_info; PMC * const ctx = CURRENT_CONTEXT(INTERP); PMC * cont = INTERP->current_cont; PMC * const call_object = Parrot_pcc_get_signature(interp, ctx); PackFile_ByteCode * const cur_code = interp->code; STRING * code = STRINGNULL; PMC * result = PMCNULL; PMC * eval_pmc; const UINTVAL regs_used[4] = {3, 3, 3, 3}; PMC * const newcontext = Parrot_push_context(interp, regs_used); Parrot_block_GC_mark(interp); Parrot_pcc_set_sub(interp, newcontext, 0); Parrot_pcc_fill_params_from_c_args(INTERP, call_object, "S", &code); imcc_reset(imcc); result = imcc_compile_string(imcc, code, attrs->is_pasm); if (PMC_IS_NULL(result)) { STRING * const msg = imcc_last_error_message(imcc); const INTVAL errcode = imcc_last_error_code(imcc); Parrot_unblock_GC_mark(interp); Parrot_ex_throw_from_c_args(INTERP, NULL, errcode, "%Ss", msg); } eval_pmc = get_packfile_eval_pmc(interp, result, attrs->current_eval++); Parrot_pop_context(interp); Parrot_unblock_GC_mark(interp); /* Handle the case where we we've been tailcalled into. See NCI.invoke for more details */ if (!PMC_IS_NULL(cont) && (PObj_get_FLAGS(cont) & SUB_FLAG_TAILCALL)) { cont = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp)); next = VTABLE_invoke(INTERP, cont, next); } Parrot_pcc_set_call_from_c_args(INTERP, call_object, "P", eval_pmc); interp->code = cur_code; return (opcode_t*)next; } VTABLE void *get_pointer() { UNUSED(INTERP) const Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF); return attrs->imcc_info; } VTABLE INTVAL get_integer() { UNUSED(INTERP) const Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF); return attrs->is_pasm; } VTABLE STRING *get_string() { const Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF); if (attrs->is_pasm) return CONST_STRING(INTERP, "PASM"); else return CONST_STRING(INTERP, "PIR"); } VTABLE void destroy() { UNUSED(INTERP) Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF); imcc_destroy((imc_info_t*)(attrs->imcc_info)); attrs->imcc_info = NULL; } METHOD compile(STRING *source, STRING *path :optional, INTVAL has_path :opt_flag, STRING *target :named("target") :optional, INTVAL has_target :opt_flag, PMC *outer_ctx :named("outer_ctx") :optional, INTVAL has_ctx :opt_flag) { Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF); PMC * pf; imc_info_t * const imcc = (imc_info_t*)attrs->imcc_info; if (has_target) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "IMCCompiler: compiler does not support the target option"); BEGIN_IMCC_COMPILE(interp); /* TODO: Handle outer_ctx */ pf = imcc_compile_string(imcc, source, attrs->is_pasm); if (PMC_IS_NULL(pf)) { STRING * const msg = imcc_last_error_message(imcc); INTVAL code = imcc_last_error_code(imcc); ERROR_IMCC_COMPILE(interp); Parrot_ex_throw_from_c_args(INTERP, NULL, code, "%Ss", msg); } if (has_path) VTABLE_set_string_native(INTERP, pf, path); END_IMCC_COMPILE(interp); RETURN(PMC *pf); } METHOD compile_file(STRING *filename, STRING *path :optional, INTVAL has_path :opt_flag, STRING *target :named("target") :optional, INTVAL has_target :opt_flag, PMC *outer_ctx :named("outer_ctx") :optional, INTVAL has_ctx :opt_flag) { Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF); PMC * pf = PMCNULL; imc_info_t * const imcc = (imc_info_t*)attrs->imcc_info; if (has_target) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "IMCCompiler: compiler does not support the target option"); BEGIN_IMCC_COMPILE(interp); /* TODO: Handle outer_ctx */ pf = imcc_compile_file(imcc, filename, attrs->is_pasm); if (PMC_IS_NULL(pf)) { STRING * const msg = imcc_last_error_message(imcc); const INTVAL code = imcc_last_error_code(imcc); ERROR_IMCC_COMPILE(interp); Parrot_ex_throw_from_c_args(INTERP, NULL, code, "%Ss", msg); } if (has_path) VTABLE_set_string_native(INTERP, pf, path); END_IMCC_COMPILE(interp); RETURN(PMC *pf); } /*METHOD eval(STRING *source, STRING *target :named("target") :optional, INTVAL has_target :opt_flag, PMC *outer_ctx :named("outer_ctx") :optional, INTVAL has_ctx :opt_flag) { Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF); PMC * pf = PMCNULL; imc_info_t * const imcc = (imc_info_t*)attrs->imcc_info; if (has_target) Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "IMCCompiler: compiler does not support the target option"); pf = imcc_compile_string(imcc, source, attrs->is_pasm); }*/ METHOD preprocess(STRING *code) { const Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF); imc_info_t * const imcc = (imc_info_t*)attrs->imcc_info; imcc_preprocess(imcc, code); } /*METHOD parse_name(STRING *name) { Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED, "IMCCompiler: parse_name is not supported"); }*/ /* TODO: This */ /*METHOD load_module(STRING *name) { }*/ /* TODO: This */ /*METHOD get_module(STRING *name) { }*/ /* TODO: This */ /*METHOD get_exports(PMC *module) { }*/ } /* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4 cinoptions='\:2=2' : */ Rules.in000644000765000765 2153112101554066 17065 0ustar00brucebruce000000000000parrot-5.9.0/compilers/imcccompilers/imcc/api$(O) : \ compilers/imcc/api.c \ include/imcc/api.h \ include/imcc/embed.h \ include/parrot/extend_vtable.h \ compilers/imcc/imc.h \ compilers/imcc/cfg.h \ include/parrot/extend.h \ include/parrot/oplib/ops.h \ compilers/imcc/symreg.h \ compilers/imcc/sets.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ compilers/imcc/debug.h \ include/parrot/api.h \ compilers/imcc/instructions.h \ $(PARROT_H_HEADERS) compilers/imcc/pcc$(O) : \ compilers/imcc/pcc.c \ compilers/imcc/cfg.h \ compilers/imcc/debug.h \ compilers/imcc/imc.h \ compilers/imcc/imcparser.h \ compilers/imcc/instructions.h \ compilers/imcc/parser.h \ compilers/imcc/sets.h \ compilers/imcc/symreg.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ include/imcc/embed.h \ $(INC_DIR)/oplib/ops.h \ $(INC_DIR)/oplib/core_ops.h \ $(INC_DIR)/runcore_api.h \ $(PARROT_H_HEADERS) compilers/imcc/instructions$(O) : \ compilers/imcc/instructions.c \ compilers/imcc/cfg.h \ compilers/imcc/debug.h \ compilers/imcc/imc.h \ compilers/imcc/instructions.h \ compilers/imcc/optimizer.h \ compilers/imcc/pbc.h \ compilers/imcc/sets.h \ compilers/imcc/symreg.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ include/imcc/embed.h \ $(INC_DIR)/oplib/ops.h \ $(INC_DIR)/oplib/core_ops.h \ $(INC_DIR)/runcore_api.h \ $(PARROT_H_HEADERS) compilers/imcc/pbc$(O) : \ compilers/imcc/pbc.c \ compilers/imcc/cfg.h \ compilers/imcc/debug.h \ compilers/imcc/imc.h \ compilers/imcc/instructions.h \ compilers/imcc/pbc.h \ compilers/imcc/sets.h \ compilers/imcc/symreg.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ include/imcc/embed.h \ $(INC_DIR)/oplib/ops.h \ $(INC_DIR)/oplib/core_ops.h \ $(INC_DIR)/runcore_api.h \ $(PARROT_H_HEADERS) \ include/pmc/pmc_key.h \ include/pmc/pmc_sub.h compilers/imcc/parser_util$(O) : \ compilers/imcc/parser_util.c \ compilers/imcc/cfg.h \ compilers/imcc/debug.h \ compilers/imcc/imc.h \ compilers/imcc/imcparser.h \ compilers/imcc/instructions.h \ compilers/imcc/optimizer.h \ compilers/imcc/parser.h \ compilers/imcc/pbc.h \ compilers/imcc/sets.h \ compilers/imcc/symreg.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ include/imcc/embed.h \ $(INC_DIR)/dynext.h \ $(INC_DIR)/oplib/ops.h \ $(PARROT_H_HEADERS) \ include/pmc/pmc_sub.h compilers/imcc/imc$(O) : \ compilers/imcc/imc.c \ compilers/imcc/cfg.h \ compilers/imcc/debug.h \ compilers/imcc/imc.h \ compilers/imcc/instructions.h \ compilers/imcc/optimizer.h \ compilers/imcc/sets.h \ compilers/imcc/symreg.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ include/imcc/embed.h \ $(INC_DIR)/oplib/ops.h \ $(PARROT_H_HEADERS) compilers/imcc/cfg$(O) : \ compilers/imcc/cfg.c \ compilers/imcc/cfg.h \ compilers/imcc/debug.h \ compilers/imcc/imc.h \ compilers/imcc/instructions.h \ compilers/imcc/optimizer.h \ compilers/imcc/sets.h \ compilers/imcc/symreg.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ include/imcc/embed.h \ $(INC_DIR)/oplib/ops.h \ $(INC_DIR)/oplib/core_ops.h \ $(INC_DIR)/runcore_api.h \ $(PARROT_H_HEADERS) compilers/imcc/debug$(O) : \ compilers/imcc/debug.c \ compilers/imcc/cfg.h \ compilers/imcc/debug.h \ compilers/imcc/imc.h \ compilers/imcc/instructions.h \ compilers/imcc/sets.h \ compilers/imcc/symreg.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ include/imcc/embed.h \ $(INC_DIR)/oplib/ops.h \ $(PARROT_H_HEADERS) ## SUFFIX OVERRIDE - Warnings (This is generated code) compilers/imcc/imclexer$(O) : \ compilers/imcc/imclexer.c \ compilers/imcc/cfg.h \ compilers/imcc/debug.h \ compilers/imcc/imc.h \ compilers/imcc/imcparser.h \ compilers/imcc/instructions.h \ compilers/imcc/parser.h \ compilers/imcc/sets.h \ compilers/imcc/symreg.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ include/imcc/embed.h \ $(INC_DIR)/oplib/ops.h \ $(PARROT_H_HEADERS) $(CC) $(CFLAGS) @optimize::compilers/imcc/imclexer.c@ @ccwarn::compilers/imcc/imclexer.c@ @cc_shared@ -I$(@D)/. @cc_o_out@$@ -c compilers/imcc/imclexer.c ## SUFFIX OVERRIDE - Warnings (This is generated code) compilers/imcc/imcparser$(O) : \ compilers/imcc/imcparser.c \ compilers/imcc/cfg.h \ compilers/imcc/debug.h \ compilers/imcc/imc.h \ compilers/imcc/imcparser.h \ compilers/imcc/instructions.h \ compilers/imcc/optimizer.h \ compilers/imcc/parser.h \ compilers/imcc/pbc.h \ compilers/imcc/sets.h \ compilers/imcc/symreg.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ include/imcc/embed.h \ $(INC_DIR)/dynext.h \ $(INC_DIR)/oplib/ops.h \ $(PARROT_H_HEADERS) $(CC) $(CFLAGS) @optimize::compilers/imcc/imcparser.c@ @ccwarn::compilers/imcc/imcparser.c@ @cc_shared@ -I$(@D)/. @cc_o_out@$@ -c compilers/imcc/imcparser.c compilers/imcc/main$(O) : \ include/imcc/embed.h \ compilers/imcc/main.c \ compilers/imcc/cfg.h \ compilers/imcc/debug.h \ compilers/imcc/imc.h \ compilers/imcc/imcparser.h \ compilers/imcc/instructions.h \ compilers/imcc/optimizer.h \ compilers/imcc/parser.h \ compilers/imcc/pbc.h \ compilers/imcc/sets.h \ compilers/imcc/symreg.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ $(INC_DIR)/oplib/ops.h \ $(INC_DIR)/runcore_api.h \ $(INC_DIR)/api.h \ $(INC_DIR)/longopt.h \ include/pmc/pmc_sub.h \ $(PARROT_H_HEADERS) ## SUFFIX OVERRIDE - Warnings (This is generated code) compilers/imcc/optimizer$(O) : \ compilers/imcc/optimizer.c \ compilers/imcc/cfg.h \ compilers/imcc/debug.h \ compilers/imcc/imc.h \ compilers/imcc/instructions.h \ compilers/imcc/optimizer.h \ compilers/imcc/pbc.h \ compilers/imcc/sets.h \ compilers/imcc/symreg.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ include/imcc/embed.h \ $(INC_DIR)/oplib/ops.h \ $(INC_DIR)/oplib/core_ops.h \ $(INC_DIR)/runcore_api.h \ $(PARROT_H_HEADERS) $(CC) $(CFLAGS) @optimize::compilers/imcc/optimizer.c@ @ccwarn::compilers/imcc/optimizer.c@ @cc_shared@ -I$(@D)/. @cc_o_out@$@ -c compilers/imcc/optimizer.c compilers/imcc/reg_alloc$(O) : \ compilers/imcc/reg_alloc.c \ compilers/imcc/cfg.h \ compilers/imcc/debug.h \ compilers/imcc/imc.h \ compilers/imcc/instructions.h \ compilers/imcc/optimizer.h \ compilers/imcc/sets.h \ compilers/imcc/symreg.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ include/imcc/embed.h \ $(INC_DIR)/oplib/ops.h \ $(PARROT_H_HEADERS) compilers/imcc/sets$(O) : \ compilers/imcc/sets.c \ compilers/imcc/cfg.h \ compilers/imcc/debug.h \ compilers/imcc/imc.h \ compilers/imcc/instructions.h \ compilers/imcc/sets.h \ compilers/imcc/symreg.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ include/imcc/embed.h \ $(INC_DIR)/oplib/ops.h \ $(PARROT_H_HEADERS) compilers/imcc/symreg$(O) : \ compilers/imcc/symreg.c \ compilers/imcc/cfg.h \ compilers/imcc/debug.h \ compilers/imcc/imc.h \ compilers/imcc/instructions.h \ compilers/imcc/sets.h \ compilers/imcc/symreg.h \ compilers/imcc/unit.h \ include/imcc/yyscanner.h \ include/imcc/embed.h \ $(INC_DIR)/oplib/ops.h \ $(PARROT_H_HEADERS) # imcc file dependencies # # The .flag files are needed because we keep some generated files in Git, # which does not keep accurate timestamps on the files, relative to each other. # Note that YACC or LEX may be null commands, so we must `touch` all the # target files, instead of just the .flag files. compilers/imcc/imcc.y.flag compilers/imcc/imcparser.c compilers/imcc/imcparser.h : compilers/imcc/imcc.y $(YACC) compilers/imcc/imcc.y -d -o compilers/imcc/imcparser.c $(PERL) $(BUILD_TOOLS_DIR)/fixup_gen_file.pl -noheaderizer compilers/imcc/imcparser.c compilers/imcc/imcc.y $(PERL) $(BUILD_TOOLS_DIR)/fixup_gen_file.pl -noheaderizer compilers/imcc/imcparser.h compilers/imcc/imcc.y $(TOUCH) compilers/imcc/imcc.y.flag compilers/imcc/imcparser.c compilers/imcc/imcparser.h compilers/imcc/imcc.l.flag compilers/imcc/imclexer.c : compilers/imcc/imcc.l $(LEX) -ocompilers/imcc/imclexer.c compilers/imcc/imcc.l $(TOUCH) compilers/imcc/imcc.l.flag compilers/imcc/imclexer.c # Needed for parallel builds. The rules above might still be executed multiple # times, but not in parallel. compilers/imcc/imcparser.c : compilers/imcc/imcc.y.flag compilers/imcc/imcparser.h : compilers/imcc/imcparser.c compilers/imcc/imclexer.c : compilers/imcc/imcc.l.flag # Local variables: # mode: makefile # End: # vim: ft=make: subproxy.t000644000765000765 234111533177644 16341 0ustar00brucebruce000000000000parrot-5.9.0/t/dynpmc#!./parrot # Copyright (C) 2005-2010, Parrot Foundation. =head1 NAME t/dynpmc/subproxy.t - test if Sub is overridable via hll_map() =head1 SYNOPSIS % prove t/dynpmc/subproxy.t =head1 DESCRIPTION Tests the hll mapping of Sub PMCs. The test is using SubProxy, which happens to be a Sub. =cut .sub main :main .include 'test_more.pir' plan(3) test_loadlib() test_type_of_hll_mapped_sub() .end .sub test_loadlib .local pmc lib lib = loadlib "subproxy" unless lib goto not_loaded ok(1, 'loadlib') .return() not_loaded: ok(1, 'loadlib') .end .sub test_type_of_hll_mapped_sub .local pmc b, f b = get_global 'bar' $S0 = typeof b is($S0, 'Sub', "test type of hll_map'ped .Sub") f = get_root_global ['some'], 'foo' $S0 = typeof f is($S0, 'SubProxy', "test type of hll_map'ped .Sub") .end .sub bar noop .end .HLL "Some" .loadlib "subproxy" .sub load :anon :immediate .local pmc interp .local pmc sub,subproxy interp = getinterp sub = get_class 'Sub' subproxy = get_class 'SubProxy' interp.'hll_map'(sub,subproxy) .end .sub foo noop .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: parrot_github_release.pl000644000765000765 3230712121732643 22225 0ustar00brucebruce000000000000parrot-5.9.0/tools/release#! perl # Copyright (C) 2012, Parrot Foundation. =head1 NAME tools/release/parrot_github_release.pl - automates the 'parrot.github.com' release process =head1 SYNOPSIS $ perl tools/release/parrot_github_release.pl [OPTIONS] =head1 DESCRIPTION This script automates the packaging of the 'parrot.github.com' repository and the archiving of the previous documentation release into the appropriate 'parrot-docsx' repository. In short, this script automates Section X of the Release Manager Guide (F) as outlined in the Release Parrot Github Guide (F). =head1 OPTIONS =over 4 =item B<--docs>=[/path_to/previous/docs/] The path to the directory which contains the previous documentation release. Specifically, the 'docs/' directory of the previous release of parrot. =item B<-h>, B<--help> Displays this help message and exits. =item B<-v>, B<--version> Displays the version and copyright information and exits. =back =head1 LIMITATIONS 1. As written, this script will execute only on *nix (and related) systems. 2. You must execute this script from the parrot root directory, I, './parrot'; otherwise, it will fail. =head1 NOTES 1. This script assumes you are the Release Manager, working on Section X of the Release Manger Guide, and have, therefore, already cut the new Parrot release. 2. You must use a fully qualified path for the '--docs' option. For example, if the path to the previous version of the documentation is contained in F, you I specify the complete path to the 'docs/' directory and may not use "shell expansion" as the name of your home directory, I you may not use C<~/git-work/parrot/docs/>. To do otherwise means the script will fail. =head1 HISTORY * [2012-03-21] Initial version written by Alvis Yardley * [2012-07-13] Made the script more robust Alvis Yardley =head1 SEE ALSO F F =cut use strict; use warnings; use Getopt::Long; use Pod::Usage; use System::Command; use lib qw( ./lib ); use Parrot::Config; use Cwd; # Switches my $docs; # Path to the previous docs release my $help; # Displays help message my $version; # Displays version and copyright information my $result = GetOptions('docs=s' => \$docs, 'h|help' => \$help, 'v|version' => \$version); my $repos; # Path to where to store, temporarily, the repositories # Catch unrecognized switches pod2usage() unless $result; # Display help message if '-h' was given pod2usage(0) if $help; # Display version and copyright information if '-v' was given version() && exit(0) if $version; # Get temporary directory defined in 'Parrot::Config::Generated.pm' get_repo_directory(); # Get 'docs/' directory if not supplied get_docs_directory() unless $docs; # Test 'docs/' directory to ensure it's a valid 'docs/' directory. tst_docs_directory(); # Get VERSION open my $FH, '<', 'VERSION' or stop("Unable to open 'VERSION' file"); chomp($version = <$FH>); close $FH; # Parse version number my ($major, $minor, $patch); # Quiet perlcritic ($major, $minor, $patch) = ($1, $2, $3) if $version =~ /^(\d+)\.(\d+)\.(\d+)$/; stop("There is some problem with the major or the minor release numbers") unless $major and $minor; # Set to the previous release version if ($minor == 0) { $minor = 11; $major -= 1; } else { $minor -= 1; } # Get the current working directory my $parrot_dir = getcwd(); # Release process get_parrot_github(); get_parrot_docsx(); archive_parrot_docsx(); update_parrot_github(); delete_repos(); exit(0); ########################## # Subroutine definitions # ########################## # Get the temporary directory, contained in '%PConfig', in which to clone # the repos sub get_repo_directory { $repos = $PConfig{tempdir}; if (!defined $repos) { print "\'\$PConfig{\'tempdir\'}\' is undefined. This variable must ", "be defined and defined with a readable and a writeable directory ", "to execute, successfuly, this script.\n"; print "Did you, perhaps, fail to configure parrot?\n"; exit(1); } $repos .= '/'; # Test '$repo' directory to ensure we can read and write to it. my $tstfile = $repos . 'parrot_github_release.out'; my $outstring = "A simple test string: parrot_github_release.out"; open my $OUT, '+>', $tstfile or stop("Unable to open file for output in $repos directory."); print $OUT $outstring; close $OUT or stop("Unable to close file in $repos directory"); open my $IN, '<', $tstfile or stop("Unable to open file for input in $repos directory."); my $instring = <$IN>; close $IN or stop("Unable to close $tstfile"); stop("Unable to read and to write to $repos directory") unless $instring eq $outstring; unlink $tstfile or warn "Unable to delete $tstfile: $!"; } # Get 'docs/' directory sub get_docs_directory { while (1) { print "Please specify the path to the previous documentation release? "; $docs = <>; chomp $docs; last if -d $docs; } $docs .= '/' if $docs =~ /[a-zA-Z0-9]$/; } # Test whether or not we actually have a valid 'docs/' directory. sub tst_docs_directory { my $parrot_dir = getcwd(); my $filename = 'parrothist.pod'; # This one's likely to stick around. $docs .= '/' if $docs =~ /[a-zA-Z0-9]$/; chdir $docs; stop("Unable to access the $docs directory") unless (-f $filename && -s $filename); chdir $parrot_dir; } # Clone a local copy of 'parrot.github.com' sub get_parrot_github { chdir $repos; print "\n== CLONING 'PARROT.GITHUB.COM' ==\n"; system('git', 'clone', 'git@github.com:parrot/parrot.github.com.git') == 0 or stop("Unable to clone 'parrot.github.com'"); chdir $parrot_dir; } # Clone a local copy of 'parrot-docsx' sub get_parrot_docsx { my $parrot_docsx = 'git@github.com:parrot/parrot-docs' . $major . '.git'; chdir $repos; print "\n== CLONING 'PARROT-DOCSX' ==\n"; system('git', 'clone', $parrot_docsx) == 0 or stop("Unable to clone the appropriate 'parrot-docsx' repo."); chdir $parrot_dir; } # Archive the previous documentation release to the 'parrot-docsx' repository sub archive_parrot_docsx { my $parrot_docsx = $repos . 'parrot-docs' . $major . '/'; chdir $parrot_docsx; print "\n== CHECKING OUT GH-PAGES BRANCH ==\n"; system('git', 'checkout', 'gh-pages') == 0 or stop("Unable to switch to the 'gh-pages' branch"); my $previous = $major . '.' . $minor . '.' . $patch; my $copy_to = $parrot_docsx . $previous . '/'; my $copy_from = $docs . '*'; print "\n== MAKING NEW DIRECTORY IN 'PARROT-DOCSX' ==\n"; mkdir($copy_to) or stop("Unable to make new directory in 'parrot-docsx'"); print "\n== COPYING DOCS TO 'PARROT-DOCSX' ==\n"; # Use shell globbing, for convenience. (Should I rewrite this?) system("cp -r --target-directory=$copy_to $copy_from") == 0 or stop("Unable to copy 'docs/' to 'parrot-docsx'"); print "\n== GIT ADD ('PARROT-DOCSX') ==\n"; system('git', 'add', '.') == 0 or stop("Unable to add to 'parrot-docsx'"); print "\n== GIT COMMIT ('PARROT-DOCSX') ==\n"; system('git', 'commit', '-m', "'Archiving documentation release'") == 0 or stop("Unable to commit to 'parrot-docsx'"); print "\n== CHECKING OUT MASTER ==\n"; system('git', 'checkout', 'master') == 0 or stop("Unable to switch to 'master'"); print "\n== PUSHING 'PARROT-DOCSX' ==\n"; system('git', 'push', 'origin', 'gh-pages') == 0 or stop("Unable to push updates to 'parrot-docsx'"); chdir $parrot_dir; } # Update parrot.github.com with present release docs sub update_parrot_github { my $parrot_github = $repos . 'parrot.github.com' . '/'; chdir $parrot_github; my $tmp = $PConfig{tempdir}; print "\n== SAVING KEY 'PARROT.GITHUB.COM' FILES ==\n"; system('cp', "--target-directory=$tmp", 'README.md') == 0 or stop("Unable to save 'README.md'"); system('cp', "--target-directory=$tmp", 'index.html') == 0 or stop("Unable to save 'index.html'"); system('cp', "--target-directory=$tmp", 'releases.html') == 0 or stop("Unable to save 'releases.html'"); print "\n== GIT RM ('PARROT.GITHUB.COM') ==\n"; system('git', 'rm', '-rf', '*') == 0 or stop("Unable to remove files from 'parrot.github.com'"); print "\n== GIT ADD ('PARROT.GITHUB.COM') ==\n"; system('git', 'add', '-A') == 0 or stop("Unable to add to 'parrot.github.com'"); print "\n== GIT COMMIT ('PARROT.GITHUB.COM') ==\n"; system('git', 'commit', '-m', "'Removed files from 'parrot.github.com'") == 0 or stop("Unable to commit to 'parrot.github.com'"); print "\n== RESTORING KEY 'PARROT.GITHUB.COM' FILES ==\n"; system('cp', "$tmp/README.md", '.') == 0 or stop("Unable to restore 'README.md'"); system('cp', "$tmp/index.html", '.') == 0 or stop("Unable to restore 'index.html'"); system('cp', "$tmp/releases.html", '.') == 0 or stop("Unable to restore 'releases.html'"); update_index_html(); update_releases_html(); my $parrot_docs = $parrot_dir . '/' . 'docs/*'; print "\n== COPYING 'DOCS/' TO 'PARROT.GITHUB.COM' ==\n"; # Here I am, relying on the shell, again. system("cp -r $parrot_docs .") == 0 or stop("Unable to copy 'docs/' to 'parrot.github.com'"); print "\n== GIT ADD ('PARROT.GITHUB.COM') ==\n"; system('git', 'add', '.') == 0 or stop("Unable to add to 'parrot.github.com'"); print "\n== GIT COMMIT ('PARROT.GITHUB.COM') ==\n"; system('git', 'commit', '-m', "'Updated 'parrot.github.com'") == 0 or stop("Unable to commit to 'parrot.github.com'"); print "\n== PUSHING ('PARROT.GITHUB.COM') ==\n"; system('git', 'push', 'origin', 'master') == 0 or stop("Unable to push updates to 'parrot.github.com' master"); chdir $parrot_dir; } # Update the link to 'Previous Parrot Documentation Releases' in 'index.html' sub update_index_html { my $buffer = ''; open my $FH, '+<', 'index.html' or stop("Unable to open 'index.html'"); while (<$FH>) { s/$1/$version/ if /Parrot ($major\.$minor\.$patch)-devel - Home/; s/$1/$version/ if /Parrot version ($major\.$minor\.$patch)-devel/; s/$1/$major\.$minor\.$patch/ if /Previous Parrot Documentation Releases \((\d.\d.\d) - 0.1.1\)/; $buffer .= $_; } seek($FH, 0, 0) or stop("Unable to seek start of 'index.html'"); print $FH $buffer or stop("Unable to print out 'index.html'"); truncate($FH, tell($FH)) or stop("Unable to truncate 'index.html'"); close $FH or stop("Unable to close 'index.html'"); } # Update 'releases.html' to point to the newly archived documents in # 'parrot-docsx' sub update_releases_html { my $buffer = ''; my $ul = '
    • HEADER } =item C Returns the html code, I links, passed to it. C<@html> is a simple array to hold the html links passed to this subroutine. =cut sub body { my $self = shift; my $body; foreach(@_) { $body .= $_; } return $body; } =item C Returns the page footer. C<$navigation> is currently unused. C<$resources> should be the relative path from the page to F, the image and CSS file directory. =cut sub footer { my $self = shift; my $navigation = shift || ''; my $resources = shift || ''; my $version = shift || ''; my $footer = <<"FOOTER";