BSD 4_4_Lite1 development
authorCSRG <csrg@ucbvax.Berkeley.EDU>
Mon, 8 Feb 1993 05:34:51 +0000 (21:34 -0800)
committerCSRG <csrg@ucbvax.Berkeley.EDU>
Mon, 8 Feb 1993 05:34:51 +0000 (21:34 -0800)
Work on file usr/src/contrib/perl-4.036/os2/README.OS2
Work on file usr/src/contrib/perl-4.036/msdos/README.msdos
Work on file usr/src/contrib/perl-4.036/README
Work on file usr/src/contrib/perl-4.036/atarist/README.ST
Work on file usr/src/contrib/perl-4.036/usub/README
Work on file usr/src/contrib/perl-4.036/t/README
Work on file usr/src/contrib/perl-4.036/eg/README
Work on file usr/src/contrib/perl-4.036/hints/sco_2_3_1.sh
Work on file usr/src/contrib/perl-4.036/README.xenix
Work on file usr/src/contrib/perl-4.036/h2pl/README
Work on file usr/src/contrib/perl-4.036/README.uport
Work on file usr/src/contrib/perl-4.036/atarist/usub/README.ATARI
Work on file usr/src/contrib/perl-4.036/eg/sysvipc/README
Work on file usr/src/contrib/perl-4.036/regcomp.c
Work on file usr/src/contrib/perl-4.036/t/op/substr.t

Synthesized-from: CSRG/cd2/4.4BSD-Lite1

15 files changed:
usr/src/contrib/perl-4.036/README [new file with mode: 0644]
usr/src/contrib/perl-4.036/README.uport [new file with mode: 0644]
usr/src/contrib/perl-4.036/README.xenix [new file with mode: 0644]
usr/src/contrib/perl-4.036/atarist/README.ST [new file with mode: 0644]
usr/src/contrib/perl-4.036/atarist/usub/README.ATARI [new file with mode: 0644]
usr/src/contrib/perl-4.036/eg/README [new file with mode: 0644]
usr/src/contrib/perl-4.036/eg/sysvipc/README [new file with mode: 0644]
usr/src/contrib/perl-4.036/h2pl/README [new file with mode: 0644]
usr/src/contrib/perl-4.036/hints/sco_2_3_1.sh [new file with mode: 0644]
usr/src/contrib/perl-4.036/msdos/README.msdos [new file with mode: 0644]
usr/src/contrib/perl-4.036/os2/README.OS2 [new file with mode: 0644]
usr/src/contrib/perl-4.036/regcomp.c [new file with mode: 0644]
usr/src/contrib/perl-4.036/t/README [new file with mode: 0644]
usr/src/contrib/perl-4.036/t/op/substr.t [new file with mode: 0644]
usr/src/contrib/perl-4.036/usub/README [new file with mode: 0644]

