NetNews Usenet Archive 1992 #18/NN_1992_18.iso/spool/comp/lang/perl/5291

Internet Message Format | 1992-08-12 | 22.1 KB

Path: sparky!uunet!eiffel!eiffel.com
From: [e-mail] (Raphael Manfredi)
Newsgroups: comp.lang.perl
Subject: Updated perload script for data/auto loading
Summary: Added option -o for optimized dataloading
Keywords: perl, autoloading, dataloading, speed
Message-ID: <[e-mail]>
Date: 13 Aug 92 04:17:31 GMT
Sender: [e-mail]
Organization: Interactive Software Engineering, Santa Barbara CA
Lines: 650

Here is an updated version of my 'perload' script, which takes an arbitrary
perl script and produces an equivalent one set up for dataloading and/or
autoloading.

This new version takes advantage of the feedback I got from Wayne Scott.
Wayne took care of optimizing the function fetching the code within
the data section by removing unneeded strings operations. The new option
-o (also from Wayne) will build an offset table right at the beginning
of the dataloaded section. This speeds up the initial loading of the functions
by skipping the parsing of the data section to locate subroutine definitions.

Enjoy!
--
Raphael Manfredi <[e-mail]>
Interactive Software Engineering Inc.
270 Storke Road, Suite #7                      / Tel [phone] \
Goleta, California 93117, USA                  \ Fax [phone] /

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then feed it
# into a shell via "sh file" or similar.  To overwrite existing files,
# type "sh file -c".
# The tool that generated this appeared in the comp.sources.unix newsgroup;
# send mail to [e-mail] if you want that tool.
# Contents:  perload
# Wrapped by ram@lyon on Wed Aug 12 21:21:21 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
echo If this archive is complete, you will see the following message:
echo '          "shar: End of archive."'
if test -f 'perload' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'perload'\"
else
  echo shar: Extracting \"'perload'\" \(19802 characters\)
  sed "s/^X//" >'perload' <<'END_OF_FILE'
