Xref: utzoo comp.sources.bugs:2604 comp.lang.perl:2595 Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!wuarchive!usc!elroy.jpl.nasa.gov!jpl-devvax!lwall From: lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) Newsgroups: comp.sources.bugs,comp.lang.perl Subject: perl 3.0 patch #32 Summary: This is an official patch for perl 3.0. Please apply it. Message-ID: <10003@jpl-devvax.JPL.NASA.GOV> Date: 17 Oct 90 16:55:25 GMT Organization: Jet Propulsion Laboratory, Pasadena, CA Lines: 1884 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 #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 () { + 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 () { + 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 () { + chop; + unless (shmwrite($id, pack("La*", length($_), $_), 0, $SIZE)) { + die "Can't write to shared memory: $!\n"; + } + } + } + else { + $SIG{'INT'} = $SIG{'QUIT'} = "leave"; + for (;;) { + $_ = ; + 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 + #include + #include + #include + + 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 <) { $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 + + /* + * Various Unix compatibility functions for OS/2 + */ + + #include + #include + #include + + #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 #include #include + #ifndef MSDOS #include /* 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 + #endif #if defined(STRERROR) && (!defined(MKDIR) || !defined(RMDIR)) #undef STRERROR *************** *** 191,199 **** --- 200,210 ---- #endif #include + #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 USING FORMAT DO SHIFT PUSH POP LVALFUN %token WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST %token FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25 ! %token FUNC0 FUNC1 FUNC2 FUNC3 HSHFUN HSHFUN3 %token FLIST2 SUB FILETEST LOCAL DELETE ! %token RELOP EQOP MULOP ADDOP PACKAGE AMPER LFUNC4 %token FORMLIST %token REG ARYLEN ARY HSH STAR %token SUBST PATTERN --- 76,84 ---- %token USING FORMAT DO SHIFT PUSH POP LVALFUN %token WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST %token FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25 ! %token FUNC0 FUNC1 FUNC2 FUNC2x FUNC3 FUNC4 FUNC5 HSHFUN HSHFUN3 %token FLIST2 SUB FILETEST LOCAL DELETE ! %token RELOP EQOP MULOP ADDOP PACKAGE AMPER %token FORMLIST %token REG ARYLEN ARY HSH STAR %token 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 ***