perl 4.0.00: (no release announcement available)perl-4.0.00

So far, 4.0 is still a beta test version.  For the last production
version, look in pub/perl.3.0/kits@44.

4 files changed, 149 insertions, 52 deletions

diff --git a/usub/README b/usub/README
new file mode 100644
index 0000000000..ffaefd1ef4
--- /dev/null
+++ b/usub/README
@@ -0,0 +1,110 @@
+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 BSD curses routines.
+You'll find this in the file curses.c, which is the processed output of
+curses.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 BSD 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.
+
+There is currently no official way to call a Perl routine back from C,
+but we're working on it.  It might be easiest to fake up a call to do_eval()
+or do_subr().  This is not for the faint of heart.  If you come up with
+such a glue routine, I'll be glad to add it into the distribution.
+
+User-defined subroutines may not currently be called as a signal handler,
+though a signal handler may itself call a user-defined subroutine.
diff --git a/usub/curses.mus b/usub/curses.mus
index 9973684d12..7bacb6b57e 100644
--- a/usub/curses.mus
+++ b/usub/curses.mus
@@ -1,6 +1,9 @@
-/* $Header: curses.mus,v 3.0.1.1 90/08/09 04:05:21 lwall Locked $
+/* $Header: curses.mus,v 4.0 91/03/20 01:56:13 lwall Locked $
  *
  * $Log:	curses.mus,v $
+ * Revision 4.0  91/03/20  01:56:13  lwall
+ * 4.0 baseline.
+ * 
  * Revision 3.0.1.1  90/08/09  04:05:21  lwall
  * patch19: Initial revision
  * 
diff --git a/usub/pager b/usub/pager
index 79e70b92f1..407bc50670 100644
--- a/usub/pager
+++ b/usub/pager
@@ -1,7 +1,8 @@
 #!./curseperl
 
-eval <<'EndOfMain';   $evaloffset = 3;	# line number of this line
+eval <<'EndOfMain';   $evaloffset = __LINE__;
 
+    $SIG{'INT'} = 'endit';
     $| = 1;		# command buffering on stdout
     &initterm;
     &inithelp;
@@ -9,15 +10,7 @@ eval <<'EndOfMain';   $evaloffset = 3;	# line number of this line
 
 EndOfMain
 
-&endwin;
-
-if ($@) {
-    print "";		# force flush of stdout
-    $@ =~ s/\(eval\)/$0/ && $@ =~ s/line (\d+)/'line ' . ($1 + $evaloffset)/e;
-    die $@;
-}
-
-exit;
+&endit;
 
 ################################################################################
 
@@ -76,7 +69,7 @@ sub pagearray {
     for (&drawscreen;;&drawscreen) {
 
 	$ch = &getch;
-	$ch = "j" if $ch eq "\n";
+	$ch = 'j' if $ch eq "\n";
 
 	if ($ch eq ' ') {
 	    last if $percent >= 100;
@@ -88,9 +81,10 @@ sub pagearray {
 	    &move(0,0);
 	    $line = 0 if $line < 0;
 	}
-	elsif ($ch eq "j") {
+	elsif ($ch eq 'j') {
+	    next if $percent >= 100;
 	    $line += 1;
-	    if ($dl) {
+	    if ($dl && $ho) {
 		print $ho, $dl;
 		&mvcur(0,0,$lines2,0);
 		print $ce,$lines[$line+$lines2],$ce;
@@ -107,10 +101,10 @@ sub pagearray {
 	    &refresh;
 	    redo;
 	}
-	elsif ($ch eq "k") {
+	elsif ($ch eq 'k') {
 	    next if $line <= 0;
 	    $line -= 1;
-	    if ($al) {
+	    if ($al && $ho && $ce) {
 		print $ho, $al, $ce, $lines[$line];
 		&wmove($curscr,0,0);
 		&winsertln($curscr);
@@ -126,10 +120,10 @@ sub pagearray {
 	elsif ($ch eq "\f") {
 	    &clear;
 	}
-	elsif ($ch eq "q") {
+	elsif ($ch eq 'q') {
 	    last;
 	}
-	elsif ($ch eq "h") {
+	elsif ($ch eq 'h') {
 	    &clear;
 	    &help;
 	    &clear;
@@ -157,42 +151,14 @@ sub help {
 sub inithelp {
     @helplines = split(/\n/,<<'EOT');
 
-      Commands marked with * may be preceeded by a number, N.
-
   h              Display this help.
   q              Exit.
 
-  f, SPACE    *  Forward  N lines, default one screen.
-  b           *  Backward N lines, default one screen.
-  e, j, CR    *  Forward  N lines, default 1 line.
-  y, k        *  Backward N lines, default 1 line.
-  d           *  Forward  N lines, default 10 or last N to d or u command.
-  u           *  Backward N lines, default 10 or last N to d or u command.
-  r              Repaint screen.
-  R              Repaint screen, discarding buffered input.
-
-  /pattern    *  Search forward for N-th line containing the pattern.
-  ?pattern    *  Search backward for N-th line containing the pattern.
-  n           *  Repeat previous search (for N-th occurence).
-
-  g           *  Go to line N, default 1.
-  G           *  Like g, but default is last line in file.
-  p, %        *  Position to N percent into the file.
-  m<letter>      Mark the current position with <letter>.
-  '<letter>      Return to a previously marked position.
-  ''             Return to previous position.
-
-  E [file]       Examine a new file.
-  N           *  Examine the next file (from the command line).
-  P           *  Examine the previous file (from the command line).
-  =              Print current file name.
-  V              Print version number of "less".
-
-  -<flag>        Toggle a command line flag.
-  +cmd           Execute the less cmd each time a new file is examined.
-
-  !command       Passes the command to a shell to be executed.
-  v              Edit the current file with $EDITOR.
+  SPACE          Forward  screen.
+  b              Backward screen.
+  j, CR          Forward  1 line.
+  k              Backward 1 line.
+  FF             Repaint screen.
 EOT
     for (@helplines) {
 	s/$/\n/;
@@ -207,3 +173,18 @@ sub percent {
     &standend;
     &clrtoeol;
 }
+
+sub endit {
+    &move($lines1,0);
+    &clrtoeol;
+    &refresh;
+    &endwin;
+
+    if ($@) {
+	print "";				# force flush of stdout
+	$@ =~ s/\(eval\)/$0/ && $@ =~ s/line (\d+)/'line ' . ($1 + $evaloffset)/e;
+	die $@;
+    }
+
+    exit;
+}
diff --git a/usub/usersub.c b/usub/usersub.c
index a8274fbd97..559f9a4fa2 100644
--- a/usub/usersub.c
+++ b/usub/usersub.c
@@ -1,6 +1,9 @@
-/* $Header: usersub.c,v 3.0.1.1 90/08/09 04:06:10 lwall Locked $
+/* $Header: usersub.c,v 4.0 91/03/20 01:56:34 lwall Locked $
  *
  * $Log:	usersub.c,v $
+ * Revision 4.0  91/03/20  01:56:34  lwall
+ * 4.0 baseline.
+ * 
  * Revision 3.0.1.1  90/08/09  04:06:10  lwall
  * patch19: Initial revision
  *