X# feed this into perl
X'/bin/true' && eval 'exec perl -S $0 "$@"'
X    if $running_under_some_shell;
X'di';
X'ig00';
X
X#
X# This perl script is its own manual page [generated by wrapman]
X#
X
X# $Id: perload,v 2.9.1.1 92/08/02 16:25:43 ram Exp Locker: ram $
X#
X#  Copyright (c) 1992, Raphael Manfredi
X#
X#  You may redistribute only under the terms of the GNU General Public
X#  Licence as specified in the README file that comes with dist.
X#
X# $Log:    perload,v $
X# Revision 2.9.1.1  92/08/02  16:25:43  ram
X# patch2: dataloading routines now fully operate in perload package
X#
X# Revision 2.9  92/07/14  16:53:40  ram
X# 3.0 beta baseline.
X#
X
X# Replace each function definition in a loading section by two stubs and
X# reject the definition into the DATA part of the script if in a dataload
X# section or into a FILE if in an autoload section.
X
X$in_load = 0;                    # In a loading section
X$autoload = '';                    # Name of autoloaded file
X$has_invocation_stub = 0;        # True if we detect a #! stub
X$current_package = 'main';        # Current package
X$init_emitted = 0;                # True when dataloading stamp was emitted
X$in_function = 0;
X
Xrequire 'getopt.pl';
X&Getopt;
X
Xwhile (<>) {
X    if ($. == 1 && /^#.*perl/) {    # Invocation stub
X        $has_invocation_stub = 1;
X        print;
X        next;
X    }
X    if ($. <= 3 && $has_invocation_stub) {
X        print;
X        next;
X    }
X    if (/^\s*$/) {
X        &flush_comment;
X        print unless $in_function;
X        print if $in_function && !$in_load;
X        if ($in_function && $in_load) {
X            push(@Data, "\n") unless $autoload;
X            $Auto{$autoload} .= "\n" if $autoload;
X        }
X        next;
X    }
X    if (/^\s*#/) {
X        if (/^#\s*perload on/i) {        # Enter a loading section
X            print unless /:$/;
X            $in_load = 1;
X            next;
X        }
X        if (/^#\s*perload off/i) {        # End a loading section
X            print unless /:$/;
X            $in_load = 0;
X            next;
X        }
X        if (/^#\s*autoload (\S+)/i) {    # Enter autoloading section
X            print unless /:$/;
X            push(@autoload, $autoload);    # Directives may be nested
X            $autoload = $1;
X            $in_load += 2;
X            next;
X        }
X        if (/^#\s*offload/i) {            # End autoloading section
X            print unless /:$/;
X            $autoload = pop(@autoload);    # Revert to previously active file
X            $in_load -= 2;
X            next;
X        }
X        &emit_init unless $init_emitted;
X        push(@Comment, $_) unless $in_function;
X        print if $in_function && !$in_load;
X        next unless $in_function;
X        push(@Data, $_) unless $autoload;
X        $Auto{$autoload} .= $_ if $autoload;
X        next;
X    }
X    &emit_init unless $init_emitted;
X    /^package (\S+)\s*;/ && ($current_package = $1);
X    unless ($in_load) {
X        &flush_comment;
X        print;
X        next;
X    }
X    # We are in a loading section
X    if (/^sub\s+([\w']+)\s*\{(.*)/) {
X        die "line $.: function $1 defined within another function.\n"
X            if $in_function;
X        # Silently ignore one-line functions
X        if (/\}/) {
X            print;
X            next;
X        }
X        $comment = $2;
X        $in_function = 1;
X        $function = $1;
X        ($fn_package, $fn_basename) = $function =~ /^(\w+)'(\w+)/;
X        unless ($fn_package) {
X            $fn_package = $current_package;
X            $fn_basename = $function;
X        }
X        # Keep leading function comment
X        foreach (@Comment) {
X            push(@Data, $_) unless $autoload;
X            $Auto{$autoload} .= $_ if $autoload;
X        }
X        @Comment = ();
X        # Change package context for correct compilation: the name is visible
X        # within the original function package while the body of the function
X        # is compiled within the current package.
X        $declaration = "sub $fn_package" . "'load_$fn_basename {$comment\n";
X        $package_context = "\tpackage $current_package;\n";
X        if ($autoload) {
X            $Auto{$autoload} .= $declaration . $package_context;
X        } else {
X            push(@Data, $declaration, $package_context);
X        }
X        # Emit stubs
X        print "sub $fn_package", "'$fn_basename";
X        print " { &auto_$fn_package", "'$fn_basename; }\n";
X        print "sub auto_$fn_package", "'$fn_basename { ";
X        print '&main\'dataload' unless $autoload;
X        print '&main\'autoload(' . "'$autoload'" . ', @_)' if $autoload;
X        print "; }\n";
X        next;
X    }
X    unless ($in_function) {
X        &flush_comment;
X        print;
X        next;
X    }
X    # We are in a loading section and inside a function body
X    push(@Data, $_) unless $autoload;
X    $Auto{$autoload} .= $_ if $autoload;
X    $in_function = 0 if /^\}/;
X    if (/^\}/) {
X        push(@Data, "\n") unless $autoload;
X        $Auto{$autoload} .= "\n" if $autoload;
X    }
X}
X
X@auto = keys %Auto;
Xprint &q(<<'EOC') if @auto > 0;
X:# Load the calling function from file and call it. This function is called
X:# only once per file to be loaded.
X:sub main'autoload {
X:    local($__file__) = shift(@_);
X:    local($__packname__) = (caller(1))[3];
X:    local($__rpackname__) = $__packname__;
X:    local($__saved__) = $@;
X:    $__rpackname__ =~ s/^auto_//;
X:    &perload'load_from_file($__file__);
X:    $__rpackname__ =~ s/'/'load_/;
X:    $@ = $__saved__;        # Restore value $@ had on entrance
X:    &$__rpackname__(@_);    # Call newly loaded function
X:}
X:
X:# Load file and compile it, substituing the second stub function with the
X:# loaded ones. Location of the file uses the @AUTO array.
X:sub perload'load_from_file {
X:    package perload;
X:    local($file) = @_;                # File to be loaded
X:    local($body) = ' ' x 1024;        # Pre-extent
X:    local($load) = ' ' x 256;        # Loading operations
X:    # Avoid side effects by protecting special variables which will be
X:    # changed by the autoloading operation.
X:    local($., $_, $@);
X:    $body = '';
X:    $load = '';
X:    &init_auto unless defined(@'AUTO);    # Make sure we have a suitable @AUTO
X:    &locate_file unless -f "$file";        # Locate file if relative path
X:    open(FILE, $file) ||
X:        die "Can't load $'__rpackname__ from $file: $!\n";
X:    while (<FILE>) {
X:        $load .= '*auto_' . $1 . '\'' . $2 . '= *' . $1 . '\'' . "load_$2;\n"
X:            if (/^sub\s+(\w+)'load_(\w+)\s*\{/);
X:        $body .= $_;
X:    }
X:    close FILE;
X:    eval $body . $load;
X:    chop($@) && die "$@, while parsing code of $file.\n";
X:}
X:
X:# Initialize the @AUTO array. Attempt defining it by using the AUTOLIB
X:# environment variable if set, otherwise look in auto/ first, then in the
X:# current directory.
X:sub perload'init_auto {
X:    if (defined $ENV{'AUTOLIB'} && $ENV{'AUTOLIB'}) {
X:        @AUTO = split(':', $ENV{'AUTOLIB'});
X:    } else {
X:        @AUTO = ('auto', '.');
X:    }
X:}
X:
X:# Locate to-be-loaded file held in $file by looking through the @AUTO array.
X:# This variable, defined in 'load_from_file', is modified as a side effect.
X:sub perload'locate_file {
X:    package perload;
X:    local($fullpath);
X:    foreach $dir (@'AUTO) {
X:        $fullpath = $dir . '/' . $file;
X:        last if -f "$fullpath";
X:        $fullpath = '';
X:    }
X:    $file = $fullpath if $fullpath;        # Update var from 'load_from_file'
X:}
X:
XEOC
X
Xprint &q(<<'EOC') if @Data > 0;
X:# Load the calling function from DATA segment and call it. This function is
X:# called only once per routine to be loaded.
X:sub main'dataload {
X:    local($__packname__) = (caller(1))[3];
X:    local($__rpackname__) = $__packname__;
X:    local($__at__) = $@;
X:    $__rpackname__ =~ s/^auto_//;
X:    &perload'load_from_data($__rpackname__);
X:    local($__fun__) = "$__rpackname__";
X:    $__fun__ =~ s/'/'load_/;
X:    eval "*$__packname__ = *$__fun__;";    # Change symbol table entry
X:    die $@ if $@;        # Should not happen
X:    $@ = $__at__;        # Restore value $@ had on entrance
X:    &$__fun__;            # Call newly loaded function
X:}
X:
X:# Load function name given as argument, fatal error if not existent
X:sub perload'load_from_data {
X:    package perload;
X:    local($pos) = $Datapos{$_[0]};            # Offset within DATA
X:    # Avoid side effects by protecting special variables which will be changed
X:    # by the dataloading operation.
X:    local($., $_, $@);
X:    $pos = &fetch_function_code unless $pos;
X:    die "Function $_[0] not found in data section.\n" unless $pos;
X:    die "Cannot seek to $pos into data section.\n"
X:        unless seek(main'DATA, $pos, 0);
X:    local($/) = "\n}";
X:    local($body) = scalar(<main'DATA>);
X:    local($*) = 1;
X:    die "End of file found while loading $_[0].\n" unless $body =~ /^\}$/;
X:    eval $body;        # Load function into perl space
X:    chop($@) && die "$@, while parsing code of $_[0].\n";
X:}
X:
XEOC
X
Xif (@Data > 0) {
X    print &q(<<'EOC') unless $opt_o;
X:# Parse text after the END token and record defined loadable functions (i.e.
X:# those whose name starts with load_) into the %Datapos array. Such function
X:# definitions must be left adjusted. Stop as soon as the function we want
X:# has been found.
X:sub perload'fetch_function_code {
X:    package perload;
X:    local($pos) = tell main'DATA;
X:    local($in_function) = 0;
X:    local($func_name);
X:    local($., $_);
X:    while (<main'DATA>) {
X:        if (/^sub\s+(\w+)'load_(\w+)\s*\{/) {
X:            die "DATA line $.: function $1'$2 defined within $func_name.\n"
X:                if $in_function;
X:            $func_name = $1 . '\'' . $2;
X:            $Datapos{$func_name} = $pos;
X:            $in_function = 1;
X:            next;
X:        }
X:        $in_function = 0 if /^\}/;
X:        next if $in_function;
X:        return $pos if $func_name eq $_[0];
X:        $pos = tell main'DATA;
X:    }
X:    0;        # Function not found
X:}
X:
XEOC
X    print &q(<<'EOC') if $opt_o;
X:# This function is called only once, and fills in the %Datapos array with
X:# the offset of each of the dataloaded routines held in the data section.
X:sub perload'fetch_function_code {
X:    package perload;
X:    local($start) = 0;
X:    local($., $_);
X:    while (<main'DATA>) {            # First move to start of offset table
X:        next if /^#/;
X:        last if /^$/ && ++$start > 2;    # Skip two blank line after end token
X:    }
X:    $start = tell(main'DATA);        # Offsets in table are relative to here
X:    local($key, $value);
X:    while (<main'DATA>) {            # Load the offset table
X:        last if /^$/;                # Ends with a single blank line
X:        ($key, $value) = split(' ');
X:        $Datapos{$key} = $value + $start;
X:    }
X:    $Datapos{$_[0]};        # All that pain to get this offset...
X:}
X:
XEOC
X    print &q(<<'EOC');
X:#
X:# The perl compiler stops here.
X:#
X:
X:__END__
X:
X:#
X:# Beyond this point lie functions we may never compile.
X:#
X:
XEOC
X    # Option -o directs us to optimize the function location by emitting an
X    # offset table, which lists all the position within DATA for each possible
X    # dataloaded routine.
X    if ($opt_o) {
X        print &q(<<'EOC');
X:#
X:# DO NOT CHANGE A IOTA BEYOND THIS COMMENT!
X:# The following table lists offsets of functions within the data section.
X:# Should modifications be needed, change original code and rerun perload
X:# with the -o option to regenerate a proper offset table.
X:#
X:
XEOC
X        $trailing_message = &q(<<'EOC');
X:
X:#
X:# End of offset table and beginning of dataloading section.
X:#
X:
XEOC
X        $pos = 0;            # Offset relative to this point (start of table)
X        foreach (@Data) {
X            $Datapos{"$1\'$2"} = $pos - $now
X                if /^sub\s+(\w+)'load_(\w+)\s*\{/;    # } for vi
X            $pos += length;
X        }
X        @poskeys = keys %Datapos;    # Array of routine names (fully qualified)
X
X        # Write out a formatted table, each entry stored on $entry bytes and
X        # formatted with the $format string.
X        ($entry, $format) = &get_format(*poskeys);
X
X        # The total size occupied by the table is the size of one item times
X        # the number of items plus the final trailing message at the end of
X        # the table.
X        $table_size = $entry * @poskeys + length($trailing_message);
X
X        # Output formatted table
X        foreach (sort @poskeys) {
X            printf($format, $_, $table_size + $Datapos{$_});
X        }
X        print $trailing_message;
X    }
X
X    # Output code for each dataloaded function
X    foreach (@Data) {
X        print;
X    }
X    print &q(<<'EOC');
X:#
X:# End of dataloading section.
X:#
X:
XEOC
X}
X
Xif (@auto > 0) {
X    mkdir('auto',0755) unless -d 'auto';
X    foreach $file (@auto) {
X        unless (open(AUTO, ">auto/$file")) {
X            warn "Can't create auto/$file: $!\n";
X            next;
X        }
X        print AUTO &q(<<'EOC');
X:# This file was generated by perload
X:
XEOC
X        print AUTO $Auto{$file};
X        close AUTO;
X    }
X}
X
X# Compute optimum format for routine offset table, returning both the size of
X# each entry and the formating string for printf.
Xsub get_format {
X    local(*names) = @_;
X    local($name_len) = 0;
X    local($max_len) = 0;
X    foreach (@names) {
X        $name_len = length;
X        $max_len = $name_len if $name_len > $max_len;
X    }
X    # The size of each entry (preceded by one tab, followed by 12 chars)
X    $name_len = $max_len + 1 + 12;
X    ($name_len, "\t%${max_len}s %10d\n");
X}
X
Xsub emit_init {
X    print &q(<<'EOC');
X:#
X:# This perl program uses dynamic loading [generated by perload]
X:#
X:
XEOC
X    $init_emitted = 1;
X}
X
Xsub flush_comment {
X    print @Comment if @Comment > 0;
X    @Comment = ();
X}
X
Xsub q {
X    local($_) = @_;
X    local($*) = 1;
X    s/^://g;
X    $_;
X}
X
X#
X# These next few lines are legal in both perl and nroff.
X#
X
X.00;        # finish .ig
X
X'di            \" finish diversion--previous line must be blank
X.nr nl 0-1    \" fake up transition to first page again
X.nr % 0        \" start at page 1
X'; __END__    \" the perl compiler stops here
X
X'''
X''' From here on it's a standard manual page.
X'''
X
X.TH PERLOAD 1 "June 20, 1992"
X.AT 3
X.SH NAME
Xperload \- builds up autoloaded and dataloaded perl scripts
X.SH SYNOPSIS
X.B perload
X[ \fB\-o\fR ]
X[ \fIfile\fR ]
X.SH DESCRIPTION
X.I Perload
Xtakes a perl script as argument (or from stdin if no argument is supplied)
Xand prints out on stdout an equivalent script set-up to perform autoloading
Xor dataloading. The translation is directed by special comments within the
Xoriginal script. Using dynamic loading can drastically improve start-up
Xperformances, both in time and in memory, as perl does not need to compile
Xthe whole script nor store its whole compiled form in memory.
X.PP
X.I Autoloading
Xdelays compilation of some functions until they are needed. The code for these
Xfunctions is loaded dynamically at run-time. The atomicity of loading is a
Xfile, which means that putting more than one function into a file will cause
Xall these functions to be loaded and compiled as soon as one among them is
Xneeded.
X.PP
X.I Dataloading
Xis a form of autoloading where no extra file are needed. The script carries
Xall the functions whose compilation is to be delayed in its data segment
X(in the \fIperl\fR sense, i.e. they are accessible via the DATA filehandle).
XThe scripts parses the data segment and extracts only the code for the needed
Xsubroutine, which means granularity is better than with autloading.
X.PP
XIt is possible for a single script to use both autoloading and dataloading at
Xthe same time. However, it should be noted that a script using only dataloading
Xis self contained and can be moved or shared accross different platforms without
Xfear. On the contrary, a script using only autoloading relies on some externally
Xprovided files. Sharing this script among different platforms requires sharing
Xof these external files. The script itself cannot be redistributed without
Xalso giving the extra files holding the autoloaded functions.
X.PP
XThe major drawback with dataloading is that the DATA filehandle cannot be used
Xfor anything else and may result in code duplication when two scripts could
Xshare the same pieces of code. Autoloading appears as the perfect solution in
Xthis case since two scripts may freely share the same functions without
Xactually duplicating them on the disk (hence saving some precious disk blocks
X:-).
X.SH CRITERIA
XFunctions to be dataloaded or autoloaded must meet the following layout
Xcriteria:
X.TP 5
X\-
XThey must not be one-line functions like \fIsub sorter { $a <=> $b }\fR.
XThose functions are simply output verbatim, as they are already so
Xsmall that it would not be worth to dynamically load them,
X.TP
X\-
XThe first line must be of the form \fIsub routine_name {\fR, with an optional
Xcomment allowed after the '{'.
X.TP
X\-
XThe function definition must end with a single '}' character left aligned.
X.TP
X\-
XPackage directives outside any function must be left aligned.
X.PP
XAll the above restrictions should not be source of a problem if "standard"
Xwriting style is used. There are also some name restrictions: the package
Xname \fIperload\fR is reserved, as is the \fI@AUTO\fR array when autoloading
Xis used. Packages must not start with \fIauto_\fR, as this is prepended to
Xuser's package names when building the stubs. Furthermore, the subroutines
Xnames \fImain'autoload\fR and
X\fImain'dataload\fR must not be used by the original script. Again, these
Xshould not cause any grief.
X.SH DIRECTIVES
XThe translation performed by
X.I Perload
Xis driven by some special comment directives placed directly within the code.
XEnding those directives with a ':' character will actually prevent them from
Xbeing output into the produced script. Case is irrelevant for all the directives
Xand the comment need not be left-aligned, although it must be the first
Xnon-space item on the line.
X.PP
XThe following directives are available:
X.TP 10
X# Perload ON
XTurns on the \fIperload\fR processing. Any function definition which meets
Xthe criteria listed in the previous section will be replaced by two stubs and
Xits actual definition will be reject into the data segment (default) or a file
Xwhen inside an autoloading section.
X.TP
X# Perload OFF
XTurns off any processing. The script is written as-is on the standard output.
X.TP
X# Autoload \fIpath\fR
XRequests autoloading from file \fIpath\fR, which may be an absolute path or
Xa relative path. The file will be located at run-time using the @AUTO array
Xif a non-absolute path is supplied or if the file does not exist as listed.
XAutoloading directives may be nested.
X.TP
X# Offload \fIpath\fR
XThe argument is not required. The directive ends the previous autoloading
Xdirective (the inmost one). This does not turn off the \fIperload\fR processing
Xthough. The \fIpath\fR name is optional here (in fact, it has only a comment
Xvalue).
X.SH OPTION
XPerload accepts only one option, \fB\-o\fR, which is meaningful only when
Xdataloading is used. It outputs an offset table which lists the relative
Xoffset of the dataloaded functions within the data section. This will spare
Xperl the run-time parsing needed to locate the function, and results in an good
Xspeed gain. However, it has one major drawback: it prevents people from
Xactually modifying the source beyond the start of the table. But anything
Xbefore can be freely edited, which is particulary useful when tailoring the
Xscript.
X.PP
XThis option should not be used when editing of functions within the data
Xsection is necessary for whatever reason. When \fB\-o\fR is used, any
Xchange in the dataloaded function must be committed by re-running perload
Xon the original script.
X.SH FILES
X.TP 10
Xauto
Xthe subdirectory where all produced autoloaded files are written.
X.SH ENVIRONMENT
XNo environment variables are used by \fIperload\fR. However, the autoloaded
Xversion of the script pays attention to the \fIAUTOLIB\fR variable as a colon
Xseparated set of directories where the to-be-loaded files are to be found
Xwhen a non-absolute path was specified. If the \fIAUTOLIB\fR variable is not
Xset, the default value 'auto:.' is used (i.e. look first in the auto/
Xsubdirectory, then in the current directory.
X.SH CAVEAT
XSpecial care is required when using an autoloading script, especially when
Xexecuted by the super-user: it would be very easy for someone to leave a
Xspecial version of a routine to be loaded, in the hope the super-user (or
Xanother suitable target) executes the autoloaded version of the script with
Xsome \fIad hoc\fR changes...
X.PP
XThe directory holding the to-be-loaded files should therefore be protected
Xagainst unauthorized access, and no file should have write permission on them.
XThe directory itself should not be world-writable either, or someone might
Xsubstitute his own version.
XIt should also be considered wise to manually set the @AUTO variable to a
Xsuitable value within the script itself.
X.PP
XThe \fB\-o\fR option uses \fIperl\fR's special variable \fI$/\fR with a
Xmulti-character value. I suspect this did not work with versions of \fIperl\fR
Xprior to 4.0, so any script using this optimized form of dataloading will not
Xbe 100% backward compatible.
X.SH AUTHOR
XRaphael Manfredi <[e-mail]>
X.SH CREDITS
XValuable input came from Wayne H. Scott <[e-mail]>. He is
Xmerely the author of the optimizing offset table (\fB\-o\fR option).
X.PP
X.I Perload
Xis based on an article from Tom Christiansen <[e-mail]>,
X.I Autoloading in Perl,
Xexplaining the concept of dataloading and giving a basic implementation.
X.SH "SEE ALSO"
Xperl(1).
END_OF_FILE
  if test 19802 -ne `wc -c <'perload'`; then
    echo shar: \"'perload'\" unpacked with wrong size!
  fi
  chmod +x 'perload'
  # end of 'perload'
fi
echo shar: End of archive.
exit 0