Subject: perl autoloader

From: "Mark W. Eichin" <[email-masked]>
Date: Mon, 6 Jul 92 10:43:49 EDT

SUB: Building auto/data loaded perl scripts
SUM: [email-masked] (Raphael Manfredi)->[email-masked]

Here is a little script which transforms a perl program into another
equivalent perl program using dataloading and/or autoloading.

Tom Christiansen <[email-masked]> wrote an article on this subject,
describing the approach he took for his plum package. However, although
his method is minimal, it heavily relies on the internal data structure
used by the symbol table, and the meta-knowledge that the eigth pointer
(stored on 4 bytes) is the one pointing to the subroutine definition.

The method I am using is a little more costly and requires an additional
indirection, but it is "plain" perl, i.e. does not rely on any
meta-knowledge. It has been developped with perl 4.0 PL19 and higher.
I have been using this script for a while now, and it appears to be quite
reliable.

Applied on my mailagent (a program which is about 5500 lines long) to build a
pure dataloaded script, it generates a 6400 lines script but the perl process
is about 650K smaller and starts three times faster than the original plain
version.

The only drawback with a dataloaded script is when you get messages like
this:

	Illegal division by zero at (eval) line 65.

This is why it is desirable to have an automatic translator and work on
the plain perl script when developping, using the dataloaded version only when
everything is working (unless you are ready to spend time tracing the problem
within the dataloaded form of the script).

Oh!, I forgot: unlike most programs posted on this newsgroup, this one is
formatted with tabstops=4. And it does not have the leading #! incantation
either. Sorry.

I would appreciate any feedback on this program.
--
Raphael Manfredi <[email-masked]>
Interactive Software Engineering Inc.
270 Storke Road, Suite #7                      / Tel +1 (805) 685-1006 \
Goleta, California 93117, USA                  \ Fax +1 (805) 685-6869 /

#! /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 [email-masked] if you want that tool.
# Contents:  perload
# Wrapped by ram@lyon on Sun Jul  5 14:14:10 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'\" \(15691 characters\)
  sed "s/^X//" >'perload' <<'END_OF_FILE'
Xeval "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.8.1.4 91/11/18 13:53:49 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
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
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($__package__,$__name__) = (caller(1))[3] =~ m|(\w+)'(\w+)|;
X:	local($__rpackage__) = $__package__;
X:	local($__saved__) = $@;
X:	$__rpackage__ =~ s/^auto_//;
X:	&perload'load_from_file($__file__);
X:	local($__fun__) = "$__rpackage__" . "'" . "load_$__name__";
X:	$@ = $__saved__;	# Restore value $@ had on entrance
X:	&$__fun__(@_);		# 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 $'__rpackage__" . "'$'__name__ 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($__package__,$__name__) = (caller(1))[3] =~ m|(\w+)'(\w+)|;
X:	local($__rpackage__) = $__package__;
X:	local($__at__) = $@;
X:	$__rpackage__ =~ s/^auto_//;
X:	&perload'load_from_data($__rpackage__ . '\'' . $__name__);
X:	local($__dataload__) = "*$__package__" . "'" . "$__name__ = " .
X:		"*$__rpackage__" . "'" . "load_$__name__;";
X:	local($__fun__) = "$__rpackage__" . "'" . "load_$__name__";
X:	eval $__dataload__;	# 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:	local($pos) = $perload'Datapos{$_[0]};	# Offset within DATA
X:	local($body) = ' ' x 1024;				# Pre-extent
X:	# Avoid side effects by protecting special variables which will be changed
X:	# by the dataloading operation.
X:	local($., $_, $@);
X:	$pos = &perload'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(DATA, $pos, 0);
X:	$body = '';
X:	while (<DATA>) {
X:		$body .= $_;
X:		last if /^\}/;
X:	}
X:	die "End of file found while loading $_[0].\n" unless /^\}/;
X:	eval $body;		# Load function into perl space
X:	chop($@) && die "$@, while parsing code of $_[0].\n";
X:}
X:
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:	local($pos) = tell DATA;
X:	local($in_function) = 0;
X:	local($func_name);
X:	local($., $_);
X:	while (<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:			$perload'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 DATA;
X:	}
X:	0;		# Function not found
X:}
X:
XEOC
X
Xif (@Data > 0) {
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	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
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[ \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 restriction 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 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.SH AUTHOR
XRaphael Manfredi <[email-masked]>
X.SH "SEE ALSO"
Xperl(1).
END_OF_FILE
  if test 15691 -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