From: Larry Wall Date: Mon, 8 Jun 1992 04:52:51 +0000 (+0000) Subject: perl 4.0 patch 21: patch #20, continued X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bf10efe7e35fa48859e575b890018da16608a9d7;p=p5sagit%2Fp5-mst-13.2.git perl 4.0 patch 21: patch #20, continued See patch #20. --- diff --git a/README.ncr b/README.ncr new file mode 100644 index 0000000..dba3b19 --- /dev/null +++ b/README.ncr @@ -0,0 +1,151 @@ +From: lreed@ncratl.AtlantaGA.NCR.COM (Len Reed) +Newsgroups: comp.lang.perl +Subject: Fixes for Perl 4.019 on NCR Tower V.3 +Date: 17 Feb 92 16:41:30 GMT +Organization: Holos Software, Inc. + +Here are the fixes needed to make perl 4.019 on the NCR Tower V.3 system. +I have bundled this as a shar file: feed everything below the CUT line +to /bin/sh. + +The file hints/ncr_tower.sh fixes several problems. It replaces the +standard copy thereof. Note that I use perl's malloc. Note also +that I have turned the optimizer completely off (-O0). Optimizing +at -O1 or -O2 produces some errors that the test suite doesn't catch. +(Problems with alloca() and setjmp/longjmp, I think.) It should be +possible to optimize some modules but I haven't experimented with this. + +[NOTE: this hints file is already installed--lwall] + +I'm don't know if mkdir(2) works: I've left it undef'ed. It is certainly +broken in V.2. If you need fast mkdir's you may want to experiment with +this. + +The file patch.twg fixes a stupidity in /usr/netinclude/sys/time.h. +You'll need this if you have WIN-TCP; you can't use it if you don't +have WIN-TCP. If needed, apply this patch *before* running Configure. + +Make sure you tell Configure that any config.sh it finds is to be ignored. + +After running Configure and make depend, edit config.h so that +the CPPSTDIN definition has DEFAULT_CPP=/dev/null prepended. It should +look this this: + +#define CPPSTDIN "DEFAULT_CPP=/dev/null cc -E" + +This must be done by hand after running "make depend" and before running +make. I was unable to encode this into the hints file. + +This resulting perl should pass all tests. + +-Len Reed +Holos Software, Inc. +holos0!lbr@gatech.edu (my main account) +lreed@ncratl.atlantaga.ncr.com (this account--on a customer's machine) + +-----CUT HERE---- +#!/bin/sh +# This is a shell archive (shar 3.32) +# made 02/17/1992 16:36 UTC by lreed@ncratl +# Source directory /usr/acct/lreed/,q +# +# existing files WILL be overwritten +# +# This shar contains: +# length mode name +# ------ ---------- ------------------------------------------ +# 1593 -rw-rw-rw- patch.twg +# 176 -rw-r--r-- hints/ncr_tower.sh +# +if touch 2>&1 | fgrep 'amc' > /dev/null + then TOUCH=touch + else TOUCH=true +fi +# ============= patch.twg ============== +echo "x - extracting patch.twg (Text)" +sed 's/^X//' << 'SHAR_EOF' > patch.twg && +XThe following patch fixes /usr/netinclude/sys/time.h on the Tower V.3. +XPulling in with -I/usr/inetinclude makes a mess unless +Xthe file is pulled in, too. It's stupid that an +Xapplication (e.g., perl) should have to do this. Thus, I fixed +Xthe system header file. The alternative is to make each application +Xget the header file itself. (The #if allows the application to do +Xit, though, for compatibility with existing applications.) +X +XTo apply this patch, chdir to /usr/netinclude/sys and run +X patch shouldn't cause +X HDEF to blow up the compile--auto pull in its defining file. +X */ +X# include +X#endif +X +Xbefore HDEF is used. +X +X-----The patch starts below this line +X +X*** time.h.old Fri Feb 14 12:06:46 1992 +X--- time.h Fri Feb 14 12:04:32 1992 +X*************** +X*** 4,12 **** +X /* time.h 6.1 83/07/29 */ +X /* " @(#)time.h (TWG) 2.2 88/05/17 " */ +X +X! /* +X HDEF( "@(#)$RCSfile: README.ncr,v $$Revision: 4.0.1.1 $$Date: 92/06/08 11:41:41 $" ) +X- */ +X +X /* +X * Structure returned by gettimeofday(2) system call, +X--- 4,17 ---- +X /* time.h 6.1 83/07/29 */ +X /* " @(#)time.h (TWG) 2.2 88/05/17 " */ +X +X! #ifndef HDEF +X! /* Len Reed 5/6/91 -- pulling in shouldn't cause +X! HDEF to blow up the compile--auto pull in its defining file. +X! */ +X! # include +X! #endif +X! +X HDEF( "@(#)$RCSfile: README.ncr,v $$Revision: 4.0.1.1 $$Date: 92/06/08 11:41:41 $" ) +X +X /* +X * Structure returned by gettimeofday(2) system call, +SHAR_EOF +$TOUCH -am 0217113592 patch.twg && +chmod 0666 patch.twg || +echo "restore of patch.twg failed" +set `wc -c patch.twg`;Wc_c=$1 +if test "$Wc_c" != "1593"; then + echo original size 1593, current size $Wc_c +fi +# ============= hints/ncr_tower.sh ============== +if test ! -d 'hints'; then + echo "x - creating directory hints" + mkdir 'hints' +fi +echo "x - extracting hints/ncr_tower.sh (Text)" +sed 's/^X//' << 'SHAR_EOF' > hints/ncr_tower.sh && +Xoptimize='-O0' +Xccflags="$ccflags -W2,-Sl,2000" +Xeval_cflags='large="-W0,-XL"' +Xteval_cflags=$eval_cflags +Xd_mkdir=$undef +Xusemymalloc='y' +Xmallocsrc='malloc.c' +Xmallocobj='malloc.o' +SHAR_EOF +$TOUCH -am 0214073692 hints/ncr_tower.sh && +chmod 0644 hints/ncr_tower.sh || +echo "restore of hints/ncr_tower.sh failed" +set `wc -c hints/ncr_tower.sh`;Wc_c=$1 +if test "$Wc_c" != "176"; then + echo original size 176, current size $Wc_c +fi +exit 0 + + diff --git a/arg.h b/arg.h index bd2c43d..cbcf4eb 100644 --- a/arg.h +++ b/arg.h @@ -1,4 +1,4 @@ -/* $RCSfile: arg.h,v $$Revision: 4.0.1.2 $$Date: 91/11/05 15:51:05 $ +/* $RCSfile: arg.h,v $$Revision: 4.0.1.3 $$Date: 92/06/08 11:44:06 $ * * Copyright (c) 1991, Larry Wall * @@ -6,6 +6,10 @@ * License or the Artistic License, as specified in the README file. * * $Log: arg.h,v $ + * Revision 4.0.1.3 92/06/08 11:44:06 lwall + * patch20: O_PIPE conflicted with Atari + * patch20: clarified debugging output for literals and double-quoted strings + * * Revision 4.0.1.2 91/11/05 15:51:05 lwall * patch11: added eval {} * patch11: added sort {} LIST @@ -286,7 +290,7 @@ #define O_REWINDDIR 263 #define O_CLOSEDIR 264 #define O_SYSCALL 265 -#define O_PIPE 266 +#define O_PIPE_OP 266 #define O_TRY 267 #define O_EVALONCE 268 #define MAXO 269 @@ -603,8 +607,8 @@ char *argname[] = { "CMD", "STAB", "LVAL", - "SINGLE", - "DOUBLE", + "LITERAL", + "DOUBLEQUOTE", "BACKTICK", "READ", "SPAT", diff --git a/array.c b/array.c index fb2801f..acf7bd8 100644 --- a/array.c +++ b/array.c @@ -1,4 +1,4 @@ -/* $RCSfile: array.c,v $$Revision: 4.0.1.2 $$Date: 91/11/05 16:00:14 $ +/* $RCSfile: array.c,v $$Revision: 4.0.1.3 $$Date: 92/06/08 11:45:05 $ * * Copyright (c) 1991, Larry Wall * @@ -6,6 +6,9 @@ * License or the Artistic License, as specified in the README file. * * $Log: array.c,v $ + * Revision 4.0.1.3 92/06/08 11:45:05 lwall + * patch20: Perl now distinguishes overlapped copies from non-overlapped + * * Revision 4.0.1.2 91/11/05 16:00:14 lwall * patch11: random cleanup * patch11: passing non-existend array elements to subrouting caused core dump @@ -67,7 +70,7 @@ STR *val; if (ar->ary_alloc != ar->ary_array) { retval = ar->ary_array - ar->ary_alloc; - Copy(ar->ary_array, ar->ary_alloc, ar->ary_max+1, STR*); + Move(ar->ary_array, ar->ary_alloc, ar->ary_max+1, STR*); Zero(ar->ary_alloc+ar->ary_max+1, retval, STR*); ar->ary_max += retval; ar->ary_array -= retval; @@ -212,6 +215,7 @@ register ARRAY *ar; return retval; } +void aunshift(ar,num) register ARRAY *ar; register int num; @@ -266,6 +270,7 @@ register ARRAY *ar; return ar->ary_fill; } +void afill(ar, fill) register ARRAY *ar; int fill; diff --git a/array.h b/array.h index 980672d..1ab0985 100644 --- a/array.h +++ b/array.h @@ -1,4 +1,4 @@ -/* $RCSfile: array.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:19:20 $ +/* $RCSfile: array.h,v $$Revision: 4.0.1.2 $$Date: 92/06/08 11:45:57 $ * * Copyright (c) 1991, Larry Wall * @@ -6,6 +6,9 @@ * License or the Artistic License, as specified in the README file. * * $Log: array.h,v $ + * Revision 4.0.1.2 92/06/08 11:45:57 lwall + * patch20: removed implicit int declarations on funcions + * * Revision 4.0.1.1 91/06/07 10:19:20 lwall * patch4: new copyright notice * @@ -35,3 +38,5 @@ bool apush(); int alen(); ARRAY *anew(); ARRAY *afake(); +void aunshift(); +void afill(); diff --git a/atarist/README.ST b/atarist/README.ST new file mode 100644 index 0000000..0d42ba0 --- /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 . (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(OUT, ">&STDOUT"); # so we don't dongle stdout + select(OUT); + $| = 1; # for DB'OUT + select(STDOUT); +--- 49,56 ---- + # + # + +! open(IN, "/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 0000000..d276890 --- /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 0000000..6f62f4d --- /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 0000000..0618b40 --- /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 + +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; +} diff --git a/lib/bigrat.pl b/lib/bigrat.pl index 008beff..fb10cf3 100644 --- a/lib/bigrat.pl +++ b/lib/bigrat.pl @@ -3,6 +3,8 @@ require "bigint.pl"; # Arbitrary size rational math package # +# by Mark Biggar +# # Input values to these routines consist of strings of the form # m|^\s*[+-]?[\d\s]+(/[\d\s]+)?$|. # Examples: diff --git a/lib/cacheout.pl b/lib/cacheout.pl index bec40bd..513c25b 100644 --- a/lib/cacheout.pl +++ b/lib/cacheout.pl @@ -1,5 +1,3 @@ -#!/usr/bin/perl - # Open in their package. sub cacheout'open { diff --git a/os2/README.OS2 b/os2/README.OS2 index 7e3536d..2cca20c 100644 --- a/os2/README.OS2 +++ b/os2/README.OS2 @@ -376,7 +376,7 @@ especially not with -DDEBUGGING 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 shure if I can verify the OS/2 port with each release ++ 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 @@ -392,6 +392,34 @@ Some bugs were fixed. Added alarm() support (using PD implementation). 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. diff --git a/os2/eg/alarm.pl b/os2/eg/alarm.pl index 8ceb4e2..e244df4 100644 --- a/os2/eg/alarm.pl +++ b/os2/eg/alarm.pl @@ -4,9 +4,10 @@ sub handler { exit(0); } -$SIG{'INT'} = 'handler'; -$SIG{'QUIT'} = 'handler'; $SIG{'ALRM'} = 'handler'; +$SIG{'INT'} = 'handler'; # Ctrl-C pressed +$SIG{'BREAK'} = 'handler'; # Ctrl-Break pressed +$SIG{'TERM'} = 'handler'; # Killed by another process print "Starting execution ...\n"; alarm(10); diff --git a/patchlevel.h b/patchlevel.h index 37c7e31..49ea5df 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 20 +#define PATCHLEVEL 21 diff --git a/x2p/Makefile.SH b/x2p/Makefile.SH index a8a7717..6d8d735 100644 --- a/x2p/Makefile.SH +++ b/x2p/Makefile.SH @@ -14,10 +14,16 @@ case $CONFIG in ;; esac echo "Extracting x2p/Makefile (with variable substitutions)" +rm -f Makefile cat >Makefile <>Makefile <<'!NO!SUBS!' -CCCMD = `sh cflags $@` +CCCMD = `sh $(shellflags) cflags $@` public = a2p s2p find2perl @@ -58,7 +65,7 @@ util = sh = Makefile.SH makedepend.SH -h = EXTERN.h INTERN.h config.h handy.h hash.h a2p.h str.h util.h +h = EXTERN.h INTERN.h ../config.h handy.h hash.h a2p.h str.h util.h c = hash.c $(mallocsrc) str.c util.c walk.c @@ -81,7 +88,7 @@ a2p: $(obj) a2p.o $(CC) $(LDFLAGS) $(obj) a2p.o $(libs) -o a2p a2p.c: a2p.y - @ echo Expect 226 shift/reduce conflicts... + @ echo Expect 231 shift/reduce conflicts... $(YACC) a2p.y mv y.tab.c a2p.c @@ -105,7 +112,7 @@ done; \ fi clean: - rm -f a2p *.o + rm -f a2p *.o a2p.c realclean: clean rm -f *.orig */*.orig core $(addedbyconf) a2p.c s2p find2perl all cflags @@ -141,7 +148,7 @@ malloc.c: ../malloc.c $(obj): @ echo "You haven't done a "'"make depend" yet!'; exit 1 makedepend: makedepend.SH - /bin/sh makedepend.SH + /bin/sh $(shellflags) makedepend.SH !NO!SUBS! $eunicefix Makefile case `pwd` in diff --git a/x2p/a2p.h b/x2p/a2p.h index 3e15b37..0eb0d1c 100644 --- a/x2p/a2p.h +++ b/x2p/a2p.h @@ -1,4 +1,4 @@ -/* $RCSfile: a2p.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:27 $ +/* $RCSfile: a2p.h,v $$Revision: 4.0.1.2 $$Date: 92/06/08 16:12:23 $ * * Copyright (c) 1991, Larry Wall * @@ -6,6 +6,9 @@ * License or the Artistic License, as specified in the README file. * * $Log: a2p.h,v $ + * Revision 4.0.1.2 92/06/08 16:12:23 lwall + * patch20: hash tables now split only if the memory is available to do so + * * Revision 4.0.1.1 91/06/07 12:12:27 lwall * patch4: new copyright notice * @@ -295,6 +298,8 @@ EXT bool need_entire INIT(FALSE); EXT bool absmaxfld INIT(FALSE); EXT bool saw_altinput INIT(FALSE); +EXT bool nomemok INIT(FALSE); + EXT char const_FS INIT(0); EXT char *namelist INIT(Nullch); EXT char fswitch INIT(0); diff --git a/x2p/a2p.y b/x2p/a2p.y index 84026dd..6136edf 100644 --- a/x2p/a2p.y +++ b/x2p/a2p.y @@ -1,5 +1,5 @@ %{ -/* $RCSfile: a2p.y,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:41 $ +/* $RCSfile: a2p.y,v $$Revision: 4.0.1.2 $$Date: 92/06/08 16:13:03 $ * * Copyright (c) 1991, Larry Wall * @@ -7,6 +7,9 @@ * License or the Artistic License, as specified in the README file. * * $Log: a2p.y,v $ + * Revision 4.0.1.2 92/06/08 16:13:03 lwall + * patch20: in a2p, getline should allow variable to be array element + * * Revision 4.0.1.1 91/06/07 12:12:41 lwall * patch4: new copyright notice * @@ -184,18 +187,18 @@ term : variable { $$ = oper1(OPAREN,$2); } | GETLINE { $$ = oper0(OGETLINE); } - | GETLINE VAR + | GETLINE variable { $$ = oper1(OGETLINE,$2); } | GETLINE '<' expr { $$ = oper3(OGETLINE,Nullop,string("<",1),$3); if (ops[$3].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } - | GETLINE VAR '<' expr + | GETLINE variable '<' expr { $$ = oper3(OGETLINE,$2,string("<",1),$4); if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } | term 'p' GETLINE { $$ = oper3(OGETLINE,Nullop,string("|",1),$1); if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } - | term 'p' GETLINE VAR + | term 'p' GETLINE variable { $$ = oper3(OGETLINE,$4,string("|",1),$1); if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } | FUN1 diff --git a/x2p/a2py.c b/x2p/a2py.c index b2ac121..c785828 100644 --- a/x2p/a2py.c +++ b/x2p/a2py.c @@ -1,4 +1,4 @@ -/* $RCSfile: a2py.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:59 $ +/* $RCSfile: a2py.c,v $$Revision: 4.0.1.2 $$Date: 92/06/08 16:15:16 $ * * Copyright (c) 1991, Larry Wall * @@ -6,6 +6,11 @@ * License or the Artistic License, as specified in the README file. * * $Log: a2py.c,v $ + * Revision 4.0.1.2 92/06/08 16:15:16 lwall + * patch20: in a2p, now warns about spurious backslashes + * patch20: in a2p, now allows [ to be backslashed in pattern + * patch20: in a2p, now allows numbers of the form 2. + * * Revision 4.0.1.1 91/06/07 12:12:59 lwall * patch4: new copyright notice * @@ -14,8 +19,8 @@ * */ -#ifdef MSDOS -#include "../patchlev.h" +#ifdef OS2 +#include "../patchlevel.h" #endif #include "util.h" char *index(); @@ -26,10 +31,10 @@ char *myname; int checkers = 0; STR *walk(); -#ifdef MSDOS +#ifdef OS2 usage() { - printf("\nThis is the AWK to PERL translator, version 3.0, patchlevel %d\n", PATCHLEVEL); + printf("\nThis is the AWK to PERL translator, version 4.0, patchlevel %d\n", PATCHLEVEL); printf("\nUsage: %s [-D] [-F] [-n] [-] filename\n", myname); printf("\n -D sets debugging flags." "\n -F the awk script to translate is always invoked with" @@ -85,7 +90,7 @@ register char **env; break; default: fatal("Unrecognized switch: %s\n",argv[0]); -#ifdef MSDOS +#ifdef OS2 usage(); #endif } @@ -95,7 +100,7 @@ register char **env; /* open script */ if (argv[0] == Nullch) { -#ifdef MSDOS +#ifdef OS2 if ( isatty(fileno(stdin)) ) usage(); #endif @@ -216,6 +221,12 @@ yylex() *s++,filename,line); goto retry; case '\\': + s++; + if (*s && *s != '\n') { + yyerror("Ignoring spurious backslash"); + goto retry; + } + /*FALLSTHROUGH*/ case 0: s = str_get(linestr); *s = '\0'; @@ -802,6 +813,8 @@ register char *s; *d++ = *s++; else if (s[1] == '\\') *d++ = *s++; + else if (s[1] == '[') + *d++ = *s++; } else if (*s == '[') { *d++ = *s++; @@ -846,11 +859,15 @@ register char *s; while (isdigit(*s)) { *d++ = *s++; } - if (*s == '.' && index("0123456789eE",s[1])) { - *d++ = *s++; - while (isdigit(*s)) { + if (*s == '.') { + if (isdigit(s[1])) { *d++ = *s++; + while (isdigit(*s)) { + *d++ = *s++; + } } + else + s++; } if (index("eE",*s) && index("+-0123456789",s[1])) { *d++ = *s++; @@ -1265,7 +1282,6 @@ int prevargs; sprintf(tmpbuf,"%s:%d",name,prevargs); str = hfetch(curarghash,tmpbuf); - fprintf(stderr,"Looking for %s\n",tmpbuf); if (str && strEQ(str->str_ptr,"*")) { if (type == OVAR || type == OSTAR) { ops[arg].ival &= ~255;