lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (10/17/90)
System: perl version 3.0 Patch #: 32 Priority: HIGH Subject: patch #29, continued Description: See patch #29. Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle". If you don't have the patch program, apply the following by hand, or get patch (version 2.0, latest patchlevel). After patching: *** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #36 FIRST *** If patch indicates that patchlevel is the wrong version, you may need to apply one or more previous patches, or the patch may already have been applied. See the patchlevel.h file to find out what has or has not been applied. In any event, don't continue with the patch. If you are missing previous patches they can be obtained from me: Larry Wall lwall@jpl-devvax.jpl.nasa.gov If you send a mail message of the following form it will greatly speed processing: Subject: Command @SH mailpatch PATH perl 3.0 LIST ^ note the c where PATH is a return path FROM ME TO YOU either in Internet notation, or in bang notation from some well-known host, and LIST is the number of one or more patches you need, separated by spaces, commas, and/or hyphens. Saying 35- says everything from 35 to the end. You can also get the patches via anonymous FTP from jpl-devvax.jpl.nasa.gov (128.149.1.143). Index: patchlevel.h Prereq: 31 1c1 < #define PATCHLEVEL 31 --- > #define PATCHLEVEL 32 Index: evalargs.xc Prereq: 3.0.1.6 *** evalargs.xc.old Tue Oct 16 11:52:22 1990 --- evalargs.xc Tue Oct 16 11:52:26 1990 *************** *** 2,10 **** * kit sizes from getting too big. */ ! /* $Header: evalargs.xc,v 3.0.1.6 90/08/09 03:37:15 lwall Locked $ * * $Log: evalargs.xc,v $ * Revision 3.0.1.6 90/08/09 03:37:15 lwall * patch19: passing *name to subroutine now forces filehandle and array creation * patch19: `command` in array context now returns array of lines --- 2,14 ---- * kit sizes from getting too big. */ ! /* $Header: evalargs.xc,v 3.0.1.7 90/10/15 16:48:11 lwall Locked $ * * $Log: evalargs.xc,v $ + * Revision 3.0.1.7 90/10/15 16:48:11 lwall + * patch29: non-existent array values no longer cause core dumps + * patch29: added caller + * * Revision 3.0.1.6 90/08/09 03:37:15 lwall * patch19: passing *name to subroutine now forces filehandle and array creation * patch19: `command` in array context now returns array of lines *************** *** 92,99 **** } st[++sp] = afetch(stab_array(argptr.arg_stab), arg[argtype].arg_len - arybase, FALSE); - if (!st[sp]) - st[sp] = &str_undef; #ifdef DEBUGGING if (debug & 8) { (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab), --- 96,101 ---- *************** *** 263,269 **** break; case A_WANTARRAY: { ! if (wantarray == G_ARRAY) st[++sp] = &str_yes; else st[++sp] = &str_no; --- 265,271 ---- break; case A_WANTARRAY: { ! if (curcsv->wantarray == G_ARRAY) st[++sp] = &str_yes; else st[++sp] = &str_no; *************** *** 323,329 **** st = stack->ary_array; tmpstr = Str_new(55,0); #ifdef MSDOS ! str_set(tmpstr, "glob "); str_scat(tmpstr,str); str_cat(tmpstr," |"); #else --- 325,331 ---- st = stack->ary_array; tmpstr = Str_new(55,0); #ifdef MSDOS ! str_set(tmpstr, "perlglob "); str_scat(tmpstr,str); str_cat(tmpstr," |"); #else Index: form.c Prereq: 3.0.1.2 *** form.c.old Tue Oct 16 11:52:34 1990 --- form.c Tue Oct 16 11:52:36 1990 *************** *** 1,4 **** ! /* $Header: form.c,v 3.0.1.2 90/08/09 03:38:40 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: form.c,v 3.0.1.3 90/10/15 17:26:24 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: form.c,v $ + * Revision 3.0.1.3 90/10/15 17:26:24 lwall + * patch29: added @###.## fields to format + * * Revision 3.0.1.2 90/08/09 03:38:40 lwall * patch19: did preliminary work toward debugging packages and evals * *************** *** 281,286 **** --- 284,314 ---- d += size; linebeg = fcmd->f_next; break; + case F_DECIMAL: { + double value; + + (void)eval(fcmd->f_expr,G_SCALAR,sp); + str = stack->ary_array[sp+1]; + /* If the field is marked with ^ and the value is undefined, + blank it out. */ + if ((fcmd->f_flags & FC_CHOP) && !str->str_pok && !str->str_nok) { + while (size) { + size--; + *d++ = ' '; + } + break; + } + value = str_gnum(str); + size = fcmd->f_size; + CHKLEN(size); + if (fcmd->f_flags & FC_DP) { + sprintf(d, "%#*.*f", size, fcmd->f_decimals, value); + } else { + sprintf(d, "%*.0f", size, value); + } + d += size; + break; + } } } CHKLEN(1); Index: form.h Prereq: 3.0 *** form.h.old Tue Oct 16 11:52:40 1990 --- form.h Tue Oct 16 11:52:41 1990 *************** *** 1,4 **** ! /* $Header: form.h,v 3.0 89/10/18 15:17:39 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: form.h,v 3.0.1.1 90/10/15 17:26:57 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: form.h,v $ + * Revision 3.0.1.1 90/10/15 17:26:57 lwall + * patch29: added @###.## fields to format + * * Revision 3.0 89/10/18 15:17:39 lwall * 3.0 baseline * *************** *** 16,21 **** --- 19,25 ---- #define F_RIGHT 2 #define F_CENTER 3 #define F_LINES 4 + #define F_DECIMAL 5 struct formcmd { struct formcmd *f_next; *************** *** 25,30 **** --- 29,35 ---- char *f_pre; short f_presize; short f_size; + short f_decimals; char f_type; char f_flags; }; *************** *** 33,38 **** --- 38,44 ---- #define FC_NOBLANK 2 #define FC_MORE 4 #define FC_REPEAT 8 + #define FC_DP 16 #define Nullfcmd Null(FCMD*) Index: h2ph.SH *** h2ph.SH.old Tue Oct 16 11:52:47 1990 --- h2ph.SH Tue Oct 16 11:52:49 1990 *************** *** 102,108 **** } } elsif (/^include <(.*)>/) { ! print OUT $t,"do '$1' || die \"Can't include $1: \$!\";\n"; } elsif (/^ifdef\s+(\w+)/) { print OUT $t,"if (defined &$1) {\n"; --- 102,109 ---- } } elsif (/^include <(.*)>/) { ! ($incl = $1) =~ s/\.h$/.ph/; ! print OUT $t,"require '$incl';\n"; } elsif (/^ifdef\s+(\w+)/) { print OUT $t,"if (defined &$1) {\n"; Index: hash.c Prereq: 3.0.1.5 *** hash.c.old Tue Oct 16 11:52:58 1990 --- hash.c Tue Oct 16 11:53:05 1990 *************** *** 1,4 **** ! /* $Header: hash.c,v 3.0.1.5 90/08/13 22:18:27 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: hash.c,v 3.0.1.6 90/10/15 17:32:52 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,17 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: hash.c,v $ + * Revision 3.0.1.6 90/10/15 17:32:52 lwall + * patch29: non-existent array values no longer cause core dumps + * patch29: %foo = () will now clear dbm files + * patch29: dbm files couldn't be opened read only + * patch29: the cache array for dbm files wasn't correctly created on fetches + * * Revision 3.0.1.5 90/08/13 22:18:27 lwall * patch28: defined(@array) and defined(%array) didn't work right * *************** *** 39,49 **** 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1}; STR * hfetch(tb,key,klen,lval) register HASH *tb; char *key; ! int klen; int lval; { register char *s; --- 45,57 ---- 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1}; + static void hfreeentries(); + STR * hfetch(tb,key,klen,lval) register HASH *tb; char *key; ! unsigned int klen; int lval; { register char *s; *************** *** 57,68 **** #endif if (!tb) ! return Nullstr; if (!tb->tbl_array) { if (lval) Newz(503,tb->tbl_array, tb->tbl_max + 1, HENT*); else ! return Nullstr; } /* The hash function we use on symbols has to be equal to the first --- 65,76 ---- #endif if (!tb) ! return &str_undef; if (!tb->tbl_array) { if (lval) Newz(503,tb->tbl_array, tb->tbl_max + 1, HENT*); else ! return &str_undef; } /* The hash function we use on symbols has to be equal to the first *************** *** 114,120 **** hstore(tb,key,klen,str,hash); return str; } ! return Nullstr; } bool --- 122,128 ---- hstore(tb,key,klen,str,hash); return str; } ! return &str_undef; } bool *************** *** 121,127 **** hstore(tb,key,klen,val,hash) register HASH *tb; char *key; ! int klen; STR *val; register int hash; { --- 129,135 ---- hstore(tb,key,klen,val,hash) register HASH *tb; char *key; ! unsigned int klen; STR *val; register int hash; { *************** *** 209,215 **** hdelete(tb,key,klen) register HASH *tb; char *key; ! int klen; { register char *s; register int i; --- 217,223 ---- hdelete(tb,key,klen) register HASH *tb; char *key; ! unsigned int klen; { register char *s; register int i; *************** *** 357,370 **** } void ! hclear(tb) register HASH *tb; { register HENT *hent; register HENT *ohent = Null(HENT*); if (!tb || !tb->tbl_array) return; (void)hiterinit(tb); while (hent = hiternext(tb)) { /* concise but not very efficient */ hentfree(ohent); --- 365,415 ---- } void ! hclear(tb,dodbm) register HASH *tb; + int dodbm; { + if (!tb) + return; + hfreeentries(tb,dodbm); + tb->tbl_fill = 0; + #ifndef lint + if (tb->tbl_array) + (void)bzero((char*)tb->tbl_array, (tb->tbl_max + 1) * sizeof(HENT*)); + #endif + } + + static void + hfreeentries(tb,dodbm) + register HASH *tb; + int dodbm; + { register HENT *hent; register HENT *ohent = Null(HENT*); + #ifdef SOME_DBM + datum dkey; + datum nextdkey; + #ifdef NDBM + DBM *old_dbm; + #else + int old_dbm; + #endif + #endif if (!tb || !tb->tbl_array) return; + #ifdef SOME_DBM + if ((old_dbm = tb->tbl_dbm) && dodbm) { + while (dkey = dbm_firstkey(tb->tbl_dbm), dkey.dptr) { + do { + nextdkey = dbm_nextkey(tb->tbl_dbm, dkey); + dbm_delete(tb->tbl_dbm,dkey); + dkey = nextdkey; + } while (dkey.dptr); /* one way or another, this works */ + } + } + tb->tbl_dbm = 0; /* now clear just cache */ + #endif (void)hiterinit(tb); while (hent = hiternext(tb)) { /* concise but not very efficient */ hentfree(ohent); *************** *** 371,397 **** ohent = hent; } hentfree(ohent); ! tb->tbl_fill = 0; ! #ifndef lint ! (void)bzero((char*)tb->tbl_array, (tb->tbl_max + 1) * sizeof(HENT*)); #endif } void ! hfree(tb) register HASH *tb; { - register HENT *hent; - register HENT *ohent = Null(HENT*); - if (!tb) return; ! (void)hiterinit(tb); ! while (hent = hiternext(tb)) { ! hentfree(ohent); ! ohent = hent; ! } ! hentfree(ohent); Safefree(tb->tbl_array); Safefree(tb); } --- 416,434 ---- ohent = hent; } hentfree(ohent); ! #ifdef SOME_DBM ! tb->tbl_dbm = old_dbm; #endif } void ! hfree(tb,dodbm) register HASH *tb; + int dodbm; { if (!tb) return; ! hfreeentries(tb,dodbm); Safefree(tb->tbl_array); Safefree(tb); } *************** *** 532,543 **** hdbmclose(tb); tb->tbl_dbm = 0; } ! hclear(tb); #ifdef NDBM if (mode >= 0) tb->tbl_dbm = dbm_open(fname, O_RDWR|O_CREAT, mode); if (!tb->tbl_dbm) tb->tbl_dbm = dbm_open(fname, O_RDWR, mode); #else if (dbmrefcnt++) fatal("Old dbm can only open one database"); --- 569,582 ---- hdbmclose(tb); tb->tbl_dbm = 0; } ! hclear(tb, FALSE); /* clear cache */ #ifdef NDBM if (mode >= 0) tb->tbl_dbm = dbm_open(fname, O_RDWR|O_CREAT, mode); if (!tb->tbl_dbm) tb->tbl_dbm = dbm_open(fname, O_RDWR, mode); + if (!tb->tbl_dbm) + tb->tbl_dbm = dbm_open(fname, O_RDONLY, mode); #else if (dbmrefcnt++) fatal("Old dbm can only open one database"); *************** *** 551,556 **** --- 590,597 ---- } tb->tbl_dbm = dbminit(fname) >= 0; #endif + if (!tb->tbl_array && tb->tbl_dbm != 0) + Newz(507,tb->tbl_array, tb->tbl_max + 1, HENT*); return tb->tbl_dbm != 0; } *************** *** 574,580 **** hdbmstore(tb,key,klen,str) register HASH *tb; char *key; ! int klen; register STR *str; { datum dkey, dcontent; --- 615,621 ---- hdbmstore(tb,key,klen,str) register HASH *tb; char *key; ! unsigned int klen; register STR *str; { datum dkey, dcontent; Index: hash.h Prereq: 3.0.1.1 *** hash.h.old Tue Oct 16 11:53:15 1990 --- hash.h Tue Oct 16 11:53:17 1990 *************** *** 1,4 **** ! /* $Header: hash.h,v 3.0.1.1 90/08/09 03:51:34 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: hash.h,v 3.0.1.2 90/10/15 17:33:58 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: hash.h,v $ + * Revision 3.0.1.2 90/10/15 17:33:58 lwall + * patch29: the debugger now understands packages and evals + * * Revision 3.0.1.1 90/08/09 03:51:34 lwall * patch19: various MSDOS and OS/2 patches folded in * *************** *** 38,43 **** --- 41,47 ---- int tbl_riter; /* current root of iterator */ HENT *tbl_eiter; /* current entry of iterator */ SPAT *tbl_spatroot; /* list of spats for this package */ + char *tbl_name; /* name, if a symbol table */ #ifdef SOME_DBM #ifdef NDBM DBM *tbl_dbm; Index: eg/sysvipc/ipcmsg *** eg/sysvipc/ipcmsg.old Tue Oct 16 11:50:29 1990 --- eg/sysvipc/ipcmsg Tue Oct 16 11:50:34 1990 *************** *** 0 **** --- 1,47 ---- + #!/usr/bin/perl + eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' + if 0; + + require 'sys/ipc.ph'; + require 'sys/msg.ph'; + + $| = 1; + + $mode = shift; + die "usage: ipcmsg {r|s}\n" unless $mode =~ /^[rs]$/; + $send = ($mode eq "s"); + + $id = msgget(0x1234, ($send ? 0 : &IPC_CREAT) | 0644); + die "Can't get message queue: $!\n" unless defined($id); + print "message queue id: $id\n"; + + if ($send) { + while (<STDIN>) { + chop; + unless (msgsnd($id, pack("LA*", $., $_), 0)) { + die "Can't send message: $!\n"; + } + } + } + else { + $SIG{'INT'} = $SIG{'QUIT'} = "leave"; + for (;;) { + unless (msgrcv($id, $_, 512, 0, 0)) { + die "Can't receive message: $!\n"; + } + ($type, $message) = unpack("La*", $_); + printf "[%d] %s\n", $type, $message; + } + } + + &leave; + + sub leave { + if (!$send) { + $x = msgctl($id, &IPC_RMID, 0); + if (!defined($x) || $x < 0) { + die "Can't remove message queue: $!\n"; + } + } + exit; + } Index: eg/sysvipc/ipcsem *** eg/sysvipc/ipcsem.old Tue Oct 16 11:50:53 1990 --- eg/sysvipc/ipcsem Tue Oct 16 11:50:58 1990 *************** *** 0 **** --- 1,46 ---- + #!/usr/bin/perl + eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' + if 0; + + require 'sys/ipc.ph'; + require 'sys/msg.ph'; + + $| = 1; + + $mode = shift; + die "usage: ipcmsg {r|s}\n" unless $mode =~ /^[rs]$/; + $signal = ($mode eq "s"); + + $id = semget(0x1234, 1, ($signal ? 0 : &IPC_CREAT) | 0644); + die "Can't get semaphore: $!\n" unless defined($id); + print "semaphore id: $id\n"; + + if ($signal) { + while (<STDIN>) { + print "Signalling\n"; + unless (semop($id, 0, pack("sss", 0, 1, 0))) { + die "Can't signal semaphore: $!\n"; + } + } + } + else { + $SIG{'INT'} = $SIG{'QUIT'} = "leave"; + for (;;) { + unless (semop($id, 0, pack("sss", 0, -1, 0))) { + die "Can't wait for semaphore: $!\n"; + } + print "Unblocked\n"; + } + } + + &leave; + + sub leave { + if (!$signal) { + $x = semctl($id, 0, &IPC_RMID, 0); + if (!defined($x) || $x < 0) { + die "Can't remove semaphore: $!\n"; + } + } + exit; + } Index: eg/sysvipc/ipcshm *** eg/sysvipc/ipcshm.old Tue Oct 16 11:51:09 1990 --- eg/sysvipc/ipcshm Tue Oct 16 11:51:13 1990 *************** *** 0 **** --- 1,50 ---- + #!/usr/bin/perl + eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' + if 0; + + require 'sys/ipc.ph'; + require 'sys/shm.ph'; + + $| = 1; + + $mode = shift; + die "usage: ipcshm {r|s}\n" unless $mode =~ /^[rs]$/; + $send = ($mode eq "s"); + + $SIZE = 32; + $id = shmget(0x1234, $SIZE, ($send ? 0 : &IPC_CREAT) | 0644); + die "Can't get message queue: $!\n" unless defined($id); + print "message queue id: $id\n"; + + if ($send) { + while (<STDIN>) { + chop; + unless (shmwrite($id, pack("La*", length($_), $_), 0, $SIZE)) { + die "Can't write to shared memory: $!\n"; + } + } + } + else { + $SIG{'INT'} = $SIG{'QUIT'} = "leave"; + for (;;) { + $_ = <STDIN>; + unless (shmread($id, $_, 0, $SIZE)) { + die "Can't read shared memory: $!\n"; + } + $len = unpack("L", $_); + $message = substr($_, length(pack("L",0)), $len); + printf "[%d] %s\n", $len, $message; + } + } + + &leave; + + sub leave { + if (!$send) { + $x = shmctl($id, &IPC_RMID, 0); + if (!defined($x) || $x < 0) { + die "Can't remove shared memory: $!\n"; + } + } + exit; + } Index: os2/makefile *** os2/makefile.old Tue Oct 16 11:55:12 1990 --- os2/makefile Tue Oct 16 11:55:14 1990 *************** *** 0 **** --- 1,125 ---- + # + # Makefile for compiling Perl under OS/2 + # + # Needs a Unix compatible make. + # This makefile works for an initial compilation. It does not + # include all dependencies and thus is unsuitable for serious + # development work. Hey, I'm just inheriting what Diomidis gave me. + # + # Originally by Diomidis Spinellis, March 1990 + # Adjusted for OS/2 port by Raymond Chen, June 1990 + # + + # Source files + SRC = array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c \ + eval.c form.c hash.c perl.y perly.c regcomp.c regexec.c \ + stab.c str.c toke.c util.c os2.c popen.c director.c suffix.c mktemp.c + + # Object files + OBJ = perl.obj array.obj cmd.obj cons.obj consarg.obj doarg.obj doio.obj \ + dolist.obj dump.obj eval.obj form.obj hash.obj perly.obj regcomp.obj \ + regexec.obj stab.obj str.obj toke.obj util.obj os2.obj popen.obj \ + director.obj suffix.obj mktemp.obj + + # Files in the OS/2 distribution + DOSFILES=config.h director.c dir.h makefile os2.c popen.c suffix.c \ + mktemp.c readme.os2 + + # Yacc flags + YFLAGS=-d + + # Manual pages + MAN=perlman.1 perlman.2 perlman.3 perlman.4 + + CC=cl + # CBASE = flags everybody gets + # CPLAIN = flags for modules that give the compiler indigestion + # CFLAGS = flags for milder modules + # PERL = which version of perl to build + # + # For preliminary building: No optimization, DEBUGGING set, symbols included. + #CBASE=-AL -Zi -G2 -Gs -DDEBUGGING + #CPLAIN=$(CBASE) -Od + #CFLAGS=$(CBASE) -Od + #PERL=perlsym.exe + + # For the final build: Optimization on, symbols stripped. + CBASE=-AL -Zi -G2 -Gs -DDEBUGGING + CPLAIN=$(CBASE) -Olt + CFLAGS=$(CBASE) -Oeglt + PERL=perl.exe + + # Destination directory for executables + DESTDIR=\usr\bin + + # Deliverables + # + all: $(PERL) glob.exe + + perl.exe: $(OBJ) perl.arp + link @perl.arp,perl,nul,/stack:32767 /NOE; + exehdr /nologo /newfiles /pmtype:windowcompat perl.exe >nul + + perlsym.exe: $(OBJ) perl.arp + link @perl.arp,perlsym,nul,/stack:32767 /NOE /CODE; + exehdr /nologo /newfiles /pmtype:windowcompat perlsym.exe >nul + + perl.arp: + echo array+cmd+cons+consarg+doarg+doio+dolist+dump+ >perl.arp + echo eval+form+hash+perl+perly+regcomp+regexec+stab+suffix+ >>perl.arp + echo str+toke+util+os2+popen+director+\c600\lib\setargv >>perl.arp + + glob.exe: glob.c + $(CC) glob.c setargv.obj -link /NOE + exehdr /nologo /newfiles /pmtype:windowcompat glob.exe >nul + + array.obj: array.c + $(CC) $(CPLAIN) -c array.c + cmd.obj: cmd.c + cons.obj: cons.c perly.h + consarg.obj: consarg.c + # $(CC) $(CPLAIN) -c consarg.c + doarg.obj: doarg.c + doio.obj: doio.c + dolist.obj: dolist.c + dump.obj: dump.c + eval.obj: eval.c evalargs.xc + $(CC) /B2c2l /B3c3l $(CFLAGS) -c eval.c + form.obj: form.c + hash.obj: hash.c + perl.obj: perl.y + perly.obj: perly.c + regcomp.obj: regcomp.c + regexec.obj: regexec.c + stab.obj: stab.c + $(CC) $(CPLAIN) -c stab.c + str.obj: str.c + suffix.obj: suffix.c + toke.obj: toke.c + $(CC) /B3c3l $(CFLAGS) -c toke.c + util.obj: util.c + # $(CC) $(CPLAIN) -c util.c + perly.h: ytab.h + cp ytab.h perly.h + director.obj: director.c + popen.obj: popen.c + os2.obj: os2.c + + perl.1: $(MAN) + nroff -man $(MAN) >perl.1 + + install: all + exepack perl.exe $(DESTDIR)\perl.exe + exepack glob.exe $(DESTDIR)\glob.exe + + clean: + rm -f *.obj *.exe perl.1 perly.h perl.arp + + tags: + ctags *.c *.h *.xc + + dosperl: + mv $(DOSFILES) ../perl30.new + + doskit: + mv $(DOSFILES) ../os2 Index: os2/mktemp.c *** os2/mktemp.c.old Tue Oct 16 11:55:23 1990 --- os2/mktemp.c Tue Oct 16 11:55:27 1990 *************** *** 0 **** --- 1,28 ---- + /* MKTEMP.C using TMP environment variable */ + + #include <stdio.h> + #include <stdlib.h> + #include <string.h> + #include <io.h> + + void Mktemp(char *file) + { + char fname[32], *tmp; + + tmp = getenv("TMP"); + + if ( tmp != NULL ) + { + strcpy(fname, file); + strcpy(file, tmp); + + if ( file[strlen(file) - 1] != '\\' ) + strcat(file, "\\"); + + strcat(file, fname); + } + + mktemp(file); + } + + /* End of MKTEMP.C */ Index: usub/mus *** usub/mus.old Tue Oct 16 12:05:32 1990 --- usub/mus Tue Oct 16 12:05:33 1990 *************** *** 103,109 **** } elsif ($rettype =~ /^[A-Z]+\s*\*$/) { print <<EOF; ! str_set(st[0], (char*) &retval, sizeof retval); EOF } else { --- 103,109 ---- } elsif ($rettype =~ /^[A-Z]+\s*\*$/) { print <<EOF; ! str_nset(st[0], (char*) &retval, sizeof retval); EOF } else { Index: t/op.index Prereq: 3.0 *** t/op.index.old Tue Oct 16 12:04:05 1990 --- t/op.index Tue Oct 16 12:04:07 1990 *************** *** 1,8 **** #!./perl ! # $Header: op.index,v 3.0 89/10/18 15:29:29 lwall Locked $ ! print "1..6\n"; $foo = 'Now is the time for all good men to come to the aid of their country.'; --- 1,8 ---- #!./perl ! # $Header: op.index,v 3.0.1.1 90/10/16 10:50:28 lwall Locked $ ! print "1..20\n"; $foo = 'Now is the time for all good men to come to the aid of their country.'; *************** *** 24,26 **** --- 24,42 ---- $last = substr($foo,rindex($foo,'.'),100); print ($last eq "." ? "ok 6\n" : "not ok 6\n"); + + print index("ababa","a",-1) == 0 ? "ok 7\n" : "not ok 7\n"; + print index("ababa","a",0) == 0 ? "ok 8\n" : "not ok 8\n"; + print index("ababa","a",1) == 2 ? "ok 9\n" : "not ok 9\n"; + print index("ababa","a",2) == 2 ? "ok 10\n" : "not ok 10\n"; + print index("ababa","a",3) == 4 ? "ok 11\n" : "not ok 11\n"; + print index("ababa","a",4) == 4 ? "ok 12\n" : "not ok 12\n"; + print index("ababa","a",5) == -1 ? "ok 13\n" : "not ok 13\n"; + + print rindex("ababa","a",-1) == -1 ? "ok 14\n" : "not ok 14\n"; + print rindex("ababa","a",0) == 0 ? "ok 15\n" : "not ok 15\n"; + print rindex("ababa","a",1) == 0 ? "ok 16\n" : "not ok 16\n"; + print rindex("ababa","a",2) == 2 ? "ok 17\n" : "not ok 17\n"; + print rindex("ababa","a",3) == 2 ? "ok 18\n" : "not ok 18\n"; + print rindex("ababa","a",4) == 4 ? "ok 19\n" : "not ok 19\n"; + print rindex("ababa","a",5) == 4 ? "ok 20\n" : "not ok 20\n"; Index: t/op.s Prereq: 3.0.1.1 *** t/op.s.old Tue Oct 16 12:04:16 1990 --- t/op.s Tue Oct 16 12:04:19 1990 *************** *** 1,8 **** #!./perl ! # $Header: op.s,v 3.0.1.1 90/02/28 18:37:30 lwall Locked $ ! print "1..42\n"; $x = 'foo'; $_ = "x"; --- 1,8 ---- #!./perl ! # $Header: op.s,v 3.0.1.2 90/10/16 10:51:50 lwall Locked $ ! print "1..51\n"; $x = 'foo'; $_ = "x"; *************** *** 163,165 **** --- 163,179 ---- print $_ eq 'abc 246xyz' ? "ok 41\n" : "not ok 41\n"; s/\w/$& x 2/eg; # yields 'aabbcc 224466xxyyzz' print $_ eq 'aabbcc 224466xxyyzz' ? "ok 42\n" : "not ok 42\n"; + + $_ = "aaaaa"; + print y/a/b/ == 5 ? "ok 43\n" : "not ok 43\n"; + print y/a/b/ == 0 ? "ok 44\n" : "not ok 44\n"; + print y/b// == 5 ? "ok 45\n" : "not ok 45\n"; + print y/b/c/s == 5 ? "ok 46\n" : "not ok 46\n"; + print y/c// == 1 ? "ok 47\n" : "not ok 47\n"; + print y/c//d == 1 ? "ok 48\n" : "not ok 48\n"; + print $_ eq "" ? "ok 49\n" : "not ok 49\n"; + + $_ = "Now is the %#*! time for all good men..."; + print (($x=(y/a-zA-Z //cd)) == 7 ? "ok 50\n" : "not ok 50\n"); + print y/ / /s == 8 ? "ok 51\n" : "not ok 51\n"; + Index: t/op.stat Prereq: 3.0.1.4 *** t/op.stat.old Tue Oct 16 12:04:36 1990 --- t/op.stat Tue Oct 16 12:04:39 1990 *************** *** 1,6 **** #!./perl ! # $Header: op.stat,v 3.0.1.4 90/08/13 22:31:36 lwall Locked $ print "1..56\n"; --- 1,6 ---- #!./perl ! # $Header: op.stat,v 3.0.1.5 90/10/16 10:55:42 lwall Locked $ print "1..56\n"; *************** *** 97,103 **** die "Can't run op.stat test 35 without pwd working" unless $cwd; chdir '/usr/bin' || die "Can't cd to /usr/bin"; ! while (<*>) { $cnt++; $uid++ if -u; last if $uid && $uid < $cnt; --- 97,103 ---- die "Can't run op.stat test 35 without pwd working" unless $cwd; chdir '/usr/bin' || die "Can't cd to /usr/bin"; ! while (defined($_ = <*>)) { $cnt++; $uid++ if -u; last if $uid && $uid < $cnt; Index: t/op.substr Prereq: 3.0 *** t/op.substr.old Tue Oct 16 12:04:45 1990 --- t/op.substr Tue Oct 16 12:04:47 1990 *************** *** 1,8 **** #!./perl ! # $Header: op.substr,v 3.0 89/10/18 15:31:52 lwall Locked $ ! print "1..19\n"; $a = 'abcdefxyz'; --- 1,8 ---- #!./perl ! # $Header: op.substr,v 3.0.1.1 90/10/16 10:56:35 lwall Locked $ ! print "1..22\n"; $a = 'abcdefxyz'; *************** *** 40,42 **** --- 40,47 ---- 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"); Index: os2/os2.c *** os2/os2.c.old Tue Oct 16 11:55:34 1990 --- os2/os2.c Tue Oct 16 11:55:39 1990 *************** *** 0 **** --- 1,273 ---- + /* $Header: os2.c,v 3.0.1.1 90/10/15 17:49:55 lwall Locked $ + * + * (C) Copyright 1989, 1990 Diomidis Spinellis. + * + * You may distribute under the terms of the GNU General Public License + * as specified in the README file that comes with the perl 3.0 kit. + * + * $Log: os2.c,v $ + * Revision 3.0.1.1 90/10/15 17:49:55 lwall + * patch29: Initial revision + * + * Revision 3.0.1.1 90/03/27 16:10:41 lwall + * patch16: MSDOS support + * + * Revision 1.1 90/03/18 20:32:01 dds + * Initial revision + * + */ + + #define INCL_DOS + #define INCL_NOPM + #include <os2.h> + + /* + * Various Unix compatibility functions for OS/2 + */ + + #include <stdio.h> + #include <errno.h> + #include <process.h> + + #include "EXTERN.h" + #include "perl.h" + + + /* dummies */ + + int ioctl(int handle, unsigned int function, char *data) + { return -1; } + + int userinit() + { return -1; } + + int syscall() + { return -1; } + + + /* extendd chdir() */ + + int chdir(char *path) + { + if ( path[0] != 0 && path[1] == ':' ) + DosSelectDisk(tolower(path[0]) - '@'); + + DosChDir(path, 0L); + } + + + /* priorities */ + + int setpriority(int class, int pid, int val) + { + int flag = 0; + + if ( pid < 0 ) + { + flag++; + pid = -pid; + } + + return DosSetPrty(flag ? PRTYS_PROCESSTREE : PRTYS_PROCESS, class, val, pid); + } + + int getpriority(int which /* ignored */, int pid) + { + USHORT val; + + if ( DosGetPrty(PRTYS_PROCESS, &val, pid) ) + return -1; + else + return val; + } + + + /* get parent process id */ + + int getppid(void) + { + PIDINFO pi; + + DosGetPID(&pi); + return pi.pidParent; + } + + + /* kill */ + + int kill(int pid, int sig) + { + int flag = 0; + + if ( pid < 0 ) + { + flag++; + pid = -pid; + } + + switch ( sig & 3 ) + { + + case 0: + DosKillProcess(flag ? DKP_PROCESSTREE : DKP_PROCESS, pid); + break; + + case 1: /* FLAG A */ + DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_A, 0); + break; + + case 2: /* FLAG B */ + DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_B, 0); + break; + + case 3: /* FLAG C */ + DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_C, 0); + break; + + } + } + + + /* Sleep function. */ + void + sleep(unsigned len) + { + DosSleep(len * 1000L); + } + + /* Just pretend that everyone is a superuser */ + + int setuid() + { return 0; } + + int setgid() + { return 0; } + + int getuid(void) + { return 0; } + + int geteuid(void) + { return 0; } + + int getgid(void) + { return 0; } + + int getegid(void) + { return 0; } + + /* + * The following code is based on the do_exec and do_aexec functions + * in file doio.c + */ + int + do_aspawn(really,arglast) + STR *really; + int *arglast; + { + register STR **st = stack->ary_array; + register int sp = arglast[1]; + register int items = arglast[2] - sp; + register char **a; + char **argv; + char *tmps; + int status; + + if (items) { + New(1101,argv, items+1, char*); + a = argv; + for (st += ++sp; items > 0; items--,st++) { + if (*st) + *a++ = str_get(*st); + else + *a++ = ""; + } + *a = Nullch; + if (really && *(tmps = str_get(really))) + status = spawnvp(P_WAIT,tmps,argv); + else + status = spawnvp(P_WAIT,argv[0],argv); + Safefree(argv); + } + return status; + } + + char *getenv(char *name); + + int + do_spawn(cmd) + char *cmd; + { + register char **a; + register char *s; + char **argv; + char flags[10]; + int status; + char *shell, *cmd2; + + /* save an extra exec if possible */ + if ((shell = getenv("COMSPEC")) == 0) + shell = "C:\\OS2\\CMD.EXE"; + + /* see if there are shell metacharacters in it */ + if (strchr(cmd, '>') || strchr(cmd, '<') || strchr(cmd, '|') + || strchr(cmd, '&') || strchr(cmd, '^')) + doshell: + return spawnl(P_WAIT,shell,shell,"/C",cmd,(char*)0); + + New(1102,argv, strlen(cmd) / 2 + 2, char*); + + New(1103,cmd2, strlen(cmd) + 1, char); + strcpy(cmd2, cmd); + a = argv; + for (s = cmd2; *s;) { + while (*s && isspace(*s)) s++; + if (*s) + *(a++) = s; + while (*s && !isspace(*s)) s++; + if (*s) + *s++ = '\0'; + } + *a = Nullch; + if (argv[0]) + if ((status = spawnvp(P_WAIT,argv[0],argv)) == -1) { + Safefree(argv); + Safefree(cmd2); + goto doshell; + } + Safefree(cmd2); + Safefree(argv); + return status; + } + + usage(char *myname) + { + #ifdef MSDOS + printf("\nUsage: %s [-acdnpsSvw] [-Dnumber] [-i[extension]] [-Idirectory]" + #else + printf("\nUsage: %s [-acdnpPsSuUvw] [-Dnumber] [-i[extension]] [-Idirectory]" + #endif + "\n [-e \"command\"] [-x[directory]] [filename] [arguments]\n", myname); + + printf("\n -a autosplit mode with -n or -p" + "\n -c syntaxcheck only" + "\n -d run scripts under debugger" + "\n -n assume 'while (<>) { ...script... }' loop arround your script" + "\n -p assume loop like -n but print line also like sed" + #ifndef MSDOS + "\n -P run script through C preprocessor befor compilation" + #endif + "\n -s enable some switch parsing for switches after script name" + "\n -S look for the script using PATH environment variable"); + #ifndef MSDOS + printf("\n -u dump core after compiling the script" + "\n -U allow unsafe operations"); + #endif + printf("\n -v print version number and patchlevel of perl" + "\n -w turn warnings on for compilation of your script\n" + "\n -Dnumber set debugging flags" + "\n -i[extension] edit <> files in place (make backup if extension supplied)" + "\n -Idirectory specify include directory in conjunction with -P" + "\n -e command one line of script, multiple -e options are allowed" + "\n [filename] can be ommitted, when -e is used" + "\n -x[directory] strip off text before #!perl line and perhaps cd to directory\n"); + } Index: os2/perl.bad *** os2/perl.bad.old Tue Oct 16 11:55:47 1990 --- os2/perl.bad Tue Oct 16 11:55:51 1990 *************** *** 0 **** --- 1,6 ---- + DOSMAKEPIPE + DOSCWAIT + DOSKILLPROCESS + DOSFLAGPROCESS + DOSSETPRTY + DOSGETPRTY Index: os2/perl.cs *** os2/perl.cs.old Tue Oct 16 11:55:55 1990 --- os2/perl.cs Tue Oct 16 11:55:57 1990 *************** *** 0 **** --- 1,13 ---- + (-W1 -Od -Olt -DDEBUGGING -Gt2048 + array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c form.c + hash.c perl.c perly.c regcomp.c regexec.c stab.c str.c util.c + ) + (-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c{evalargs.xc} toke.c) + (-W1 -Od -Olt os2.c popen.c mktemp.c director.c suffix.c) + + setargv.obj + perl.def + perl.bad + perl.exe + + -AL -LB -S0x9000 Index: os2/perl.def *** os2/perl.def.old Tue Oct 16 11:56:02 1990 --- os2/perl.def Tue Oct 16 11:56:05 1990 *************** *** 0 **** --- 1,2 ---- + NAME PERL WINDOWCOMPAT NEWFILES + DESCRIPTION 'PERL 3.0, patchlevel 28 - for MS-DOS and OS/2' Index: perl.h Prereq: 3.0.1.8 *** perl.h.old Tue Oct 16 11:56:59 1990 --- perl.h Tue Oct 16 11:57:07 1990 *************** *** 1,4 **** ! /* $Header: perl.h,v 3.0.1.8 90/08/09 04:10:53 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: perl.h,v 3.0.1.9 90/10/15 17:59:41 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perl.h,v $ + * Revision 3.0.1.9 90/10/15 17:59:41 lwall + * patch29: some machines didn't like unsigned C preprocessor values + * * Revision 3.0.1.8 90/08/09 04:10:53 lwall * patch19: various MSDOS and OS/2 patches folded in * patch19: did preliminary work toward debugging packages and evals *************** *** 76,81 **** --- 79,86 ---- */ #define BINARY /**/ + #define I_FCNTL + #else /* !MSDOS */ /* *************** *** 156,162 **** --- 161,169 ---- #include <stdio.h> #include <ctype.h> #include <setjmp.h> + #ifndef MSDOS #include <sys/param.h> /* if this needs types.h we're still wrong */ + #endif #ifndef _TYPES_ /* If types.h defines this it's easy. */ #ifndef major /* Does everyone's types.h define this? */ *************** *** 184,190 **** --- 191,199 ---- # endif #endif + #ifndef MSDOS #include <sys/times.h> + #endif #if defined(STRERROR) && (!defined(MKDIR) || !defined(RMDIR)) #undef STRERROR *************** *** 191,199 **** --- 200,210 ---- #endif #include <errno.h> + #ifndef MSDOS #ifndef errno extern int errno; /* ANSI allows errno to be an lvalue expr */ #endif + #endif #ifdef STRERROR char *strerror(); *************** *** 288,293 **** --- 299,305 ---- typedef struct regexp REGEXP; typedef struct stabptrs STBP; typedef struct stab STAB; + typedef struct callsave CSV; #include "handy.h" #include "regexp.h" *************** *** 396,402 **** #define NTOHS #endif #ifndef HTONL ! #if (BYTEORDER != 0x4321) && (BYTEORDER != 0x87654321) #define HTONS #define HTONL #define NTOHS --- 408,414 ---- #define NTOHS #endif #ifndef HTONL ! #if (BYTEORDER & 0xffff) != 0x4321 #define HTONS #define HTONL #define NTOHS *************** *** 408,414 **** #define ntohl my_ntohl #endif #else ! #if (BYTEORDER == 0x4321) || (BYTEORDER == 0x87654321) #undef HTONS #undef HTONL #undef NTOHS --- 420,426 ---- #define ntohl my_ntohl #endif #else ! #if (BYTEORDER & 0xffff) == 0x4321 #undef HTONS #undef HTONL #undef NTOHS *************** *** 525,533 **** EXT int arybase INIT(0); struct outrec { ! line_t o_lines; ! char *o_str; ! int o_len; }; EXT struct outrec outrec; --- 537,545 ---- EXT int arybase INIT(0); struct outrec { ! long o_lines; ! char *o_str; ! int o_len; }; EXT struct outrec outrec; *************** *** 547,552 **** --- 559,565 ---- EXT STAB *amperstab INIT(Nullstab); EXT STAB *rightstab INIT(Nullstab); EXT STAB *DBstab INIT(Nullstab); + EXT STAB *DBline INIT(Nullstab); EXT STAB *DBsub INIT(Nullstab); EXT HASH *defstash; /* main symbol table */ *************** *** 558,569 **** EXT STR *freestrroot INIT(Nullstr); EXT STR *lastretstr INIT(Nullstr); EXT STR *DBsingle INIT(Nullstr); EXT int lastspbase; EXT int lastsize; - EXT char *curpack; - EXT char *filename; EXT char *origfilename; EXT FILE * VOLATILE rsfp; EXT char buf[1024]; --- 571,582 ---- EXT STR *freestrroot INIT(Nullstr); EXT STR *lastretstr INIT(Nullstr); EXT STR *DBsingle INIT(Nullstr); + EXT STR *DBtrace INIT(Nullstr); + EXT STR *DBsignal INIT(Nullstr); EXT int lastspbase; EXT int lastsize; EXT char *origfilename; EXT FILE * VOLATILE rsfp; EXT char buf[1024]; *************** *** 637,643 **** --- 650,658 ---- EXT struct stat statcache; STAB *statstab INIT(Nullstab); STR *statname; + #ifndef MSDOS EXT struct tms timesbuf; + #endif EXT int uid; EXT int euid; EXT int gid; *************** *** 692,699 **** EXT ARRAY *tosave; /* strings to save on recursive subroutine */ EXT ARRAY *lineary; /* lines of script for debugger */ ! EXT ARRAY *pidstatary; /* keep pids and statuses by fd for mypopen */ EXT int *di; /* for tmp use in debuggers */ EXT char *dc; --- 707,716 ---- EXT ARRAY *tosave; /* strings to save on recursive subroutine */ EXT ARRAY *lineary; /* lines of script for debugger */ + EXT ARRAY *dbargs; /* args to call listed by caller function */ ! EXT ARRAY *fdpid; /* keep fd-to-pid mappings for mypopen */ ! EXT HASH *pidstatus; /* keep pid-to-status mappings for waitpid */ EXT int *di; /* for tmp use in debuggers */ EXT char *dc; *************** *** 701,706 **** --- 718,724 ---- double atof(); long time(); + EXT long basetime INIT(0); struct tm *gmtime(), *localtime(); char *mktemp(); char *index(), *rindex(); Index: perl.y Prereq: 3.0.1.8 *** perl.y.old Tue Oct 16 11:57:23 1990 --- perl.y Tue Oct 16 11:57:29 1990 *************** *** 1,4 **** ! /* $Header: perl.y,v 3.0.1.8 90/08/13 22:19:55 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: perl.y,v 3.0.1.9 90/10/15 18:01:45 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,16 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perl.y,v $ + * Revision 3.0.1.9 90/10/15 18:01:45 lwall + * patch29: added SysV IPC + * patch29: package behavior is now more consistent + * patch29: index and substr now have optional 3rd args + * * Revision 3.0.1.8 90/08/13 22:19:55 lwall * patch28: lowercase unquoted strings caused infinite loop * *************** *** 71,79 **** %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST %token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25 ! %token <ival> FUNC0 FUNC1 FUNC2 FUNC3 HSHFUN HSHFUN3 %token <ival> FLIST2 SUB FILETEST LOCAL DELETE ! %token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER LFUNC4 %token <formval> FORMLIST %token <stabval> REG ARYLEN ARY HSH STAR %token <arg> SUBST PATTERN --- 76,84 ---- %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST %token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25 ! %token <ival> FUNC0 FUNC1 FUNC2 FUNC2x FUNC3 FUNC4 FUNC5 HSHFUN HSHFUN3 %token <ival> FLIST2 SUB FILETEST LOCAL DELETE ! %token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER %token <formval> FORMLIST %token <stabval> REG ARYLEN ARY HSH STAR %token <arg> SUBST PATTERN *************** *** 346,354 **** sprintf(tmpbuf,"'_%s",$2); tmpstab = hadd(stabent(tmpbuf,TRUE)); curstash = stab_xhash(tmpstab); ! curpack = stab_name(tmpstab); curstash->tbl_coeffsize = 0; Safefree($2); } ; --- 351,361 ---- sprintf(tmpbuf,"'_%s",$2); tmpstab = hadd(stabent(tmpbuf,TRUE)); curstash = stab_xhash(tmpstab); ! if (!curstash->tbl_name) ! curstash->tbl_name = savestr($2); curstash->tbl_coeffsize = 0; Safefree($2); + cmdline = NOLINE; } ; *************** *** 473,480 **** | '(' ')' { $$ = make_list(Nullarg); } | DO sexpr %prec FILETEST ! { $$ = fixeval( ! make_op(O_DOFILE,2,$2,Nullarg,Nullarg) ); allstabs = TRUE;} | DO block %prec '(' { $$ = cmd_to_arg($2); } --- 480,486 ---- | '(' ')' { $$ = make_list(Nullarg); } | DO sexpr %prec FILETEST ! { $$ = make_op(O_DOFILE,2,$2,Nullarg,Nullarg); allstabs = TRUE;} | DO block %prec '(' { $$ = cmd_to_arg($2); } *************** *** 584,596 **** { $$ = make_op($1,1,cval_to_arg($2), Nullarg,Nullarg); } | UNIOP ! { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); ! if ($1 == O_EVAL || $1 == O_RESET || $1 == O_REQUIRE) ! $$ = fixeval($$); } | UNIOP sexpr ! { $$ = make_op($1,1,$2,Nullarg,Nullarg); ! if ($1 == O_EVAL || $1 == O_RESET || $1 == O_REQUIRE) ! $$ = fixeval($$); } | SSELECT { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);} | SSELECT '(' handle ')' --- 590,598 ---- { $$ = make_op($1,1,cval_to_arg($2), Nullarg,Nullarg); } | UNIOP ! { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); } | UNIOP sexpr ! { $$ = make_op($1,1,$2,Nullarg,Nullarg); } | SSELECT { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);} | SSELECT '(' handle ')' *************** *** 696,716 **** | FUNC0 '(' ')' { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); } | FUNC1 '(' ')' ! { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); ! if ($1 == O_EVAL || $1 == O_RESET || $1 == O_REQUIRE) ! $$ = fixeval($$); } | FUNC1 '(' expr ')' ! { $$ = make_op($1, 1, $3, Nullarg, Nullarg); ! if ($1 == O_EVAL || $1 == O_RESET || $1 == O_REQUIRE) ! $$ = fixeval($$); } | FUNC2 '(' sexpr cexpr ')' { $$ = make_op($1, 2, $3, $4, Nullarg); if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE) fbmcompile($$[2].arg_ptr.arg_str,0); } | FUNC3 '(' sexpr csexpr cexpr ')' { $$ = make_op($1, 3, $3, $4, $5); } ! | LFUNC4 '(' sexpr csexpr csexpr cexpr ')' ! { arg4 = $6; $$ = make_op($1, 4, l($3), $4, $5); } | HSHFUN '(' hshword ')' { $$ = make_op($1, 1, $3, --- 698,726 ---- | FUNC0 '(' ')' { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); } | FUNC1 '(' ')' ! { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); } | FUNC1 '(' expr ')' ! { $$ = make_op($1, 1, $3, Nullarg, Nullarg); } | FUNC2 '(' sexpr cexpr ')' { $$ = make_op($1, 2, $3, $4, Nullarg); if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE) fbmcompile($$[2].arg_ptr.arg_str,0); } + | FUNC2x '(' sexpr csexpr ')' + { $$ = make_op($1, 2, $3, $4, Nullarg); + if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE) + fbmcompile($$[2].arg_ptr.arg_str,0); } + | FUNC2x '(' sexpr csexpr cexpr ')' + { $$ = make_op($1, 3, $3, $4, $5); + if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE) + fbmcompile($$[2].arg_ptr.arg_str,0); } | FUNC3 '(' sexpr csexpr cexpr ')' { $$ = make_op($1, 3, $3, $4, $5); } ! | FUNC4 '(' sexpr csexpr csexpr cexpr ')' ! { arg4 = $6; ! $$ = make_op($1, 4, $3, $4, $5); } ! | FUNC5 '(' sexpr csexpr csexpr csexpr cexpr ')' ! { arg4 = $6; arg5 = $7; ! $$ = make_op($1, 5, $3, $4, $5); } | HSHFUN '(' hshword ')' { $$ = make_op($1, 1, $3, Index: malloc.c Prereq: 3.0.1.2 *** malloc.c.old Tue Oct 16 15:28:16 1990 --- malloc.c Tue Oct 16 15:28:17 1990 *************** *** 1,6 **** ! /* $Header: malloc.c,v 3.0.1.2 89/11/11 04:36:37 lwall Locked $ * * $Log: malloc.c,v $ * Revision 3.0.1.2 89/11/11 04:36:37 lwall * patch2: malloc pointer corruption check made more portable * --- 1,9 ---- ! /* $Header: malloc.c,v 3.0.1.3 90/10/16 15:27:47 lwall Locked $ * * $Log: malloc.c,v $ + * Revision 3.0.1.3 90/10/16 15:27:47 lwall + * patch29: various portability fixes + * * Revision 3.0.1.2 89/11/11 04:36:37 lwall * patch2: malloc pointer corruption check made more portable * *************** *** 53,59 **** */ union overhead { union overhead *ov_next; /* when free */ ! #if defined (mips) || defined (sparc) double strut; /* alignment problems */ #endif struct { --- 56,62 ---- */ union overhead { union overhead *ov_next; /* when free */ ! #if defined(mips) || defined(sparc) || defined(luna88k) double strut; /* alignment problems */ #endif struct { *** End of Patch 32 ***