perl 4.0 patch 21: patch #20, continued

See patch #20.

4 files changed, 1022 insertions, 0 deletions

diff --git a/atarist/README.ST b/atarist/README.ST
new file mode 100644
index 0000000000..0d42ba0c6d
--- /dev/null
+++ b/atarist/README.ST
@@ -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/atarist/RESULTS b/atarist/RESULTS
new file mode 100644
index 0000000000..d2768908c2
--- /dev/null
+++ b/atarist/RESULTS
@@ -0,0 +1,120 @@
+t/base:
+
+cond.t
+if.t
+lex.t
+pat.t
+term.t
+
+all of these pass. if you are running from this directory
+make sure you have a file ..\Makefile for term.t to pass.
+
+=================================
+
+t/cmd:
+
+elsif.t
+for.t
+mod.t
+subval.t
+switch.t
+while.t
+
+all of these passed. be sure to set UNIXMODE for these to pass.
+make sure there is a file called ./TEST if you run in this sub-directory
+for mod.t.
+
+=================================
+
+t/comp:
+
+cmdopt.t
+decl.t
+package.t
+script.t
+term.t
+multiline.t
+
+all these work. if you are running in this subdir then cp perl.ttp ./perl
+before running.
+
+cpp.t
+ fails. i need to fix for -P.
+=================================
+
+t/io:
+
+if you are running in this subdir make sure:
+-- there is a file ../Makefile
+-- have a ./perl
+
+argv.t: 2 & 3 fail
+	`.....` with pipes will not work. redirections may (have'nt checked)
+
+dup.t: only 1 will pass. what the hell is the rest doing (the atari goes
+	into in infinite loop)
+
+pipe.t: fails. have to look into this. pipe() on the atari sort of
+work most of the time. see gcc-lib/pipe.c
+
+print.t: all pass
+tell.t: all pass
+=================================
+
+t/lib:
+
+bit.t : pass
+=================================
+
+t/op:
+
+append.t	pass
+array.t		pass
+auto.t		pass
+chop.t		pass
+cond.t		pass
+dbm.t -- cant possibly work with gdbm, it does'nt create .pag etc files
+gdbm.t		added new test to test gdbm based perl
+delete.t	pass
+do.t		pass
+each.t		pass
+eval.t		pass
+exec.t 4,5,6 fail rest pass (obviously)
+exp.t		pass
+flip.t		pass
+fork.t		correctly fails
+glob.t	1 fails rest pass (as i said dont depend on `....` to work on the ST)
+goto.t  1,2 pass 3 fail (again because of `...`)
+groups.t	makes no sense on the ST
+index.t		pass
+int.t		pass
+join.t		pass
+list.t		pass
+local.t		pass
+magic.t		fail obviously
+mkdir.t	the failure is obvious, rest pass (our err strings dont match unix's)
+oct.t		pass
+ord.t		pass
+pack.t		pass
+pat.t		pass!!!! (works with lib malloc too now, yeah!)
+push.t		pass
+range.t		pass
+read.t		pass
+regexp.t	pass! (make sure re_tests is in cwd if running in cwd, and edit
+			path in regexp.t)
+repeat.t	pass
+s.t		pass
+sleep.t		pass
+sort.t		pass
+split.t		pass
+sprintf.t	pass
+stat.t		obvious ones fail, looks good
+study.t		pass
+substr.t	pass
+time.t		pass
+undef.t		pass
+unshift.t	pass
+vec.t		pass
+write.t	fail due to  `...`
+=================================
+
diff --git a/atarist/test/binhandl b/atarist/test/binhandl
new file mode 100644
index 0000000000..6f62f4d6cc
--- /dev/null
+++ b/atarist/test/binhandl
@@ -0,0 +1,15 @@
+die "Usage: binhandl files ...\n" if $#ARGV < $[;
+
+NEXTFILE:
+while ($FILEHAND = shift) {
+    unless (open(FILEHAND)) {
+	printf STDERR "Can't open \"$FILEHAND\"\n";
+        next NEXTFILE;
+    }
+    if (-B FILEHAND) {
+	print "\"$FILEHAND\" is binary\n";
+    } else {
+	print "\"$FILEHAND\" is text\n";
+    }
+    close(FILEHAND);
+}
diff --git a/atarist/usub/acurses.mus b/atarist/usub/acurses.mus
new file mode 100644
index 0000000000..0618b40fc7
--- /dev/null
+++ b/atarist/usub/acurses.mus
@@ -0,0 +1,701 @@
+/* $RCSfile: acurses.mus,v $$Revision: 4.0.1.1 $$Date: 92/06/08 11:54:30 $
+ *
+ * $Log:	acurses.mus,v $
+ * Revision 4.0.1.1  92/06/08  11:54:30  lwall
+ * Initial revision
+ * 
+ * Revision 4.0.1.1  91/11/05  19:04:53  lwall
+ * initial checkin
+ * 
+ * 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
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+char *savestr();
+
+#ifdef atarist	/* save and restore definition of VOID around curses.h */
+# define __SAVEVOID VOID
+# undef  VOID
+#endif
+
+#include <curses.h>
+
+static enum uservars {
+    UV_curscr,
+    UV_stdscr,
+    UV_Def_term,
+    UV_My_term,
+    UV_ttytype,
+    UV_LINES,
+    UV_COLS,
+    UV_ERR,
+    UV_OK,
+};
+
+static enum usersubs {
+    US_addch,
+    US_waddch,
+    US_addstr,
+    US_waddstr,
+    US_box,
+    US_clear,
+    US_wclear,
+    US_clearok,
+    US_clrtobot,
+    US_wclrtobot,
+    US_clrtoeol,
+    US_wclrtoeol,
+    US_delch,
+    US_wdelch,
+    US_deleteln,
+    US_wdeleteln,
+    US_erase,
+    US_werase,
+    US_flushok,
+    US_idlok,
+    US_insch,
+    US_winsch,
+    US_insertln,
+    US_winsertln,
+    US_move,
+    US_wmove,
+    US_overlay,
+    US_overwrite,
+    US_printw,
+    US_wprintw,
+    US_refresh,
+    US_wrefresh,
+    US_standout,
+    US_wstandout,
+    US_standend,
+    US_wstandend,
+    US_cbreak,
+    US_nocbreak,
+    US_echo,
+    US_noecho,
+    US_getch,
+    US_wgetch,
+    US_getstr,
+    US_wgetstr,
+    US_raw,
+    US_noraw,
+    US_scanw,
+    US_wscanw,
+    US_baudrate,
+    US_delwin,
+    US_endwin,
+    US_erasechar,
+    US_getcap,
+    US_getyx,
+    US_inch,
+    US_winch,
+    US_initscr,
+    US_killchar,
+    US_leaveok,
+    US_longname,
+    US_fullname,
+    US_mvwin,
+    US_newwin,
+    US_nl,
+    US_nonl,
+    US_scrollok,
+    US_subwin,
+    US_touchline,
+    US_touchoverlap,
+    US_touchwin,
+    US_unctrl,
+    US_gettmode,
+    US_mvcur,
+    US_scroll,
+    US_savetty,
+    US_resetty,
+    US_setterm,
+    US_tstp,
+    US__putchar,
+    US_testcallback,
+};
+
+static int usersub();
+static int userset();
+static int userval();
+
+int
+init_curses()
+{
+    struct ufuncs uf;
+    char *filename = "curses.c";
+
+    uf.uf_set = userset;
+    uf.uf_val = userval;
+
+#define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)
+
+    MAGICVAR("curscr",	UV_curscr);
+    MAGICVAR("stdscr",	UV_stdscr);
+    MAGICVAR("Def_term",UV_Def_term);
+    MAGICVAR("My_term",	UV_My_term);
+    MAGICVAR("ttytype",	UV_ttytype);
+    MAGICVAR("LINES",	UV_LINES);
+    MAGICVAR("COLS",	UV_COLS);
+    MAGICVAR("ERR",	UV_ERR);
+    MAGICVAR("OK",	UV_OK);
+
+    make_usub("addch",		US_addch,	usersub, filename);
+    make_usub("waddch",		US_waddch,	usersub, filename);
+    make_usub("addstr",		US_addstr,	usersub, filename);
+    make_usub("waddstr",	US_waddstr,	usersub, filename);
+    make_usub("box",		US_box,		usersub, filename);
+    make_usub("clear",		US_clear,	usersub, filename);
+    make_usub("wclear",		US_wclear,	usersub, filename);
+    make_usub("clearok",	US_clearok,	usersub, filename);
+    make_usub("clrtobot",	US_clrtobot,	usersub, filename);
+    make_usub("wclrtobot",	US_wclrtobot,	usersub, filename);
+    make_usub("clrtoeol",	US_clrtoeol,	usersub, filename);
+    make_usub("wclrtoeol",	US_wclrtoeol,	usersub, filename);
+    make_usub("delch",		US_delch,	usersub, filename);
+    make_usub("wdelch",		US_wdelch,	usersub, filename);
+    make_usub("deleteln",	US_deleteln,	usersub, filename);
+    make_usub("wdeleteln",	US_wdeleteln,	usersub, filename);
+    make_usub("erase",		US_erase,	usersub, filename);
+    make_usub("werase",		US_werase,	usersub, filename);
+    make_usub("flushok",	US_flushok,	usersub, filename);
+    make_usub("idlok",		US_idlok,	usersub, filename);
+    make_usub("insch",		US_insch,	usersub, filename);
+    make_usub("winsch",		US_winsch,	usersub, filename);
+    make_usub("insertln",	US_insertln,	usersub, filename);
+    make_usub("winsertln",	US_winsertln,	usersub, filename);
+    make_usub("move",		US_move,	usersub, filename);
+    make_usub("wmove",		US_wmove,	usersub, filename);
+    make_usub("overlay",	US_overlay,	usersub, filename);
+    make_usub("overwrite",	US_overwrite,	usersub, filename);
+    make_usub("printw",		US_printw,	usersub, filename);
+    make_usub("wprintw",	US_wprintw,	usersub, filename);
+    make_usub("refresh",	US_refresh,	usersub, filename);
+    make_usub("wrefresh",	US_wrefresh,	usersub, filename);
+    make_usub("standout",	US_standout,	usersub, filename);
+    make_usub("wstandout",	US_wstandout,	usersub, filename);
+    make_usub("standend",	US_standend,	usersub, filename);
+    make_usub("wstandend",	US_wstandend,	usersub, filename);
+    make_usub("cbreak",		US_cbreak,	usersub, filename);
+    make_usub("nocbreak",	US_nocbreak,	usersub, filename);
+    make_usub("echo",		US_echo,	usersub, filename);
+    make_usub("noecho",		US_noecho,	usersub, filename);
+    make_usub("getch",		US_getch,	usersub, filename);
+    make_usub("wgetch",		US_wgetch,	usersub, filename);
+    make_usub("getstr",		US_getstr,	usersub, filename);
+    make_usub("wgetstr",	US_wgetstr,	usersub, filename);
+    make_usub("raw",		US_raw,		usersub, filename);
+    make_usub("noraw",		US_noraw,	usersub, filename);
+    make_usub("scanw",		US_scanw,	usersub, filename);
+    make_usub("wscanw",		US_wscanw,	usersub, filename);
+    make_usub("baudrate",	US_baudrate,	usersub, filename);
+    make_usub("delwin",		US_delwin,	usersub, filename);
+    make_usub("endwin",		US_endwin,	usersub, filename);
+    make_usub("erasechar",	US_erasechar,	usersub, filename);
+    make_usub("getcap",		US_getcap,	usersub, filename);
+    make_usub("getyx",		US_getyx,	usersub, filename);
+    make_usub("inch",		US_inch,	usersub, filename);
+    make_usub("winch",		US_winch,	usersub, filename);
+    make_usub("initscr",	US_initscr,	usersub, filename);
+    make_usub("killchar",	US_killchar,	usersub, filename);
+    make_usub("leaveok",	US_leaveok,	usersub, filename);
+    make_usub("longname",	US_longname,	usersub, filename);
+    make_usub("fullname",	US_fullname,	usersub, filename);
+    make_usub("mvwin",		US_mvwin,	usersub, filename);
+    make_usub("newwin",		US_newwin,	usersub, filename);
+    make_usub("nl",		US_nl,		usersub, filename);
+    make_usub("nonl",		US_nonl,	usersub, filename);
+    make_usub("scrollok",	US_scrollok,	usersub, filename);
+    make_usub("subwin",		US_subwin,	usersub, filename);
+    make_usub("touchline",	US_touchline,	usersub, filename);
+    make_usub("touchoverlap",	US_touchoverlap,usersub, filename);
+    make_usub("touchwin",	US_touchwin,	usersub, filename);
+    make_usub("unctrl",		US_unctrl,	usersub, filename);
+    make_usub("gettmode",	US_gettmode,	usersub, filename);
+    make_usub("mvcur",		US_mvcur,	usersub, filename);
+    make_usub("scroll",		US_scroll,	usersub, filename);
+    make_usub("savetty",	US_savetty,	usersub, filename);
+    make_usub("resetty",	US_resetty,	usersub, filename);
+    make_usub("setterm",	US_setterm,	usersub, filename);
+    make_usub("tstp",		US_tstp,	usersub, filename);
+    make_usub("_putchar",	US__putchar,	usersub, filename);
+    make_usub("testcallback",	US_testcallback,usersub, filename);
+};
+
+static int
+usersub(ix, sp, items)
+int ix;
+register int sp;
+register int items;
+{
+    STR **st = stack->ary_array + sp;
+    register int i;
+    register char *tmps;
+    register STR *Str;		/* used in str_get and str_gnum macros */
+
+    switch (ix) {
+CASE int addch
+I	char		ch
+END
+
+CASE int waddch
+I	WINDOW*		win
+I	char		ch
+END
+
+CASE int addstr
+I	char*		str
+END
+
+CASE int waddstr
+I	WINDOW*		win
+I	char*		str
+END
+
+CASE void box
+I	WINDOW*		win
+I	char		vert
+I	char		hor
+END
+
+CASE int clear
+END
+
+CASE int wclear
+I	WINDOW*		win
+END
+
+CASE int clearok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE void clrtobot
+END
+
+CASE void wclrtobot
+I	WINDOW*		win
+END
+
+CASE void clrtoeol
+END
+
+CASE void wclrtoeol
+I	WINDOW*		win
+END
+
+CASE int delch
+END
+
+CASE int wdelch
+I	WINDOW*		win
+END
+
+CASE int deleteln
+END
+
+CASE int wdeleteln
+I	WINDOW*		win
+END
+
+CASE void erase
+END
+
+CASE void werase
+I	WINDOW*		win
+END
+
+CASE int flushok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE void idlok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE int insch
+I	char		c
+END
+
+CASE int winsch
+I	WINDOW*		win
+I	char		c
+END
+
+CASE void insertln
+END
+
+CASE void winsertln
+I	WINDOW*		win
+END
+
+CASE int move
+I	int		y
+I	int		x
+END
+
+CASE int wmove
+I	WINDOW*		win
+I	int		y
+I	int		x
+END
+
+CASE void overlay
+I	WINDOW*		win1
+I	WINDOW*		win2
+END
+
+CASE void overwrite
+I	WINDOW*		win1
+I	WINDOW*		win2
+END
+
+    case US_printw:
+	if (items < 1)
+	    fatal("Usage: &printw($fmt, $arg1, $arg2, ... )");
+	else {
+	    int retval;
+	    STR*	str =		str_new(0);
+
+	    do_sprintf(str, items - 1, st + 1);
+	    retval = addstr(str->str_ptr);
+	    str_numset(st[0], (double) retval);
+	    str_free(str);
+	}
+	return sp;
+
+    case US_wprintw:
+	if (items < 2)
+	    fatal("Usage: &wprintw($win, $fmt, $arg1, $arg2, ... )");
+	else {
+	    int retval;
+	    STR*	str =		str_new(0);
+	    WINDOW*	win =		*(WINDOW**)	str_get(st[1]);
+
+	    do_sprintf(str, items - 1, st + 1);
+	    retval = waddstr(win, str->str_ptr);
+	    str_numset(st[0], (double) retval);
+	    str_free(str);
+	}
+	return sp;
+
+CASE int refresh
+END
+
+CASE int wrefresh
+I	WINDOW*		win
+END
+
+CASE int standout
+END
+
+CASE void wstandout
+I	WINDOW*		win
+END
+
+CASE int standend
+END
+
+CASE void wstandend
+I	WINDOW*		win
+END
+
+CASE int cbreak
+END
+
+CASE int nocbreak
+END
+
+CASE int echo
+END
+
+CASE int noecho
+END
+
+    case US_getch:
+        if (items != 0)
+            fatal("Usage: &getch()");
+        else {
+            int retval;
+	    char retch;
+
+            retval = getch();
+	    if (retval == EOF)
+		st[0] = &str_undef;
+	    else {
+		retch = retval;
+		str_nset(st[0], &retch, 1);
+	    }
+        }
+        return sp;
+
+    case US_wgetch:
+        if (items != 1)
+            fatal("Usage: &wgetch($win)");
+        else {
+            int retval;
+	    char retch;
+            WINDOW*     win =           *(WINDOW**)     str_get(st[1]);
+
+            retval = wgetch(win);
+	    if (retval == EOF)
+		st[0] = &str_undef;
+	    else {
+		retch = retval;
+		str_nset(st[0], &retch, 1);
+	    }
+        }
+        return sp;
+
+CASE int getstr
+IO	char*		str
+END
+
+CASE int wgetstr
+I	WINDOW*		win
+IO	char*		str
+END
+
+CASE int raw
+END
+
+CASE int noraw
+END
+
+CASE int baudrate
+END
+
+CASE void delwin
+I	WINDOW*		win
+END
+
+CASE void endwin
+END
+
+CASE int erasechar
+END
+
+    case US_getcap:
+	if (items != 1)
+	    fatal("Usage: &getcap($str)");
+	else {
+	    char* retval;
+	    char*	str =		(char*)		str_get(st[1]);
+	    char output[50], *outputp = output;
+
+	    retval = tgetstr(str, &outputp);
+	    str_set(st[0], (char*) retval);
+	}
+	return sp;
+
+    case US_getyx:
+	if (items != 3)
+	    fatal("Usage: &getyx($win, $y, $x)");
+	else {
+	    int retval;
+	    STR*	str =		str_new(0);
+	    WINDOW*	win =		*(WINDOW**)	str_get(st[1]);
+	    int		y;
+	    int		x;
+
+	    do_sprintf(str, items - 1, st + 1);
+	    retval = getyx(win, y, x);
+	    str_numset(st[2], (double)y);
+	    str_numset(st[3], (double)x);
+	    str_numset(st[0], (double) retval);
+	    str_free(str);
+	}
+	return sp;
+
+	
+CASE int inch
+END
+
+CASE int winch
+I	WINDOW*		win
+END
+
+CASE WINDOW* initscr
+END
+
+CASE int killchar
+END
+
+CASE int leaveok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE char* longname
+I	char*		termbuf
+IO	char*		name
+END
+
+CASE int fullname
+I	char*		termbuf
+IO	char*		name
+END
+
+CASE int mvwin
+I	WINDOW*		win
+I	int		y
+I	int		x
+END
+
+CASE WINDOW* newwin
+I	int		lines
+I	int		cols
+I	int		begin_y
+I	int		begin_x
+END
+
+CASE int nl
+END
+
+CASE int nonl
+END
+
+CASE int scrollok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE WINDOW* subwin
+I	WINDOW*		win
+I	int		lines
+I	int		cols
+I	int		begin_y
+I	int		begin_x
+END
+
+CASE void touchline
+I	WINDOW*		win
+I	int		y
+I	int		startx
+I	int		endx
+END
+
+CASE void touchoverlap
+I	WINDOW*		win1
+I	WINDOW*		win2
+END
+
+CASE void touchwin
+I	WINDOW*		win
+END
+
+CASE char* unctrl
+I	char		ch
+END
+
+CASE void gettmode
+END
+
+CASE void mvcur
+I	int		lasty
+I	int		lastx
+I	int		newy
+I	int		newx
+END
+
+CASE int scroll
+I	WINDOW*		win
+END
+
+CASE int savetty
+END
+
+CASE void resetty
+END
+
+CASE int setterm
+I	char*		name
+END
+
+CASE void tstp
+END
+
+CASE int _putchar
+I	char		ch
+END
+
+    case US_testcallback:
+	sp = callback("callback", sp + items, curcsv->wantarray, 1, items);
+	break;
+
+    default:
+	fatal("Unimplemented user-defined subroutine");
+    }
+    return sp;
+}
+
+static int
+userval(ix, str)
+int ix;
+STR *str;
+{
+    switch (ix) {
+    case UV_COLS:
+	str_numset(str, (double)COLS);
+	break;
+    case UV_Def_term:
+	str_set(str, Def_term);
+	break;
+    case UV_ERR:
+	str_numset(str, (double)ERR);
+	break;
+    case UV_LINES:
+	str_numset(str, (double)LINES);
+	break;
+    case UV_My_term:
+	str_numset(str, (double)My_term);
+	break;
+    case UV_OK:
+	str_numset(str, (double)OK);
+	break;
+    case UV_curscr:
+	str_nset(str, &curscr, sizeof(WINDOW*));
+	break;
+    case UV_stdscr:
+	str_nset(str, &stdscr, sizeof(WINDOW*));
+	break;
+    case UV_ttytype:
+	str_set(str, ttytype);
+	break;
+    }
+    return 0;
+}
+
+static int
+userset(ix, str)
+int ix;
+STR *str;
+{
+    switch (ix) {
+    case UV_COLS:
+	COLS = (int)str_gnum(str);
+	break;
+    case UV_Def_term:
+	Def_term = savestr(str_get(str));	/* never freed */
+	break;
+    case UV_LINES:
+	LINES = (int)str_gnum(str);
+	break;
+    case UV_My_term:
+	My_term = (bool)str_gnum(str);
+	break;
+    case UV_ttytype:
+	strcpy(ttytype, str_get(str));		/* hope it fits */
+	break;
+    }
+    return 0;
+}