diff --git a/usr/src/contrib/perl-4.036/README b/usr/src/contrib/perl-4.036/README
new file mode 100644 (file)
index 0000000..c52c7f4
--- /dev/null
@@ -0,0 +1,195 @@
+
+                       Perl Kit, Version 4.0
+
+               Copyright (c) 1989,1990,1991, Larry Wall
+                         All rights reserved.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of either:
+    
+       a) the GNU General Public License as published by the Free
+       Software Foundation; either version 1, or (at your option) any
+       later version, or
+
+       b) the "Artistic License" which comes with this Kit.
+
+    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.  See either
+    the GNU General Public License or the Artistic License for more details.
+
+    You should have received a copy of the Artistic License with this
+    Kit, in the file named "Artistic".  If not, I'll be glad to provide one.
+
+    You should also have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+    For those of you that choose to use the GNU General Public License,
+    my interpretation of the GNU General Public License is that no Perl
+    script falls under the terms of the GPL unless you explicitly put
+    said script under the terms of the GPL yourself.  Furthermore, any
+    object code linked with uperl.o does not automatically fall under the
+    terms of the GPL, provided such object code only adds definitions
+    of subroutines and variables, and does not otherwise impair the
+    resulting interpreter from executing any standard Perl script.  I
+    consider linking in C subroutines in this manner to be the moral
+    equivalent of defining subroutines in the Perl language itself.  You
+    may sell such an object file as proprietary provided that you provide
+    or offer to provide the Perl source, as specified by the GNU General
+    Public License.  (This is merely an alternate way of specifying input
+    to the program.)  You may also sell a binary produced by the dumping of
+    a running Perl script that belongs to you, provided that you provide or
+    offer to provide the Perl source as specified by the GPL.  (The
+    fact that a Perl interpreter and your code are in the same binary file
+    is, in this case, a form of mere aggregation.)  This is my interpretation
+    of the GPL.  If you still have concerns or difficulties understanding
+    my intent, feel free to contact me.  Of course, the Artistic License
+    spells all this out for your protection, so you may prefer to use that.
+
+--------------------------------------------------------------------------
+
+Perl is a language that combines some of the features of C, sed, awk and shell.
+See the manual page for more hype.  There's also a Nutshell Handbook published
+by O'Reilly & Assoc.  Their U.S. number is 1-800-338-6887 (dev-nuts) and
+their international number is 1-707-829-0515.  E-mail to nuts@ora.com.
+
+Perl will probably not run on machines with a small address space.
+
+Please read all the directions below before you proceed any further, and
+then follow them carefully.
+
+After you have unpacked your kit, you should have all the files listed
+in MANIFEST.
+
+Installation
+
+1)  Run Configure.  This will figure out various things about your system.
+    Some things Configure will figure out for itself, other things it will
+    ask you about.  It will then proceed to make config.h, config.sh, and
+    Makefile.  If you're a hotshot, run Configure -d to take all the
+    defaults and then edit config.sh to patch up any flaws.
+
+    You might possibly have to trim # comments from the front of Configure
+    if your sh doesn't handle them, but all other # comments will be taken
+    care of.
+
+    (If you don't have sh, you'll have to copy the sample file config.H to
+    config.h and edit the config.h to reflect your system's peculiarities.)
+
+2)  Glance through config.h to make sure system dependencies are correct.
+    Most of them should have been taken care of by running the Configure script.
+
+    If you have any additional changes to make to the C definitions, they
+    can be done in cflags.SH.  For instance, to turn off the optimizer
+    on eval.c, find the line in the switch structure for eval.c and
+    put the command $optimize='-g' before the ;;.  You will probably
+    want to change the entry for teval.c too.  To change the C flags
+    for all the files, edit config.sh and change either $ccflags or $optimize.
+
+3)  make depend
+
+    This will look for all the includes and modify Makefile accordingly.
+    Configure will offer to do this for you.
+
+4)  make
+
+    This will attempt to make perl in the current directory.
+
+    If you can't compile successfully, try adding a -DCRIPPLED_CC flag.
+    (Just because you get no errors doesn't mean it compiled right!)
+    This simplifies some complicated expressions for compilers that
+    get indigestion easily.  If that has no effect, try turning off
+    optimization.  If you have missing routines, you probably need to
+    add some library or other, or you need to undefine some feature that
+    Configure thought was there but is defective or incomplete.
+
+    Some compilers will not compile or optimize the larger files without
+    some extra switches to use larger jump offsets or allocate larger
+    internal tables.  You can customize the switches for each file in
+    cflags.SH.  It's okay to insert rules for specific files into
+    Makefile.SH, since a default rule only takes effect in the
+    absence of a specific rule.
+
+    Most of the following hints are now done automatically by Configure.
+
+    The 3b2 needs to turn off -O.
+    Compilers with limited switch tables may have to define -DSMALLSWITCHES
+    Domain/OS 10.3 (at least) native C 6.7 may need -opt 2 for eval.c
+    AIX/RT may need a -a switch and -DCRIPPLED_CC.
+    AIX RS/6000 needs to use system malloc and avoid -O on eval.c and toke.c.
+    AIX RS/6000 needs -D_NO_PROTO.
+    SUNOS 4.0.[12] needs -DFPUTS_BOTCH.
+    SUNOS 3.[45] should use the system malloc.
+    SGI machines may need -Ddouble="long float" and -O1.
+    Vax-based systems may need to hand assemble teval.s with a -J switch.
+    Ultrix on MIPS machines may need -DLANGUAGE_C.
+    Ultrix 4.0 on MIPS machines may need -Olimit 2900 or so.
+    Ultrix 3.[01] on MIPS needs to undefine WAITPID--the system call is busted.
+    MIPS machines need /bin before /bsd43/bin in PATH.
+    MIPS machines may need to undef d_volatile.
+    MIPS machines may need to turn off -O on cmd.c, perl.c and tperl.c.
+    Some MIPS machines may need to undefine CASTNEGFLOAT.
+    Xenix 386 needs -Sm11000 for yacc, and may need -UM_I86.
+    SCO Xenix may need -m25000 for yacc.  See also README.xenix.
+    Genix needs to use libc rather than libc_s, or #undef VARARGS.
+    NCR Tower 32 (OS 2.01.01) may need -W2,-Sl,2000 and #undef MKDIR.
+    A/UX may appears to work with -O -B/usr/lib/big/ optimizer flags.
+    A/UX needs -lposix to find rewinddir.
+    A/UX may need -ZP -DPOSIX, and -g if big cc is used.
+    FPS machines may need -J and -DBADSWITCH.
+    UTS may need one or more of -DCRIPPLED_CC, -K or -g, and undef LSTAT.
+    dynix may need to undefine CASTNEGFLOAT (d_castneg='undef' in config.sh).
+    Dnix (not dynix) may need to remove -O.
+    IRIX 3.3 may need to undefine VFORK.
+    HP/UX may need to pull cerror.o and syscall.o out of libc.a and link
+       them in explicitly.
+    If you get syntax errors on '(', try -DCRIPPLED_CC or -DBADSWITCH or both.
+    Machines with half-implemented dbm routines will need to #undef ODBM & NDBM.
+    If you have GDBM available and want it instead of NDBM, say -DHAS_GDBM.
+    C's that don't try to restore registers on longjmp() may need -DJMPCLOBBER.
+       (Try this if you get random glitches.)
+    If you get duplicates upon linking for malloc et al, say -DHIDEMYMALLOC.
+    Turn on support for 64-bit integers (long longs) with -DQUAD.
+
+5)  make test
+
+    This will run the regression tests on the perl you just made.
+    If it doesn't say "All tests successful" then something went wrong.
+    See the README in the t subdirectory.  Note that you can't run it
+    in background if this disables opening of /dev/tty.  If "make test"
+    bombs out, just cd to the t directory and run TEST by hand to see if
+    it makes any difference.  If individual tests bomb, you can run
+    them by hand, e.g., ./perl op/groups.t
+
+6)  make install
+
+    This will put perl into a public directory (such as /usr/local/bin).
+    It will also try to put the man pages in a reasonable place.  It will not
+    nroff the man page, however.  You may need to be root to do this.  If
+    you are not root, you must own the directories in question and you should
+    ignore any messages about chown not working.
+
+7)  Read the manual entry before running perl.
+
+8)  IMPORTANT!  Help save the world!  Communicate any problems and suggested
+    patches to me, lwall@netlabs.com (Larry Wall), so we can
+    keep the world in sync.  If you have a problem, there's someone else
+    out there who either has had or will have the same problem.
+
+    If possible, send in patches such that the patch program will apply them.
+    Context diffs are the best, then normal diffs.  Don't send ed scripts--
+    I've probably changed my copy since the version you have.  It's also
+    helpful if you send the output of "uname -a".
+
+    Watch for perl patches in comp.lang.perl.  Patches will generally be
+    in a form usable by the patch program.  If you are just now bringing up
+    perl and aren't sure how many patches there are, write to me and I'll
+    send any you don't have.  Your current patch level is shown in patchlevel.h.
+
+
+Just a personal note:  I want you to know that I create nice things like this
+because it pleases the Author of my story.  If this bothers you, then your
+notion of Authorship needs some revision.  But you can use perl anyway. :-)
+
+                                                       The author.
diff --git a/usr/src/contrib/perl-4.036/README.uport b/usr/src/contrib/perl-4.036/README.uport
new file mode 100644 (file)
index 0000000..b2b5712
--- /dev/null
@@ -0,0 +1,34 @@
+From dwm@uf.msc.umn.edu  Tue Dec 19 15:03:27 1989
+Subject: perl on Microport Un*x 2.4
+
+Here are the steps to get perl patchlevel 6 running on Microport Un*x 2.4.
+
+(1) Get the directory routines (opendir, readdir, etc) from an archive 
+    somewhere.   I got mine from uunet:  comp.sources.unix/volume9/gwyn-dir-lib
+    and comp.sources.unix/volume10/dir-lib.pch.   Compile a large memory
+    version of the library and put it in /usr/lib/large/dir.a.  Also put
+    the dir.h include file in /usr/include/sys.  [ If you don't want to
+    do this make sure I_SYSDIR does not defined in config.sh ]
+
+(2) Configure causes sh to get a segmentation fault when it does the
+    ". config.sh" near line 2551.   You will have to remove that line 
+    from Configure and make sure you get your configuration info right 
+    the first time or start over if you make a mistake.  
+
+[Or just run the .SH files by hand and proceed to the make depend.]
+
+(3) If you are using C-shell, put a blank line at the start of Configure so it
+    wont get executed by the C-shell.   If you are using ksh, you will have to
+    execute Configure with 'sh Configure'.  Configure does not work with
+    ksh.
+
+(4) When you run Configure, select compilation option -DCRIPPLED_CC.
+    I also selected -DDEBUGGING to make debugging easier.  I recommend it.
+    You can use -O, but you will then have to compile consarg.c and util.c
+    separately without -O because the optimizer generates bad code for these
+    routines.   The optimizer also dies harmlessly while optimizing cmd.c,
+    eval.c (who can blame it? [sorry, Larry]), and toke.c.   
+    I am still trying to isolate the remaining optimization problems in 
+    consarg.c and util.c.
+
+[The rest of the previously published instructions are no longer necessary.]
diff --git a/usr/src/contrib/perl-4.036/README.xenix b/usr/src/contrib/perl-4.036/README.xenix
new file mode 100644 (file)
index 0000000..ca9a060
--- /dev/null
@@ -0,0 +1,53 @@
+From jpl-devvax!elroy.jpl.nasa.gov!sdd.hp.com!spool.mu.edu!uunet!mcsun!ukc!stl!robobar!ronald Thu Mar  7 09:51:06 PST 1991
+Article 4564 of comp.lang.perl:
+Path: jpl-devvax!elroy.jpl.nasa.gov!sdd.hp.com!spool.mu.edu!uunet!mcsun!ukc!stl!robobar!ronald
+>From: ronald@robobar.co.uk (Ronald S H Khoo)
+Newsgroups: comp.lang.perl
+Subject: Re: directory entries chopped on SCO Unix
+Message-ID: <1991Mar7.083046.14410@robobar.co.uk>
+Date: 7 Mar 91 08:30:46 GMT
+References: <18097@ogicse.ogi.edu> <DJM.91Mar5054514@egypt.eng.umd.edu> <498@stephsf.stephsf.com>
+Organization: Robobar Ltd., Perivale, Middx., ENGLAND.
+Lines: 38
+Status: OR
+
+wengland@stephsf.stephsf.com (Bill England) writes:
+
+>   Would modification of the config to 
+>   drop the Xenix specific test and also dropping the -lx library
+>   work better on Xenix boxes ?  Sorry I can't test Xenix here.
+
+This is a difficult question to answer, mostly because it's hard to
+tell exactly what kind of Xenix you have.
+
+       Early releases didn't have any kind of ndir  -- no problem
+
+       Many releases have only sys/ndir + -lx       -- no problem
+
+       SCO Xenix 2.3.[012] have ndir + dirent, but dirent is reputedly
+               broken on .0 and .1, hence the hack to undef it.
+
+       *However*, the kernel upgrade to 2.3.3 (where dirent apparently works)
+       from any lower 2.3.? is a free upgrade, which you can anon FTP or UUCP.
+
+I use dirent -- I had to make a decision which set of directory routines
+to throw out (so that there would be no confusion), so I threw out the
+old ones.  This means I have to manually remove the ! defined(M_XENIX)
+hacks from the source which is very ugh.
+
+My opinion is that the hacks should be removed seeing as they only apply
+to a small number of operating system versions which you upgrade for
+free anyway.  Chip may disagree with me.  It all rather depends on your
+particular point of view.
+
+You could hack Configure to do case "`uname -r`" in 2.3.[01])
+I guess.  It's a lot of code to handle just one specific case,
+since you have to determine whether to do it or not as well.
+
+In short, I Really Don't Know But It's All Very Annoying.
+
+Just another Xenix user,
+-- 
+Ronald Khoo <ronald@robobar.co.uk> +44 81 991 1142 (O) +44 71 229 7741 (H)
+
+
diff --git a/usr/src/contrib/perl-4.036/atarist/README.ST b/usr/src/contrib/perl-4.036/atarist/README.ST
new file mode 100644 (file)
index 0000000..0d42ba0
--- /dev/null
@@ -0,0 +1,186 @@
+See: FILES for a shipping list of files in this archive.
+See: explain for a brief explaination of the diffs in perl.diffs.
+
+Here is a port of perl 4.0 Patchlevel 19 to the atariST series.:
+
+Whats new since atariST perl 4.010
+       - many minor problems fixed.
+
+       - configuration cleaned up.
+
+        - makefiles now have a uperl.a target, so that usub's can be
+          linked. (see usub/* to see how to make cursesperl)
+
+       - perl will now compile and run correctly with or without
+       the malloc that comes with perl.
+
+       - FILEs opened for write now correctly contain CR/LF unless
+       they are binmode'ed.
+
+       - complete support for gemdos/xbios/bios calls. see osbind.pl
+       and osexample.pl on how to use this facility.
+
+       - tracked perl to Patchlevel 19.
+
+known problems:
+        - $! still does'nt contain the correct value when there is no error.
+       i still have'nt been able to track this down.
+
+-------------------------------------------------------------------------
+
+Here is a port of perl 4.0 Patchlevel 10 to the atariST series.
+
+What you'll need:
+       - a decent shell (i use gulam for obvious reasons), other
+       highly recommended ones are bash 1.08/1.10, gemini/mufpel, okami,
+       microCsh, init from apratt for MiNT. avoid neodesk. avoid the
+       desktop like the plague. The shell should be setup to use
+       atari/mwc conventions for command lines and environment setup
+       and passing. (in gulam be sure to `set env_style mw').
+
+       - a decent set of file utils (ls, rm, mv, etc etc) in your $PATH.
+       if you dont have these, look on atari.archive. the gnuFileutils
+       are available there.
+       
+       - included here are echo and perlglob that you will need.
+
+       - setting UNIXMODE is recommended but not required. If you are
+       going to run the perl tests, then set UNIXMODE to atleast
+       "/.,LAd", else you will get a lot of unnecessary failures.
+       (alternately you will have to go in and edit long path names.
+        get rid of things dealing with links, and rename paths
+        beginning with "/dev/..." etc)
+
+       - if you are going to compile: you'll need gcc distribution,
+       (i used gcc-1.40 and libs at Patchlevel 73 initially. i 
+         currently use gcc-2.1 and libs at Patchlevel 80). Also you will
+       need the port of gdbm (i used v1.5). you'll also need bison.
+       all these are available on atari.archive, in atari/gnustuff/tos
+       the diffs as enclosed in this kit assume you have gcc libs at
+        Patchlevel 80.
+       
+Compiling:
+       - get and install gnu gdbm (i used v1.5 -- see README.ST in
+         the gdbm distribution on how to make the gdbm library).
+
+       - get the perl kit at Patchlevel 19
+
+        - copy  config.h usersub.c atarist.c echo.c wildmat.c  perlglob.c  
+          makefile.sm makefile.smd makefile.st makefile.std makefile.stm
+
+       - apply the diffs in file `perl.diffs' using patch
+
+       - decide which makefile you want to use:
+       makefile.st     perl with gcc library malloc
+       makefile.sm     perl with malloc that comes with perl
+
+       - hit make -f <MAKEFILE>. (if you are not cross-compiling, 
+          you'll have to adjust the makefile yourself -- watchout for
+          perly.fixer).
+          This will result in 3 executables, perl.ttp, perlglob.ttp
+          and echo.ttp. Put all these executables in a sub-directory
+          in your $PATH (and depending on your shell, issue a rehash).
+       (if you use makefile.std instead of makefile.st, the executable
+        will be called perld.ttp. this is perl compiled with
+        -DDEBUGGING)
+
+Compiling usubs:
+       see the files in usub/* and the makefile.st there.
+
+Testing:
+       - run perl from a decent shell. i use either gulam or bash
+       if you are going to be running from gulam, be sure to
+               set env_style mw
+       (this can be done automatically by including the above
+        line in the gulam.g startup file). bash always uses
+       atari/mwc conventions so you dont have to do anything special.
+       (if you run perl from the desktop, you are asking for trouble!)
+
+       - you'll have to run the tests by hand. Almost all the tests
+       pass. You'll have to judge for yourself when a test fails
+       if it should have. I was able to explain all failures. If you
+       cant, ask me via mail. (one day i will cook up a script to
+       do this).
+
+       - It helps to have all the gnu fileutils in your PATH here.
+       especially echo.ttp and perlglob.ttp.
+
+       - Also a lot more tests will pass if you have UNIXMODE setup
+       i use "/.,LAd". If you dont use UNIXMODE, you'll have to hack
+       some of the tests.
+
+       - You may have to fix up a few Pathnames in the tests if you
+       are cd'ing to a particular test sub-directory to run the tests.
+
+       - Compare your tests with the results i got -- see file RESULTS.
+       
+General:
+       - setenv PERLLIB to point at the subdirectory containing lib/*
+       (if you want PERLLIB to contain more than one path, seperate
+        them with commas)
+
+       - UNIXMODE is supported not required.
+
+       - Pipes are a little flakey sometimes, but mostly work fine.
+       Pipes, `prog`  etc are much more efficient if you have set
+       the environment var TEMP to point to a ramdisk. Note, when
+       you set TEMP, it should contain *no* tailing backslash (or slash).
+
+       - to force binary mode use "binmode FILE"
+
+       - browse thru config.h to see whats supported
+
+       - should MiNT'ize this much more.
+
+       - avoid using the backtick (`commands`). Use 'open(FOO, "command |")'
+       and use the filehandle FOO as appro.
+
+       - the command passed to system etc can contain
+       redirections of stdin/out, but system does not understand
+       fancy pipelines etc.
+
+       - syscall() to make gemdos/bios/xbios are fully supported now.
+       (note: we dont use ioctl like messy-dos to do this, as we can do
+        real ioctl's on devices)
+
+       - i still need to cons up the lineA stuff.
+         it should be just as easy to cons up aes/vdi outcalls too. imagine
+         graphics from perl!.
+
+       - watch out for re-directions. TOS blows up if you try to
+       re-direct a re-directed handle. atari has greatly improved this
+       situation. hopefully, the next general release of TOS will contain
+       these fixes.
+
+       - in the perl libs (particularly perldb.pl) you will
+       need to s?/dev/tty?/dev/console?. perl -d works just fine.
+       for instance: (for this to work, UNIXMODE should include the
+       'd' option):
+*** /home/bammi/etc/src/perl/lib/perldb.pl     Tue Jun 11 17:40:17 1991
+--- perldb.pl  Mon Oct  7 21:46:28 1991
+***************
+*** 49,56 ****
+  # 
+  #
+  
+! open(IN, "</dev/tty") || open(IN,  "<&STDIN");       # so we don't dingle stdin
+! open(OUT,">/dev/tty") || open(OUT, ">&STDOUT");      # so we don't dongle stdout
+  select(OUT);
+  $| = 1;                              # for DB'OUT
+  select(STDOUT);
+--- 49,56 ----
+  # 
+  #
+  
+! open(IN, "</dev/console") || open(IN,  "<&STDIN");   # so we don't dingle stdin
+! open(OUT,">/dev/console") || open(OUT, ">&STDOUT");  # so we don't dongle stdout
+  select(OUT);
+  $| = 1;                              # for DB'OUT
+  select(STDOUT);
+
+cheers,
+--
+bang:   uunet!cadence!bammi                    jwahar r. bammi
+domain: bammi@cadence.com
+GEnie: J.Bammi
+CIS:    71515,155
diff --git a/usr/src/contrib/perl-4.036/atarist/usub/README.ATARI b/usr/src/contrib/perl-4.036/atarist/usub/README.ATARI
new file mode 100644 (file)
index 0000000..89174eb
--- /dev/null
@@ -0,0 +1 @@
+For the atariST bsd derived curses use acurses.mus (its got its own wrinkles!)
diff --git a/usr/src/contrib/perl-4.036/eg/README b/usr/src/contrib/perl-4.036/eg/README
new file mode 100644 (file)
index 0000000..87cfc33
--- /dev/null
@@ -0,0 +1,22 @@
+Although supplied with the perl package, the perl scripts in this eg
+directory and its subdirectories are placed in the public domain, and
+you may do anything with them that you wish.
+
+This stuff is supplied on an as-is basis--little attempt has been made to make
+any of it portable.  It's mostly here to give you an idea of what perl code
+looks like, and what tricks and idioms are used.
+
+System administrators responsible for many computers will enjoy the items
+down in the g directory very much.  The scan directory contains the beginnings
+of a system to check on and report various kinds of anomalies.
+
+If you machine doesn't support #!, the first thing you'll want to do is
+replace the #! with a couple of lines that look like this:
+
+       eval "exec /usr/bin/perl -S $0 $*"
+               if $running_under_some_shell;
+
+being sure to include any flags that were on the #! line.  A supplied script
+called "nih" will translate perl scripts in place for you:
+
+       nih g/g??
diff --git a/usr/src/contrib/perl-4.036/eg/sysvipc/README b/usr/src/contrib/perl-4.036/eg/sysvipc/README
new file mode 100644 (file)
index 0000000..54094f1
--- /dev/null
@@ -0,0 +1,9 @@
+FYEnjoyment, here are the test scripts I used while implementing SysV
+IPC in Perl.  Each of them must be run with the parameter "s" for
+"send" or "r" for "receive"; in each case, the receiver is the server
+and the sender is the client.
+
+-- 
+Chip Salzenberg at ComDev/TCT     <chip@tct.uucp>, <uunet!ateng!tct!chip>
+
+
diff --git a/usr/src/contrib/perl-4.036/h2pl/README b/usr/src/contrib/perl-4.036/h2pl/README
new file mode 100644 (file)
index 0000000..5fe8ae7
--- /dev/null
@@ -0,0 +1,71 @@
+[This file of Tom Christiansen's has been edited to change makelib to h2ph
+and .h to .ph where appropriate--law.]
+
+This directory contains files to help you convert the *.ph files generated my
+h2ph out of the perl source directory into *.pl files with all the
+indirection of the subroutine calls removed.  The .ph version will be more
+safely portable, because if something isn't defined on the new system, like
+&TIOCGETP, then you'll get a fatal run-time error on the system lacking that
+function.  Using the .pl version means that the subsequent scripts will give
+you a 0 $TIOCGETP and God only knows what may then happen.   Still, I like the
+.pl stuff because they're faster to load.
+
+FIrst, you need to run h2ph on things like sys/ioctl.h to get stuff
+into the perl library directory, often /usr/local/lib/perl.  For example,
+    # h2ph sys/ioctl.h
+takes /usr/include/sys/ioctl.h as input and writes (without i/o redirection)
+the file /usr/local/lib/perl/sys/ioctl.ph, which looks like this
+
+    eval 'sub TIOCM_RTS {0004;}';
+    eval 'sub TIOCM_ST {0010;}';
+    eval 'sub TIOCM_SR {0020;}';
+    eval 'sub TIOCM_CTS {0040;}';
+    eval 'sub TIOCM_CAR {0100;}';
+
+and much worse, rather than what Larry's ioctl.pl from the perl source dir has, 
+which is:
+
+    $TIOCM_RTS = 0004;
+    $TIOCM_ST = 0010;
+    $TIOCM_SR = 0020;
+    $TIOCM_CTS = 0040;
+    $TIOCM_CAR = 0100;
+
+[Workaround for fixed bug in makedir/h2ph deleted--law.]
+
+The more complicated ioctl subs look like this:
+
+    eval 'sub TIOCGSIZE {&TIOCGWINSZ;}';
+    eval 'sub TIOCGWINSZ {&_IOR("t", 104, \'struct winsize\');}';
+    eval 'sub TIOCSETD {&_IOW("t", 1, \'int\');}';
+    eval 'sub TIOCGETP {&_IOR("t", 8,\'struct sgttyb\');}';
+
+The _IO[RW] routines use a %sizeof array, which (presumably) 
+is keyed on the type name with the value being the size in bytes.  
+
+To build %sizeof, try running this in this directory:
+
+    % ./getioctlsizes 
+
+Which will tell you which things the %sizeof array needs
+to hold.  You can try to build a sizeof.ph file with:
+
+    % ./getioctlsizes | ./mksizes > sizeof.ph
+
+Note that mksizes hardcodes the #include files for all the types, so it will
+probably require customization.  Once you have sizeof.ph, install it in the
+perl library directory.  Run my tcbreak script to see whether you can do
+ioctls in perl now.  You'll get some kind of fatal run-time error if you
+can't.  That script should be included in this directory.
+
+If this works well, now you can try to convert the *.ph files into
+*.pl files.  Try this:
+
+    foreach file ( sysexits.ph sys/{errno.ph,ioctl.ph} )
+       ./mkvars $file > t/$file:r.pl
+    end
+
+The last one will be the hardest.  If it works, should be able to 
+run tcbreak2 and have it work the same as tcbreak.
+
+Good luck.
diff --git a/usr/src/contrib/perl-4.036/hints/sco_2_3_1.sh b/usr/src/contrib/perl-4.036/hints/sco_2_3_1.sh
new file mode 100644 (file)
index 0000000..146363a
--- /dev/null
@@ -0,0 +1,2 @@
+yacc='/usr/bin/yacc -Sm25000'
+i_dirent=undef
diff --git a/usr/src/contrib/perl-4.036/msdos/README.msdos b/usr/src/contrib/perl-4.036/msdos/README.msdos
new file mode 100644 (file)
index 0000000..3a5c38f
--- /dev/null
@@ -0,0 +1,195 @@
+                  Notes on the MS-DOS Perl port
+
+                       Diomidis Spinellis
+                        (dds@cc.ic.ac.uk)
+
+[0. First copy the files in the msdos directory into the parent
+directory--law]
+
+1.  Compiling.
+
+     Perl has been compiled under MS-DOS using the Microsoft
+C  compiler  version 5.1.  Before compiling install dir.h as
+<sys/dir.h>.  You will need a Unix-like make  program  (e.g.
+pdmake) and something like yacc (e.g. bison).  You could get
+away by running yacc and dry running make on  a  Unix  host,
+but  I  haven't tried it.  Compilation takes 12 minutes on a
+20MHz 386 machine (together with formating the  manual),  so
+you  will probably need something to do in the meantime. The
+executable is 272k and the top level directory needs 1M  for
+sources  and  about the same ammount for the object code and
+the executables.
+
+     The makefile will compile glob for you which  you  will
+need  to  place somewhere in your path so that perl globbing
+will work correctly.  I have not tried all the tests or  the
+examples,  nor the awk and sed to Perl translators.  You are
+on your own with them.  In the eg directory I have  included
+an  example  program  that uses ioctl to display the charac-
+teristics of the storage devices of the system.
+
+2.  Using MS-DOS Perl
+
+     The MS-DOS version of perl has most of the  functional-
+ity of the Unix version.  Functions that can not be provided
+under  MS-DOS  like  sockets,  password  and  host  database
+access,  fork  and wait have been ommited and will terminate
+with a fatal error.  Care has been taken  to  implement  the
+rest.   In particular directory access, redirection (includ-
+ing pipes, but excluding the pipe function),  system,  ioctl
+and sleep have been provided.
+
+[Files currently can be edited in-place provided you are cre-
+ating  a  backup.   However, if the backup coincidentally has 
+the same name as the original, or  if  the  resulting  backup 
+filename  is invalid, then the file will probably be trashed.
+For example, don't do
+
+       perl -i~ script makefile
+       perl -i.bak script file.dat
+
+because  (1)  MS-DOS treats "makefile~" and "makefile" as the
+same filename, and (2) "file.dat.bak" is an invalid filename.
+The  files  "makefile"  and  "file.dat" will probably be lost 
+forever.  Moral of the story:   Don't  use  in-place  editing 
+under MS-DOS. --rjc]
+
+2.1.  Interface to the MS-DOS ioctl system call.
+
+     The function code of the  ioctl  function  (the  second
+argument) is encoded as follows:
+
+- The lowest nibble of the function code goes to AL.
+- The two middle nibbles go to CL.
+- The high nibble goes to CH.
+
+     The return code is -1 in the case of an  error  and  if
+successful:
+
+- for functions AL = 00, 09, 0a the value of the register DX
+- for functions AL = 02 - 08, 0e the value of the register AX
+- for functions AL = 01, 0b - 0f the number 0.
+
+     See the perl manual for instruction on how  to  distin-
+guish between the return value and the success of ioctl.
+
+     Some ioctl functions need a number as the  first  argu-
+ment.   Provided  that  no  other files have been opened the
+number  can  be   obtained   if   ioctl   is   called   with
+@fdnum[number]  as  the  first  argument after executing the
+following code:
+
+        @fdnum = ("STDIN", "STDOUT", "STDERR");
+        $maxdrives = 15;
+        for ($i = 3; $i < $maxdrives; $i++) {
+                open("FD$i", "nul");
+                @fdnum[$i - 1] = "FD$i";
+        }
+
+2.2.  Binary file access
+
+     Files are opened in text mode by default.   This  means
+that  CR LF pairs are translated to LF.  If binary access is
+needed the `binary'  function  should  be  used.   There  is
+currently  no  way to reverse the effect of the binary func-
+tion.  If that is needed close and reopen the file.
+
+2.3.  Interpreter startup.
+
+     The effect of the Unix #!/bin/perl interpreter  startup
+can  be  obtained  under  MS-DOS by giving the script a .bat
+extension and using the following lines on its begining:
+
+        @REM=("
+        @perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
+        @end ") if 0 ;
+
+(Note that you will probably want an absolute path name in
+front of %0.bat).
+
+                               March 1990
+
+                               Diomidis Spinellis <dds@cc.ic.ac.uk>
+                               Myrsinis 1
+                               GR-145 62 Kifissia
+                               Greece
+
+--------------------------------------------------------------------------
+
+       Revisions to the MS-DOS support in Perl 4.0
+       Tom Dinger, 18 March 1991
+
+The DOS compatibility added to Perl sometime in release 3.x was not
+maintained, and Perl as distributed could not be built without changes.
+
+Both myself and Len Reed more or less "rediscovered" how to get Perl built
+and running reliably for MS-DOS, using the Microsoft C compiler.  He and I
+have communicated, and will be putting together additional patches for the
+DOS version of Perl.
+
+1. Compiling Perl
+
+    For now, I have not supplied a makefile, as there is no standard for
+    make utilities under DOS.  All the files can be compiled with Microsoft
+    C 5.1, using the switches "-AL -Ox" for Large memory model, maximum
+    optimization (this turned out a few code generation bugs in MSC 5.1).
+    The code will also compile with MSC 6.00A, with the optimization
+    "-Oacegils /Gs" for all files (regcomp.c has special case code to change
+    the aliasing optimizations).
+
+    Generally, you follow the instructions given above to compile and build
+    Perl 4.0 for DOS.  I used the output of SunOS yacc run on perly.y,
+    without modification, but I expect both Bison and Berkeley-YACC will work
+    also.  From inspection of the generated code, however, I believe AT&T
+    derived YACC produces the smallest tables, i.e. uses the least memory.
+    This is important for a 300K executable file.
+
+2. Editing in-place.
+
+    You will need the file suffix.c from the os2 subdirectory -- it will
+    create a backup file with much less danger for DOS.
+
+3. A "Smarter" chdir() function.
+
+    I have added to the DOS version of Perl 4.0 a replacement chdir()
+    function.  Unlike the "normal" behavior, it is aware of drive letters
+    at the start of paths for DOS.  So for example:
+
+    perl_chdir( "B:" )      changes to the default directory, on drive B:
+    perl_chdir( "C:\FOO" )  changes to the specified directory, on drive C:
+    perl_chdir( "\BAR" )    changes to the specified directory on the
+                            current drive.
+
+4. *.BAT Scripts as Perl scripts
+
+    The strategy described above for turning a Perl script into a *.BAT
+    script do not work.  I have been using the following lines at the
+    beginning of a Perl *.BAT script:
+
+        @REM=(qq!
+        @perl -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
+        @goto end !) if 0 ;
+
+    and the following at the end of the *.BAT script:
+
+        @REM=(qq!
+        :end !) if 0 ;
+
+    If you like, with the proper editor you can replace the four '!'
+    characters with some untypeable character, such as Ctrl-A.  This will
+    allow you to pass any characters, including ".." strings as arguments.
+
+4. Things to Come
+
+     *  Better temporary file handling.
+     *  A real Makefile -- Len Reed has one for Dmake 3.6
+     *  Swapping code -- swaps most of Perl out of memory (to EMS, XMS or
+       disk) before running a sub-program or pipe.
+     * MKS command line support, both into Perl, and to other programs
+       spawned by Perl.
+     * Smarter pipe functions, not using COMMAND.COM.
+
+
+                                       Tom Dinger
+                                       tdinger@East.Sun.COM
+                                       Martch 18, 1991
diff --git a/usr/src/contrib/perl-4.036/os2/README.OS2 b/usr/src/contrib/perl-4.036/os2/README.OS2
new file mode 100644 (file)
index 0000000..2cca20c
--- /dev/null
@@ -0,0 +1,434 @@
+                  Notes on the OS/2 Perl port
+
+                       Raymond Chen
+                (rjc@math.princeton.edu)
+
+                        Kai Uwe Rommel
+          (rommel@lan.informatik.tu-muenchen.dbp.de)
+
+-1.  Background.
+
+This port was based on the MS-DOS port by Diomidis Spinellis.
+
+0.  Set-up.
+
+First copy the files in the os2 directory into the parent
+directory.  Also install the file msdos/dir.h in your include
+directory.
+
+1.  Compiling.
+
+Perl has been compiled under MS-DOS using the Microsoft C compiler
+version 6.0.  Before compiling install dir.h as <sys/dir.h>.  You will
+need a Unix-like make program and something like yacc (e.g. bison).  I
+just ran yacc on my UNIX box and downloaded the resulting y.tab.[ch]
+files.  Compilation takes 45 minutes on a 16MHz 386 machine running
+no jobs other than the compiler, so you will probably need something to
+do in the meantime.  Like, say, lunch.  (Compilation time does not
+include formatting the manual.)  If you compile with optimization
+turned off, it takes about half as long.
+
+The executable is 270k (perlsym.exe is 473k; if you compile
+without optimization, the sizes are 329K/531K), and the top level
+directory needs 800K for sources, 550K for object code, and 800K for the
+executables, assuming you want to build both perl.exe and perlsym.exe
+with full optimization.
+
+The makefile will compile glob for you which you will need to place
+somewhere in your path so that perl globbing will work correctly.  All
+the tests were run, although some modifications were necessary because
+OS/2 isn't UNIX. The tests that failed failed because of limitations of
+the operating system and aren't the fault of the compiler.  a2p and s2p
+were not tested.
+
+In the eg directory you will find the syscalls.pl header file,
+and a sample program that demonstrates some of the improvements
+of the OS/2 version over the MS-DOS version and some of the
+system calls.
+
+2.  Using OS/2 Perl
+
+The OS/2 version of perl has much of the functionality of the Unix
+version.  Here are some things that don't work:  sockets, password
+functions, [gs]et[eug]id, dbm functions, fork.
+
+One thing that doesn't work is "split" with no arguments.  Somehow,
+yylval.arg is empty ...  [[ Wait, sorry, I fixed that. --rjc ]]
+
+Care has been taken to implement the rest, although the implementation
+might not be the best possible.  Here are short notes on the tricky
+bits:
+
+2.1.  In-place editing.
+
+Files currently can be edited in-place provided you are creating a
+backup.  Considerable effort is made to ensure that a reasonable
+name for the backup is selected, while still remaining within
+the 8.3 contraints of the FAT filesystem.  (HPFS users have nothing
+to worry about, since HPFS doesn't have the stupid 8.3 rule.)
+
+The rules for how OS/2 perl combines your filename with the suffix
+(the thing passed to "-i") are rather complicated, but the basic
+idea is that the "obvious" name is chosen.
+
+Here are the rules:
+
+Style 0:  Append the suffix exactly as UNIX perl would do it.
+          If the filesystem likes it, use it.  (HPFS will always
+          swallow it.  FAT will rarely accept it.)
+
+Style 1:  If the suffix begins with a '.', change the file extension
+         to whatever you supplied.  If the name matches the original
+         name, use the fallback method.
+
+Style 2:  If the suffix is a single character, not a '.', try to add the
+          suffix to the following places, using the first one that works.
+              [1] Append to extension.
+              [2] Append to filename,
+              [3] Replace end of extension,
+              [4] Replace end of filename.
+          If the name matches the original name, use the fallback method.
+
+Style 3:  Any other case:  Ignore the suffix completely and use the
+          fallback method.
+
+Fallback method:  Change the extension to ".$$$".  If that matches the
+          original name, then change the extension to ".~~~".
+
+If filename is more than 1000 characters long, we die a horrible
+death.  Sorry.
+
+Examples, assuming style 0 failed.
+
+suffix = ".bak" (style 1)
+               foo.bar => foo.bak
+               foo.bak => foo.$$$      (fallback)
+               foo.$$$ => foo.~~~      (fallback)
+               makefile => makefile.bak
+
+suffix = "~" (style 2)
+               foo.c => foo.c~
+               foo.c~ => foo.c~~
+               foo.c~~ => foo~.c~~
+               foo~.c~~ => foo~~.c~~
+               foo~~~~~.c~~ => foo~~~~~.$$$ (fallback)
+
+               foo.pas => foo~.pas
+               makefile => makefile.~
+               longname.fil => longname.fi~
+               longname.fi~ => longnam~.fi~
+               longnam~.fi~ => longnam~.$$$
+
+2.2.  Directory access.
+
+Are implemented, but in order to support telldir() and seekdir(),
+they operate by reading in the entire directory at opendir(),
+then handing out pieces of it each time you do a readdir().
+
+2.3.  Pipes and redirection.
+
+Pipes and redirection are supported.  Although OS/2 does not
+terminate programs which try to write to closed pipes, perl will
+kill them for you if you do it like this:
+
+       open(I, "long-running-program|");
+       ... process a few lines ...
+       close(I);       # discard the rest ...
+
+The killing works like this:  We wait until the child program either
+closes its stdout or tries to write to it.  If it writes to its stdout,
+we kill it.  Otherwise, we cwait for it.  This is pretty much what UNIX
+does by default.
+
+All pipe commands are given to cmd.exe (or your COMSPEC) for execution as
+
+       CMD /c your-command-line
+
+so you can go ahead and load it up with any goofy things you want,
+like 2>1 redirection, more pipes, && || etc.
+
+The pipe() function is also supported, so you can go ahead and
+make your own funky file descriptor connections before piping off
+a process.  However, you have to mark the descriptor you are
+retaining as NOINHERIT before spawning, else you are in deadlock city.
+Unfortunately, there's no way to mark the handle as NOINHERIT yet.
+It's on my wish list.
+
+2.4.  Syscall and Ioctl
+
+IOCtl is not supported because the API is very different from the
+UNIX API.  Instead, IOCtl is supported as a syscall.  Here are
+the syscalls I've written so far:
+
+       $OS2_GetVersion = 0;
+       $OS2_Shutdown = 1;
+       $OS2_Beep = 2;
+       $OS2_PhysicalDisk = 3;
+       $OS2_Config = 4;
+       $OS2_IOCtl = 5;
+       $OS2_QCurDisk = 6;
+       $OS2_SelectDisk = 7;
+       $OS2_SetMaxFH = 8;
+       $OS2_Sleep = 9;
+       $OS2_StartSession = 10;
+       $OS2_StopSession = 11;
+       $OS2_SelectSession = 12;
+
+The arguments you pass are handed off to OS/2 without interpretation,
+and the return value is returned straight to you.  However, you don't
+have to supply arguments for the ones whose descriptions are "must be
+zero"; perl will supply the mandatory zeros for you.
+
+2.5.  Binary file access
+
+Files are opened in text mode by default.  This means that CR LF pairs
+are translated to LF. If binary access is needed the `binarymode'
+function should be used.  There is currently no way to reverse the
+effect of the binary function.  If that is needed close and reopen the
+file.
+
+2.6.  Priority
+
+The getpriority and setpriority functions are implemented, but since
+OS/2 priorities are different from UNIX priorities, the arguments aren't
+the same.  Basically, the arguments you pass are handed directly to
+OS/2. The only exception is the last argument to setpriority.  To make
+it easier to make delta priorities, if the priority class is 0xff, it
+is changed to 0.  That way, you can write
+
+       setpriority(0,0,-2)
+
+instead of
+
+       setpriority(0,0,0xfe)
+
+to decrease the delta by 2.
+
+2.7.  Interpreter startup.
+
+The effect of the Unix #!/bin/perl interpreter startup can be obtained
+under OS/2 by giving the script a .cmd extension and beginning the script
+with the line
+
+       extproc C:\binp\perl.exe -S
+
+You should provide the appropriate path to your executable, and
+the -S option is necessary so that perl can find your script.
+
+2.8.  The kill function.
+
+UNIX and OS/2 have different ideas about the kill function.  I've
+done a pretty feeble job of taking perl's UNIXish approach and
+trying to jam it into the OS/2 way.  No doubt you'll find that
+your kill()s aren't working.  My apologies in advance.
+
+3.  Bug reports.
+
+I don't normally have access to an OS/2 machine, so if you find
+a bug, you can go ahead and tell me about it, but the odds that
+I'd be able to fix it are slim.
+
+4.  Wish list.
+
+4.1.  OS/2.
+
+Make ENOPIPE a fatal error.
+
+Permit linking of files.  (Allegedly, they're working on this.)
+
+Get a fork.
+
+Make CMD.EXE pass through the return code of its child.
+
+4.2 perl.
+
+Provide a nice way to add new functions to perl without having
+to understand the innards of perl.  Not being fluent in perl
+innards hacking, I added my extra functions via syscall.
+
+4.3. My port.
+
+4.3.1.  In-place editing.
+
+Make more idiot-proof.
+
+Allow in-place editing without backup.  (How?)
+
+4.3.2.  Spawning and piping.
+
+Make popen() cleverer.  Currently, it blindly hands everything
+off to CMD.EXE.  This wastes an exec if the command line didn't
+have any shell metacharacters and if the program being run
+is not a batch file.
+
+Clever spawning is carried out by do_spawn.  We should try
+to make popen() do much of the same sort of preprocessing
+as do_spawn does (which means, of course, that we probably
+should yank out code to be dished off into a subroutine).
+
+In do_spawn(), use DosExecPgm instead of spawnl in order to get more
+precise reasons why the child terminated (RESULTCODES).
+
+
+                               July 1990
+
+                               Raymond Chen <rjc@math.princeton.edu>
+                               1817 Oxford St. Apt 6
+                               Berkeley, CA 94709-1828 USA
+
+-----------------------
+I picked up the OS/2 port with patches 19-28. When compiling, I found
+out that os2.c and director.c were missing. I had to rewrite them because
+even the original author of the port (Raymond Chen) did no longer have them.
+
+I had directory routines laying around, this was no big deal.
+I rewrote os2.c, but did not implement the syscall() as described above.
+I had not the time and did not really need it. Feel free ...
+
+Changes to above described port:
+
+- the small program GLOB is now named PERLGLOB for better ordering in
+  my /bin directory
+
+- added help page (well, a graphical user interface would be overkill
+  but a simple help page should be in every program :-)
+
+- several cosmetic changes in standard distribution files because of
+  naming conventions etc., #ifdef'd OS2
+
+- syscall() not supported as noted above
+
+- chdir now recognizes also drive letters and changes also the drive
+
+- new mypopen(), mypclose() functions and simulation routines for DOS mode,
+  they are selected automatically in real mode
+- the new pclose() does not kill the child, my experience is that this is
+  not needed.
+
+- setpriority is now:   setpriority(class, pid, val)
+  see description of DosSetPrty() for class and val meanings
+- getpriority is now:   getpriority(dummy, pid)
+  see description of DosGetPrty()
+
+- kill is now:          kill(pid, sig)
+  where sig can be 0 (kill process)
+                   1-3 (send process flags A-C, see DosFlagProcess())
+  if pid is less than zero, the signal is sent to the whole
+  process tree originating at -pid.
+
+The following files are now new with patch >=29:
+
+readme.os2        this file
+
+dir.h             sys/dir.h
+director.c        directory routines
+os2.c             kernel of OS/2 port (see below)
+popen.c           new popen.c
+mktemp.c          enhanced mktemp(), uses TMP env. variable, used by popen.c
+alarm.c           PD implementation for alarm()
+alarm.h                  header for alarm.c
+
+perl.cs           Compiler Shell script for perl itself
+perl.def          linker definition file for perl
+perl.bad          names of protect-only API calls for BIND
+perlglob.cs       Compiler Shell script for perl globbing program
+perlglob.def      linker definition file for perlglob
+a2p.cs            Compiler Shell script for a2p (see below)
+a2p.def           linker definition file for a2p
+makefile          Makefile, not tested
+
+perlsh.cmd        the converted perlsh
+perldb.dif        changes required for perldb.pl (change for your needs)
+selfrun.cmd       sample selfrunning perl script for OS/2
+selfrun.bat       sample selfrunning perl script for DOS mode
+
+Note: I don't use make but my own utility, the Compiler Shell CS.
+It was posted in comp.binaries.os2 or you can ask me for the newest
+version. The .CS files are the "makefiles" for it.
+
+Note: MS C 6.00 is required. C 5.1 is not capable of compiling perl,
+especially not with -DDEBUGGING
+
+
+                                August 1990
+
+                                Kai Uwe Rommel
+                                rommel@lan.informatik.tu-muenchen.dbp.de
+                                Zennerstr. 1
+                                D-8000 Muenchen 70
+
+
++ I have verified with patchlevel 37, that the OS/2 port compiles,
+  after doing two minor changes. HPFS filenames support was also added.
+  Some bugs were fixed.
++ To compile,
+  - you need the bison parser generator
+  - copy config.h from os2 into the main perl directory (important !)
+  - copy perl.cs and perlglob.cs from the os2 subdir to the main dir
+  - copy a2p.cs from os2 to x2p
+  - say "bison -d perl.y"
+      "ren perl_tab.c perl.c" and
+      "ren perl_tab.h perly.h" in the main directory
+  - say "cs perl" and
+      "cs perlglob" in the main directory
+  - say "cs a2p" in the x2p subdir
++ If you don't have CS or don't want to use it, you have to
+  construct a makefile ...
++ If you have GNU gdbm, you can define NDBM in config.h and link with a
+  large model library of gdbm.
++ I am not sure if I can verify the OS/2 port with each release
+  from Larry Wall. Therefore, in future releases there may be
+  changes required to compile perl for OS/2.
+                               October 1990
+                               Kai Uwe Rommel
+                               rommel@lan.informatik.tu-muenchen.dbp.de
+
+
+Verified patchlevel 40.
+Some bugs were fixed. Added alarm() support (using PD implementation).
+
+
+                               November 1990
+
+                                Kai Uwe Rommel
+                                rommel@lan.informatik.tu-muenchen.dbp.de
+Verified perl 4.0 at patchlevel 10
+Changes:
+- some minor corrections and updates in various files
+- new os2/config.h created from original config.H
+- added support for crypt(), PD routine by A.Tanenbaum in new os2/crypt.c
+- added support for wait4pid() in os2.c
+- fixed/added support for -P option (requires a standard CPP for OS/2)
+- os2/mktemp.c deleted, no longer needed
+- new Makefile created for MS C 6.00 and it's NMAKE
+- with os2/perl.cs, bison has no longer to be called manually
+I have successfully run most tests. Diffs are in os2/tests.dif.
+Often, only command names, shell expansion etc. have to be changed.
+Test that still don't run are Unix-specific ones or fail because
+of CR/LF-problems:
+- io/argv.t, io/inplace.t, op/exec.t, op/glob.t  (minor problems)
+- io/fs.t, io/pipe.t op/fork.t, op/magic.t, op/time.t
+   (under OS/2 not supported features of Unix)
+- op/pat.t (bug, not yet fixed)
+Remember to remove the HAS_GDBM symbol from os2/config.h or
+get GNU gdbm for OS/2.
+                               June 1991
+                                Kai Uwe Rommel
+                                rommel@lan.informatik.tu-muenchen.dbp.de
+Verified perl 4.0 at patchlevel 19
+Minor fixes. Previous fixes at PL10 were not included into distribution.
+                               November 1991
+                                Kai Uwe Rommel
+                                rommel@informatik.tu-muenchen.dbp.de
+
+
+Verified patchlevel 44.
+Only two #ifdefs added to eval.c. Stack size for A2P had to be corrected.
+PERLGLOB separated from DOS version because of HPFS support.
+
+[Note: instead of #ifdef'ing eval.c I fixed it in perl.h--lwall]
+
+                               January 1991
+
+                                Kai Uwe Rommel
+                                  rommel@lan.informatik.tu-muenchen.dbp.de
diff --git a/usr/src/contrib/perl-4.036/regcomp.c b/usr/src/contrib/perl-4.036/regcomp.c
new file mode 100644 (file)
index 0000000..fa07260
--- /dev/null
@@ -0,0 +1,1475 @@
+/* NOTE: this is derived from Henry Spencer's regexp code, and should not
+ * confused with the original package (see point 3 below).  Thanks, Henry!
+ */
+
+/* Additional note: this code is very heavily munged from Henry's version
+ * in places.  In some spots I've traded clarity for efficiency, so don't
+ * blame Henry for some of the lack of readability.
+ */
+
+/* $RCSfile: regcomp.c,v $$Revision: 4.0.1.5 $$Date: 92/06/08 15:23:36 $
+ *
+ * $Log:       regcomp.c,v $
+ * Revision 4.0.1.5  92/06/08  15:23:36  lwall
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: /^stuff/ wrongly assumed an implicit $* == 1
+ * patch20: /x{0}/ was wrongly interpreted as /x{0,}/
+ * patch20: added \W, \S and \D inside /[...]/
+ * 
+ * Revision 4.0.1.4  91/11/05  22:55:14  lwall
+ * patch11: Erratum
+ * 
+ * Revision 4.0.1.3  91/11/05  18:22:28  lwall
+ * patch11: minimum match length calculation in regexp is now cumulative
+ * patch11: initial .* in pattern had dependency on value of $*
+ * patch11: certain patterns made use of garbage pointers from uncleared memory
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * 
+ * Revision 4.0.1.2  91/06/07  11:48:24  lwall
+ * patch4: new copyright notice
+ * patch4: /(x+) \1/ incorrectly optimized to not match "xxx xx"
+ * patch4: // wouldn't use previous pattern if it started with a null character
+ * 
+ * Revision 4.0.1.1  91/04/12  09:04:45  lwall
+ * patch1: random cleanup in cpp namespace
+ * 
+ * Revision 4.0  91/03/20  01:39:01  lwall
+ * 4.0 baseline.
+ * 
+ */
+/*SUPPRESS 112*/
+/*
+ * regcomp and regexec -- regsub and regerror are not used in perl
+ *
+ *     Copyright (c) 1986 by University of Toronto.
+ *     Written by Henry Spencer.  Not derived from licensed software.
+ *
+ *     Permission is granted to anyone to use this software for any
+ *     purpose on any computer system, and to redistribute it freely,
+ *     subject to the following restrictions:
+ *
+ *     1. The author is not responsible for the consequences of use of
+ *             this software, no matter how awful, even if they arise
+ *             from defects in it.
+ *
+ *     2. The origin of this software must not be misrepresented, either
+ *             by explicit claim or by omission.
+ *
+ *     3. Altered versions must be plainly marked as such, and must not
+ *             be misrepresented as being the original software.
+ *
+ *
+ ****    Alterations to Henry's code are...
+ ****
+ ****    Copyright (c) 1991, Larry Wall
+ ****
+ ****    You may distribute under the terms of either the GNU General Public
+ ****    License or the Artistic License, as specified in the README file.
+
+ *
+ * Beware that some of this code is subtly aware of the way operator
+ * precedence is structured in regular expressions.  Serious changes in
+ * regular-expression syntax might require a total rethink.
+ */
+#include "EXTERN.h"
+#include "perl.h"
+#include "INTERN.h"
+#include "regcomp.h"
+
+#ifdef MSDOS
+# if defined(BUGGY_MSC6)
+ /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
+ # pragma optimize("a",off)
+ /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
+ # pragma optimize("w",on )
+# endif /* BUGGY_MSC6 */
+#endif /* MSDOS */
+
+#ifndef STATIC
+#define        STATIC  static
+#endif
+
+#define        ISMULT1(c)      ((c) == '*' || (c) == '+' || (c) == '?')
+#define        ISMULT2(s)      ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
+       ((*s) == '{' && regcurly(s)))
+#ifdef atarist
+#define        PERL_META       "^$.[()|?+*\\"
+#else
+#define        META    "^$.[()|?+*\\"
+#endif
+
+#ifdef SPSTART
+#undef SPSTART         /* dratted cpp namespace... */
+#endif
+/*
+ * Flags to be passed up and down.
+ */
+#define        HASWIDTH        01      /* Known never to match null string. */
+#define        SIMPLE          02      /* Simple enough to be STAR/PLUS operand. */
+#define        SPSTART         04      /* Starts with * or +. */
+#define        WORST           0       /* Worst case. */
+
+/*
+ * Global work variables for regcomp().
+ */
+static char *regprecomp;               /* uncompiled string. */
+static char *regparse;         /* Input-scan pointer. */
+static char *regxend;          /* End of input for compile */
+static int regnpar;            /* () count. */
+static char *regcode;          /* Code-emit pointer; &regdummy = don't. */
+static long regsize;           /* Code size. */
+static int regfold;
+static int regsawbracket;      /* Did we do {d,d} trick? */
+static int regsawback;         /* Did we see \1, ...? */
+
+/*
+ * Forward declarations for regcomp()'s friends.
+ */
+STATIC int regcurly();
+STATIC char *reg();
+STATIC char *regbranch();
+STATIC char *regpiece();
+STATIC char *regatom();
+STATIC char *regclass();
+STATIC char *regnode();
+STATIC char *reganode();
+STATIC void regc();
+STATIC void reginsert();
+STATIC void regtail();
+STATIC void regoptail();
+
+/*
+ - regcomp - compile a regular expression into internal code
+ *
+ * We can't allocate space until we know how big the compiled form will be,
+ * but we can't compile it (and thus know how big it is) until we've got a
+ * place to put the code.  So we cheat:  we compile it twice, once with code
+ * generation turned off and size counting turned on, and once "for real".
+ * This also means that we don't allocate space until we are sure that the
+ * thing really will compile successfully, and we never have to move the
+ * code and thus invalidate pointers into it.  (Note that it has to be in
+ * one piece because free() must be able to free it all.) [NB: not true in perl]
+ *
+ * Beware that the optimization-preparation code in here knows about some
+ * of the structure of the compiled regexp.  [I'll say.]
+ */
+regexp *
+regcomp(exp,xend,fold)
+char *exp;
+char *xend;
+int fold;
+{
+       register regexp *r;
+       register char *scan;
+       register STR *longish;
+       STR *longest;
+       register int len;
+       register char *first;
+       int flags;
+       int backish;
+       int backest;
+       int curback;
+       int minlen;
+       int sawplus = 0;
+       int sawopen = 0;
+
+       if (exp == NULL)
+               fatal("NULL regexp argument");
+
+       /* First pass: determine size, legality. */
+       regfold = fold;
+       regparse = exp;
+       regxend = xend;
+       regprecomp = nsavestr(exp,xend-exp);
+       regsawbracket = 0;
+       regsawback = 0;
+       regnpar = 1;
+       regsize = 0L;
+       regcode = &regdummy;
+       regc((char)MAGIC);
+       if (reg(0, &flags) == NULL) {
+               Safefree(regprecomp);
+               regprecomp = Nullch;
+               return(NULL);
+       }
+
+       /* Small enough for pointer-storage convention? */
+       if (regsize >= 32767L)          /* Probably could be 65535L. */
+               FAIL("regexp too big");
+
+       /* Allocate space. */
+       Newc(1001, r, sizeof(regexp) + (unsigned)regsize, char, regexp);
+       if (r == NULL)
+               FAIL("regexp out of space");
+
+       /* Second pass: emit code. */
+       if (regsawbracket)
+           Copy(regprecomp,exp,xend-exp,char);
+       r->prelen = xend-exp;
+       r->precomp = regprecomp;
+       r->subbeg = r->subbase = NULL;
+       regparse = exp;
+       regnpar = 1;
+       regcode = r->program;
+       regc((char)MAGIC);
+       if (reg(0, &flags) == NULL)
+               return(NULL);
+
+       /* Dig out information for optimizations. */
+       r->regstart = Nullstr;  /* Worst-case defaults. */
+       r->reganch = 0;
+       r->regmust = Nullstr;
+       r->regback = -1;
+       r->regstclass = Nullch;
+       scan = r->program+1;                    /* First BRANCH. */
+       if (OP(regnext(scan)) == END) {/* Only one top-level choice. */
+               scan = NEXTOPER(scan);
+
+               first = scan;
+               while ((OP(first) == OPEN && (sawopen = 1)) ||
+                   (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
+                   (OP(first) == PLUS) ||
+                   (OP(first) == CURLY && ARG1(first) > 0) ) {
+                       if (OP(first) == PLUS)
+                           sawplus = 1;
+                       else
+                           first += regarglen[OP(first)];
+                       first = NEXTOPER(first);
+               }
+
+               /* Starting-point info. */
+           again:
+               if (OP(first) == EXACTLY) {
+                       r->regstart =
+                           str_make(OPERAND(first)+1,*OPERAND(first));
+                       if (r->regstart->str_cur > !(sawstudy|fold))
+                               fbmcompile(r->regstart,fold);
+               }
+               else if ((exp = index(simple,OP(first))) && exp > simple)
+                       r->regstclass = first;
+               else if (OP(first) == BOUND || OP(first) == NBOUND)
+                       r->regstclass = first;
+               else if (OP(first) == BOL) {
+                       r->reganch = ROPT_ANCH;
+                       first = NEXTOPER(first);
+                       goto again;
+               }
+               else if ((OP(first) == STAR && OP(NEXTOPER(first)) == ANY) &&
+                        !(r->reganch & ROPT_ANCH) ) {
+                       /* turn .* into ^.* with an implied $*=1 */
+                       r->reganch = ROPT_ANCH | ROPT_IMPLICIT;
+                       first = NEXTOPER(first);
+                       goto again;
+               }
+               if (sawplus && (!sawopen || !regsawback))
+                   r->reganch |= ROPT_SKIP;    /* x+ must match 1st of run */
+
+#ifdef DEBUGGING
+               if (debug & 512)
+                   fprintf(stderr,"first %d next %d offset %d\n",
+                     OP(first), OP(NEXTOPER(first)), first - scan);
+#endif
+               /*
+                * If there's something expensive in the r.e., find the
+                * longest literal string that must appear and make it the
+                * regmust.  Resolve ties in favor of later strings, since
+                * the regstart check works with the beginning of the r.e.
+                * and avoiding duplication strengthens checking.  Not a
+                * strong reason, but sufficient in the absence of others.
+                * [Now we resolve ties in favor of the earlier string if
+                * it happens that curback has been invalidated, since the
+                * earlier string may buy us something the later one won't.]
+                */
+               longish = str_make("",0);
+               longest = str_make("",0);
+               len = 0;
+               minlen = 0;
+               curback = 0;
+               backish = 0;
+               backest = 0;
+               while (OP(scan) != END) {
+                       if (OP(scan) == BRANCH) {
+                           if (OP(regnext(scan)) == BRANCH) {
+                               curback = -30000;
+                               while (OP(scan) == BRANCH)
+                                   scan = regnext(scan);
+                           }
+                           else        /* single branch is ok */
+                               scan = NEXTOPER(scan);
+                       }
+                       if (OP(scan) == EXACTLY) {
+                           char *t;
+
+                           first = scan;
+                           while (OP(t = regnext(scan)) == CLOSE)
+                               scan = t;
+                           minlen += *OPERAND(first);
+                           if (curback - backish == len) {
+                               str_ncat(longish, OPERAND(first)+1,
+                                   *OPERAND(first));
+                               len += *OPERAND(first);
+                               curback += *OPERAND(first);
+                               first = regnext(scan);
+                           }
+                           else if (*OPERAND(first) >= len + (curback >= 0)) {
+                               len = *OPERAND(first);
+                               str_nset(longish, OPERAND(first)+1,len);
+                               backish = curback;
+                               curback += len;
+                               first = regnext(scan);
+                           }
+                           else
+                               curback += *OPERAND(first);
+                       }
+                       else if (index(varies,OP(scan))) {
+                           curback = -30000;
+                           len = 0;
+                           if (longish->str_cur > longest->str_cur) {
+                               str_sset(longest,longish);
+                               backest = backish;
+                           }
+                           str_nset(longish,"",0);
+                           if (OP(scan) == PLUS &&
+                             index(simple,OP(NEXTOPER(scan))))
+                               minlen++;
+                           else if (OP(scan) == CURLY &&
+                             index(simple,OP(NEXTOPER(scan)+4)))
+                               minlen += ARG1(scan);
+                       }
+                       else if (index(simple,OP(scan))) {
+                           curback++;
+                           minlen++;
+                           len = 0;
+                           if (longish->str_cur > longest->str_cur) {
+                               str_sset(longest,longish);
+                               backest = backish;
+                           }
+                           str_nset(longish,"",0);
+                       }
+                       scan = regnext(scan);
+               }
+
+               /* Prefer earlier on tie, unless we can tail match latter */
+
+               if (longish->str_cur + (OP(first) == EOL) > longest->str_cur) {
+                   str_sset(longest,longish);
+                   backest = backish;
+               }
+               else
+                   str_nset(longish,"",0);
+               if (longest->str_cur
+                   &&
+                   (!r->regstart
+                    ||
+                    !fbminstr((unsigned char*) r->regstart->str_ptr,
+                         (unsigned char *) r->regstart->str_ptr
+                           + r->regstart->str_cur,
+                         longest)
+                   )
+                  )
+               {
+                       r->regmust = longest;
+                       if (backest < 0)
+                               backest = -1;
+                       r->regback = backest;
+                       if (longest->str_cur
+                         > !(sawstudy || fold || OP(first) == EOL) )
+                               fbmcompile(r->regmust,fold);
+                       r->regmust->str_u.str_useful = 100;
+                       if (OP(first) == EOL && longish->str_cur)
+                           r->regmust->str_pok |= SP_TAIL;
+               }
+               else {
+                       str_free(longest);
+                       longest = Nullstr;
+               }
+               str_free(longish);
+       }
+
+       r->do_folding = fold;
+       r->nparens = regnpar - 1;
+       r->minlen = minlen;
+       Newz(1002, r->startp, regnpar, char*);
+       Newz(1002, r->endp, regnpar, char*);
+#ifdef DEBUGGING
+       if (debug & 512)
+               regdump(r);
+#endif
+       return(r);
+}
+
+/*
+ - reg - regular expression, i.e. main body or parenthesized thing
+ *
+ * Caller must absorb opening parenthesis.
+ *
+ * Combining parenthesis handling with the base level of regular expression
+ * is a trifle forced, but the need to tie the tails of the branches to what
+ * follows makes it hard to avoid.
+ */
+static char *
+reg(paren, flagp)
+int paren;                     /* Parenthesized? */
+int *flagp;
+{
+       register char *ret;
+       register char *br;
+       register char *ender;
+       register int parno;
+       int flags;
+
+       *flagp = HASWIDTH;      /* Tentatively. */
+
+       /* Make an OPEN node, if parenthesized. */
+       if (paren) {
+               parno = regnpar;
+               regnpar++;
+               ret = reganode(OPEN, parno);
+       } else
+               ret = NULL;
+
+       /* Pick up the branches, linking them together. */
+       br = regbranch(&flags);
+       if (br == NULL)
+               return(NULL);
+       if (ret != NULL)
+               regtail(ret, br);       /* OPEN -> first. */
+       else
+               ret = br;
+       if (!(flags&HASWIDTH))
+               *flagp &= ~HASWIDTH;
+       *flagp |= flags&SPSTART;
+       while (*regparse == '|') {
+               regparse++;
+               br = regbranch(&flags);
+               if (br == NULL)
+                       return(NULL);
+               regtail(ret, br);       /* BRANCH -> BRANCH. */
+               if (!(flags&HASWIDTH))
+                       *flagp &= ~HASWIDTH;
+               *flagp |= flags&SPSTART;
+       }
+
+       /* Make a closing node, and hook it on the end. */
+       if (paren)
+           ender = reganode(CLOSE, parno);
+       else
+           ender = regnode(END);
+       regtail(ret, ender);
+
+       /* Hook the tails of the branches to the closing node. */
+       for (br = ret; br != NULL; br = regnext(br))
+               regoptail(br, ender);
+
+       /* Check for proper termination. */
+       if (paren && *regparse++ != ')') {
+               FAIL("unmatched () in regexp");
+       } else if (!paren && regparse < regxend) {
+               if (*regparse == ')') {
+                       FAIL("unmatched () in regexp");
+               } else
+                       FAIL("junk on end of regexp");  /* "Can't happen". */
+               /* NOTREACHED */
+       }
+
+       return(ret);
+}
+
+/*
+ - regbranch - one alternative of an | operator
+ *
+ * Implements the concatenation operator.
+ */
+static char *
+regbranch(flagp)
+int *flagp;
+{
+       register char *ret;
+       register char *chain;
+       register char *latest;
+       int flags;
+
+       *flagp = WORST;         /* Tentatively. */
+
+       ret = regnode(BRANCH);
+       chain = NULL;
+       while (regparse < regxend && *regparse != '|' && *regparse != ')') {
+               latest = regpiece(&flags);
+               if (latest == NULL)
+                       return(NULL);
+               *flagp |= flags&HASWIDTH;
+               if (chain == NULL)      /* First piece. */
+                       *flagp |= flags&SPSTART;
+               else
+                       regtail(chain, latest);
+               chain = latest;
+       }
+       if (chain == NULL)      /* Loop ran zero times. */
+               (void) regnode(NOTHING);
+
+       return(ret);
+}
+
+/*
+ - regpiece - something followed by possible [*+?]
+ *
+ * Note that the branching code sequences used for ? and the general cases
+ * of * and + are somewhat optimized:  they use the same NOTHING node as
+ * both the endmarker for their branch list and the body of the last branch.
+ * It might seem that this node could be dispensed with entirely, but the
+ * endmarker role is not redundant.
+ */
+static char *
+regpiece(flagp)
+int *flagp;
+{
+       register char *ret;
+       register char op;
+       register char *next;
+       int flags;
+       char *origparse = regparse;
+       int orignpar = regnpar;
+       char *max;
+       int iter;
+       char ch;
+
+       ret = regatom(&flags);
+       if (ret == NULL)
+               return(NULL);
+
+       op = *regparse;
+
+       /* Here's a total kludge: if after the atom there's a {\d+,?\d*}
+        * then we decrement the first number by one and reset our
+        * parsing back to the beginning of the same atom.  If the first number
+        * is down to 0, decrement the second number instead and fake up
+        * a ? after it.  Given the way this compiler doesn't keep track
+        * of offsets on the first pass, this is the only way to replicate
+        * a piece of code.  Sigh.
+        */
+       if (op == '{' && regcurly(regparse)) {
+           next = regparse + 1;
+           max = Nullch;
+           while (isDIGIT(*next) || *next == ',') {
+               if (*next == ',') {
+                   if (max)
+                       break;
+                   else
+                       max = next;
+               }
+               next++;
+           }
+           if (*next == '}') {         /* got one */
+               if (!max)
+                   max = next;
+               regparse++;
+               iter = atoi(regparse);
+               if (flags&SIMPLE) {     /* we can do it right after all */
+                   int tmp;
+
+                   reginsert(CURLY, ret);
+                   if (iter > 0)
+                       *flagp = (WORST|HASWIDTH);
+                   if (*max == ',')
+                       max++;
+                   else
+                       max = regparse;
+                   tmp = atoi(max);
+                   if (!tmp && *max != '0')
+                       tmp = 32767;            /* meaning "infinity" */
+                   if (tmp && tmp < iter)
+                       fatal("Can't do {n,m} with n > m");
+                   if (regcode != &regdummy) {
+#ifdef REGALIGN
+                       *(unsigned short *)(ret+3) = iter;
+                       *(unsigned short *)(ret+5) = tmp;
+#else
+                       ret[3] = iter >> 8; ret[4] = iter & 0377;
+                       ret[5] = tmp  >> 8; ret[6] = tmp  & 0377;
+#endif
+                   }
+                   regparse = next;
+                   goto nest_check;
+               }
+               regsawbracket++;        /* remember we clobbered exp */
+               if (iter > 0) {
+                   ch = *max;
+                   sprintf(regparse,"%.*d", max-regparse, iter - 1);
+                   *max = ch;
+                   if (*max == ',' && max[1] != '}') {
+                       if (atoi(max+1) <= 0)
+                           fatal("Can't do {n,m} with n > m");
+                       ch = *next;
+                       sprintf(max+1,"%.*d", next-(max+1), atoi(max+1) - 1);
+                       *next = ch;
+                   }
+                   if (iter != 1 || *max == ',') {
+                       regparse = origparse;   /* back up input pointer */
+                       regnpar = orignpar;     /* don't make more parens */
+                   }
+                   else {
+                       regparse = next;
+                       goto nest_check;
+                   }
+                   *flagp = flags;
+                   return ret;
+               }
+               if (*max == ',') {
+                   max++;
+                   iter = atoi(max);
+                   if (max == next) {          /* any number more? */
+                       regparse = next;
+                       op = '*';               /* fake up one with a star */
+                   }
+                   else if (iter > 0) {
+                       op = '?';               /* fake up optional atom */
+                       ch = *next;
+                       sprintf(max,"%.*d", next-max, iter - 1);
+                       *next = ch;
+                       if (iter == 1)
+                           regparse = next;
+                       else {
+                           regparse = origparse - 1; /* offset ++ below */
+                           regnpar = orignpar;
+                       }
+                   }
+                   else
+                       fatal("Can't do {n,0}");
+               }
+               else
+                   fatal("Can't do {0}");
+           }
+       }
+
+       if (!ISMULT1(op)) {
+               *flagp = flags;
+               return(ret);
+       }
+
+       if (!(flags&HASWIDTH) && op != '?')
+               FAIL("regexp *+ operand could be empty");
+       *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
+
+       if (op == '*' && (flags&SIMPLE))
+               reginsert(STAR, ret);
+       else if (op == '*') {
+               /* Emit x* as (x&|), where & means "self". */
+               reginsert(BRANCH, ret);                 /* Either x */
+               regoptail(ret, regnode(BACK));          /* and loop */
+               regoptail(ret, ret);                    /* back */
+               regtail(ret, regnode(BRANCH));          /* or */
+               regtail(ret, regnode(NOTHING));         /* null. */
+       } else if (op == '+' && (flags&SIMPLE))
+               reginsert(PLUS, ret);
+       else if (op == '+') {
+               /* Emit x+ as x(&|), where & means "self". */
+               next = regnode(BRANCH);                 /* Either */
+               regtail(ret, next);
+               regtail(regnode(BACK), ret);            /* loop back */
+               regtail(next, regnode(BRANCH));         /* or */
+               regtail(ret, regnode(NOTHING));         /* null. */
+       } else if (op == '?') {
+               /* Emit x? as (x|) */
+               reginsert(BRANCH, ret);                 /* Either x */
+               regtail(ret, regnode(BRANCH));          /* or */
+               next = regnode(NOTHING);                /* null. */
+               regtail(ret, next);
+               regoptail(ret, next);
+       }
+      nest_check:
+       regparse++;
+       if (ISMULT2(regparse))
+               FAIL("nested *?+ in regexp");
+
+       return(ret);
+}
+
+/*
+ - regatom - the lowest level
+ *
+ * Optimization:  gobbles an entire sequence of ordinary characters so that
+ * it can turn them into a single node, which is smaller to store and
+ * faster to run.  Backslashed characters are exceptions, each becoming a
+ * separate node; the code is simpler that way and it's not worth fixing.
+ *
+ * [Yes, it is worth fixing, some scripts can run twice the speed.]
+ */
+static char *
+regatom(flagp)
+int *flagp;
+{
+       register char *ret;
+       int flags;
+
+       *flagp = WORST;         /* Tentatively. */
+
+       switch (*regparse++) {
+       case '^':
+               ret = regnode(BOL);
+               break;
+       case '$':
+               ret = regnode(EOL);
+               break;
+       case '.':
+               ret = regnode(ANY);
+               *flagp |= HASWIDTH|SIMPLE;
+               break;
+       case '[':
+               ret = regclass();
+               *flagp |= HASWIDTH|SIMPLE;
+               break;
+       case '(':
+               ret = reg(1, &flags);
+               if (ret == NULL)
+                       return(NULL);
+               *flagp |= flags&(HASWIDTH|SPSTART);
+               break;
+       case '|':
+       case ')':
+               FAIL("internal urp in regexp"); /* Supposed to be caught earlier. */
+               break;
+       case '?':
+       case '+':
+       case '*':
+               FAIL("?+* follows nothing in regexp");
+               break;
+       case '\\':
+               switch (*regparse) {
+               case 'w':
+                       ret = regnode(ALNUM);
+                       *flagp |= HASWIDTH|SIMPLE;
+                       regparse++;
+                       break;
+               case 'W':
+                       ret = regnode(NALNUM);
+                       *flagp |= HASWIDTH|SIMPLE;
+                       regparse++;
+                       break;
+               case 'b':
+                       ret = regnode(BOUND);
+                       *flagp |= SIMPLE;
+                       regparse++;
+                       break;
+               case 'B':
+                       ret = regnode(NBOUND);
+                       *flagp |= SIMPLE;
+                       regparse++;
+                       break;
+               case 's':
+                       ret = regnode(SPACE);
+                       *flagp |= HASWIDTH|SIMPLE;
+                       regparse++;
+                       break;
+               case 'S':
+                       ret = regnode(NSPACE);
+                       *flagp |= HASWIDTH|SIMPLE;
+                       regparse++;
+                       break;
+               case 'd':
+                       ret = regnode(DIGIT);
+                       *flagp |= HASWIDTH|SIMPLE;
+                       regparse++;
+                       break;
+               case 'D':
+                       ret = regnode(NDIGIT);
+                       *flagp |= HASWIDTH|SIMPLE;
+                       regparse++;
+                       break;
+               case 'n':
+               case 'r':
+               case 't':
+               case 'f':
+               case 'e':
+               case 'a':
+               case 'x':
+               case 'c':
+               case '0':
+                       goto defchar;
+               case '1': case '2': case '3': case '4':
+               case '5': case '6': case '7': case '8': case '9':
+                       {
+                           int num = atoi(regparse);
+
+                           if (num > 9 && num >= regnpar)
+                               goto defchar;
+                           else {
+                               regsawback = 1;
+                               ret = reganode(REF, num);
+                               while (isDIGIT(*regparse))
+                                   regparse++;
+                               *flagp |= SIMPLE;
+                           }
+                       }
+                       break;
+               case '\0':
+                       if (regparse >= regxend)
+                           FAIL("trailing \\ in regexp");
+                       /* FALL THROUGH */
+               default:
+                       goto defchar;
+               }
+               break;
+       default: {
+                       register int len;
+                       register char ender;
+                       register char *p;
+                       char *oldp;
+                       int numlen;
+
+                   defchar:
+                       ret = regnode(EXACTLY);
+                       regc(0);                /* save spot for len */
+                       for (len=0, p=regparse-1;
+                         len < 127 && p < regxend;
+                         len++)
+                       {
+                           oldp = p;
+                           switch (*p) {
+                           case '^':
+                           case '$':
+                           case '.':
+                           case '[':
+                           case '(':
+                           case ')':
+                           case '|':
+                               goto loopdone;
+                           case '\\':
+                               switch (*++p) {
+                               case 'w':
+                               case 'W':
+                               case 'b':
+                               case 'B':
+                               case 's':
+                               case 'S':
+                               case 'd':
+                               case 'D':
+                                   --p;
+                                   goto loopdone;
+                               case 'n':
+                                       ender = '\n';
+                                       p++;
+                                       break;
+                               case 'r':
+                                       ender = '\r';
+                                       p++;
+                                       break;
+                               case 't':
+                                       ender = '\t';
+                                       p++;
+                                       break;
+                               case 'f':
+                                       ender = '\f';
+                                       p++;
+                                       break;
+                               case 'e':
+                                       ender = '\033';
+                                       p++;
+                                       break;
+                               case 'a':
+                                       ender = '\007';
+                                       p++;
+                                       break;
+                               case 'x':
+                                   ender = scanhex(++p, 2, &numlen);
+                                   p += numlen;
+                                   break;
+                               case 'c':
+                                   p++;
+                                   ender = *p++;
+                                   if (isLOWER(ender))
+                                       ender = toupper(ender);
+                                   ender ^= 64;
+                                   break;
+                               case '0': case '1': case '2': case '3':case '4':
+                               case '5': case '6': case '7': case '8':case '9':
+                                   if (*p == '0' ||
+                                     (isDIGIT(p[1]) && atoi(p) >= regnpar) ) {
+                                       ender = scanoct(p, 3, &numlen);
+                                       p += numlen;
+                                   }
+                                   else {
+                                       --p;
+                                       goto loopdone;
+                                   }
+                                   break;
+                               case '\0':
+                                   if (p >= regxend)
+                                       FAIL("trailing \\ in regexp");
+                                   /* FALL THROUGH */
+                               default:
+                                   ender = *p++;
+                                   break;
+                               }
+                               break;
+                           default:
+                               ender = *p++;
+                               break;
+                           }
+                           if (regfold && isUPPER(ender))
+                                   ender = tolower(ender);
+                           if (ISMULT2(p)) { /* Back off on ?+*. */
+                               if (len)
+                                   p = oldp;
+                               else {
+                                   len++;
+                                   regc(ender);
+                               }
+                               break;
+                           }
+                           regc(ender);
+                       }
+                   loopdone:
+                       regparse = p;
+                       if (len <= 0)
+                               FAIL("internal disaster in regexp");
+                       *flagp |= HASWIDTH;
+                       if (len == 1)
+                               *flagp |= SIMPLE;
+                       if (regcode != &regdummy)
+                           *OPERAND(ret) = len;
+                       regc('\0');
+               }
+               break;
+       }
+
+       return(ret);
+}
+
+static void
+regset(bits,def,c)
+char *bits;
+int def;
+register int c;
+{
+       if (regcode == &regdummy)
+           return;
+       c &= 255;
+       if (def)
+               bits[c >> 3] &= ~(1 << (c & 7));
+       else
+               bits[c >> 3] |=  (1 << (c & 7));
+}
+
+static char *
+regclass()
+{
+       register char *bits;
+       register int class;
+       register int lastclass;
+       register int range = 0;
+       register char *ret;
+       register int def;
+       int numlen;
+
+       ret = regnode(ANYOF);
+       if (*regparse == '^') { /* Complement of range. */
+               regparse++;
+               def = 0;
+       } else {
+               def = 255;
+       }
+       bits = regcode;
+       for (class = 0; class < 32; class++)
+           regc(def);
+       if (*regparse == ']' || *regparse == '-')
+               goto skipcond;          /* allow 1st char to be ] or - */
+       while (regparse < regxend && *regparse != ']') {
+             skipcond:
+               class = UCHARAT(regparse++);
+               if (class == '\\') {
+                       class = UCHARAT(regparse++);
+                       switch (class) {
+                       case 'w':
+                               for (class = 0; class < 256; class++)
+                                   if (isALNUM(class))
+                                       regset(bits,def,class);
+                               lastclass = 1234;
+                               continue;
+                       case 'W':
+                               for (class = 0; class < 256; class++)
+                                   if (!isALNUM(class))
+                                       regset(bits,def,class);
+                               lastclass = 1234;
+                               continue;
+                       case 's':
+                               for (class = 0; class < 256; class++)
+                                   if (isSPACE(class))
+                                       regset(bits,def,class);
+                               lastclass = 1234;
+                               continue;
+                       case 'S':
+                               for (class = 0; class < 256; class++)
+                                   if (!isSPACE(class))
+                                       regset(bits,def,class);
+                               lastclass = 1234;
+                               continue;
+                       case 'd':
+                               for (class = '0'; class <= '9'; class++)
+                                       regset(bits,def,class);
+                               lastclass = 1234;
+                               continue;
+                       case 'D':
+                               for (class = 0; class < '0'; class++)
+                                       regset(bits,def,class);
+                               for (class = '9' + 1; class < 256; class++)
+                                       regset(bits,def,class);
+                               lastclass = 1234;
+                               continue;
+                       case 'n':
+                               class = '\n';
+                               break;
+                       case 'r':
+                               class = '\r';
+                               break;
+                       case 't':
+                               class = '\t';
+                               break;
+                       case 'f':
+                               class = '\f';
+                               break;
+                       case 'b':
+                               class = '\b';
+                               break;
+                       case 'e':
+                               class = '\033';
+                               break;
+                       case 'a':
+                               class = '\007';
+                               break;
+                       case 'x':
+                               class = scanhex(regparse, 2, &numlen);
+                               regparse += numlen;
+                               break;
+                       case 'c':
+                               class = *regparse++;
+                               if (isLOWER(class))
+                                   class = toupper(class);
+                               class ^= 64;
+                               break;
+                       case '0': case '1': case '2': case '3': case '4':
+                       case '5': case '6': case '7': case '8': case '9':
+                               class = scanoct(--regparse, 3, &numlen);
+                               regparse += numlen;
+                               break;
+                       }
+               }
+               if (range) {
+                       if (lastclass > class)
+                               FAIL("invalid [] range in regexp");
+                       range = 0;
+               }
+               else {
+                       lastclass = class;
+                       if (*regparse == '-' && regparse+1 < regxend &&
+                           regparse[1] != ']') {
+                               regparse++;
+                               range = 1;
+                               continue;       /* do it next time */
+                       }
+               }
+               for ( ; lastclass <= class; lastclass++) {
+                       regset(bits,def,lastclass);
+                       if (regfold && isUPPER(lastclass))
+                               regset(bits,def,tolower(lastclass));
+               }
+               lastclass = class;
+       }
+       if (*regparse != ']')
+               FAIL("unmatched [] in regexp");
+       regparse++;
+       return ret;
+}
+
+/*
+ - regnode - emit a node
+ */
+static char *                  /* Location. */
+regnode(op)
+char op;
+{
+       register char *ret;
+       register char *ptr;
+
+       ret = regcode;
+       if (ret == &regdummy) {
+#ifdef REGALIGN
+               if (!(regsize & 1))
+                       regsize++;
+#endif
+               regsize += 3;
+               return(ret);
+       }
+
+#ifdef REGALIGN
+#ifndef lint
+       if (!((long)ret & 1))
+           *ret++ = 127;
+#endif
+#endif
+       ptr = ret;
+       *ptr++ = op;
+       *ptr++ = '\0';          /* Null "next" pointer. */
+       *ptr++ = '\0';
+       regcode = ptr;
+
+       return(ret);
+}
+
+/*
+ - reganode - emit a node with an argument
+ */
+static char *                  /* Location. */
+reganode(op, arg)
+char op;
+unsigned short arg;
+{
+       register char *ret;
+       register char *ptr;
+
+       ret = regcode;
+       if (ret == &regdummy) {
+#ifdef REGALIGN
+               if (!(regsize & 1))
+                       regsize++;
+#endif
+               regsize += 5;
+               return(ret);
+       }
+
+#ifdef REGALIGN
+#ifndef lint
+       if (!((long)ret & 1))
+           *ret++ = 127;
+#endif
+#endif
+       ptr = ret;
+       *ptr++ = op;
+       *ptr++ = '\0';          /* Null "next" pointer. */
+       *ptr++ = '\0';
+#ifdef REGALIGN
+       *(unsigned short *)(ret+3) = arg;
+#else
+       ret[3] = arg >> 8; ret[4] = arg & 0377;
+#endif
+       ptr += 2;
+       regcode = ptr;
+
+       return(ret);
+}
+
+/*
+ - regc - emit (if appropriate) a byte of code
+ */
+static void
+regc(b)
+char b;
+{
+       if (regcode != &regdummy)
+               *regcode++ = b;
+       else
+               regsize++;
+}
+
+/*
+ - reginsert - insert an operator in front of already-emitted operand
+ *
+ * Means relocating the operand.
+ */
+static void
+reginsert(op, opnd)
+char op;
+char *opnd;
+{
+       register char *src;
+       register char *dst;
+       register char *place;
+       register offset = (op == CURLY ? 4 : 0);
+
+       if (regcode == &regdummy) {
+#ifdef REGALIGN
+               regsize += 4 + offset;
+#else
+               regsize += 3 + offset;
+#endif
+               return;
+       }
+
+       src = regcode;
+#ifdef REGALIGN
+       regcode += 4 + offset;
+#else
+       regcode += 3 + offset;
+#endif
+       dst = regcode;
+       while (src > opnd)
+               *--dst = *--src;
+
+       place = opnd;           /* Op node, where operand used to be. */
+       *place++ = op;
+       *place++ = '\0';
+       *place++ = '\0';
+       while (offset-- > 0)
+           *place++ = '\0';
+#ifdef REGALIGN
+       *place++ = '\177';
+#endif
+}
+
+/*
+ - regtail - set the next-pointer at the end of a node chain
+ */
+static void
+regtail(p, val)
+char *p;
+char *val;
+{
+       register char *scan;
+       register char *temp;
+       register int offset;
+
+       if (p == &regdummy)
+               return;
+
+       /* Find last node. */
+       scan = p;
+       for (;;) {
+               temp = regnext(scan);
+               if (temp == NULL)
+                       break;
+               scan = temp;
+       }
+
+#ifdef REGALIGN
+       offset = val - scan;
+#ifndef lint
+       *(short*)(scan+1) = offset;
+#else
+       offset = offset;
+#endif
+#else
+       if (OP(scan) == BACK)
+               offset = scan - val;
+       else
+               offset = val - scan;
+       *(scan+1) = (offset>>8)&0377;
+       *(scan+2) = offset&0377;
+#endif
+}
+
+/*
+ - regoptail - regtail on operand of first argument; nop if operandless
+ */
+static void
+regoptail(p, val)
+char *p;
+char *val;
+{
+       /* "Operandless" and "op != BRANCH" are synonymous in practice. */
+       if (p == NULL || p == &regdummy || OP(p) != BRANCH)
+               return;
+       regtail(NEXTOPER(p), val);
+}
+
+/*
+ - regcurly - a little FSA that accepts {\d+,?\d*}
+ */
+STATIC int
+regcurly(s)
+register char *s;
+{
+    if (*s++ != '{')
+       return FALSE;
+    if (!isDIGIT(*s))
+       return FALSE;
+    while (isDIGIT(*s))
+       s++;
+    if (*s == ',')
+       s++;
+    while (isDIGIT(*s))
+       s++;
+    if (*s != '}')
+       return FALSE;
+    return TRUE;
+}
+
+#ifdef DEBUGGING
+
+/*
+ - regdump - dump a regexp onto stderr in vaguely comprehensible form
+ */
+void
+regdump(r)
+regexp *r;
+{
+       register char *s;
+       register char op = EXACTLY;     /* Arbitrary non-END op. */
+       register char *next;
+
+
+       s = r->program + 1;
+       while (op != END) {     /* While that wasn't END last time... */
+#ifdef REGALIGN
+               if (!((long)s & 1))
+                       s++;
+#endif
+               op = OP(s);
+               fprintf(stderr,"%2d%s", s-r->program, regprop(s));      /* Where, what. */
+               next = regnext(s);
+               s += regarglen[op];
+               if (next == NULL)               /* Next ptr. */
+                       fprintf(stderr,"(0)");
+               else 
+                       fprintf(stderr,"(%d)", (s-r->program)+(next-s));
+               s += 3;
+               if (op == ANYOF) {
+                       s += 32;
+               }
+               if (op == EXACTLY) {
+                       /* Literal string, where present. */
+                       s++;
+                       while (*s != '\0') {
+                               (void)putchar(*s);
+                               s++;
+                       }
+                       s++;
+               }
+               (void)putchar('\n');
+       }
+
+       /* Header fields of interest. */
+       if (r->regstart)
+               fprintf(stderr,"start `%s' ", r->regstart->str_ptr);
+       if (r->regstclass)
+               fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
+       if (r->reganch & ROPT_ANCH)
+               fprintf(stderr,"anchored ");
+       if (r->reganch & ROPT_SKIP)
+               fprintf(stderr,"plus ");
+       if (r->reganch & ROPT_IMPLICIT)
+               fprintf(stderr,"implicit ");
+       if (r->regmust != NULL)
+               fprintf(stderr,"must have \"%s\" back %d ", r->regmust->str_ptr,
+                 r->regback);
+       fprintf(stderr, "minlen %d ", r->minlen);
+       fprintf(stderr,"\n");
+}
+
+/*
+ - regprop - printable representation of opcode
+ */
+char *
+regprop(op)
+char *op;
+{
+       register char *p;
+
+       (void) strcpy(buf, ":");
+
+       switch (OP(op)) {
+       case BOL:
+               p = "BOL";
+               break;
+       case EOL:
+               p = "EOL";
+               break;
+       case ANY:
+               p = "ANY";
+               break;
+       case ANYOF:
+               p = "ANYOF";
+               break;
+       case BRANCH:
+               p = "BRANCH";
+               break;
+       case EXACTLY:
+               p = "EXACTLY";
+               break;
+       case NOTHING:
+               p = "NOTHING";
+               break;
+       case BACK:
+               p = "BACK";
+               break;
+       case END:
+               p = "END";
+               break;
+       case ALNUM:
+               p = "ALNUM";
+               break;
+       case NALNUM:
+               p = "NALNUM";
+               break;
+       case BOUND:
+               p = "BOUND";
+               break;
+       case NBOUND:
+               p = "NBOUND";
+               break;
+       case SPACE:
+               p = "SPACE";
+               break;
+       case NSPACE:
+               p = "NSPACE";
+               break;
+       case DIGIT:
+               p = "DIGIT";
+               break;
+       case NDIGIT:
+               p = "NDIGIT";
+               break;
+       case CURLY:
+               (void)sprintf(buf+strlen(buf), "CURLY {%d,%d}",
+                   ARG1(op),ARG2(op));
+               p = NULL;
+               break;
+       case REF:
+               (void)sprintf(buf+strlen(buf), "REF%d", ARG1(op));
+               p = NULL;
+               break;
+       case OPEN:
+               (void)sprintf(buf+strlen(buf), "OPEN%d", ARG1(op));
+               p = NULL;
+               break;
+       case CLOSE:
+               (void)sprintf(buf+strlen(buf), "CLOSE%d", ARG1(op));
+               p = NULL;
+               break;
+       case STAR:
+               p = "STAR";
+               break;
+       case PLUS:
+               p = "PLUS";
+               break;
+       default:
+               FAIL("corrupted regexp opcode");
+       }
+       if (p != NULL)
+               (void) strcat(buf, p);
+       return(buf);
+}
+#endif /* DEBUGGING */
+
+void
+regfree(r)
+struct regexp *r;
+{
+       if (r->precomp) {
+               Safefree(r->precomp);
+               r->precomp = Nullch;
+       }
+       if (r->subbase) {
+               Safefree(r->subbase);
+               r->subbase = Nullch;
+       }
+       if (r->regmust) {
+               str_free(r->regmust);
+               r->regmust = Nullstr;
+       }
+       if (r->regstart) {
+               str_free(r->regstart);
+               r->regstart = Nullstr;
+       }
+       Safefree(r->startp);
+       Safefree(r->endp);
+       Safefree(r);
+}
diff --git a/usr/src/contrib/perl-4.036/t/README b/usr/src/contrib/perl-4.036/t/README
new file mode 100644 (file)
index 0000000..47ab845
--- /dev/null
@@ -0,0 +1,11 @@
+This is the perl test library.  To run all the tests, just type 'TEST'.
+
+To add new tests, just look at the current tests and do likewise.
+
+If a test fails, run it by itself to see if it prints any informative
+diagnostics.  If not, modify the test to print informative diagnostics.
+If you put out extra lines with a '#' character on the front, you don't
+have to worry about removing the extra print statements later since TEST
+ignores lines beginning with '#'.
+
+If you come up with new tests, send them to lwall@netlabs.com.
diff --git a/usr/src/contrib/perl-4.036/t/op/substr.t b/usr/src/contrib/perl-4.036/t/op/substr.t
new file mode 100644 (file)
index 0000000..12ad531
--- /dev/null
@@ -0,0 +1,47 @@
+#!./perl
+
+# $Header: substr.t,v 4.0 91/03/20 01:55:05 lwall Locked $
+
+print "1..22\n";
+
+$a = 'abcdefxyz';
+
+print (substr($a,0,3) eq 'abc' ? "ok 1\n" : "not ok 1\n");
+print (substr($a,3,3) eq 'def' ? "ok 2\n" : "not ok 2\n");
+print (substr($a,6,999) eq 'xyz' ? "ok 3\n" : "not ok 3\n");
+print (substr($a,999,999) eq '' ? "ok 4\n" : "not ok 4\n");
+print (substr($a,6,-1) eq '' ? "ok 5\n" : "not ok 5\n");
+print (substr($a,-3,1) eq 'x' ? "ok 6\n" : "not ok 6\n");
+
+$[ = 1;
+
+print (substr($a,1,3) eq 'abc' ? "ok 7\n" : "not ok 7\n");
+print (substr($a,4,3) eq 'def' ? "ok 8\n" : "not ok 8\n");
+print (substr($a,7,999) eq 'xyz' ? "ok 9\n" : "not ok 9\n");
+print (substr($a,999,999) eq '' ? "ok 10\n" : "not ok 10\n");
+print (substr($a,7,-1) eq '' ? "ok 11\n" : "not ok 11\n");
+print (substr($a,-3,1) eq 'x' ? "ok 12\n" : "not ok 12\n");
+
+$[ = 0;
+
+substr($a,3,3) = 'XYZ';
+print $a eq 'abcXYZxyz' ? "ok 13\n" : "not ok 13\n";
+substr($a,0,2) = '';
+print $a eq 'cXYZxyz' ? "ok 14\n" : "not ok 14\n";
+y/a/a/;
+substr($a,0,0) = 'ab';
+print $a eq 'abcXYZxyz' ? "ok 15\n" : "not ok 15 $a\n";
+substr($a,0,0) = '12345678';
+print $a eq '12345678abcXYZxyz' ? "ok 16\n" : "not ok 16\n";
+substr($a,-3,3) = 'def';
+print $a eq '12345678abcXYZdef' ? "ok 17\n" : "not ok 17\n";
+substr($a,-3,3) = '<';
+print $a eq '12345678abcXYZ<' ? "ok 18\n" : "not ok 18\n";
+substr($a,-1,1) = '12345678';
+print $a eq '12345678abcXYZ12345678' ? "ok 19\n" : "not ok 19\n";
+
+$a = 'abcdefxyz';
+
+print (substr($a,6) eq 'xyz' ? "ok 20\n" : "not ok 20\n");
+print (substr($a,-3) eq 'xyz' ? "ok 21\n" : "not ok 21\n");
+print (substr($a,999) eq '' ? "ok 22\n" : "not ok 22\n");
diff --git a/usr/src/contrib/perl-4.036/usub/README b/usr/src/contrib/perl-4.036/usub/README
new file mode 100644 (file)
index 0000000..a80a650
--- /dev/null
@@ -0,0 +1,114 @@
+This directory contains an example of how you might link in C subroutines
+with perl to make your own special copy of perl.  In the perl distribution
+directory, there will be (after make is run) a file called uperl.o, which
+is all of perl except for a single undefined subroutine, named userinit().
+See usersub.c.
+
+The sole purpose of the userinit() routine is to call the initialization
+routines for any modules that you want to link in.  In this example, we just
+call init_curses(), which sets up to link in the System V curses routines.
+You'll find this in the file curses.c, which is the processed output of
+curses.mus.  (To get BSD curses, replace curses.mus with bsdcurses.mus.)
+
+The magicname() routine adds variable names into the symbol table.  Along
+with the name of the variable as Perl knows it, we pass a structure containing
+an index identifying the variable, and the names of two C functions that
+know how to set or evaluate a variable given the index of the variable.
+Our example uses a macro to handle this conveniently.
+
+The init routine calls make_usub() to add user-defined subroutine names
+into the symbol table.  The arguments are
+
+       make_usub(subname, subindex, subfunc, filename);
+       char *subname;
+       int subindex;
+       int subfunc();
+       char *filename;
+
+The subname is the name that will be used in the Perl program.  The subindex
+will be passed to subfunc() when it is called to tell it which C function
+is desired.  subfunc() is a glue routine that translates the arguments
+from Perl internal stack form to the form required by the routine in
+question, calls the desired C function, and then translates any return
+value back into the stack format.  The glue routine used by curses just
+has a large switch statement, each branch of which does the processing
+for a particular C function.  The subindex could, however, be used to look
+up a function in a dynamically linked library.  No example of this is
+provided.
+
+As a help in producing the glue routine, a preprocessor called "mus" lets
+you specify argument and return value types in a tabular format.  An entry
+such as:
+
+    CASE int waddstr
+    I       WINDOW*         win
+    I       char*           str
+    END
+
+indicates that waddstr takes two input arguments, the first of which is a
+pointer to a window, and the second of which is an ordinary C string.  It
+also indicates that an integer is returned.  The mus program turns this into:
+
+    case US_waddstr:
+        if (items != 2)
+            fatal("Usage: &waddstr($win, $str)");
+        else {
+            int retval;
+            WINDOW*     win =           *(WINDOW**)     str_get(st[1]);
+            char*       str =           (char*)         str_get(st[2]);
+
+            retval = waddstr(win, str);
+            str_numset(st[0], (double) retval);
+        }
+        return sp;
+
+It's also possible to have output parameters, indicated by O, and input/ouput
+parameters indicated by IO.
+
+The mus program isn't perfect.  You'll note that curses.mus has some
+cases which are hand coded.  They'll be passed straight through unmodified.
+You can produce similar cases by analogy to what's in curses.c, as well
+as similar routines in the doarg.c, dolist.c and doio.c routines of Perl.
+The mus program is only intended to get you about 90% there.  It's not clear,
+for instance, how a given structure should be passed to Perl.  But that
+shouldn't bother you--if you've gotten this far, it's already obvious
+that you are totally mad.
+
+Here's an example of how to return an array value:
+
+    case US_appl_errlist:
+       if (!wantarray) {
+           str_numset(st[0], (double) appl_nerr);
+           return sp;
+       }
+       astore(stack, sp + appl_nerr, Nullstr);         /* extend stack */
+       st = stack->ary_array + sp;                     /* possibly realloced */
+       for (i = 0; i < appl_nerr; i++) {
+           tmps = appl_errlist[i];
+           st[i] = str_2mortal(str_make(tmps,strlen(tmps)));
+       }
+       return sp + appl_nerr - 1;
+
+
+In addition, there is a program, man2mus, that will scan a man page for
+function prototypes and attempt to construct a mus CASE entry for you.  It has
+to guess about input/output parameters, so you'll have to tidy up after it.
+But it can save you a lot of time if the man pages for a library are
+reasonably well formed.
+
+If you happen to have curses on your machine, you might try compiling
+a copy of curseperl.  The "pager" program in this directory is a rudimentary
+start on writing a pager--don't believe the help message, which is stolen
+from the less program.
+
+User-defined subroutines may not currently be called as a signal handler,
+though a signal handler may itself call a user-defined subroutine.
+
+There are now glue routines to call back from C into Perl.  In usersub.c
+in this directory, you'll find callback() and callv().  The callback()
+routine presumes that any arguments to pass to the Perl subroutine
+have already been pushed onto the Perl stack.  The callv() routine
+is a wrapper that pushes an argv-style array of strings onto the
+stack for you, and then calls callback().  Be sure to recheck your
+stack pointer after returning from these routine, since the Perl code
+may have reallocated it.