lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (10/17/90)
System: perl version 3.0 Patch #: 30 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: 29 1c1 < #define PATCHLEVEL 29 --- > #define PATCHLEVEL 30 Index: os2/a2p.cs *** os2/a2p.cs.old Tue Oct 16 11:54:09 1990 --- os2/a2p.cs Tue Oct 16 11:54:11 1990 *************** *** 0 **** --- 1,8 ---- + (-W1 -Od -Ocgelt a2p.y{a2py.c}) + (-W1 -Od -Ocgelt hash.c str.c util.c walk.c) + + setargv.obj + a2p.def + a2p.exe + + -AL -LB -S0xA000 Index: os2/a2p.def *** os2/a2p.def.old Tue Oct 16 11:54:18 1990 --- os2/a2p.def Tue Oct 16 11:54:25 1990 *************** *** 0 **** --- 1,2 ---- + NAME AWK2PERL WINDOWCOMPAT NEWFILES + DESCRIPTION 'AWK to PERL translator - for MS-DOS and OS/2' Index: x2p/a2py.c Prereq: 3.0.1.1 *** x2p/a2py.c.old Tue Oct 16 12:06:17 1990 --- x2p/a2py.c Tue Oct 16 12:06:25 1990 *************** *** 1,4 **** ! /* $Header: a2py.c,v 3.0.1.1 90/08/09 05:48:53 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: a2py.c,v 3.0.1.2 90/10/16 11:30:34 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: a2py.c,v $ + * Revision 3.0.1.2 90/10/16 11:30:34 lwall + * patch29: various portability fixes + * * Revision 3.0.1.1 90/08/09 05:48:53 lwall * patch19: a2p didn't emit a chop when NF was referenced though split needs it * *************** *** 14,27 **** --- 17,49 ---- * */ + #ifdef MSDOS + #include "../patchlev.h" + #endif #include "util.h" char *index(); char *filename; + char *myname; int checkers = 0; STR *walk(); + #ifdef MSDOS + usage() + { + printf("\nThis is the AWK to PERL translator, version 3.0, patchlevel %d\n", PATCHLEVEL); + printf("\nUsage: %s [-D<number>] [-F<char>] [-n<fieldlist>] [-<number>] filename\n", myname); + printf("\n -D<number> sets debugging flags." + "\n -F<character> the awk script to translate is always invoked with" + "\n this -F switch." + "\n -n<fieldlist> specifies the names of the input fields if input does" + "\n not have to be split into an array." + "\n -<number> causes a2p to assume that input will always have that" + "\n many fields.\n"); + exit(1); + } + #endif main(argc,argv,env) register int argc; register char **argv; *************** *** 32,37 **** --- 54,60 ---- int i; STR *tmpstr; + myname = argv[0]; linestr = str_new(80); str = str_new(0); /* first used for -I flags */ for (argc--,argv++; argc; argc--,argv++) { *************** *** 65,70 **** --- 88,96 ---- break; default: fatal("Unrecognized switch: %s\n",argv[0]); + #ifdef MSDOS + usage(); + #endif } } switch_end: *************** *** 71,79 **** /* open script */ ! if (argv[0] == Nullch) ! argv[0] = "-"; filename = savestr(argv[0]); if (strEQ(filename,"-")) argv[0] = ""; if (!*argv[0]) --- 97,112 ---- /* open script */ ! if (argv[0] == Nullch) { ! #ifdef MSDOS ! if ( isatty(fileno(stdin)) ) ! usage(); ! #endif ! argv[0] = "-"; ! } filename = savestr(argv[0]); + + filename = savestr(argv[0]); if (strEQ(filename,"-")) argv[0] = ""; if (!*argv[0]) *************** *** 1207,1213 **** } else fatal("panic: unknown argument type %d, arg %d, line %d\n", ! type,numargs+1,line); return numargs; } --- 1240,1246 ---- } else fatal("panic: unknown argument type %d, arg %d, line %d\n", ! type,prevargs+1,line); return numargs; } Index: arg.h Prereq: 3.0.1.6 *** arg.h.old Tue Oct 16 11:45:17 1990 --- arg.h Tue Oct 16 11:45:20 1990 *************** *** 1,4 **** ! /* $Header: arg.h,v 3.0.1.6 90/08/09 02:25:14 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: arg.h,v 3.0.1.7 90/10/15 14:53:59 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,23 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: arg.h,v $ + * Revision 3.0.1.7 90/10/15 14:53:59 lwall + * patch29: added SysV IPC + * patch29: added waitpid + * patch29: added cmp and <=> + * patch29: added caller + * patch29: added scalar + * patch29: added sysread and syswrite + * patch29: added -M, -A and -C + * patch29: index and substr now have optional 3rd args + * patch29: you can now read into the middle string + * patch29: various portability fixes + * * Revision 3.0.1.6 90/08/09 02:25:14 lwall * patch19: added require operator * patch19: added truncate operator *************** *** 123,129 **** #define O_EACH 89 #define O_CHOP 90 #define O_FORK 91 ! #define O_EXEC 92 #define O_SYSTEM 93 #define O_OCT 94 #define O_HEX 95 --- 135,141 ---- #define O_EACH 89 #define O_CHOP 90 #define O_FORK 91 ! #define O_EXEC_OP 92 #define O_SYSTEM 93 #define O_OCT 94 #define O_HEX 95 *************** *** 277,283 **** #define O_BINMODE 243 #define O_REQUIRE 244 #define O_TRUNCATE 245 ! #define MAXO 246 #ifndef DOINIT extern char *opname[]; --- 289,316 ---- #define O_BINMODE 243 #define O_REQUIRE 244 #define O_TRUNCATE 245 ! #define O_MSGGET 246 ! #define O_MSGCTL 247 ! #define O_MSGSND 248 ! #define O_MSGRCV 249 ! #define O_SEMGET 250 ! #define O_SEMCTL 251 ! #define O_SEMOP 252 ! #define O_SHMGET 253 ! #define O_SHMCTL 254 ! #define O_SHMREAD 255 ! #define O_SHMWRITE 256 ! #define O_NCMP 257 ! #define O_SCMP 258 ! #define O_CALLER 259 ! #define O_SCALAR 260 ! #define O_SYSREAD 261 ! #define O_SYSWRITE 262 ! #define O_FTMTIME 263 ! #define O_FTATIME 264 ! #define O_FTCTIME 265 ! #define O_WAITPID 266 ! #define MAXO 267 #ifndef DOINIT extern char *opname[]; *************** *** 529,535 **** "BINMODE", "REQUIRE", "TRUNCATE", ! "245" }; #endif --- 562,589 ---- "BINMODE", "REQUIRE", "TRUNCATE", ! "MSGGET", ! "MSGCTL", ! "MSGSND", ! "MSGRCV", ! "SEMGET", ! "SEMCTL", ! "SEMOP", ! "SHMGET", ! "SHMCTL", ! "SHMREAD", ! "SHMWRITE", ! "NCMP", ! "SCMP", ! "CALLER", ! "SCALAR", ! "SYSREAD", ! "SYSWRITE", ! "FTMTIME", ! "FTATIME", ! "FTCTIME", ! "WAITPID", ! "264" }; #endif *************** *** 629,639 **** struct arg { union argptr arg_ptr; short arg_len; ! #ifdef mips ! short pad; ! #endif ! unsigned char arg_type; ! unsigned char arg_flags; }; #define AF_ARYOK 1 /* op can handle multiple values here */ --- 683,690 ---- struct arg { union argptr arg_ptr; short arg_len; ! unsigned short arg_type; ! unsigned short arg_flags; }; #define AF_ARYOK 1 /* op can handle multiple values here */ *************** *** 658,667 **** #define Nullarg Null(ARG*) #ifndef DOINIT ! EXT char opargs[MAXO+1]; #else ! #define A(e1,e2,e3) (e1+(e2<<2)+(e3<<4)) ! char opargs[MAXO+1] = { A(0,0,0), /* NULL */ A(1,0,0), /* ITEM */ A(0,0,0), /* ITEM2 */ --- 709,719 ---- #define Nullarg Null(ARG*) #ifndef DOINIT ! EXT unsigned short opargs[MAXO+1]; #else ! #define A(e1,e2,e3) (e1+(e2<<2)+(e3<<4)) ! #define A5(e1,e2,e3,e4,e5) (e1+(e2<<2)+(e3<<4)+(e4<<6)+(e5<<8)) ! unsigned short opargs[MAXO+1] = { A(0,0,0), /* NULL */ A(1,0,0), /* ITEM */ A(0,0,0), /* ITEM2 */ *************** *** 733,739 **** A(0,0,0), /* NEXT */ A(0,0,0), /* REDO */ A(0,0,0), /* GOTO */ ! A(1,1,0), /* INDEX */ A(0,0,0), /* TIME */ A(0,0,0), /* TIMES */ A(1,0,0), /* LOCALTIME */ --- 785,791 ---- A(0,0,0), /* NEXT */ A(0,0,0), /* REDO */ A(0,0,0), /* GOTO */ ! A(1,1,1), /* INDEX */ A(0,0,0), /* TIME */ A(0,0,0), /* TIMES */ A(1,0,0), /* LOCALTIME */ *************** *** 818,827 **** A(1,1,1), /* IOCTL */ A(1,1,1), /* FCNTL */ A(1,1,0), /* FLOCK */ ! A(1,1,0), /* RINDEX */ A(1,3,0), /* PACK */ A(1,1,0), /* UNPACK */ ! A(1,1,1), /* READ */ A(0,3,0), /* WARN */ A(1,1,1), /* DBMOPEN */ A(1,0,0), /* DBMCLOSE */ --- 870,879 ---- A(1,1,1), /* IOCTL */ A(1,1,1), /* FCNTL */ A(1,1,0), /* FLOCK */ ! A(1,1,1), /* RINDEX */ A(1,3,0), /* PACK */ A(1,1,0), /* UNPACK */ ! A(1,1,3), /* READ */ A(0,3,0), /* WARN */ A(1,1,1), /* DBMOPEN */ A(1,0,0), /* DBMCLOSE */ *************** *** 843,849 **** A(1,1,0), /* LISTEN */ A(1,1,0), /* ACCEPT */ A(1,1,3), /* SEND */ ! A(1,1,1), /* RECV */ A(1,1,1), /* SSELECT */ A(1,1,1), /* SOCKPAIR */ A(0,3,0), /* DBSUBR */ --- 895,901 ---- A(1,1,0), /* LISTEN */ A(1,1,0), /* ACCEPT */ A(1,1,3), /* SEND */ ! A(1,1,3), /* RECV */ A(1,1,1), /* SSELECT */ A(1,1,1), /* SOCKPAIR */ A(0,3,0), /* DBSUBR */ *************** *** 908,916 **** --- 960,990 ---- A(1,0,0), /* BINMODE */ A(1,0,0), /* REQUIRE */ A(1,1,0), /* TRUNCATE */ + A(1,1,0), /* MSGGET */ + A(1,1,1), /* MSGCTL */ + A(1,1,1), /* MSGSND */ + A5(1,1,1,1,1), /* MSGRCV */ + A(1,1,1), /* SEMGET */ + A5(1,1,1,1,0), /* SEMCTL */ + A(1,1,1), /* SEMOP */ + A(1,1,1), /* SHMGET */ + A(1,1,1), /* SHMCTL */ + A5(1,1,1,1,0), /* SHMREAD */ + A5(1,1,1,1,0), /* SHMWRITE */ + A(1,1,0), /* NCMP */ + A(1,1,0), /* SCMP */ + A(1,0,0), /* CALLER */ + A(1,0,0), /* SCALAR */ + A(1,1,3), /* SYSREAD */ + A(1,1,3), /* SYSWRITE */ + A(1,0,0), /* FTMTIME */ + A(1,0,0), /* FTATIME */ + A(1,0,0), /* FTCTIME */ + A(1,1,0), /* WAITPID */ 0 }; #undef A + #undef A5 #endif int do_trans(); Index: array.c Prereq: 3.0.1.2 *** array.c.old Tue Oct 16 11:45:29 1990 --- array.c Tue Oct 16 11:45:31 1990 *************** *** 1,4 **** ! /* $Header: array.c,v 3.0.1.2 90/08/13 21:52:20 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: array.c,v 3.0.1.3 90/10/15 14:56:17 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: array.c,v $ + * Revision 3.0.1.3 90/10/15 14:56:17 lwall + * patch29: non-existent array values no longer cause core dumps + * * Revision 3.0.1.2 90/08/13 21:52:20 lwall * patch28: defined(@array) and defined(%array) didn't work right * *************** *** 38,49 **** return str; } else ! return Nullstr; } ! if (lval && !ar->ary_array[key]) { ! str = Str_new(6,0); ! (void)astore(ar,key,str); ! return str; } return ar->ary_array[key]; } --- 41,55 ---- return str; } else ! return &str_undef; } ! if (!ar->ary_array[key]) { ! if (lval) { ! str = Str_new(6,0); ! (void)astore(ar,key,str); ! return str; ! } ! return &str_undef; } return ar->ary_array[key]; } Index: lib/cacheout.pl *** lib/cacheout.pl.old Tue Oct 16 11:53:23 1990 --- lib/cacheout.pl Tue Oct 16 11:53:26 1990 *************** *** 0 **** --- 1,44 ---- + #!/usr/bin/perl + + # Open in their package. + + sub cacheout'open { + open($_[0], $_[1]); + } + + # But only this sub name is visible to them. + + sub cacheout { + package cacheout; + + ($file) = @_; + ($package) = caller; + if (!$isopen{$file}) { + if (++$numopen > $maxopen) { + sub byseq {$isopen{$a} != $isopen{$b};} + local(@lru) = sort byseq keys(%isopen); + splice(@lru, $maxopen / 3); + $numopen -= @lru; + for (@lru) { close $_; delete $isopen{$_}; } + } + &open($file, ($saw{$file}++ ? '>>' : '>') . $file) + || die "Can't create $file: $!\n"; + } + $isopen{$file} = ++$seq; + } + + package cacheout; + + $seq = 0; + $numopen = 0; + + if (open(PARAM,'/usr/include/sys/param.h')) { + local($.); + while (<PARAM>) { + $maxopen = $1 - 4 if /^#define NOFILE\s+(\d+)/; + } + close PARAM; + } + $maxopen = 16 unless $maxopen; + + 1; Index: cmd.c Prereq: 3.0.1.8 *** cmd.c.old Tue Oct 16 11:45:50 1990 --- cmd.c Tue Oct 16 11:45:59 1990 *************** *** 1,4 **** ! /* $Header: cmd.c,v 3.0.1.8 90/08/09 02:28:49 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: cmd.c,v 3.0.1.9 90/10/15 15:32:39 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: cmd.c,v $ + * Revision 3.0.1.9 90/10/15 15:32:39 lwall + * patch29: non-existent array values no longer cause core dumps + * patch29: scripts now run at almost full speed under the debugger + * patch29: @ENV = () now works + * patch29: added caller + * * Revision 3.0.1.8 90/08/09 02:28:49 lwall * patch19: did preliminary work toward debugging packages and evals * patch19: conditionals now always supply a scalar context to expression *************** *** 600,611 **** } else { match++; ! retstr = stab_val(cmd->c_stab) = ar->ary_array[match]; cmd->c_short->str_u.str_useful = match; match = TRUE; } newsp = -2; goto maybe; } /* we have tried to make this normal case as abnormal as possible */ --- 606,629 ---- } else { match++; ! if (!(retstr = ar->ary_array[match])) ! retstr = afetch(ar,match,TRUE); ! stab_val(cmd->c_stab) = retstr; cmd->c_short->str_u.str_useful = match; match = TRUE; } newsp = -2; goto maybe; + case CFT_D1: + break; + case CFT_D0: + if (DBsingle->str_u.str_nval != 0) + break; + if (DBsignal->str_u.str_nval != 0) + break; + if (DBtrace->str_u.str_nval != 0) + break; + goto next_cmd; } /* we have tried to make this normal case as abnormal as possible */ *************** *** 1130,1136 **** break; case SS_SHASH: /* hash reference */ stab = value->str_u.str_stab; ! (void)hfree(stab_xhash(stab)); stab_xhash(stab) = (HASH*)value->str_ptr; value->str_ptr = Nullch; str_free(value); --- 1148,1154 ---- break; case SS_SHASH: /* hash reference */ stab = value->str_u.str_stab; ! (void)hfree(stab_xhash(stab), FALSE); stab_xhash(stab) = (HASH*)value->str_ptr; value->str_ptr = Nullch; str_free(value); *************** *** 1161,1166 **** --- 1179,1198 ---- value->str_magic = Nullstr; (void)stab_clear(stab); str_free(value); + break; + case SS_SCSV: /* callsave structure */ + { + CSV *csv = (CSV*) value->str_ptr; + + curcmd = csv->curcmd; + curcsv = csv->curcsv; + csv->sub->depth = csv->depth; + if (csv->hasargs) { /* put back old @_ */ + afree(csv->argarray); + stab_xarray(defstab) = csv->savearray; + } + str_free(value); + } break; default: fatal("panic: restorelist inconsistency"); Index: cmd.h Prereq: 3.0.1.3 *** cmd.h.old Tue Oct 16 11:46:11 1990 --- cmd.h Tue Oct 16 11:46:14 1990 *************** *** 1,4 **** ! /* $Header: cmd.h,v 3.0.1.3 90/08/09 02:29:58 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: cmd.h,v 3.0.1.4 90/10/15 15:34:50 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: cmd.h,v $ + * Revision 3.0.1.4 90/10/15 15:34:50 lwall + * patch29: scripts now run at almost full speed under the debugger + * patch29: added caller + * * Revision 3.0.1.3 90/08/09 02:29:58 lwall * patch19: did preliminary work toward debugging packages and evals * *************** *** 78,83 **** --- 82,89 ---- #define CFT_INDGETS 11 /* c_expr is <$variable> */ #define CFT_NUMOP 12 /* c_expr is a numeric comparison */ #define CFT_CCLASS 13 /* c_expr must start with one of these characters */ + #define CFT_D0 14 /* no special breakpoint at this line */ + #define CFT_D1 15 /* possible special breakpoint at this line */ #ifdef DEBUGGING #ifndef DOINIT *************** *** 134,146 **** } ucmd; short c_slen; /* len of c_short, if not null */ VOLATILE short c_flags; /* optimization flags--see above */ ! char *c_pack; /* package line was compiled in */ ! char *c_file; /* file the following line # is from */ line_t c_line; /* line # of this command */ char c_type; /* what this command does */ }; #define Nullcmd Null(CMD*) EXT CMD * VOLATILE main_root INIT(Nullcmd); EXT CMD * VOLATILE eval_root INIT(Nullcmd); --- 140,153 ---- } ucmd; short c_slen; /* len of c_short, if not null */ VOLATILE short c_flags; /* optimization flags--see above */ ! HASH *c_stash; /* package line was compiled in */ ! STAB *c_filestab; /* file the following line # is from */ line_t c_line; /* line # of this command */ char c_type; /* what this command does */ }; #define Nullcmd Null(CMD*) + #define Nullcsv Null(CSV*) EXT CMD * VOLATILE main_root INIT(Nullcmd); EXT CMD * VOLATILE eval_root INIT(Nullcmd); *************** *** 147,152 **** --- 154,172 ---- EXT CMD compiling; EXT CMD * VOLATILE curcmd INIT(&compiling); + EXT CSV * VOLATILE curcsv INIT(Nullcsv); + + struct callsave { + SUBR *sub; + STAB *stab; + CSV *curcsv; + CMD *curcmd; + ARRAY *savearray; + ARRAY *argarray; + long depth; + int wantarray; + char hasargs; + }; struct compcmd { CMD *comp_true; Index: t/cmd.subval Prereq: 3.0 *** t/cmd.subval.old Tue Oct 16 12:03:56 1990 --- t/cmd.subval Tue Oct 16 12:03:58 1990 *************** *** 1,6 **** #!./perl ! # $Header: cmd.subval,v 3.0 89/10/18 15:24:52 lwall Locked $ sub foo1 { 'true1'; --- 1,6 ---- #!./perl ! # $Header: cmd.subval,v 3.0.1.1 90/10/16 10:46:53 lwall Locked $ sub foo1 { 'true1'; *************** *** 33,39 **** 'true2' unless $_[0]; } ! print "1..26\n"; if (do foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";} if (do foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";} --- 33,39 ---- 'true2' unless $_[0]; } ! print "1..34\n"; if (do foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";} if (do foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";} *************** *** 99,101 **** --- 99,179 ---- $x = join(':',&ary2); print $x eq '1:2:3' ? "ok 26\n" : "not ok 26 $x\n"; + sub somesub { + local($num,$P,$F,$L) = @_; + ($p,$f,$l) = caller; + print "$p:$f:$l" eq "$P:$F:$L" ? "ok $num\n" : "not ok $num\n"; + } + + &somesub(27, 'main', __FILE__, __LINE__); + + package foo; + &main'somesub(28, 'foo', __FILE__, __LINE__); + + package main; + $i = 28; + open(FOO,">Cmd_subval.tmp"); + print FOO "blah blah\n"; + close FOO; + + &file_main(*F); + close F; + &info_main; + + &file_package(*F); + close F; + &info_package; + + unlink 'Cmd_subval.tmp'; + + sub file_main { + local(*F) = @_; + + open(F, 'Cmd_subval.tmp') || die "can't open\n"; + $i++; + eof F ? print "not ok $i\n" : print "ok $i\n"; + } + + sub info_main { + local(*F); + + open(F, 'Cmd_subval.tmp') || die "test: can't open\n"; + $i++; + eof F ? print "not ok $i\n" : print "ok $i\n"; + &iseof(*F); + close F; + } + + sub iseof { + local(*UNIQ) = @_; + + $i++; + eof UNIQ ? print "(not ok $i)\n" : print "ok $i\n"; + } + + {package foo; + + sub main'file_package { + local(*F) = @_; + + open(F, 'Cmd_subval.tmp') || die "can't open\n"; + $main'i++; + eof F ? print "not ok $main'i\n" : print "ok $main'i\n"; + } + + sub main'info_package { + local(*F); + + open(F, 'Cmd_subval.tmp') || die "can't open\n"; + $main'i++; + eof F ? print "not ok $main'i\n" : print "ok $main'i\n"; + &iseof(*F); + } + + sub iseof { + local(*UNIQ) = @_; + + $main'i++; + eof UNIQ ? print "not ok $main'i\n" : print "ok $main'i\n"; + } + } Index: os2/config.h *** os2/config.h.old Tue Oct 16 11:54:34 1990 --- os2/config.h Tue Oct 16 11:54:37 1990 *************** *** 14,20 **** #define GETPPID #define GETPRIORITY #define SETPRIORITY - #define SYSCALL #define KILL #endif /* OS2 */ --- 14,19 ---- *************** *** 435,441 **** * This symbol, if defined, indicates to the C program that it should * include fcntl.h. */ ! #define I_FCNTL /**/ /* I_GRP: * This symbol, if defined, indicates to the C program that it should --- 434,440 ---- * This symbol, if defined, indicates to the C program that it should * include fcntl.h. */ ! /*#define I_FCNTL /**/ /* I_GRP: * This symbol, if defined, indicates to the C program that it should *************** *** 545,551 **** * execution path, but it should be accessible by the world. The program * should be prepared to do ^ expansion. */ ! #define PRIVLIB "/usr/local/lib/perl" /**/ /* * BUGGY_MSC: --- 544,550 ---- * execution path, but it should be accessible by the world. The program * should be prepared to do ^ expansion. */ ! #define PRIVLIB "c:/bin/perl" /**/ /* * BUGGY_MSC: Index: config_h.SH *** config_h.SH.old Tue Oct 16 11:46:30 1990 --- config_h.SH Tue Oct 16 11:46:36 1990 *************** *** 421,426 **** --- 421,431 ---- */ #$d_syscall SYSCALL /**/ + /* SYSVIPC: + * This symbol, if defined, indicates that System V IPC exists. + */ + #$d_sysvipc SYSVIPC /**/ + /* TRUNCATE: * This symbol, if defined, indicates that the truncate routine is * available to truncate files. *************** *** 471,476 **** --- 476,486 ---- */ #$d_wait4 WAIT4 /**/ + /* WAITPID: + * This symbol, if defined, indicates that waitpid() exists. + */ + #$d_waitpid WAITPID /**/ + /* GIDTYPE: * This symbol has a value like gid_t, int, ushort, or whatever type is * used to declare group ids in the kernel. *************** *** 511,516 **** --- 521,530 ---- * This symbol, if defined, indicates to the C program that it should * include pwd.h. */ + /* PWCOMMENT: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_comment. + */ /* PWQUOTA: * This symbol, if defined, indicates to the C program that struct passwd * contains pw_quota. *************** *** 532,537 **** --- 546,552 ---- * contains pw_expire. */ #$i_pwd I_PWD /**/ + #$d_pwcomment PWCOMMENT /**/ #$d_pwquota PWQUOTA /**/ #$d_pwage PWAGE /**/ #$d_pwchange PWCHANGE /**/ Index: cons.c Prereq: 3.0.1.7 *** cons.c.old Tue Oct 16 11:47:07 1990 --- cons.c Tue Oct 16 11:47:17 1990 *************** *** 1,4 **** ! /* $Header: cons.c,v 3.0.1.7 90/08/09 02:35:52 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: cons.c,v 3.0.1.8 90/10/15 15:41:09 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: cons.c,v $ + * Revision 3.0.1.8 90/10/15 15:41:09 lwall + * patch29: added caller + * patch29: scripts now run at almost full speed under the debugger + * patch29: the debugger now understands packages and evals + * patch29: package behavior is now more consistent + * * Revision 3.0.1.7 90/08/09 02:35:52 lwall * patch19: did preliminary work toward debugging packages and evals * patch19: Added support for linked-in C subroutines *************** *** 76,82 **** } Safefree(stab_sub(stab)); } ! sub->filename = filename; saw_return = FALSE; tosave = anew(Nullstab); tosave->ary_fill = 0; /* make 1 based */ --- 82,88 ---- } Safefree(stab_sub(stab)); } ! sub->filestab = curcmd->c_filestab; saw_return = FALSE; tosave = anew(Nullstab); tosave->ary_fill = 0; /* make 1 based */ *************** *** 94,106 **** sub->cmd = cmd; stab_sub(stab) = sub; if (perldb) { ! STR *str = str_nmake((double)subline); str_cat(str,"-"); sprintf(buf,"%ld",(long)curcmd->c_line); str_cat(str,buf); name = str_get(subname); ! hstore(stab_xhash(DBsub),name,strlen(name),str,0); str_set(subname,"main"); } subline = 0; --- 100,117 ---- sub->cmd = cmd; stab_sub(stab) = sub; if (perldb) { ! STR *str; ! STR *tmpstr = str_static(&str_undef); + sprintf(buf,"%s:%ld",stab_val(curcmd->c_filestab)->str_ptr, + (long)subline); + str = str_make(buf,0); str_cat(str,"-"); sprintf(buf,"%ld",(long)curcmd->c_line); str_cat(str,buf); name = str_get(subname); ! stab_fullname(tmpstr,stab); ! hstore(stab_xhash(DBsub), tmpstr->str_ptr, tmpstr->str_cur, str, 0); str_set(subname,"main"); } subline = 0; *************** *** 129,135 **** } Safefree(stab_sub(stab)); } ! sub->filename = filename; sub->usersub = subaddr; sub->userindex = ix; stab_sub(stab) = sub; --- 140,146 ---- } Safefree(stab_sub(stab)); } ! sub->filestab = fstab(filename); sub->usersub = subaddr; sub->userindex = ix; stab_sub(stab) = sub; *************** *** 445,471 **** head = cur; if (!head->c_line) return cur; ! str = afetch(lineary,(int)head->c_line,FALSE); ! if (!str || str->str_nok) return cur; str->str_u.str_nval = (double)head->c_line; str->str_nok = 1; Newz(106,cmd,1,CMD); cmd->c_type = C_EXPR; cmd->ucmd.acmd.ac_stab = Nullstab; cmd->ucmd.acmd.ac_expr = Nullarg; ! arg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg); ! arg[1].arg_type = A_SINGLE; ! arg[1].arg_ptr.arg_str = str_nmake((double)head->c_line); ! cmd->c_expr = make_op(O_SUBR, 2, stab2arg(A_WORD,DBstab), ! make_list(arg), Nullarg); ! cmd->c_flags |= CF_COND|CF_DBSUB; cmd->c_line = head->c_line; cmd->c_label = head->c_label; ! cmd->c_file = filename; ! cmd->c_pack = curpack; return append_line(cmd, cur); } --- 456,481 ---- head = cur; if (!head->c_line) return cur; ! str = afetch(stab_xarray(curcmd->c_filestab),(int)head->c_line,FALSE); ! if (str == &str_undef || str->str_nok) return cur; str->str_u.str_nval = (double)head->c_line; str->str_nok = 1; Newz(106,cmd,1,CMD); + str_magic(str, curcmd->c_filestab, 0, Nullch, 0); + str->str_magic->str_u.str_cmd = cmd; cmd->c_type = C_EXPR; cmd->ucmd.acmd.ac_stab = Nullstab; cmd->ucmd.acmd.ac_expr = Nullarg; ! cmd->c_expr = make_op(O_SUBR, 1, stab2arg(A_WORD,DBstab), ! Nullarg, Nullarg); ! cmd->c_flags |= CF_COND|CF_DBSUB|CFT_D0; cmd->c_line = head->c_line; cmd->c_label = head->c_label; ! cmd->c_filestab = curcmd->c_filestab; ! cmd->c_stash = curstash; return append_line(cmd, cur); } *************** *** 491,498 **** cmd->c_line = cmdline; cmdline = NOLINE; } ! cmd->c_file = filename; ! cmd->c_pack = curpack; if (perldb) cmd = dodb(cmd); return cmd; --- 501,508 ---- cmd->c_line = cmdline; cmdline = NOLINE; } ! cmd->c_filestab = curcmd->c_filestab; ! cmd->c_stash = curstash; if (perldb) cmd = dodb(cmd); return cmd; *************** *** 519,524 **** --- 529,536 ---- cmd->c_line = cmdline; cmdline = NOLINE; } + cmd->c_filestab = curcmd->c_filestab; + cmd->c_stash = curstash; if (perldb) cmd = dodb(cmd); return cmd; *************** *** 550,555 **** --- 562,569 ---- cmd->c_line = cmdline; cmdline = NOLINE; } + cmd->c_filestab = curcmd->c_filestab; + cmd->c_stash = curstash; cur = cmd; alt = cblock.comp_alt; while (alt && alt->c_type == C_ELSIF) { *************** *** 939,945 **** else (void)sprintf(tname,"next char %c",yychar); (void)sprintf(buf, "%s in file %s at line %d, %s\n", ! s,filename,curcmd->c_line,tname); if (curcmd->c_line == multi_end && multi_start < multi_end) sprintf(buf+strlen(buf), " (Might be a runaway multi-line %c%c string starting on line %d)\n", --- 953,959 ---- else (void)sprintf(tname,"next char %c",yychar); (void)sprintf(buf, "%s in file %s at line %d, %s\n", ! s,stab_val(curcmd->c_filestab)->str_ptr,curcmd->c_line,tname); if (curcmd->c_line == multi_end && multi_start < multi_end) sprintf(buf+strlen(buf), " (Might be a runaway multi-line %c%c string starting on line %d)\n", *************** *** 949,955 **** else fputs(buf,stderr); if (++error_count >= 10) ! fatal("%s has too many errors.\n", filename); } void --- 963,970 ---- else fputs(buf,stderr); if (++error_count >= 10) ! fatal("%s has too many errors.\n", ! stab_val(curcmd->c_filestab)->str_ptr); } void Index: consarg.c Prereq: 3.0.1.6 *** consarg.c.old Tue Oct 16 11:47:40 1990 --- consarg.c Tue Oct 16 11:47:53 1990 *************** *** 1,4 **** ! /* $Header: consarg.c,v 3.0.1.6 90/08/09 02:38:51 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: consarg.c,v 3.0.1.7 90/10/15 15:55:28 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: consarg.c,v $ + * Revision 3.0.1.7 90/10/15 15:55:28 lwall + * patch29: defined @foo was behaving inconsistently + * patch29: -5 % 5 was wrong + * patch29: package behavior is now more consistent + * * Revision 3.0.1.6 90/08/09 02:38:51 lwall * patch19: fixed problem with % of negative number * *************** *** 92,97 **** --- 97,105 ---- register SPAT *spat; register ARG *newarg; + if (!pat) + return Nullarg; + if ((pat->arg_type == O_MATCH || pat->arg_type == O_SUBST || pat->arg_type == O_TRANS || *************** *** 156,172 **** { register ARG *arg; register ARG *chld; ! register int doarg; extern ARG *arg4; /* should be normal arguments, really */ extern ARG *arg5; arg = op_new(newlen); arg->arg_type = type; - doarg = opargs[type]; if (chld = arg1) { if (chld->arg_type == O_ITEM && ! (hoistable[chld[1].arg_type] || chld[1].arg_type == A_LVAL || ! (chld[1].arg_type == A_LEXPR && (chld[1].arg_ptr.arg_arg->arg_type == O_LIST || chld[1].arg_ptr.arg_arg->arg_type == O_ARRAY || chld[1].arg_ptr.arg_arg->arg_type == O_HASH )))) --- 164,180 ---- { register ARG *arg; register ARG *chld; ! register unsigned doarg; ! register int i; extern ARG *arg4; /* should be normal arguments, really */ extern ARG *arg5; arg = op_new(newlen); arg->arg_type = type; if (chld = arg1) { if (chld->arg_type == O_ITEM && ! (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL || ! (i == A_LEXPR && (chld[1].arg_ptr.arg_arg->arg_type == O_LIST || chld[1].arg_ptr.arg_arg->arg_type == O_ARRAY || chld[1].arg_ptr.arg_arg->arg_type == O_HASH )))) *************** *** 181,195 **** arg[1].arg_type = A_EXPR; arg[1].arg_ptr.arg_arg = chld; } - if (!(doarg & 1)) - arg[1].arg_type |= A_DONT; - if (doarg & 2) - arg[1].arg_flags |= AF_ARYOK; } - doarg >>= 2; if (chld = arg2) { if (chld->arg_type == O_ITEM && ! (hoistable[chld[1].arg_type] || (type == O_ASSIGN && ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT)) || --- 189,198 ---- arg[1].arg_type = A_EXPR; arg[1].arg_ptr.arg_arg = chld; } } if (chld = arg2) { if (chld->arg_type == O_ITEM && ! (hoistable[chld[1].arg_type&A_MASK] || (type == O_ASSIGN && ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT)) || *************** *** 206,219 **** arg[2].arg_type = A_EXPR; arg[2].arg_ptr.arg_arg = chld; } - if (!(doarg & 1)) - arg[2].arg_type |= A_DONT; - if (doarg & 2) - arg[2].arg_flags |= AF_ARYOK; } - doarg >>= 2; if (chld = arg3) { ! if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) { arg[3].arg_type = chld[1].arg_type; arg[3].arg_ptr = chld[1].arg_ptr; arg[3].arg_len = chld[1].arg_len; --- 209,217 ---- arg[2].arg_type = A_EXPR; arg[2].arg_ptr.arg_arg = chld; } } if (chld = arg3) { ! if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) { arg[3].arg_type = chld[1].arg_type; arg[3].arg_ptr = chld[1].arg_ptr; arg[3].arg_len = chld[1].arg_len; *************** *** 223,235 **** arg[3].arg_type = A_EXPR; arg[3].arg_ptr.arg_arg = chld; } - if (!(doarg & 1)) - arg[3].arg_type |= A_DONT; - if (doarg & 2) - arg[3].arg_flags |= AF_ARYOK; } if (newlen >= 4 && (chld = arg4)) { ! if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) { arg[4].arg_type = chld[1].arg_type; arg[4].arg_ptr = chld[1].arg_ptr; arg[4].arg_len = chld[1].arg_len; --- 221,229 ---- arg[3].arg_type = A_EXPR; arg[3].arg_ptr.arg_arg = chld; } } if (newlen >= 4 && (chld = arg4)) { ! if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) { arg[4].arg_type = chld[1].arg_type; arg[4].arg_ptr = chld[1].arg_ptr; arg[4].arg_len = chld[1].arg_len; *************** *** 241,247 **** } } if (newlen >= 5 && (chld = arg5)) { ! if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) { arg[5].arg_type = chld[1].arg_type; arg[5].arg_ptr = chld[1].arg_ptr; arg[5].arg_len = chld[1].arg_len; --- 235,241 ---- } } if (newlen >= 5 && (chld = arg5)) { ! if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) { arg[5].arg_type = chld[1].arg_type; arg[5].arg_ptr = chld[1].arg_ptr; arg[5].arg_len = chld[1].arg_len; *************** *** 252,257 **** --- 246,259 ---- arg[5].arg_ptr.arg_arg = chld; } } + doarg = opargs[type]; + for (i = 1; i <= newlen; ++i) { + if (!(doarg & 1)) + arg[i].arg_type |= A_DONT; + if (doarg & 2) + arg[i].arg_flags |= AF_ARYOK; + doarg >>= 2; + } #ifdef DEBUGGING if (debug & 16) { fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]); *************** *** 354,360 **** if (tmp2 >= 0) str_numset(str,(double)(tmp2 % tmplong)); else ! str_numset(str,(double)(tmplong - ((-tmp2 - 1) % tmplong))) - 1; #else tmp2 = tmp2; #endif --- 356,362 ---- if (tmp2 >= 0) str_numset(str,(double)(tmp2 % tmplong)); else ! str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1)); #else tmp2 = tmp2; #endif *************** *** 410,415 **** --- 412,426 ---- value = str_gnum(s1); str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0); break; + case O_NCMP: + value = str_gnum(s1); + value -= str_gnum(s2); + if (value > 0.0) + value = 1.0; + else if (value < 0.0) + value = -1.0; + str_numset(str,value); + break; case O_BIT_AND: value = str_gnum(s1); #ifndef lint *************** *** 499,504 **** --- 510,518 ---- case O_SNE: str_numset(str,(double)(!str_eq(s1,s2))); break; + case O_SCMP: + str_numset(str,(double)(str_cmp(s1,s2))); + break; case O_CRYPT: #ifdef CRYPT tmps = str_get(s1); *************** *** 937,956 **** ARG *arg; { arg->arg_flags |= AF_LOCAL; - return arg; - } - - ARG * - fixeval(arg) - ARG *arg; - { - Renew(arg, 3, ARG); - if (arg->arg_len == 0) - arg[1].arg_type = A_NULL; - arg->arg_len = 2; - arg[2].arg_flags = 0; - arg[2].arg_ptr.arg_hash = curstash; - arg[2].arg_type = A_NULL; return arg; } --- 951,956 ---- Index: os2/dir.h *** os2/dir.h.old Tue Oct 16 11:54:45 1990 --- os2/dir.h Tue Oct 16 11:54:48 1990 *************** *** 0 **** --- 1,163 ---- + /* + * @(#) dir.h 1.4 87/11/06 Public Domain. + * + * A public domain implementation of BSD directory routines for + * MS-DOS. Written by Michael Rendell ({uunet,utai}michael@garfield), + * August 1987 + * + * Enhanced and ported to OS/2 by Kai Uwe Rommel; added scandir() prototype + * December 1989, February 1990 + */ + + + #define MAXNAMLEN 12 + #define MAXPATHLEN 128 + + #define A_RONLY 0x01 + #define A_HIDDEN 0x02 + #define A_SYSTEM 0x04 + #define A_LABEL 0x08 + #define A_DIR 0x10 + #define A_ARCHIVE 0x20 + + + struct direct + { + ino_t d_ino; /* a bit of a farce */ + int d_reclen; /* more farce */ + int d_namlen; /* length of d_name */ + char d_name[MAXNAMLEN + 1]; /* null terminated */ + long d_size; /* size in bytes */ + int d_mode; /* DOS or OS/2 file attributes */ + }; + + /* The fields d_size and d_mode are extensions by me (Kai Uwe Rommel). + * The find_first and find_next calls deliver this data without any extra cost. + * If this data is needed, these fields save a lot of extra calls to stat() + * (each stat() again performs a find_first call !). + */ + + struct _dircontents + { + char *_d_entry; + long _d_size; + int _d_mode; + struct _dircontents *_d_next; + }; + + typedef struct _dirdesc + { + int dd_id; /* uniquely identify each open directory */ + long dd_loc; /* where we are in directory entry is this */ + struct _dircontents *dd_contents; /* pointer to contents of dir */ + struct _dircontents *dd_cp; /* pointer to current position */ + } + DIR; + + + extern DIR *opendir(char *); + extern struct direct *readdir(DIR *); + extern void seekdir(DIR *, long); + extern long telldir(DIR *); + extern void closedir(DIR *); + #define rewinddir(dirp) seekdir(dirp, 0L) + + extern int scandir(char *, struct direct ***, + int (*)(struct direct *), + int (*)(struct direct *, struct direct *)); + + extern int getfmode(char *); + extern int setfmode(char *, unsigned); + + /* + NAME + opendir, readdir, telldir, seekdir, rewinddir, closedir - + directory operations + + SYNTAX + #include <sys/types.h> + #include <sys/dir.h> + + DIR *opendir(filename) + char *filename; + + struct direct *readdir(dirp) + DIR *dirp; + + long telldir(dirp) + DIR *dirp; + + seekdir(dirp, loc) + DIR *dirp; + long loc; + + rewinddir(dirp) + DIR *dirp; + + int closedir(dirp) + DIR *dirp; + + DESCRIPTION + The opendir library routine opens the directory named by + filename and associates a directory stream with it. A + pointer is returned to identify the directory stream in sub- + sequent operations. The pointer NULL is returned if the + specified filename can not be accessed, or if insufficient + memory is available to open the directory file. + + The readdir routine returns a pointer to the next directory + entry. It returns NULL upon reaching the end of the direc- + tory or on detecting an invalid seekdir operation. The + readdir routine uses the getdirentries system call to read + directories. Since the readdir routine returns NULL upon + reaching the end of the directory or on detecting an error, + an application which wishes to detect the difference must + set errno to 0 prior to calling readdir. + + The telldir routine returns the current location associated + with the named directory stream. Values returned by telldir + are good only for the lifetime of the DIR pointer from which + they are derived. If the directory is closed and then reo- + pened, the telldir value may be invalidated due to + undetected directory compaction. + + The seekdir routine sets the position of the next readdir + operation on the directory stream. Only values returned by + telldir should be used with seekdir. + + The rewinddir routine resets the position of the named + directory stream to the beginning of the directory. + + The closedir routine closes the named directory stream and + returns a value of 0 if successful. Otherwise, a value of -1 + is returned and errno is set to indicate the error. All + resources associated with this directory stream are + released. + + EXAMPLE + The following sample code searches a directory for the entry + name. + + len = strlen(name); + + dirp = opendir("."); + + for (dp = readdir(dirp); dp != NULL; dp = readdir(dirp)) + + if (dp->d_namlen == len && !strcmp(dp->d_name, name)) { + + closedir(dirp); + + return FOUND; + + } + + closedir(dirp); + + return NOT_FOUND; + + + SEE ALSO + close(2), getdirentries(2), lseek(2), open(2), read(2), + dir(5) + */ Index: os2/director.c *** os2/director.c.old Tue Oct 16 11:54:54 1990 --- os2/director.c Tue Oct 16 11:54:58 1990 *************** *** 0 **** --- 1,200 ---- + /* + * @(#)dir.c 1.4 87/11/06 Public Domain. + * + * A public domain implementation of BSD directory routines for + * MS-DOS. Written by Michael Rendell ({uunet,utai}michael@garfield), + * August 1897 + * Ported to OS/2 by Kai Uwe Rommel + * December 1989 + */ + + #include <sys/types.h> + #include <sys/stat.h> + #include <sys/dir.h> + + #include <stdio.h> + #include <malloc.h> + #include <string.h> + + #define INCL_NOPM + #include <os2.h> + + + int attributes = A_DIR | A_HIDDEN; + + + static char *getdirent(char *); + static void free_dircontents(struct _dircontents *); + + static HDIR hdir; + static USHORT count; + static FILEFINDBUF find; + + + DIR *opendir(char *name) + { + struct stat statb; + DIR *dirp; + char c; + char *s; + struct _dircontents *dp; + char nbuf[MAXPATHLEN + 1]; + + strcpy(nbuf, name); + + if ( ((c = nbuf[strlen(nbuf) - 1]) == '\\' || c == '/') && + (strlen(nbuf) > 1) ) + { + nbuf[strlen(nbuf) - 1] = 0; + + if ( nbuf[strlen(nbuf) - 1] == ':' ) + strcat(nbuf, "\\."); + } + else + if ( nbuf[strlen(nbuf) - 1] == ':' ) + strcat(nbuf, "."); + + if (stat(nbuf, &statb) < 0 || (statb.st_mode & S_IFMT) != S_IFDIR) + return NULL; + + if ( (dirp = malloc(sizeof(DIR))) == NULL ) + return NULL; + + if ( nbuf[strlen(nbuf) - 1] == '.' ) + strcpy(nbuf + strlen(nbuf) - 1, "*.*"); + else + if ( ((c = nbuf[strlen(nbuf) - 1]) == '\\' || c == '/') && + (strlen(nbuf) == 1) ) + strcat(nbuf, "*.*"); + else + strcat(nbuf, "\\*.*"); + + dirp -> dd_loc = 0; + dirp -> dd_contents = dirp -> dd_cp = NULL; + + if ((s = getdirent(nbuf)) == NULL) + return dirp; + + do + { + if (((dp = malloc(sizeof(struct _dircontents))) == NULL) || + ((dp -> _d_entry = malloc(strlen(s) + 1)) == NULL) ) + { + if (dp) + free(dp); + free_dircontents(dirp -> dd_contents); + + return NULL; + } + + if (dirp -> dd_contents) + dirp -> dd_cp = dirp -> dd_cp -> _d_next = dp; + else + dirp -> dd_contents = dirp -> dd_cp = dp; + + strcpy(dp -> _d_entry, s); + dp -> _d_next = NULL; + + dp -> _d_size = find.cbFile; + dp -> _d_mode = find.attrFile; + dp -> _d_time = *(unsigned *) &(find.ftimeLastWrite); + dp -> _d_date = *(unsigned *) &(find.fdateLastWrite); + } + while ((s = getdirent(NULL)) != NULL); + + dirp -> dd_cp = dirp -> dd_contents; + + return dirp; + } + + + void closedir(DIR * dirp) + { + free_dircontents(dirp -> dd_contents); + free(dirp); + } + + + struct direct *readdir(DIR * dirp) + { + static struct direct dp; + + if (dirp -> dd_cp == NULL) + return NULL; + + dp.d_namlen = dp.d_reclen = + strlen(strcpy(dp.d_name, dirp -> dd_cp -> _d_entry)); + + strlwr(dp.d_name); /* JF */ + dp.d_ino = 0; + + dp.d_size = dirp -> dd_cp -> _d_size; + dp.d_mode = dirp -> dd_cp -> _d_mode; + dp.d_time = dirp -> dd_cp -> _d_time; + dp.d_date = dirp -> dd_cp -> _d_date; + + dirp -> dd_cp = dirp -> dd_cp -> _d_next; + dirp -> dd_loc++; + + return &dp; + } + + + void seekdir(DIR * dirp, long off) + { + long i = off; + struct _dircontents *dp; + + if (off >= 0) + { + for (dp = dirp -> dd_contents; --i >= 0 && dp; dp = dp -> _d_next); + + dirp -> dd_loc = off - (i + 1); + dirp -> dd_cp = dp; + } + } + + + long telldir(DIR * dirp) + { + return dirp -> dd_loc; + } + + + static void free_dircontents(struct _dircontents * dp) + { + struct _dircontents *odp; + + while (dp) + { + if (dp -> _d_entry) + free(dp -> _d_entry); + + dp = (odp = dp) -> _d_next; + free(odp); + } + } + + + static char *getdirent(char *dir) + { + int done; + + if (dir != NULL) + { /* get first entry */ + hdir = HDIR_CREATE; + count = 1; + done = DosFindFirst(dir, &hdir, attributes, + &find, sizeof(find), &count, 0L); + } + else /* get next entry */ + done = DosFindNext(hdir, &find, sizeof(find), &count); + + if (done == 0) + return find.achName; + else + { + DosFindClose(hdir); + return NULL; + } + } *** End of Patch 30 ***