diff --git a/glafp-utils/scripts/Jmakefile b/glafp-utils/scripts/Jmakefile new file mode 100644 index 0000000000000000000000000000000000000000..b3589a3fb07788aedd460d2599d5997d44afb111 --- /dev/null +++ b/glafp-utils/scripts/Jmakefile @@ -0,0 +1,50 @@ +PROGRAMS = lndir \ + runstdtest \ + mkdependC \ + mkdirhier \ + fastmake \ + ltx + +all:: $(PROGRAMS) +/* stuff to have before we get going */ +MsubNeededHere($(PROGRAMS)) + +/* === BUILD STUFF (installation, etc., below) ========== */ + +/* std X11 stuff: used in installing ghc/hslibs */ +MsubProgramScriptTarget(BourneShell,mkdirhier,mkdirhier.sh,,) + +BuildPgmFromOneCFile(lndir) + +MsubMakefileDependentProgramScriptTarget(PerlCmd,runstdtest,runstdtest.prl,,) +MsubMakefileDependentProgramScriptTarget(PerlCmd,ltx,ltx.prl,,) +MsubProgramScriptTarget(PerlCmd,fastmake,fastmake.prl,,) + +/* +mkdependC has to go in "bin" directory, because there may be +machine-dependent ideas of what CC to use, etc. + +ltx, runstdtest: ditto, but only because of TMPDIR +*/ +MsubMakefileDependentProgramScriptTarget(PerlCmd,mkdependC,mkdependC.prl,/*noflags*/,/*Makefile*/) + +/* === INSTALLATION ======== */ + +/* the rest of these vary from std/useful to hackish dans le extreme */ + +MakeDirectories(install, $(INSTBINDIR) $(INSTSCRIPTDIR)) +InstallScriptTarget(fastmake, $(INSTSCRIPTDIR)) +InstallBinaryTarget(lndir, $(INSTBINDIR)) +InstallScriptTarget(ltx, $(INSTBINDIR)) +InstallScriptTarget(mkdependC, $(INSTBINDIR)) +InstallScriptTarget(runstdtest, $(INSTBINDIR)) + +InstallManPageTarget(lndir,$(INSTCOMMANDIR),$(COMMANSUFFIX)) +InstallManPageTarget(mkdirhier,$(INSTCOMMANDIR),$(COMMANSUFFIX)) + +/* === OTHER STUFF ========= */ + +ExtraStuffToClean($(PROGRAMS)) + +ClearTagsFile() +PerlTagsTarget( *.prl ) /* nothing for the Bourne shell scripts */ diff --git a/glafp-utils/scripts/fastmake.prl b/glafp-utils/scripts/fastmake.prl new file mode 100644 index 0000000000000000000000000000000000000000..730e6a41a5aa3c5806dc46e1781b61fa3e5b3fbe --- /dev/null +++ b/glafp-utils/scripts/fastmake.prl @@ -0,0 +1,127 @@ +#! /usr/local/bin/perl +# +($Pgm = $0) =~ s/.*\/([^\/]+)$/\1/; +$Usage = "\n" . <<EOUSAGE; +Usage: + $Pgm [-? or -help] [-k] [-n] [-v] [-t] dir/module-target(s) + +This script runs `make' to build the requested target, WITHOUT +including the dependencies generated by `mkdependHS' (i.e., all those +derived from import declarations). + +With a -t flag, it also sets the modification time of the resulting +.hi file (one target only, please) to some EARLY date, so that changes +to that interface will not trigger much useless recompilation. + +Typical uses, for module "Bar" in directory "foo": + +(1) You've changed "Bar" and you want to recompile it; you know that + other module interfaces are stable, so you'd rather do without all + of `make''s prognostications: + + $Pgm foo/Bar.s + +(2) You've ADDED a new function to "Bar"; you want to recompile that + module, BUT NOT TRIGGER LOTS OF FURTHER COMPILATION because of the + "changed" interface file: + + $Pgm -t foo/Bar.s + +USE AT YOUR OWN RISK: you can make a big mess with this script! +EOUSAGE + +$Makefile = 'Makefile'; +if ( $ENV{'TMPDIR'} ) { # where to make tmp file names + $Tmpfile = $ENV{'TMPDIR'} . "/Makefile$$"; +} else { + $Tmpfile = "$(TMPDIR)/Makefile$$"; + $ENV{'TMPDIR'} = '$(TMPDIR)'; # set the env var as well +} +$SleazyTouch = '/usr/5bin/touch'; +$DoTouch = 0; +$Verbose = 0; +$MakeFlags = ''; + +sub rm_temp_file { + print STDERR "rm $Tmpfile\n" if $Verbose; + unlink $Tmpfile; + exit(1); +} +$SIG{'INT'} = 'rm_temp_file'; +$SIG{'QUIT'} = 'rm_temp_file'; + +$Target = ''; +$DirMod = ''; # the dir/module-file to make + +# process ARGV +while ($_ = $ARGV[0]) { + shift(@ARGV); + if (/^-\?$/ || /^-help$/) { + print $Usage; + exit 1; + } elsif (/^-v$/) { + $Verbose = 1; + } elsif (/^-t$/) { + $Do_touch = 1; + } elsif (/^-k$/) { + $MakeFlags .= ' -k'; + } elsif (/^-n$/) { + $MakeFlags .= ' -n'; + } elsif (/^-d$/) { + $MakeFlags .= ' -d'; + } elsif (/^-/) { + print STDERR "$Pgm: unknown option: $_\n\n$Usage"; + exit 1; + } elsif (/^([A-Z_]+)=(.+)/) { + $MakeFlags .= " $1=\"$2\""; + + } elsif ($Do_touch) { # the module file + $Target = $_; + if ( /([^\/]+\/[^\/\.]+)\.[a-z]+/ ) { + $DirMod = $1; + } else { + print STDERR "$Pgm: argument not of the form: directory/Module.suffix: $_\n\n$Usage"; + exit 1; + } + } else { # accumulate as "Target"... + $Target .= " $_"; + } +} + +if ($Do_touch && $Target =~ / /) { + print STDERR "$Pgm: too many arguments\n\n$Usage"; + exit 1; +} + +open(INF, "<$Makefile") || die "Can't open $Makefile for input\n"; + +open(OUTF,">$Tmpfile") || die "Can't open $Tmpfile for output\n"; +select(OUTF); + +$_ = <INF>; + +# copy through until ... +while ( $_ && ! /^# DO NOT DELETE: Beginning of Haskell dependencies/ ) { + print $_; + $_ = <INF>; +} + +# now copy through 'til the end, omitting the %.{o,s,hc} : %.hi dependencies +while ( $_ ) { + print $_ if ! /^\S+ : \S+\.hi$/; + $_ = <INF>; +} + +close(INF); +close(OUTF); + +$Make = 'make JMAKE=jmake LIT2PGM=lit2pgm LIT2LATEX=lit2latex LIT2TEXI=lit2texi MKDEPENDLIT=mkdependlit MAKEINFO=makeinfo POSTMAKEINFO=postmakeinfo'; + +print STDERR "$Make $MakeFlags -f $Tmpfile $Target; rm $Tmpfile\n" if $Verbose; + +system( "$Make $MakeFlags -f $Tmpfile $Target; rm $Tmpfile" ); + +if ($Do_touch) { + print STDERR "$SleazyTouch -m 01010101 $DirMod\.hi\n" if $Verbose; + system( "$SleazyTouch -m 01010101 $DirMod\.hi" ); +} diff --git a/glafp-utils/scripts/lndir-Xos.h b/glafp-utils/scripts/lndir-Xos.h new file mode 100644 index 0000000000000000000000000000000000000000..e91e959c73f6de52d737e6204d0855b79bc427df --- /dev/null +++ b/glafp-utils/scripts/lndir-Xos.h @@ -0,0 +1,152 @@ +/* + * $XConsortium: Xos.h,v 1.47 91/08/17 17:14:38 rws Exp $ + * + * Copyright 1987 by the Massachusetts Institute of Technology + * + * Permission to use, copy, modify, and distribute this software and its + * documentation for any purpose and without fee is hereby granted, provided + * that the above copyright notice appear in all copies and that both that + * copyright notice and this permission notice appear in supporting + * documentation, and that the name of M.I.T. not be used in advertising + * or publicity pertaining to distribution of the software without specific, + * written prior permission. M.I.T. makes no representations about the + * suitability of this software for any purpose. It is provided "as is" + * without express or implied warranty. + * + * The X Window System is a Trademark of MIT. + * + */ + +/* This is a collection of things to try and minimize system dependencies + * in a "signficant" number of source files. + */ + +#ifndef _XOS_H_ +#define _XOS_H_ + +#include "lndir-Xosdefs.h" + +/* + * Get major data types (esp. caddr_t) + */ + +#ifdef USG +#ifndef __TYPES__ +#ifdef CRAY +#define word word_t +#endif /* CRAY */ +#include <sys/types.h> /* forgot to protect it... */ +#define __TYPES__ +#endif /* __TYPES__ */ +#else /* USG */ +#if defined(_POSIX_SOURCE) && defined(MOTOROLA) +#undef _POSIX_SOURCE +#include <sys/types.h> +#define _POSIX_SOURCE +#else +#include <sys/types.h> +#endif +#endif /* USG */ + + +/* + * Just about everyone needs the strings routines. We provide both forms here, + * index/rindex and strchr/strrchr, so any systems that don't provide them all + * need to have #defines here. + */ + +#ifndef X_NOT_STDC_ENV +#include <string.h> +#define index strchr +#define rindex strrchr +#else +#ifdef SYSV +#include <string.h> +#define index strchr +#define rindex strrchr +#else +#include <strings.h> +#define strchr index +#define strrchr rindex +#endif +#endif + + +/* + * Get open(2) constants + */ +#ifdef X_NOT_POSIX +#include <fcntl.h> +#ifdef USL +#include <unistd.h> +#endif /* USL */ +#ifdef CRAY +#include <unistd.h> +#endif /* CRAY */ +#ifdef MOTOROLA +#include <unistd.h> +#endif /* MOTOROLA */ +#ifdef SYSV386 +#include <unistd.h> +#endif /* SYSV386 */ +#include <sys/file.h> +#else /* X_NOT_POSIX */ +#if !defined(_POSIX_SOURCE) && defined(macII) +#define _POSIX_SOURCE +#include <fcntl.h> +#undef _POSIX_SOURCE +#else +#include <fcntl.h> +#endif +#include <unistd.h> +#endif /* X_NOT_POSIX else */ + +/* + * Get struct timeval + */ + +#ifdef SYSV + +#ifndef USL +#include <sys/time.h> +#endif +#include <time.h> +#ifdef CRAY +#undef word +#endif /* CRAY */ +#if defined(USG) && !defined(CRAY) && !defined(MOTOROLA) +struct timeval { + long tv_sec; + long tv_usec; +}; +#ifndef USL_SHARELIB +struct timezone { + int tz_minuteswest; + int tz_dsttime; +}; +#endif /* USL_SHARELIB */ +#endif /* USG */ + +#else /* not SYSV */ + +#if defined(_POSIX_SOURCE) && defined(SVR4) +/* need to omit _POSIX_SOURCE in order to get what we want in SVR4 */ +#undef _POSIX_SOURCE +#include <sys/time.h> +#define _POSIX_SOURCE +#else +#include <sys/time.h> +#endif + +#endif /* SYSV */ + +/* use POSIX name for signal */ +#if defined(X_NOT_POSIX) && defined(SYSV) && !defined(SIGCHLD) +#define SIGCHLD SIGCLD +#endif + +#ifdef ISC +#include <sys/bsdtypes.h> +#endif + +#endif /* _XOS_H_ */ diff --git a/glafp-utils/scripts/lndir-Xosdefs.h b/glafp-utils/scripts/lndir-Xosdefs.h new file mode 100644 index 0000000000000000000000000000000000000000..e21db4b24ed08e1263621630b2c0b445efc37b90 --- /dev/null +++ b/glafp-utils/scripts/lndir-Xosdefs.h @@ -0,0 +1,99 @@ +/* + * O/S-dependent (mis)feature macro definitions + * + * $XConsortium: Xosdefs.h,v 1.7 91/07/19 23:22:19 rws Exp $ + * + * Copyright 1991 Massachusetts Institute of Technology + * + * Permission to use, copy, modify, distribute, and sell this software and its + * documentation for any purpose is hereby granted without fee, provided that + * the above copyright notice appear in all copies and that both that + * copyright notice and this permission notice appear in supporting + * documentation, and that the name of M.I.T. not be used in advertising or + * publicity pertaining to distribution of the software without specific, + * written prior permission. M.I.T. makes no representations about the + * suitability of this software for any purpose. It is provided "as is" + * without express or implied warranty. + * + * M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL M.I.T. + * BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION + * OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN + * CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +#ifndef _XOSDEFS_H_ +#define _XOSDEFS_H_ + +/* + * X_NOT_STDC_ENV means does not have ANSI C header files. Lack of this + * symbol does NOT mean that the system has stdarg.h. + * + * X_NOT_POSIX means does not have POSIX header files. Lack of this + * symbol does NOT mean that the POSIX environment is the default. + * You may still have to define _POSIX_SOURCE to get it. + */ + +#ifdef NOSTDHDRS +#define X_NOT_POSIX +#define X_NOT_STDC_ENV +#endif + +#ifdef NeXT +#define X_NOT_POSIX +#endif + +#ifdef sony +#ifndef SYSTYPE_SYSV +#define X_NOT_POSIX +#endif +#endif + +#ifdef UTEK +#define X_NOT_POSIX +#define X_NOT_STDC_ENV +#endif + +#ifdef CRAY +#define X_NOT_POSIX +#endif + +#ifdef vax +#ifndef ultrix /* assume vanilla BSD */ +#define X_NOT_POSIX +#define X_NOT_STDC_ENV +#endif +#endif + +#ifdef luna +#define X_NOT_POSIX +#define X_NOT_STDC_ENV +#endif + +#ifdef Mips +#define X_NOT_POSIX +#define X_NOT_STDC_ENV +#endif + +#ifdef USL +#ifdef SYSV /* (release 3.2) */ +#define X_NOT_POSIX +#define X_NOT_STDC_ENV +#endif +#endif + +#ifdef SYSV386 +#ifdef SYSV +#define X_NOT_POSIX +#define X_NOT_STDC_ENV +#endif +#endif + +#ifdef MOTOROLA +#ifdef SYSV +#define X_NOT_STDC_ENV +#endif +#endif + +#endif /* _XOSDEFS_H_ */ diff --git a/glafp-utils/scripts/lndir.c b/glafp-utils/scripts/lndir.c new file mode 100644 index 0000000000000000000000000000000000000000..a932ae56f07253c1c6dcf848d584cdc90b547f00 --- /dev/null +++ b/glafp-utils/scripts/lndir.c @@ -0,0 +1,223 @@ +/* $XConsortium: lndir.c,v 1.5 91/07/21 15:52:11 rws Exp $ */ +/* Create shadow link tree (after X11R4 script of the same name) + Mark Reinhold (mbr@lcs.mit.edu)/3 January 1990 */ + +/* Copyright 1990, Massachusetts Institute of Technology + + Permission to use, copy, modify, and distribute this program for any purpose + and without fee is hereby granted, provided that this copyright and + permission notice appear on all copies and supporting documentation, that + the name of MIT not be used in advertising or publicity pertaining to + distribution of this program without specific prior permission, and that + notice be given in supporting documentation that copying and distribution is + by permission of MIT. MIT makes no representations about the suitability of + this software for any purpose. It is provided "as is" without expressed or + implied warranty. +*/ + +/* From the original /bin/sh script: + + Used to create a copy of the a directory tree that has links for all + non-directories (except those named RCS or SCCS). If you are + building the distribution on more than one machine, you should use + this script. + + If your master sources are located in /usr/local/src/X and you would like + your link tree to be in /usr/local/src/new-X, do the following: + + % mkdir /usr/local/src/new-X + % cd /usr/local/src/new-X + % lndir ../X +*/ + +#include "lndir-Xos.h" +#include <stdio.h> +#include <sys/stat.h> +#include <sys/param.h> +#include <errno.h> + +#ifndef X_NOT_POSIX +#include <dirent.h> +#else +#ifdef SYSV +#include <dirent.h> +#else +#ifdef USG +#include <dirent.h> +#else +#include <sys/dir.h> +#ifndef dirent +#define dirent direct +#endif +#endif +#endif +#endif + +extern int errno; +int silent; + +void +quit (code, fmt, a1, a2, a3) +char *fmt; +int code, a1, a2, a3; /* partain */ +{ + fprintf (stderr, fmt, a1, a2, a3); + putc ('\n', stderr); + exit (code); +} + +void +quiterr (code, s) +char *s; +int code; /* partain */ +{ + perror (s); + exit (code); +} + +void +msg (fmt, a1, a2, a3) +char *fmt; +int a1, a2, a3; /* partain */ +{ + fprintf (stderr, fmt, a1, a2, a3); + putc ('\n', stderr); +} + + +/* Recursively create symbolic links from the current directory to the "from" + directory. Assumes that files described by fs and ts are directories. */ + +int +dodir (fn, fs, ts, rel) +char *fn; /* name of "from" directory, either absolute or + relative to cwd */ +struct stat *fs, *ts; /* stats for the "from" directory and cwd */ +int rel; /* if true, prepend "../" to fn before using */ +{ + DIR *df; + struct dirent *dp; + char buf[MAXPATHLEN + 1], *p; + char symbuf[MAXPATHLEN + 1]; + struct stat sb, sc; + int n_dirs; + + if ((fs->st_dev == ts->st_dev) && (fs->st_ino == ts->st_ino)) { + msg ("%s: From and to directories are identical!", fn); + return 1; + } + + if (rel) + strcpy (buf, "../"); + else + buf[0] = '\0'; + strcat (buf, fn); + + if (!(df = opendir (buf))) { + msg ("%s: Cannot opendir", buf); + return 1; + } + + p = buf + strlen (buf); + *p++ = '/'; + n_dirs = fs->st_nlink; + while (dp = readdir (df)) { + strcpy (p, dp->d_name); + + if (n_dirs > 0) { + if (stat (buf, &sb) < 0) { + perror (buf); + continue; + } + + if (sb.st_mode & S_IFDIR) { + /* directory */ + n_dirs--; + if (dp->d_name[0] == '.' && + (dp->d_name[1] == '\0' || (dp->d_name[1] == '.' && + dp->d_name[2] == '\0'))) + continue; + if (!strcmp (dp->d_name, "CVS")) /* partain */ + continue; + if (!strcmp (dp->d_name, "RCS")) + continue; + if (!strcmp (dp->d_name, "SCCS")) + continue; + if (!silent) + printf ("%s:\n", buf); + if ((stat (dp->d_name, &sc) < 0) && (errno == ENOENT)) { + if (mkdir (dp->d_name, 0777) < 0 || + stat (dp->d_name, &sc) < 0) { + perror (dp->d_name); + continue; + } + } + if (readlink (dp->d_name, symbuf, sizeof(symbuf) - 1) >= 0) { + msg ("%s: is a link instead of a directory\n", dp->d_name); + continue; + } + if (chdir (dp->d_name) < 0) { + perror (dp->d_name); + continue; + } + dodir (buf, &sb, &sc, (buf[0] != '/')); + if (chdir ("..") < 0) + quiterr (1, ".."); + continue; + } + } + + /* non-directory */ + if (symlink (buf, dp->d_name) < 0) { + int saverrno = errno; + int symlen; + symlen = readlink(dp->d_name, symbuf, sizeof(symbuf) - 1); + errno = saverrno; + if (symlen > 0) + symbuf[symlen] = '\0'; + if (symlen < 0 || strcmp(symbuf, buf)) + perror (dp->d_name); + } + } + + closedir (df); + return 0; +} + +void +main (ac, av) +int ac; +char **av; +{ + char *fn, *tn; + struct stat fs, ts; + + silent = 0; + if (ac > 1 && !strcmp(av[1], "-silent")) { + silent = 1; + } + if (ac < silent + 2 || ac > silent + 3) + quit (1, "usage: %s [-silent] fromdir [todir]", av[0]); + + fn = av[silent + 1]; + if (ac == silent + 3) + tn = av[silent + 2]; + else + tn = "."; + + /* to directory */ + if (stat (tn, &ts) < 0) + quiterr (1, tn); + if (!(ts.st_mode & S_IFDIR)) + quit (2, "%s: Not a directory", tn); + if (chdir (tn) < 0) + quiterr (1, tn); + + /* from directory */ + if (stat (fn, &fs) < 0) + quiterr (1, fn); + if (!(fs.st_mode & S_IFDIR)) + quit (2, "%s: Not a directory", fn); + + exit (dodir (fn, &fs, &ts, 0)); +} diff --git a/glafp-utils/scripts/ltx.prl b/glafp-utils/scripts/ltx.prl new file mode 100644 index 0000000000000000000000000000000000000000..bf5c767d0858f6dbf1034293065435cdecb4e71f --- /dev/null +++ b/glafp-utils/scripts/ltx.prl @@ -0,0 +1,222 @@ +$Pgm = $0; $Pgm =~ s/.*\/([^\/]+)$/\1/; +# +# set up signal handler +sub quit_upon_signal { &rm_temp_files_and_exit(); } +$SIG{'INT'} = 'quit_upon_signal'; +$SIG{'QUIT'} = 'quit_upon_signal'; +# +$Verbose = 0; +if ($ARGV[0] eq '-v') { + $Verbose = 1; + shift(@ARGV); +} +# +die "$Pgm: must have exactly one argument\n" if $#ARGV != 0; +# figure out input file and its filename root +if (-f $ARGV[0]) { + $TeX_input = $ARGV[0]; + if ($TeX_input =~ /(.+)\.[^\.\/\n]+$/) { + $TeX_root = $1; + } else { + $TeX_root = $TeX_input; + } +} elsif (-f $ARGV[0].'.tex') { + $TeX_input = $ARGV[0].'.tex'; + $TeX_root = $ARGV[0]; +} else { + die "$Pgm: input file $ARGV[0] doesn't exist\n"; +} + +if ( $ENV{'TMPDIR'} ) { # where to make tmp file names + $Tmp_prefix = $ENV{'TMPDIR'} ; +} else { + $Tmp_prefix ='$(TMPDIR)'; + $ENV{'TMPDIR'} = '$(TMPDIR)'; # set the env var as well +} + +sub rm_temp_files { + system("rm -f $Tmp_prefix/ltx-*.$$"); +} +sub rm_temp_files_and_exit { + system("rm -f $Tmp_prefix/ltx-*.$$"); + exit(1); +} +$SIG{'INT'} = 'rm_temp_files_and_exit'; +$SIG{'QUIT'} = 'rm_temp_files_and_exit'; + +sub die_gracefully { + local($msg) = @_; + + print STDERR $msg; + &rm_temp_files_and_exit(); +} + +# must read through root file to see if a \bibliography +# is there... +$Bibliography_requested = 0; +open(TEXIF, "<$TeX_input") + || &die_gracefully("$Pgm: Can't read $TeX_input\n"); +while (<TEXIF>) { + $Bibliography_requested = 1 if /^\\bibliography/; +} +close(TEXIF); +&die_gracefully("$Pgm: reading $TeX_input had errors\n") if $? >> 8; + +# run latex first time (?) +&run_latex(); # sets $Says_labels_changed +$Times_run = 1; + +while (&something_more_needed()) { + + print STDERR "labels_changed=$Says_label_changed;bibtex_needed=$BibTeX_run_needed;makeindex_needed=$MakeIndex_run_needed\n" if $Verbose; + + if ($BibTeX_run_needed) { + &run_bibtex(); + } + if ($MakeIndex_run_needed) { + unlink "$TeX_root.ind"; + (system("makeindex $TeX_root.idx") >> 8) + && &die_gracefully("$Pgm: makeindex $TeX_root.idx had errors\n"); + } + + # save (copy) .aux file as .aux-prev file for future ref + # ditto for .idx file + unlink "$TeX_root.aux-prev"; + (system("cp $TeX_root.aux $TeX_root.aux-prev") >> 8) + && &die_gracefully("$Pgm: cp $TeX_root.aux $TeX_root.aux-prev failed\n"); + if (-f "$TeX_root.idx") { + unlink "$TeX_root.idx-prev"; + (system("cp $TeX_root.idx $TeX_root.idx-prev") >> 8) + && &die_gracefully("$Pgm: cp $TeX_root.idx $TeX_root.idx-prev failed\n"); + } + + # run latex again + &run_latex(); # sets $Says_labels_changed + $Times_run++; + + if ($Times_run >= 4) { + print STDERR "*** I don't run LaTeX more than four times;\n"; + print STDERR "*** Something is probably wrong...\n"; + &rm_temp_files_and_exit(); + } +} +&rm_temp_files(); +exit(0); + +sub run_latex { + $Says_labels_changed = 0; + $Multiply_defined_labels = 0; + + select(STDERR); $| = 1; select(STDOUT); # no buffering on STDERR + print STDERR "$Pgm: *** running LaTeX...\n" if $Verbose; + unlink "$TeX_root.dvi"; + + open(LTXPIPE, "latex $TeX_input 2>&1 |") + || &die_gracefully("$Pgm: Can't run latex pipe\n"); + while (<LTXPIPE>) { + $Multiply_defined_labels = 1 if /^LaTeX Warning: Label .* multiply defined/; + $Says_labels_changed = 1 if /^LaTeX Warning: Label\(s\) may have changed/ + && ! $Multiply_defined_labels; + print STDERR $_; + } + close(LTXPIPE); + &die_gracefully("$Pgm: LaTeX run had errors\n") if $? >> 8; + + # sort .idx file, because this helps makeindex + # (can you say `bug'?) + if (-f "$TeX_root.idx") { + print STDERR "$Pgm: *** sorting $TeX_root.idx...\n" if $Verbose; + (system("sort $TeX_root.idx -o $TeX_root.idx") >> 8) + && &die_gracefully("$Pgm: sorting $TeX_root.idx failed\n"); + } + +} + +sub run_bibtex { # ugly because bibtex doesn't return a correct error status + local($bibtex_had_errors) = 0; + + print STDERR "$Pgm: *** running BibTeX...\n" if $Verbose; + unlink "$TeX_root.bbl"; + + $| = 1; # no buffering + open(BIBTXPIPE, "bibtex $TeX_root 2>&1 |") + || &die_gracefully("$Pgm: Can't run bibtex pipe\n"); + while (<BIBTXPIPE>) { + $bibtex_had_errors = 1 if /^\(There.*error message(s)?\)$/; + print STDERR $_; + } + close(BIBTXPIPE); + &die_gracefully("$Pgm: BibTeX run had errors\n") + if $? >> 8 || $bibtex_had_errors; +} + +sub something_more_needed { + # returns 1 or 0 if we need to run LaTeX + # possibly preceded by bibtex and/or makeindex run + + # $Says_labels_changed was set by previous &run_latex... + $BibTeX_run_needed = 0; + $MakeIndex_run_needed = 0; + + if ( ! -f ($TeX_root . '.aux-prev')) { # this was the first run + + print STDERR "$Pgm: *** 'twas first run of LaTeX on $TeX_input\n" if $Verbose; + + # we need makeindex to run if a non-zero-sized .idx file exists + # + $MakeIndex_run_needed = 1 + if -f "$TeX_root.idx" && -s "$TeX_root.idx"; + + # we need bibtex to run if there are \citations in the .aux file + # + &slurp_aux_file('aux'); + $BibTeX_run_needed = 1 + if $Bibliography_requested && + -f "$Tmp_prefix/ltx-aux-cite.$$" && + -s "$Tmp_prefix/ltx-aux-cite.$$"; + + + } else { # ltx had been run before (.aux-prev/.idx-prev files exist) + + # slurp both .aux and .aux-prev files + &slurp_aux_file('aux'); + &slurp_aux_file('aux-prev'); + + local($tmp_pre) = "$Tmp_prefix/ltx"; + + if ((-s "$tmp_pre-.aux-cite.$$") # there are still \cite's in there + && (system("cmp -s $tmp_pre-.aux-cite.$$ $tmp_pre-.aux-prev-cite.$$") >> 8)) { + $BibTeX_run_needed = 1 if $Bibliography_requested; + if ($Verbose) { + system("$(CONTEXT_DIFF) $tmp_pre-.aux-prev-cite.$$ $tmp_pre-.aux-cite.$$"); + } + } + + if (-f "$TeX_root.idx") { + $MakeIndex_run_needed = + (system("cmp -s $TeX_root.idx $TeX_root.idx-prev") >> 8) ? 1 : 0; + if ($MakeIndex_run_needed && $Verbose) { + system("$(CONTEXT_DIFF) $TeX_root.idx-prev $TeX_root.idx"); + } + } + } + + $Says_labels_changed || $BibTeX_run_needed || $MakeIndex_run_needed; +} + +sub slurp_aux_file { + local($ext) = @_; + + # copy all citations from slurpfile into $Tmp_prefix/ltx-$ext-cite.$$ + + open(SLURPF,"< $TeX_root.$ext") + || &die_gracefully("$Pgm: Can't open $TeX_root.$ext for reading\n"); + open(CITEF,"> $Tmp_prefix/ltx-$ext-cite.$$") + || &die_gracefully("$Pgm: Can't open $Tmp_prefix/ltx-$ext-cite.$$ for writing\n"); + + while (<SLURPF>) { + print CITEF $_ if /\\citation/; + } + close(CITEF); + close(SLURPF); +} diff --git a/glafp-utils/scripts/mkdependC.prl b/glafp-utils/scripts/mkdependC.prl new file mode 100644 index 0000000000000000000000000000000000000000..e81c1482344c022d7213a6b59d14d444286708f1 --- /dev/null +++ b/glafp-utils/scripts/mkdependC.prl @@ -0,0 +1,202 @@ +# *** MSUB does some substitutions here *** +# *** grep for $( *** +# +# tries to work like mkdependC +# +# ToDo: strip out all the .h junk +# +($Pgm = $0) =~ s/.*\/([^\/]+)$/\1/; +$Usage = "usage: $Pgm: not done yet\n"; + +$Status = 0; # just used for exit() status +$Verbose = 0; +$Dashdashes_seen = 0; + +$Begin_magic_str = "# DO NOT DELETE: Beginning of C dependencies\n"; +$End_magic_str = "# DO NOT DELETE: End of C dependencies\n"; +$Obj_suffix = '.o'; +@Defines = (); +$Include_dirs = ''; +$Col_width = 78; # ignored +$Makefile = ''; +@Src_files = (); + +# the following is a hack, so we can use RAWCPP, but there you go; +# put in just enough #defines that mkdependC will not barf. +$HostPlatform = '$(HOSTPLATFORM)'; + +if ( $HostPlatform =~ /^i386-/ ) { + push(@Defines, '-D__i386__'); +} +if ( $HostPlatform =~ /^sparc-/ ) { + push(@Defines, '-D__sparc__'); +} +if ( $HostPlatform =~ /-solaris2$/ ) { + push(@Defines, '-D__svr4__'); +} + +&mangle_command_line_args(); + +if ( ! $Makefile && -f 'makefile' ) { + $Makefile = 'makefile'; +} elsif ( ! $Makefile && -f 'Makefile') { + $Makefile = 'Makefile'; +} elsif ( ! $Makefile) { + die "$Pgm: no makefile or Makefile found\n"; +} + +@Depend_lines = (); +%Depend_seen = (); + +print STDERR "CPP defines=@Defines\n" if $Verbose; +print STDERR "Include_dirs=$Include_dirs\n" if $Verbose; + +foreach $sf (@Src_files) { + # just like lit-inputter + # except it puts each file through CPP and + # a de-commenter (not implemented); + # builds up @Depend_lines + print STDERR "Here we go for source file: $sf\n" if $Verbose; + ($of = $sf) =~ s/\.(c|hc)$/$Obj_suffix/; + + &slurp_file($sf, 'fh00'); +} + +# OK, mangle the Makefile +unlink("$Makefile.bak"); +rename($Makefile,"$Makefile.bak"); +# now copy Makefile.bak into Makefile, rm'ing old dependencies +# and adding the new +open(OMKF,"< $Makefile.bak") || die "$Pgm: can't open $Makefile.bak: $!\n"; +open(NMKF,"> $Makefile") || die "$Pgm: can't open $Makefile: $!\n"; +select(NMKF); +$_ = <OMKF>; +while ($_ && $_ ne $Begin_magic_str) { # copy through, 'til Begin_magic_str + print $_; + $_ = <OMKF>; +} +while ($_ && $_ ne $End_magic_str) { # delete 'til End_magic_str + $_ = <OMKF>; +} +# insert dependencies +print $Begin_magic_str; +print @Depend_lines; +print $End_magic_str; +while (<OMKF>) { # copy the rest through + print $_; +} +close(NMKF); +close(OMKF); +exit 0; + +sub mangle_command_line_args { + while($_ = $ARGV[0]) { + shift(@ARGV); + + if ( /^--$/ ) { + $Dashdashes_seen++; + + } elsif ( /^-D(.*)/ ) { # recognized wherever they occur + push(@Defines, $_); + } elsif ( /^-I/ ) { + $Include_dirs .= " $_"; + + } elsif ($Dashdashes_seen != 1) { # not between -- ... -- + if ( /^-v$/ ) { + $Verbose++; + } elsif ( /^-f/ ) { + $Makefile = &grab_arg_arg($_); + } elsif ( /^-o/ ) { + $Obj_suffix = &grab_arg_arg($_); + } elsif ( /^-bs/ ) { + $Begin_magic_str = &grab_arg_arg($_) . "\n"; + } elsif ( /^-es/ ) { + $End_magic_str = &grab_arg_arg($_) . "\n"; + } elsif ( /^-w/ ) { + $Width = &grab_arg_arg($_); + } elsif ( /^-/ ) { + print STDERR "$Pgm: unknown option ignored: $_\n"; + } else { + push(@Src_files, $_); + } + + } elsif ($Dashdashes_seen == 1) { # where we ignore unknown options + push(@Src_files,$_) if ! /^-/; + } + } +} + +sub grab_arg_arg { + local($option) = @_; + local($rest_of_arg); + + ($rest_of_arg = $option) =~ s/^-.//; + + if ($rest_of_arg) { + return($rest_of_arg); + } elsif ($#ARGV >= 0) { + local($temp) = $ARGV[0]; shift(@ARGV); + return($temp); + } else { + die "$Pgm: no argument following $option option\n"; + } +} + +sub slurp_file { # follows an example in the `open' item in perl man page + local($fname,$fhandle) = @_; + local($depend); # tmp + $fhandle++; # a string increment + + $fname = &tidy_dir_names($fname); + + unless (open($fhandle, "$(RAWCPP) $Include_dirs @Defines $fname |")) { + die "$Pgm: Can't open $fname: $!\n"; + } + line: while (<$fhandle>) { + next line if ! /^#/; + next line if /^#(ident|pragma)/; + chop; # rm trailing newline + + $_ = &tidy_dir_names($_); + + # strip junk off the front and back + $_ =~ s/^#\s+\d+\s+//; + $_ =~ s/[ 0-9]*$//; + + # a little bit of ad-hoc fiddling now: + # don't bother w/ dependencies on /usr/include stuff + # don't bother if it looks like a GCC built-in hdr file + # don't bother with funny yacc-ish files + # don't bother with "literate" .h files (.lh); we'll just + # depend on the de-litified versions (which have better info) + # don't let a file depend on itself + next line if /^\/usr\/include/; + next line if /\/gcc-lib\/[^\/\n]+\/[\.0-9]+\/include\//; + next line if /\/yaccpar/; + next line if /\/bison\.(simple|hairy)/; + next line if /\.lh$/; + next line if $_ eq $fname; + + print STDERR "$fname :: $_\n" if $Verbose; + + # ToDo: some sanity checks that we still have something reasonable? + + $depend = "$of : $_\n"; + next line if $Depend_seen{$depend}; # already seen this one... + + # OK, it's a new one. + push (@Depend_lines, $depend); + $Depend_seen{$depend} = 1; + } + close($fhandle); +} + +sub tidy_dir_names { # rm various pernicious dir-name combinations... + local($str) = @_; + + $str =~ s|/[^/.][^/]*/\.\.||g; # nuke: /<dir>/.. + $str =~ s|/\.[^.][^/]*/\.\.||g; # nuke: /./.. (and others) + $str =~ s|"||g; + $str =~ s| \./| |; + $str; +} diff --git a/glafp-utils/scripts/mkdirhier.sh b/glafp-utils/scripts/mkdirhier.sh new file mode 100644 index 0000000000000000000000000000000000000000..739535e1189b000b73def2073c5daed05ac687d1 --- /dev/null +++ b/glafp-utils/scripts/mkdirhier.sh @@ -0,0 +1,24 @@ +#!/bin/sh + +# +# create a heirarchy of directories +# + +for f in $*; do + parts=`echo $f | sed 's,\(.\)/\(.\),\1 \2,g' | sed 's,/$,,'`; + path=""; + for p in $parts; do + if [ x"$path" = x ]; then + dir=$p; + else + dir=$path/$p; + fi; + if [ ! -d $dir ]; then + echo mkdir $dir; + mkdir $dir; + chmod a+rx $dir; + fi; + path=$dir; + done; +done + diff --git a/glafp-utils/scripts/runstdtest.prl b/glafp-utils/scripts/runstdtest.prl new file mode 100644 index 0000000000000000000000000000000000000000..af75b693eb37a2e8d5014b1787553da517d34d0d --- /dev/null +++ b/glafp-utils/scripts/runstdtest.prl @@ -0,0 +1,459 @@ +#! /usr/local/bin/perl +# +# Given: +# * a program to run (1st arg) +# * some "command-line opts" ( -O<opt1> -O<opt2> ... ) +# [default: anything on the cmd line this script doesn't recognise ] +# the first opt not starting w/ "-" is taken to be an input +# file and (if it exists) is grepped for "what's going on here" +# comments (^--!!!). +# * a file to feed to stdin ( -i<file> ) [default: /dev/null ] +# * a "time" command to use (-t <cmd>). +# +# * alternatively, a "-script <script>" argument says: run the +# named Bourne-shell script to do the test. It's passed the +# pgm-to-run as the one-and-only arg. +# +# Run the program with those options and that input, and check: +# if we get... +# +# * an expected exit status ( -x <val> ) [ default 0 ] +# * expected output on stdout ( -o1 <file> ) [ default /dev/null ] +# ( we'll accept one of several...) +# * expected output on stderr ( -o2 <file> ) [ default /dev/null ] +# ( we'll accept one of several...) +# +# (if the expected-output files' names end in .Z, then +# they are uncompressed before doing the comparison) +# +# (This is supposed to be a "prettier" replacement for runstdtest.) +# +($Pgm = $0) =~ s|.*/||; +$Verbose = 0; +$Status = 0; +@PgmArgs = (); +$PgmExitStatus = 0; +$PgmStdinFile = '/dev/null'; +if ( $ENV{'TMPDIR'} ) { # where to make tmp file names + $TmpPrefix = $ENV{'TMPDIR'}; +} else { + $TmpPrefix ="$(TMPDIR)"; + $ENV{'TMPDIR'} = '$(TMPDIR)'; # set the env var as well +} +$ScriptFile = "$TmpPrefix/run_me$$"; +$DefaultStdoutFile = "$TmpPrefix/no_stdout$$"; # can't use /dev/null (e.g. Alphas) +$DefaultStderrFile = "$TmpPrefix/no_stderr$$"; +@PgmStdoutFile = (); +@PgmStderrFile = (); +$PreScript = ''; +$PostScript = ''; +$TimeCmd = ''; +$StatsFile = "$TmpPrefix/stats$$"; +$SysSpecificTiming = ''; +$SpixTiming = 'no'; + +die "$Pgm: program to run not given as first argument\n" if $#ARGV < 0; +$ToRun = $ARGV[0]; shift(@ARGV); +# avoid picking up same-named thing from somewhere else on $PATH... +$ToRun = "./$ToRun" if $ToRun !~ /^\//; + +arg: while ($_ = $ARGV[0]) { + shift(@ARGV); + + /^--$/ && do { # let anything past after -- + push(@PgmArgs, @ARGV); + last arg; }; + + /^-v$/ && do { $Verbose = 1; next arg; }; + /^-O(.*)/ && do { push(@PgmArgs, &grab_arg_arg('-O',$1)); next arg; }; + /^-i(.*)/ && do { $PgmStdinFile = &grab_arg_arg('-i',$1); + $Status++, + print STDERR "$Pgm: bogus -i input file: $PgmStdinFile\n" + if ! -f $PgmStdinFile; + next arg; }; + /^-x(.*)/ && do { $PgmExitStatus = &grab_arg_arg('-x',$1); + $Status++ , + print STDERR "$Pgm: bogus -x expected exit status: $PgmExitStatus\n" + if $PgmExitStatus !~ /^\d+$/; + next arg; }; + /^-o1(.*)/ && do { $out_file = &grab_arg_arg('-o1',$1); + push(@PgmStdoutFile, $out_file); + next arg; }; + /^-o2(.*)/ && do { $out_file = &grab_arg_arg('-o2',$1); + push(@PgmStderrFile, $out_file); + next arg; }; + /^-prescript(.*)/ && do { $PreScript = &grab_arg_arg('-prescript',$1); + next arg; }; + /^-postscript(.*)/ && do { $PostScript = &grab_arg_arg('-postscript',$1); + next arg; }; + /^-script/ && do { print STDERR "$Pgm: -script argument is obsolete;\nUse -prescript and -postscript instead.\n"; + $Status++; + next arg; }; + /^-(ghc|hbc)-timing$/ && do { $SysSpecificTiming = $1; + next arg; }; + /^-spix-timing$/ && do { $SysSpecificTiming = 'ghcspix'; + $SpixTiming = 'yes'; + next arg; }; + /^-t(.*)/ && do { $TimeCmd = &grab_arg_arg('-t', $1); next arg; }; + + # anything else is taken to be a pgm arg + push(@PgmArgs, $_); +} + +foreach $out_file ( @PgmStdoutFile ) { + $Status++ , + print STDERR "$Pgm: bogus -o1 expected-output file: $out_file\n" + if ! -f $out_file; +} + +foreach $out_file ( @PgmStderrFile ) { + $Status++, + print STDERR "$Pgm: bogus -o2 expected-stderr file: $out_file\n" + if ! -f $out_file; +} + +exit 1 if $Status; + +# add on defaults if none specified +@PgmStdoutFile = ( $DefaultStdoutFile ) if $#PgmStdoutFile < 0; +@PgmStderrFile = ( $DefaultStderrFile ) if $#PgmStderrFile < 0; + +# tidy up the pgm args: +# (1) look for the "first input file" +# and grep it for "interesting" comments (--!!! ) +# (2) quote any args w/ whitespace in them. +$grep_done = 0; +foreach $a ( @PgmArgs ) { + if (! $grep_done && $a !~ /^-/ && -f $a) { + print `egrep "^--!!!" $a`; + $grep_done = 1; + } + if ($a =~ /\s/ || $a =~ /'/) { + $a =~ s/'/\\'/g; # backslash the quotes; + $a = "\"$a\""; # quote the arg + } +} + +# deal with system-specific timing options +$TimingMagic = ''; +if ( $SysSpecificTiming =~ /^ghc/ ) { + $TimingMagic = "+RTS -s$StatsFile -RTS" +} elsif ( $SysSpecificTiming eq 'hbc' ) { + $TimingMagic = "-S$StatsFile"; +} + +$ToRunOrig = $ToRun; +if ( $SpixTiming eq 'yes' ) { + $ToRun .= '.spix'; + + # gotta find first/last addresses in the mutator code + $FirstSpix = '_callWrapper'; + $LastSpix = '???'; # usually _mpz_get_si, but can't be sure + + open(SPIXNM, "nm -n $ToRunOrig |") || die "nm -n $ToRunOrig open failed!\n"; + spix: while (<SPIXNM>) { + if ( / T +(_freeForeignObj|_([A-Za-z]+)Hook|_xmalloc|_mpz_get_si)$/ ) { + $LastSpix = $1; + last spix; + } + } + close(SPIXNM); # || die "nm -n $ToRunOrig close failed!\n"; + + $SpixifyLine1 = "spix -o $ToRun -t$FirstSpix,$LastSpix $ToRunOrig"; + $SpixstatsLine1 = "spixstats -b $TmpPrefix/runtest$$.3 $ToRunOrig > $ToRunOrig.spixstats1"; + $SpixifyLine2 = "spix -o $ToRun +t$FirstSpix,$LastSpix $ToRunOrig"; + $SpixstatsLine2 = "spixstats -b $TmpPrefix/runtest$$.3 $ToRunOrig > $ToRunOrig.spixstats2"; +} else { + $SpixifyLine1 = ''; + $SpixstatsLine1 = ''; + $SpixifyLine2 = ''; + $SpixstatsLine2 = ''; +} + +if ($PreScript ne '') { + local($to_do); + $PreScriptLines = `cat $PreScript`; +} else { + $PreScriptLines = ''; +} + +if ($PostScript ne '') { + local($to_do); + $PostScriptLines = `cat $PostScript`; + $* = 1; + $PostScriptLines =~ s#\$o1#$TmpPrefix/runtest$$.1#g; + $PostScriptLines =~ s#\$o2#$TmpPrefix/runtest$$.2#g; +} else { + $PostScriptLines = ''; +} + +# OK, so we're gonna do the normal thing... + +$Script = <<EOSCRIPT; +#! /bin/sh +myexit=0 +diffsShown=0 +rm -f $DefaultStdoutFile $DefaultStderrFile +cat /dev/null > $DefaultStdoutFile +cat /dev/null > $DefaultStderrFile +$PreScriptLines +$SpixifyLine1 +$TimeCmd /bin/sh -c \'$ToRun $TimingMagic @PgmArgs < $PgmStdinFile 1> $TmpPrefix/runtest$$.1 2> $TmpPrefix/runtest$$.2 3> $TmpPrefix/runtest$$.3\' +progexit=\$? +if [ \$progexit -ne $PgmExitStatus ]; then + echo $ToRun @PgmArgs \\< $PgmStdinFile + echo expected exit status $PgmExitStatus not seen \\; got \$progexit + myexit=1 +else + $PostScriptLines + hit='NO' + for out_file in @PgmStdoutFile ; do + if cmp -s \$out_file $TmpPrefix/runtest$$.1 ; then + hit='YES' + fi + done + if [ \$hit = 'NO' ] ; then + echo $ToRun @PgmArgs \\< $PgmStdinFile + echo expected stdout not matched by reality + $(CONTEXT_DIFF) $PgmStdoutFile[0] $TmpPrefix/runtest$$.1 + myexit=1 + diffsShown=1 + fi +fi +egrep -v '^ld\.so:.*has older revision than expected' < $TmpPrefix/runtest$$.2 > $TmpPrefix/runtest$$.2b +mv -f $TmpPrefix/runtest$$.2b $TmpPrefix/runtest$$.2 + +hit='NO' +for out_file in @PgmStderrFile ; do + if cmp -s \$out_file $TmpPrefix/runtest$$.2 ; then + hit='YES' + fi +done +if [ \$hit = 'NO' ] ; then + echo $ToRun @PgmArgs \\< $PgmStdinFile + echo expected stderr not matched by reality + $(CONTEXT_DIFF) $PgmStderrFile[0] $TmpPrefix/runtest$$.2 + myexit=1 + diffsShown=1 +fi +$SpixstatsLine1 + +if [ $SpixTiming = 'yes' -a \$myexit = 0 ] ; then + $SpixifyLine2 + $TimeCmd /bin/sh -c \'$ToRun $TimingMagic @PgmArgs < $PgmStdinFile 1> /dev/null 2> /dev/null 3> $TmpPrefix/runtest$$.3\' + $SpixstatsLine2 +fi + +$(RM) core $ToRunOrig.spix $DefaultStdoutFile $DefaultStderrFile $TmpPrefix/runtest$$.1 $TmpPrefix/runtest$$.2 $TmpPrefix/runtest$$.3 +exit \$myexit +EOSCRIPT + +# bung script into a file +open(SCR, "> $ScriptFile") || die "Failed opening script file $ScriptFile!\n"; +print SCR $Script; +close(SCR) || die "Failed closing script file!\n"; +chmod 0755, $ScriptFile; + +print STDERR $Script if $Verbose; + +&run_something($ScriptFile); + +if ( $SysSpecificTiming eq '' ) { + unlink $StatsFile; + unlink $ScriptFile; + exit 0; +} + +&process_stats_file(); +&process_spixstats_files() if $SpixTiming eq 'yes'; + +# print out what we found +if ( $SpixTiming ne 'yes' ) { + print STDERR "<<$SysSpecificTiming: ", + "$BytesAlloc bytes, $GCs GCs, $AvgResidency/$MaxResidency avg/max bytes residency ($ResidencySamples samples), $InitTime INIT ($InitElapsed elapsed), $MutTime MUT ($MutElapsed elapsed), $GcTime GC ($GcElapsed elapsed)", + " :$SysSpecificTiming>>\n"; +} else { + print STDERR "<<$SysSpecificTiming: ", + "$BytesAlloc bytes, $GCs GCs, $AvgResidency/$MaxResidency avg/max bytes residency ($ResidencySamples samples), $TotalInsns[1]/$TotalInsns[2] instructions, $LoadInsns[1]/$LoadInsns[2] loads, $StoreInsns[1]/$StoreInsns[2] stores, $BranchInsns[1]/$BranchInsns[2] branches, $OtherInsns[1]/$OtherInsns[2] others", + " :$SysSpecificTiming>>\n"; +} + +# OK, party over +unlink $StatsFile; +unlink $ScriptFile; +exit 0; + +sub grab_arg_arg { + local($option, $rest_of_arg) = @_; + + if ($rest_of_arg) { + return($rest_of_arg); + } elsif ($#ARGV >= 0) { + local($temp) = $ARGV[0]; shift(@ARGV); + return($temp); + } else { + print STDERR "$Pgm: no argument following $option option\n"; + $Status++; + } +} + +sub run_something { + local($str_to_do) = @_; + +# print STDERR "$str_to_do\n" if $Verbose; + + local($return_val) = 0; + system($str_to_do); + $return_val = $?; + + if ($return_val != 0) { +#ToDo: this return-value mangling is wrong +# local($die_msg) = "$Pgm: execution of the $tidy_name had trouble"; +# $die_msg .= " (program not found)" if $return_val == 255; +# $die_msg .= " ($!)" if $Verbose && $! != 0; +# $die_msg .= "\n"; + unlink $ScriptFile; + unlink $StatsFile; + + exit (($return_val == 0) ? 0 : 1); + } +} + +sub process_stats_file { + + # OK, process system-specific stats file + if ( $SysSpecificTiming =~ /^ghc/ ) { + + #NB: nearly the same as in GHC driver's -ghc-timing stuff + + open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n"; + + local($max_live) = 0; + local($tot_live) = 0; # for calculating residency stuff + local($tot_samples) = 0; + + while (<STATS>) { + if (! /Minor/ && /^\s*\d+\s+\d+\s+(\d+)\s+\d+\.\d+\%/ ) { + $max_live = $1 if $max_live < $1; + $tot_live += $1; + $tot_samples += 1; + } + + $BytesAlloc = $1 if /^\s*([0-9,]+) bytes allocated in the heap/; + +# if ( /^\s*([0-9,]+) bytes maximum residency .* (\d+) sample/ ) { +# $MaxResidency = $1; $ResidencySamples = $2; +# } + + $GCs = $1 if /^\s*([0-9,]+) garbage collections? performed/; + + if ( /^\s*INIT\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) { + $InitTime = $1; $InitElapsed = $2; + } elsif ( /^\s*MUT\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) { + $MutTime = $1; $MutElapsed = $2; + } elsif ( /^\s*GC\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) { + $GcTime = $1; $GcElapsed = $2; + } + } + close(STATS) || die "Failed when closing $StatsFile\n"; + if ( $tot_samples > 0 ) { + $ResidencySamples = $tot_samples; + $MaxResidency = $max_live; + $AvgResidency = int ($tot_live / $tot_samples) ; + } + + } elsif ( $SysSpecificTiming eq 'hbc' ) { + + open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n"; + while (<STATS>) { + $BytesAlloc = $1 if /^\s*([0-9]+) bytes allocated from the heap/; + + $GCs = $1 if /^\s*([0-9]+) GCs?,$/; + + if ( /^\s*(\d+\.\d\d) \((\d+\.\d)\) seconds total time,$/ ) { + $MutTime = $1; $MutElapsed = $2; # will fix up later + + $InitTime = 0; $InitElapsed = 0; # hbc doesn't report these + + } elsif ( /^\s*(\d+\.\d\d) \((\d+\.\d)\) seconds GC time/ ) { + $GcTime = $1; $GcElapsed = $2; + + # fix up mutator time now + $MutTime = sprintf("%.2f", ($MutTime - $GcTime)); + $MutElapsed = sprintf("%.1f", ($MutElapsed - $GcElapsed)); + } + } + close(STATS) || die "Failed when closing $StatsFile\n"; + } + + # warn about what we didn't find + print STDERR "Warning: BytesAlloc not found in stats file\n" unless defined($BytesAlloc); + print STDERR "Warning: GCs not found in stats file\n" unless defined($GCs); + print STDERR "Warning: InitTime not found in stats file\n" unless defined($InitTime); + print STDERR "Warning: InitElapsed not found in stats file\n" unless defined($InitElapsed); + print STDERR "Warning: MutTime not found in stats file\n" unless defined($MutTime); + print STDERR "Warning: MutElapsed not found in stats file\n" unless defined($MutElapsed); + print STDERR "Warning: GcTime inot found in stats file\n" unless defined($GcTime); + print STDERR "Warning: GcElapsed not found in stats file\n" unless defined($GcElapsed); + + # things we didn't necessarily expect to find + $MaxResidency = 0 unless defined($MaxResidency); + $AvgResidency = 0 unless defined($AvgResidency); + $ResidencySamples = 0 unless defined($ResidencySamples); + + # a bit of tidying + $BytesAlloc =~ s/,//g; + $MaxResidency =~ s/,//g; + $GCs =~ s/,//g; + $InitTime =~ s/,//g; + $InitElapsed =~ s/,//g; + $MutTime =~ s/,//g; + $MutElapsed =~ s/,//g; + $GcTime =~ s/,//g; + $GcElapsed =~ s/,//g; +} + +sub process_spixstats_files { # 2 of them; one for mutator, one for GC + + @TotalInsns = (); + @LoadInsns = (); + @StoreInsns = (); + @BranchInsns= (); + @OtherInsns = (); + + foreach $f (1, 2) { + + open(STATS, "< $ToRunOrig.spixstats$f") || die "Failed when opening $ToRunOrig.spixstats$f\n"; + while (<STATS>) { + last if /^OPCODES \(STATIC\):/; # party over + + next if /^OPCODES \(DYNAMIC\):/; + next if /^$/; + next if /^opcode\s+#executed/; + next if /^SUBTOTAL/; + + if ( /^ld\S*\s+(\d+)/ ) { + $LoadInsns[$f] += $1; + + } elsif ( /^st\S*\s+(\d+)/ ) { + $StoreInsns[$f] += $1; + + } elsif ( /^(jmpl|call|b\S*)\s+(\d+)/ ) { + $BranchInsns[$f] += $2; + + } elsif ( /^TOTAL\s+(\d+)/ ) { + $TotalInsns[$f] = $1; + print STDERR "TotalInsns doesn't match categories total!\n" + if $TotalInsns[$f] != + ($LoadInsns[$f] + $StoreInsns[$f] + $BranchInsns[$f] + $OtherInsns[$f]); + + } elsif ( /^\S+\s+(\d+)/ ) { + $OtherInsns[$f] += $1; + + } else { + die "Funny line?? $_"; + } + } + close(STATS) || die "Failed when closing $ToRunOrig.spixstats\n"; + } +}