home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume25 / perl / patch15 < prev    next >
Encoding:
Text File  |  1991-11-13  |  46.9 KB  |  1,763 lines
  1. Newsgroups: comp.sources.misc
  2. From: lwall@netlabs.com (Larry Wall)
  3. Subject:  v25i064:  perl - The perl programming language, Patch15
  4. Message-ID: <1991Nov13.214427.3782@sparky.imd.sterling.com>
  5. X-Md4-Signature: efbe162c35757d3f3864564e8f96ee1c
  6. Date: Wed, 13 Nov 1991 21:44:27 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: lwall@netlabs.com (Larry Wall)
  10. Posting-number: Volume 25, Issue 64
  11. Archive-name: perl/patch15
  12. Environment: UNIX, MS-DOS, OS2
  13. Patch-To: perl: Volume 18, Issue 19-54
  14.  
  15. System: perl version 4.0
  16. Patch #: 15
  17. Priority: MED-HIGH
  18. Subject: patch #11, continued
  19.  
  20. Description:
  21.     See patch #11.
  22.  
  23. Fix:    From rn, say "| patch -p -N -d DIR", where DIR is your perl source
  24.     directory.  Outside of rn, say "cd DIR; patch -p -N <thisarticle".
  25.     If you don't have the patch program, apply the following by hand,
  26.     or get patch (version 2.0, latest patchlevel).
  27.  
  28.     After patching:
  29.         *** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #18 FIRST ***
  30.  
  31.     If patch indicates that patchlevel is the wrong version, you may need
  32.     to apply one or more previous patches, or the patch may already
  33.     have been applied.  See the patchlevel.h file to find out what has or
  34.     has not been applied.  In any event, don't continue with the patch.
  35.  
  36.     If you are missing previous patches they can be obtained from me:
  37.  
  38.     Larry Wall
  39.     lwall@netlabs.com
  40.  
  41.     If you send a mail message of the following form it will greatly speed
  42.     processing:
  43.  
  44.     Subject: Command
  45.     @SH mailpatch PATH perl 4.0 LIST
  46.            ^ note the c
  47.  
  48.     where PATH is a return path FROM ME TO YOU either in Internet notation,
  49.     or in bang notation from some well-known host, and LIST is the number
  50.     of one or more patches you need, separated by spaces, commas, and/or
  51.     hyphens.  Saying 35- says everything from 35 to the end.
  52.  
  53.  
  54. Index: patchlevel.h
  55. Prereq: 14
  56. 1c1
  57. < #define PATCHLEVEL 14
  58. ---
  59. > #define PATCHLEVEL 15
  60.  
  61. Index: hash.c
  62. *** hash.c.old    Tue Nov  5 19:26:22 1991
  63. --- hash.c    Tue Nov  5 19:26:23 1991
  64. ***************
  65. *** 1,4 ****
  66. ! /* $RCSfile: hash.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:10:11 $
  67.    *
  68.    *    Copyright (c) 1991, Larry Wall
  69.    *
  70. --- 1,4 ----
  71. ! /* $RCSfile: hash.c,v $$Revision: 4.0.1.2 $$Date: 91/11/05 17:24:13 $
  72.    *
  73.    *    Copyright (c) 1991, Larry Wall
  74.    *
  75. ***************
  76. *** 6,11 ****
  77. --- 6,14 ----
  78.    *    License or the Artistic License, as specified in the README file.
  79.    *
  80.    * $Log:    hash.c,v $
  81. +  * Revision 4.0.1.2  91/11/05  17:24:13  lwall
  82. +  * patch11: saberized perl
  83. +  * 
  84.    * Revision 4.0.1.1  91/06/07  11:10:11  lwall
  85.    * patch4: new copyright notice
  86.    * 
  87. ***************
  88. *** 70,76 ****
  89.       else
  90.           maxi = tb->tbl_coeffsize;
  91.       for (s=key,        i=0,    hash = 0;
  92. !                 i < maxi;
  93.            s++,        i++,    hash *= 5) {
  94.           hash += *s * coeff[i];
  95.       }
  96. --- 73,79 ----
  97.       else
  98.           maxi = tb->tbl_coeffsize;
  99.       for (s=key,        i=0,    hash = 0;
  100. !                 i < maxi;            /*SUPPRESS 8*/
  101.            s++,        i++,    hash *= 5) {
  102.           hash += *s * coeff[i];
  103.       }
  104. ***************
  105. *** 129,134 ****
  106. --- 132,138 ----
  107.       return FALSE;
  108.   
  109.       if (hash)
  110. +     /*SUPPRESS 530*/
  111.       ;
  112.       else if (!tb->tbl_coeffsize)
  113.       hash = *key + 128 * key[1] + 128 * key[klen-1];
  114. ***************
  115. *** 138,144 ****
  116.       else
  117.           maxi = tb->tbl_coeffsize;
  118.       for (s=key,        i=0,    hash = 0;
  119. !                 i < maxi;
  120.            s++,        i++,    hash *= 5) {
  121.           hash += *s * coeff[i];
  122.       }
  123. --- 142,148 ----
  124.       else
  125.           maxi = tb->tbl_coeffsize;
  126.       for (s=key,        i=0,    hash = 0;
  127. !                 i < maxi;            /*SUPPRESS 8*/
  128.            s++,        i++,    hash *= 5) {
  129.           hash += *s * coeff[i];
  130.       }
  131. ***************
  132. *** 226,232 ****
  133.       else
  134.           maxi = tb->tbl_coeffsize;
  135.       for (s=key,        i=0,    hash = 0;
  136. !                 i < maxi;
  137.            s++,        i++,    hash *= 5) {
  138.           hash += *s * coeff[i];
  139.       }
  140. --- 230,236 ----
  141.       else
  142.           maxi = tb->tbl_coeffsize;
  143.       for (s=key,        i=0,    hash = 0;
  144. !                 i < maxi;            /*SUPPRESS 8*/
  145.            s++,        i++,    hash *= 5) {
  146.           hash += *s * coeff[i];
  147.       }
  148. ***************
  149. *** 425,430 ****
  150. --- 429,435 ----
  151.       tb->tbl_dbm = 0;            /* now clear just cache */
  152.   #endif
  153.       (void)hiterinit(tb);
  154. +     /*SUPPRESS 560*/
  155.       while (hent = hiternext(tb)) {    /* concise but not very efficient */
  156.       hentfree(ohent);
  157.       ohent = hent;
  158.  
  159. Index: hash.h
  160. *** hash.h.old    Tue Nov  5 19:26:24 1991
  161. --- hash.h    Tue Nov  5 19:26:25 1991
  162. ***************
  163. *** 1,4 ****
  164. ! /* $RCSfile: hash.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:10:33 $
  165.    *
  166.    *    Copyright (c) 1991, Larry Wall
  167.    *
  168. --- 1,4 ----
  169. ! /* $RCSfile: hash.h,v $$Revision: 4.0.1.2 $$Date: 91/11/05 17:24:31 $
  170.    *
  171.    *    Copyright (c) 1991, Larry Wall
  172.    *
  173. ***************
  174. *** 6,11 ****
  175. --- 6,14 ----
  176.    *    License or the Artistic License, as specified in the README file.
  177.    *
  178.    * $Log:    hash.h,v $
  179. +  * Revision 4.0.1.2  91/11/05  17:24:31  lwall
  180. +  * patch11: random cleanup
  181. +  * 
  182.    * Revision 4.0.1.1  91/06/07  11:10:33  lwall
  183.    * patch4: new copyright notice
  184.    * 
  185. ***************
  186. *** 59,64 ****
  187. --- 62,68 ----
  188.   HASH *hnew();
  189.   void hclear();
  190.   void hentfree();
  191. + void hfree();
  192.   int hiterinit();
  193.   HENT *hiternext();
  194.   char *hiterkey();
  195.  
  196. Index: hints/hp9000_800.sh
  197. *** hints/hp9000_800.sh.old    Tue Nov  5 19:26:32 1991
  198. --- hints/hp9000_800.sh    Tue Nov  5 19:26:32 1991
  199. ***************
  200. *** 0 ****
  201. --- 1 ----
  202. + libswanted=`echo $libswanted | sed 's/malloc //'`
  203.  
  204. Index: installperl
  205. *** installperl.old    Tue Nov  5 19:26:46 1991
  206. --- installperl    Tue Nov  5 19:26:46 1991
  207. ***************
  208. *** 6,12 ****
  209.       shift;
  210.   }
  211.   
  212. ! @scripts = ('h2ph', 'x2p/s2p', 'x2p/find2perl');
  213.   @manpages = ('perl.man', 'h2ph.man', 'x2p/a2p.man', 'x2p/s2p.man');
  214.   
  215.   $version = sprintf("%5.3f", $]);
  216. --- 6,14 ----
  217.       shift;
  218.   }
  219.   
  220. ! umask 022;
  221. ! 
  222. ! @scripts = ('cppstdin', 'h2ph', 'c2ph', 'pstruct', 'x2p/s2p', 'x2p/find2perl');
  223.   @manpages = ('perl.man', 'h2ph.man', 'x2p/a2p.man', 'x2p/s2p.man');
  224.   
  225.   $version = sprintf("%5.3f", $]);
  226. ***************
  227. *** 85,91 ****
  228.   ($udev,$uino) = stat("/usr/bin");
  229.   
  230.   if (-w _ && ($udev != $ddev || $uino != $dino) && !$nonono) {
  231. !     unlink "/usr/bin/perl";
  232.       eval 'symlink("$installbin/perl", "/usr/bin/perl")' ||
  233.       eval 'link("$installbin/perl", "/usr/bin/perl")' ||
  234.       &cmd("cp $installbin/perl /usr/bin");
  235. --- 87,93 ----
  236.   ($udev,$uino) = stat("/usr/bin");
  237.   
  238.   if (-w _ && ($udev != $ddev || $uino != $dino) && !$nonono) {
  239. !     &unlink("/usr/bin/perl");
  240.       eval 'symlink("$installbin/perl", "/usr/bin/perl")' ||
  241.       eval 'link("$installbin/perl", "/usr/bin/perl")' ||
  242.       &cmd("cp $installbin/perl /usr/bin");
  243. ***************
  244. *** 100,115 ****
  245.       s#.*/##; &chmod(0755, "$installscr/$_");
  246.   }
  247.   
  248. - # Install library files.
  249. - 
  250. - &makedir($installprivlib);
  251. - 
  252. - ($pdev,$pino) = stat($installprivlib);
  253. - 
  254. - if ($pdev != $ddev || $pino != $dino) {
  255. -     &cmd("cd lib && cp *.pl $installprivlib");
  256. - }
  257. - 
  258.   # Install man pages.
  259.   
  260.   if ($mansrc ne '') {
  261. --- 102,107 ----
  262. ***************
  263. *** 133,138 ****
  264. --- 125,152 ----
  265.       }
  266.       }
  267.   }
  268. + 
  269. + # Install library files.
  270. + 
  271. + &makedir($installprivlib);
  272. + if (chdir "lib") {
  273. + 
  274. +     ($pdev,$pino) = stat($installprivlib);
  275. +     ($ldev,$lino) = stat('.');
  276. + 
  277. +     if ($pdev != $ldev || $pino != $lino) {
  278. +     foreach $file (<*.pl>) {
  279. +         &unlink("$installprivlib/$file");
  280. +         &cmd("cp $file $installprivlib");
  281. +     }
  282. +     }
  283. +     chdir ".." || die "Can't cd back to source directory: $!\n";
  284. + }
  285. + else {
  286. +     warn "Can't cd to lib to install lib files: $!\n";
  287. + }
  288. + 
  289. + &chmod(0755, "usub/mus");
  290.   
  291.   print STDERR "  Installation complete\n";
  292.   
  293.  
  294. Index: malloc.c
  295. *** malloc.c.old    Tue Nov  5 19:27:12 1991
  296. --- malloc.c    Tue Nov  5 19:27:12 1991
  297. ***************
  298. *** 1,6 ****
  299. ! /* $RCSfile: malloc.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:20:45 $
  300.    *
  301.    * $Log:    malloc.c,v $
  302.    * Revision 4.0.1.2  91/06/07  11:20:45  lwall
  303.    * patch4: many, many itty-bitty portability fixes
  304.    * 
  305. --- 1,9 ----
  306. ! /* $RCSfile: malloc.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:57:40 $
  307.    *
  308.    * $Log:    malloc.c,v $
  309. +  * Revision 4.0.1.3  91/11/05  17:57:40  lwall
  310. +  * patch11: safe malloc code now integrated into Perl's malloc when possible
  311. +  * 
  312.    * Revision 4.0.1.2  91/06/07  11:20:45  lwall
  313.    * patch4: many, many itty-bitty portability fixes
  314.    * 
  315. ***************
  316. *** 13,18 ****
  317. --- 16,22 ----
  318.    */
  319.   
  320.   #ifndef lint
  321. + /*SUPPRESS 592*/
  322.   static char sccsid[] = "@(#)malloc.c    4.3 (Berkeley) 9/16/83";
  323.   
  324.   #ifdef DEBUGGING
  325. ***************
  326. *** 110,115 ****
  327. --- 114,123 ----
  328.   #define    ASSERT(p)
  329.   #endif
  330.   
  331. + #ifdef safemalloc
  332. + static int an = 0;
  333. + #endif
  334. + 
  335.   MALLOCPTRTYPE *
  336.   malloc(nbytes)
  337.       register unsigned nbytes;
  338. ***************
  339. *** 118,123 ****
  340. --- 126,148 ----
  341.         register int bucket = 0;
  342.         register unsigned shiftr;
  343.   
  344. + #ifdef safemalloc
  345. + #ifdef DEBUGGING
  346. +     int size = nbytes;
  347. + #endif
  348. + 
  349. + #ifdef MSDOS
  350. +     if (nbytes > 0xffff) {
  351. +         fprintf(stderr, "Allocation too large: %lx\n", nbytes);
  352. +         exit(1);
  353. +     }
  354. + #endif /* MSDOS */
  355. + #ifdef DEBUGGING
  356. +     if ((long)nbytes < 0)
  357. +         fatal("panic: malloc");
  358. + #endif
  359. + #endif /* safemalloc */
  360. + 
  361.       /*
  362.        * Convert amount of memory requested into
  363.        * closest block size stored in hash buckets
  364. ***************
  365. *** 136,143 ****
  366.        */
  367.         if (nextf[bucket] == NULL)    
  368.             morecore(bucket);
  369. !       if ((p = (union overhead *)nextf[bucket]) == NULL)
  370.             return (NULL);
  371.       /* remove from linked list */
  372.   #ifdef RCHECK
  373.       if (*((int*)p) & (sizeof(union overhead) - 1))
  374. --- 161,187 ----
  375.        */
  376.         if (nextf[bucket] == NULL)    
  377.             morecore(bucket);
  378. !       if ((p = (union overhead *)nextf[bucket]) == NULL) {
  379. ! #ifdef safemalloc
  380. !         fputs("Out of memory!\n", stderr);
  381. !         exit(1);
  382. ! #else
  383.             return (NULL);
  384. + #endif
  385. +     }
  386. + 
  387. + #ifdef safemalloc
  388. + #ifdef DEBUGGING
  389. + #  ifndef I286
  390. +     if (debug & 128)
  391. +         fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",p+1,an++,size);
  392. + #  else
  393. +     if (debug & 128)
  394. +         fprintf(stderr,"0x%lx: (%05d) malloc %d bytes\n",p+1,an++,size);
  395. + #  endif
  396. + #endif
  397. + #endif /* safemalloc */
  398. + 
  399.       /* remove from linked list */
  400.   #ifdef RCHECK
  401.       if (*((int*)p) & (sizeof(union overhead) - 1))
  402. ***************
  403. *** 240,245 ****
  404. --- 284,301 ----
  405.       register union overhead *op;
  406.       char *cp = (char*)mp;
  407.   
  408. + #ifdef safemalloc
  409. + #ifdef DEBUGGING
  410. + #  ifndef I286
  411. +     if (debug & 128)
  412. +         fprintf(stderr,"0x%x: (%05d) free\n",cp,an++);
  413. + #  else
  414. +     if (debug & 128)
  415. +         fprintf(stderr,"0x%lx: (%05d) free\n",cp,an++);
  416. + #  endif
  417. + #endif
  418. + #endif /* safemalloc */
  419. + 
  420.         if (cp == NULL)
  421.             return;
  422.       op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
  423. ***************
  424. *** 292,297 ****
  425. --- 348,372 ----
  426.       int was_alloced = 0;
  427.       char *cp = (char*)mp;
  428.   
  429. + #ifdef safemalloc
  430. + #ifdef DEBUGGING
  431. +     int size = nbytes;
  432. + #endif
  433. + 
  434. + #ifdef MSDOS
  435. +     if (nbytes > 0xffff) {
  436. +         fprintf(stderr, "Reallocation too large: %lx\n", size);
  437. +         exit(1);
  438. +     }
  439. + #endif /* MSDOS */
  440. +     if (!cp)
  441. +         fatal("Null realloc");
  442. + #ifdef DEBUGGING
  443. +     if ((long)nbytes < 0)
  444. +         fatal("panic: realloc");
  445. + #endif
  446. + #endif /* safemalloc */
  447. + 
  448.         if (cp == NULL)
  449.             return (malloc(nbytes));
  450.       op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
  451. ***************
  452. *** 336,349 ****
  453.               *((u_int *)((caddr_t)op + nbytes - RSLOP)) = RMAGIC;
  454.           }
  455.   #endif
  456. !         return((MALLOCPTRTYPE*)cp);
  457.       }
  458. !       if ((res = (char*)malloc(nbytes)) == NULL)
  459. !           return (NULL);
  460. !       if (cp != res)            /* common optimization */
  461. !         (void)bcopy(cp, res, (int)((nbytes < onb) ? nbytes : onb));
  462. !       if (was_alloced)
  463. !         free(cp);
  464.         return ((MALLOCPTRTYPE*)res);
  465.   }
  466.   
  467. --- 411,442 ----
  468.               *((u_int *)((caddr_t)op + nbytes - RSLOP)) = RMAGIC;
  469.           }
  470.   #endif
  471. !         res = cp;
  472.       }
  473. !     else {
  474. !         if ((res = (char*)malloc(nbytes)) == NULL)
  475. !             return (NULL);
  476. !         if (cp != res)            /* common optimization */
  477. !             bcopy(cp, res, (int)(nbytes < onb ? nbytes : onb));
  478. !         if (was_alloced)
  479. !             free(cp);
  480. !     }
  481. ! 
  482. ! #ifdef safemalloc
  483. ! #ifdef DEBUGGING
  484. ! #  ifndef I286
  485. !     if (debug & 128) {
  486. !         fprintf(stderr,"0x%x: (%05d) rfree\n",res,an++);
  487. !         fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",res,an++,size);
  488. !     }
  489. ! #  else
  490. !     if (debug & 128) {
  491. !         fprintf(stderr,"0x%lx: (%05d) rfree\n",res,an++);
  492. !         fprintf(stderr,"0x%lx: (%05d) realloc %d bytes\n",res,an++,size);
  493. !     }
  494. ! #  endif
  495. ! #endif
  496. ! #endif /* safemalloc */
  497.         return ((MALLOCPTRTYPE*)res);
  498.   }
  499.   
  500.  
  501. Index: hints/mpc.sh
  502. *** hints/mpc.sh.old    Tue Nov  5 19:26:34 1991
  503. --- hints/mpc.sh    Tue Nov  5 19:26:34 1991
  504. ***************
  505. *** 0 ****
  506. --- 1 ----
  507. + ccflags="$ccflags -X18"
  508.  
  509. Index: usub/mus
  510. *** usub/mus.old    Tue Nov  5 19:28:22 1991
  511. --- usub/mus    Tue Nov  5 19:28:23 1991
  512. ***************
  513. *** 64,74 ****
  514.           if ($mode =~ /O/) {
  515.           if ($what eq 'gnum') {
  516.               push(@outies, "\t    str_numset(st[$i], (double) $name);\n");
  517.           }
  518.           else {
  519.               push(@outies, "\t    str_set(st[$i], (char*) $name);\n");
  520.           }
  521. -         push(@callnames, "&$name");
  522.           }
  523.           else {
  524.           push(@callnames, $name);
  525. --- 64,75 ----
  526.           if ($mode =~ /O/) {
  527.           if ($what eq 'gnum') {
  528.               push(@outies, "\t    str_numset(st[$i], (double) $name);\n");
  529. +             push(@callnames, "&$name");
  530.           }
  531.           else {
  532.               push(@outies, "\t    str_set(st[$i], (char*) $name);\n");
  533. +             push(@callnames, "$name");
  534.           }
  535.           }
  536.           else {
  537.           push(@callnames, $name);
  538. ***************
  539. *** 76,81 ****
  540. --- 77,87 ----
  541.           if ($mode =~ /I/) {
  542.           print <<EOF;
  543.           $type    $name =$x    $cast    str_$what(st[$i]);
  544. + EOF
  545. +         }
  546. +             elsif ($type =~ /char/) {
  547. +             print <<EOF;
  548. +         char    ${name}[133];
  549.   EOF
  550.           }
  551.           else {
  552.  
  553. Index: lib/newgetopt.pl
  554. *** lib/newgetopt.pl.old    Tue Nov  5 19:27:05 1991
  555. --- lib/newgetopt.pl    Tue Nov  5 19:27:05 1991
  556. ***************
  557. *** 1,11 ****
  558.   # newgetopt.pl -- new options parsing
  559.   
  560. ! # SCCS Status     : @(#)@ newgetopt.pl    1.7
  561.   # Author          : Johan Vromans
  562.   # Created On      : Tue Sep 11 15:00:12 1990
  563.   # Last Modified By: Johan Vromans
  564. ! # Last Modified On: Sun Oct 14 14:35:36 1990
  565. ! # Update Count    : 34
  566.   # Status          : Okay
  567.   
  568.   # This package implements a new getopt function. This function adheres
  569. --- 1,11 ----
  570.   # newgetopt.pl -- new options parsing
  571.   
  572. ! # SCCS Status     : @(#)@ newgetopt.pl    1.8
  573.   # Author          : Johan Vromans
  574.   # Created On      : Tue Sep 11 15:00:12 1990
  575.   # Last Modified By: Johan Vromans
  576. ! # Last Modified On: Thu Sep 26 20:10:41 1991
  577. ! # Update Count    : 35
  578.   # Status          : Okay
  579.   
  580.   # This package implements a new getopt function. This function adheres
  581. ***************
  582. *** 138,143 ****
  583. --- 138,146 ----
  584.           if ( $mand eq "=" ) {
  585.           print STDERR ("Option ", $opt, " requires an argument\n");
  586.           $error++;
  587. +         }
  588. +         if ( $mand eq ":" ) {
  589. +         $arg = $type eq "s" ? "" : 0;
  590.           }
  591.           next;
  592.       }
  593.  
  594. Index: hints/opus.sh
  595. *** hints/opus.sh.old    Tue Nov  5 19:26:35 1991
  596. --- hints/opus.sh    Tue Nov  5 19:26:36 1991
  597. ***************
  598. *** 0 ****
  599. --- 1 ----
  600. + ccflags="$ccflags -X18"
  601.  
  602. Index: perl.c
  603. *** perl.c.old    Tue Nov  5 19:27:15 1991
  604. --- perl.c    Tue Nov  5 19:27:16 1991
  605. ***************
  606. *** 1,4 ****
  607. ! char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.4 $$Date: 91/06/10 01:23:07 $\nPatch level: ###\n";
  608.   /*
  609.    *    Copyright (c) 1991, Larry Wall
  610.    *
  611. --- 1,4 ----
  612. ! char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.5 $$Date: 91/11/05 18:03:32 $\nPatch level: ###\n";
  613.   /*
  614.    *    Copyright (c) 1991, Larry Wall
  615.    *
  616. ***************
  617. *** 6,11 ****
  618. --- 6,20 ----
  619.    *    License or the Artistic License, as specified in the README file.
  620.    *
  621.    * $Log:    perl.c,v $
  622. +  * Revision 4.0.1.5  91/11/05  18:03:32  lwall
  623. +  * patch11: random cleanup
  624. +  * patch11: $0 was being truncated at times
  625. +  * patch11: cppstdin now installed outside of source directory
  626. +  * patch11: -P didn't allow use of #elif or #undef
  627. +  * patch11: prepared for ctype implementations that don't define isascii()
  628. +  * patch11: added eval {}
  629. +  * patch11: eval confused by string containing null
  630. +  * 
  631.    * Revision 4.0.1.4  91/06/10  01:23:07  lwall
  632.    * patch10: perl -v printed incorrect copyright notice
  633.    * 
  634. ***************
  635. *** 26,31 ****
  636. --- 35,42 ----
  637.    * 
  638.    */
  639.   
  640. + /*SUPPRESS 560*/
  641. + 
  642.   #include "EXTERN.h"
  643.   #include "perl.h"
  644.   #include "perly.h"
  645. ***************
  646. *** 64,69 ****
  647. --- 75,81 ----
  648.   {
  649.       register STR *str;
  650.       register char *s;
  651. +     char *scriptname;
  652.       char *getenv();
  653.       bool dosearch = FALSE;
  654.   #ifdef DOSUID
  655. ***************
  656. *** 193,198 ****
  657. --- 205,214 ----
  658.           s++;
  659.           goto reswitch;
  660.       case 'S':
  661. + #ifdef TAINT
  662. +         if (euid != uid || egid != gid)
  663. +         fatal("No -S allowed in setuid scripts");
  664. + #endif
  665.           dosearch = TRUE;
  666.           s++;
  667.           goto reswitch;
  668. ***************
  669. *** 212,221 ****
  670.       }
  671.       }
  672.     switch_end:
  673.       if (e_fp) {
  674.       (void)fclose(e_fp);
  675.       argc++,argv--;
  676. !     argv[0] = e_tmpname;
  677.       }
  678.   
  679.   #ifdef MSDOS
  680. --- 228,238 ----
  681.       }
  682.       }
  683.     switch_end:
  684. +     scriptname = argv[0];
  685.       if (e_fp) {
  686.       (void)fclose(e_fp);
  687.       argc++,argv--;
  688. !     scriptname = e_tmpname;
  689.       }
  690.   
  691.   #ifdef MSDOS
  692. ***************
  693. *** 259,275 ****
  694.   
  695.       /* open script */
  696.   
  697. !     if (argv[0] == Nullch)
  698.   #ifdef MSDOS
  699.       {
  700.       if ( isatty(fileno(stdin)) )
  701.         moreswitches("v");
  702. !     argv[0] = "-";
  703.       }
  704.   #else
  705. !     argv[0] = "-";
  706.   #endif
  707. !     if (dosearch && !index(argv[0], '/') && (s = getenv("PATH"))) {
  708.       char *xfound = Nullch, *xfailed = Nullch;
  709.       int len;
  710.   
  711. --- 276,292 ----
  712.   
  713.       /* open script */
  714.   
  715. !     if (scriptname == Nullch)
  716.   #ifdef MSDOS
  717.       {
  718.       if ( isatty(fileno(stdin)) )
  719.         moreswitches("v");
  720. !     scriptname = "-";
  721.       }
  722.   #else
  723. !     scriptname = "-";
  724.   #endif
  725. !     if (dosearch && !index(scriptname, '/') && (s = getenv("PATH"))) {
  726.       char *xfound = Nullch, *xfailed = Nullch;
  727.       int len;
  728.   
  729. ***************
  730. *** 289,295 ****
  731.           if (len && tokenbuf[len-1] != '\\')
  732.   #endif
  733.           (void)strcat(tokenbuf+len,"/");
  734. !         (void)strcat(tokenbuf+len,argv[0]);
  735.   #ifdef DEBUGGING
  736.           if (debug & 1)
  737.           fprintf(stderr,"Looking for %s\n",tokenbuf);
  738. --- 306,312 ----
  739.           if (len && tokenbuf[len-1] != '\\')
  740.   #endif
  741.           (void)strcat(tokenbuf+len,"/");
  742. !         (void)strcat(tokenbuf+len,scriptname);
  743.   #ifdef DEBUGGING
  744.           if (debug & 1)
  745.           fprintf(stderr,"Looking for %s\n",tokenbuf);
  746. ***************
  747. *** 305,324 ****
  748.           xfailed = savestr(tokenbuf);
  749.       }
  750.       if (!xfound)
  751. !         fatal("Can't execute %s", xfailed ? xfailed : argv[0] );
  752.       if (xfailed)
  753.           Safefree(xfailed);
  754. !     argv[0] = savestr(xfound);
  755.       }
  756.   
  757.       fdpid = anew(Nullstab);    /* for remembering popen pids by fd */
  758.       pidstatus = hnew(COEFFSIZE);/* for remembering status of dead pids */
  759.   
  760. !     origfilename = savestr(argv[0]);
  761.       curcmd->c_filestab = fstab(origfilename);
  762.       if (strEQ(origfilename,"-"))
  763. !     argv[0] = "";
  764.       if (preprocess) {
  765.       str_cat(str,"-I");
  766.       str_cat(str,PRIVLIB);
  767.       (void)sprintf(buf, "\
  768. --- 322,347 ----
  769.           xfailed = savestr(tokenbuf);
  770.       }
  771.       if (!xfound)
  772. !         fatal("Can't execute %s", xfailed ? xfailed : scriptname );
  773.       if (xfailed)
  774.           Safefree(xfailed);
  775. !     scriptname = savestr(xfound);
  776.       }
  777.   
  778.       fdpid = anew(Nullstab);    /* for remembering popen pids by fd */
  779.       pidstatus = hnew(COEFFSIZE);/* for remembering status of dead pids */
  780.   
  781. !     origfilename = savestr(scriptname);
  782.       curcmd->c_filestab = fstab(origfilename);
  783.       if (strEQ(origfilename,"-"))
  784. !     scriptname = "";
  785.       if (preprocess) {
  786. +     char *cpp = CPPSTDIN;
  787. + 
  788. +     if (strEQ(cpp,"cppstdin"))
  789. +         sprintf(tokenbuf, "%s/%s", SCRIPTDIR, cpp);
  790. +     else
  791. +         sprintf(tokenbuf, "%s", cpp);
  792.       str_cat(str,"-I");
  793.       str_cat(str,PRIVLIB);
  794.       (void)sprintf(buf, "\
  795. ***************
  796. *** 329,336 ****
  797.    -e '/^#[     ]*ifdef[     ]/b' \
  798.    -e '/^#[     ]*ifndef[     ]/b' \
  799.    -e '/^#[     ]*else/b' \
  800.    -e '/^#[     ]*endif/b' \
  801. !  -e 's/^#.*//' \
  802.    %s | %s -C %s %s",
  803.   #ifdef MSDOS
  804.         "",
  805. --- 352,361 ----
  806.    -e '/^#[     ]*ifdef[     ]/b' \
  807.    -e '/^#[     ]*ifndef[     ]/b' \
  808.    -e '/^#[     ]*else/b' \
  809. +  -e '/^#[     ]*elif[     ]/b' \
  810. +  -e '/^#[     ]*undef[     ]/b' \
  811.    -e '/^#[     ]*endif/b' \
  812. !  -e 's/^[     ]*#.*//' \
  813.    %s | %s -C %s %s",
  814.   #ifdef MSDOS
  815.         "",
  816. ***************
  817. *** 338,344 ****
  818.         "/bin/",
  819.   #endif
  820.         (doextract ? "-e '1,/^#/d\n'" : ""),
  821. !       argv[0], CPPSTDIN, str_get(str), CPPMINUS);
  822.   #ifdef DEBUGGING
  823.       if (debug & 64) {
  824.           fputs(buf,stderr);
  825. --- 363,369 ----
  826.         "/bin/",
  827.   #endif
  828.         (doextract ? "-e '1,/^#/d\n'" : ""),
  829. !       scriptname, tokenbuf, str_get(str), CPPMINUS);
  830.   #ifdef DEBUGGING
  831.       if (debug & 64) {
  832.           fputs(buf,stderr);
  833. ***************
  834. *** 360,370 ****
  835.   #endif /* IAMSUID */
  836.       rsfp = mypopen(buf,"r");
  837.       }
  838. !     else if (!*argv[0])
  839.       rsfp = stdin;
  840.       else
  841. !     rsfp = fopen(argv[0],"r");
  842. !     if (rsfp == Nullfp) {
  843.   #ifdef DOSUID
  844.   #ifndef IAMSUID        /* in case script is not readable before setuid */
  845.       if (euid && stat(stab_val(curcmd->c_filestab)->str_ptr,&statbuf) >= 0 &&
  846. --- 385,400 ----
  847.   #endif /* IAMSUID */
  848.       rsfp = mypopen(buf,"r");
  849.       }
  850. !     else if (!*scriptname) {
  851. ! #ifdef TAINT
  852. !     if (euid != uid || egid != gid)
  853. !         fatal("Can't take set-id script from stdin");
  854. ! #endif
  855.       rsfp = stdin;
  856. +     }
  857.       else
  858. !     rsfp = fopen(scriptname,"r");
  859. !     if ((FILE*)rsfp == Nullfp) {
  860.   #ifdef DOSUID
  861.   #ifndef IAMSUID        /* in case script is not readable before setuid */
  862.       if (euid && stat(stab_val(curcmd->c_filestab)->str_ptr,&statbuf) >= 0 &&
  863. ***************
  864. *** 473,479 ****
  865.           fatal("No #! line");
  866.       s = tokenbuf+2;
  867.       if (*s == ' ') s++;
  868. !     while (!isspace(*s)) s++;
  869.       if (strnNE(s-4,"perl",4) && strnNE(s-9,"perl",4))  /* sanity check */
  870.           fatal("Not a perl script");
  871.       while (*s == ' ' || *s == '\t') s++;
  872. --- 503,509 ----
  873.           fatal("No #! line");
  874.       s = tokenbuf+2;
  875.       if (*s == ' ') s++;
  876. !     while (!isSPACE(*s)) s++;
  877.       if (strnNE(s-4,"perl",4) && strnNE(s-9,"perl",4))  /* sanity check */
  878.           fatal("Not a perl script");
  879.       while (*s == ' ' || *s == '\t') s++;
  880. ***************
  881. *** 484,490 ****
  882.        */
  883.       len = strlen(validarg);
  884.       if (strEQ(validarg," PHOOEY ") ||
  885. !         strnNE(s,validarg,len) || !isspace(s[len]))
  886.           fatal("Args must match #! line");
  887.   
  888.   #ifndef IAMSUID
  889. --- 514,520 ----
  890.        */
  891.       len = strlen(validarg);
  892.       if (strEQ(validarg," PHOOEY ") ||
  893. !         strnNE(s,validarg,len) || !isSPACE(s[len]))
  894.           fatal("Args must match #! line");
  895.   
  896.   #ifndef IAMSUID
  897. ***************
  898. *** 593,598 ****
  899. --- 623,629 ----
  900.           doextract = FALSE;
  901.           if (s = instr(s,"perl -")) {
  902.           s += 6;
  903. +         /*SUPPRESS 530*/
  904.           while (s = moreswitches(s)) ;
  905.           }
  906.           if (cddir && chdir(cddir) < 0)
  907. ***************
  908. *** 872,881 ****
  909.   /* this routine is in perl.c by virtue of being sort of an alternate main() */
  910.   
  911.   int
  912. ! do_eval(str,optype,stash,gimme,arglast)
  913.   STR *str;
  914.   int optype;
  915.   HASH *stash;
  916.   int gimme;
  917.   int *arglast;
  918.   {
  919. --- 903,913 ----
  920.   /* this routine is in perl.c by virtue of being sort of an alternate main() */
  921.   
  922.   int
  923. ! do_eval(str,optype,stash,savecmd,gimme,arglast)
  924.   STR *str;
  925.   int optype;
  926.   HASH *stash;
  927. + int savecmd;
  928.   int gimme;
  929.   int *arglast;
  930.   {
  931. ***************
  932. *** 891,896 ****
  933. --- 923,929 ----
  934.       SPAT * VOLATILE oldspat = curspat;
  935.       SPAT * VOLATILE oldlspat = lastspat;
  936.       static char *last_eval = Nullch;
  937. +     static long last_elen = 0;
  938.       static CMD *last_root = Nullcmd;
  939.       VOLATILE int sp = arglast[0];
  940.       char *specfilename;
  941. ***************
  942. *** 996,1006 ****
  943.           retval = yyparse();
  944.           retval |= error_count;
  945.       }
  946. !     else if (last_root && *bufptr == *last_eval && strEQ(bufptr,last_eval)){
  947.           retval = 0;
  948.           eval_root = last_root;    /* no point in reparsing */
  949.       }
  950. !     else if (in_eval == 1) {
  951.           if (last_root) {
  952.           Safefree(last_eval);
  953.           last_eval = Nullch;
  954. --- 1029,1040 ----
  955.           retval = yyparse();
  956.           retval |= error_count;
  957.       }
  958. !     else if (last_root && last_elen == bufend - bufptr
  959. !       && *bufptr == *last_eval && !bcmp(bufptr,last_eval)){
  960.           retval = 0;
  961.           eval_root = last_root;    /* no point in reparsing */
  962.       }
  963. !     else if (in_eval == 1 && !savecmd) {
  964.           if (last_root) {
  965.           Safefree(last_eval);
  966.           last_eval = Nullch;
  967. ***************
  968. *** 1007,1013 ****
  969.           cmd_free(last_root);
  970.           }
  971.           last_root = Nullcmd;
  972. !         last_eval = savestr(bufptr);
  973.           retval = yyparse();
  974.           retval |= error_count;
  975.           if (!retval)
  976. --- 1041,1048 ----
  977.           cmd_free(last_root);
  978.           }
  979.           last_root = Nullcmd;
  980. !         last_elen = bufend - bufptr;
  981. !         last_eval = nsavestr(bufptr, last_elen);
  982.           retval = yyparse();
  983.           retval |= error_count;
  984.           if (!retval)
  985. ***************
  986. *** 1035,1041 ****
  987.   #endif
  988.           cmd_free(eval_root);
  989.   #endif
  990. !         if (eval_root == last_root)
  991.           last_root = Nullcmd;
  992.           eval_root = myroot = Nullcmd;
  993.       }
  994. --- 1070,1076 ----
  995.   #endif
  996.           cmd_free(eval_root);
  997.   #endif
  998. !         if ((CMD*)eval_root == last_root)
  999.           last_root = Nullcmd;
  1000.           eval_root = myroot = Nullcmd;
  1001.       }
  1002. ***************
  1003. *** 1051,1057 ****
  1004.       for (i = arglast[0] + 1; i <= sp; i++)
  1005.           st[i] = str_mortal(st[i]);
  1006.                   /* if we don't save result, free zaps it */
  1007. !     if (in_eval != 1 && myroot != last_root)
  1008.           cmd_free(myroot);
  1009.       }
  1010.   
  1011. --- 1086,1094 ----
  1012.       for (i = arglast[0] + 1; i <= sp; i++)
  1013.           st[i] = str_mortal(st[i]);
  1014.                   /* if we don't save result, free zaps it */
  1015. !     if (savecmd)
  1016. !         eval_root = myroot;
  1017. !     else if (in_eval != 1 && myroot != last_root)
  1018.           cmd_free(myroot);
  1019.       }
  1020.   
  1021. ***************
  1022. *** 1091,1096 ****
  1023. --- 1128,1195 ----
  1024.       return sp;
  1025.   }
  1026.   
  1027. + int
  1028. + do_try(cmd,gimme,arglast)
  1029. + CMD *cmd;
  1030. + int gimme;
  1031. + int *arglast;
  1032. + {
  1033. +     STR **st = stack->ary_array;
  1034. + 
  1035. +     CMD * VOLATILE oldcurcmd = curcmd;
  1036. +     VOLATILE int oldtmps_base = tmps_base;
  1037. +     VOLATILE int oldsave = savestack->ary_fill;
  1038. +     SPAT * VOLATILE oldspat = curspat;
  1039. +     SPAT * VOLATILE oldlspat = lastspat;
  1040. +     VOLATILE int sp = arglast[0];
  1041. + 
  1042. +     tmps_base = tmps_max;
  1043. +     str_set(stab_val(stabent("@",TRUE)),"");
  1044. +     in_eval++;
  1045. +     if (++loop_ptr >= loop_max) {
  1046. +     loop_max += 128;
  1047. +     Renew(loop_stack, loop_max, struct loop);
  1048. +     }
  1049. +     loop_stack[loop_ptr].loop_label = "_EVAL_";
  1050. +     loop_stack[loop_ptr].loop_sp = sp;
  1051. + #ifdef DEBUGGING
  1052. +     if (debug & 4) {
  1053. +     deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
  1054. +     }
  1055. + #endif
  1056. +     if (setjmp(loop_stack[loop_ptr].loop_env)) {
  1057. +     st = stack->ary_array;
  1058. +     sp = arglast[0];
  1059. +     if (gimme != G_ARRAY)
  1060. +         st[++sp] = &str_undef;
  1061. +     }
  1062. +     else {
  1063. +     sp = cmd_exec(cmd,gimme,sp);
  1064. +     st = stack->ary_array;
  1065. + /*    for (i = arglast[0] + 1; i <= sp; i++)
  1066. +         st[i] = str_mortal(st[i]);  not needed, I think */
  1067. +                 /* if we don't save result, free zaps it */
  1068. +     }
  1069. + 
  1070. +     in_eval--;
  1071. + #ifdef DEBUGGING
  1072. +     if (debug & 4) {
  1073. +     char *tmps = loop_stack[loop_ptr].loop_label;
  1074. +     deb("(Popping label #%d %s)\n",loop_ptr,
  1075. +         tmps ? tmps : "" );
  1076. +     }
  1077. + #endif
  1078. +     loop_ptr--;
  1079. +     tmps_base = oldtmps_base;
  1080. +     curspat = oldspat;
  1081. +     lastspat = oldlspat;
  1082. +     curcmd = oldcurcmd;
  1083. +     if (savestack->ary_fill > oldsave)    /* let them use local() */
  1084. +     restorelist(oldsave);
  1085. + 
  1086. +     return sp;
  1087. + }
  1088. + 
  1089.   /* This routine handles any switches that can be given during run */
  1090.   
  1091.   static char *
  1092. ***************
  1093. *** 1099,1105 ****
  1094.   {
  1095.       int numlen;
  1096.   
  1097. -   reswitch:
  1098.       switch (*s) {
  1099.       case '0':
  1100.       nrschar = scanoct(s, 4, &numlen);
  1101. --- 1198,1203 ----
  1102. ***************
  1103. *** 1141,1151 ****
  1104.   #else
  1105.       warn("Recompile perl with -DDEBUGGING to use -D switch\n");
  1106.   #endif
  1107. !     for (s++; isdigit(*s); s++) ;
  1108.       return s;
  1109.       case 'i':
  1110.       inplace = savestr(s+1);
  1111. !     for (s = inplace; *s && !isspace(*s); s++) ;
  1112.       *s = '\0';
  1113.       break;
  1114.       case 'I':
  1115. --- 1239,1251 ----
  1116.   #else
  1117.       warn("Recompile perl with -DDEBUGGING to use -D switch\n");
  1118.   #endif
  1119. !     /*SUPPRESS 530*/
  1120. !     for (s++; isDIGIT(*s); s++) ;
  1121.       return s;
  1122.       case 'i':
  1123.       inplace = savestr(s+1);
  1124. !     /*SUPPRESS 530*/
  1125. !     for (s = inplace; *s && !isSPACE(*s); s++) ;
  1126.       *s = '\0';
  1127.       break;
  1128.       case 'I':
  1129. ***************
  1130. *** 1162,1168 ****
  1131.       case 'l':
  1132.       minus_l = TRUE;
  1133.       s++;
  1134. !     if (isdigit(*s)) {
  1135.           ors = savestr("\n");
  1136.           orslen = 1;
  1137.           *ors = scanoct(s, 3 + (*s == '0'), &numlen);
  1138. --- 1262,1268 ----
  1139.       case 'l':
  1140.       minus_l = TRUE;
  1141.       s++;
  1142. !     if (isDIGIT(*s)) {
  1143.           ors = savestr("\n");
  1144.           orslen = 1;
  1145.           *ors = scanoct(s, 3 + (*s == '0'), &numlen);
  1146.  
  1147. Index: perl.h
  1148. *** perl.h.old    Tue Nov  5 19:27:19 1991
  1149. --- perl.h    Tue Nov  5 19:27:20 1991
  1150. ***************
  1151. *** 1,4 ****
  1152. ! /* $RCSfile: perl.h,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:25:10 $
  1153.    *
  1154.    *    Copyright (c) 1991, Larry Wall
  1155.    *
  1156. --- 1,4 ----
  1157. ! /* $RCSfile: perl.h,v $$Revision: 4.0.1.4 $$Date: 91/11/05 18:06:10 $
  1158.    *
  1159.    *    Copyright (c) 1991, Larry Wall
  1160.    *
  1161. ***************
  1162. *** 6,11 ****
  1163. --- 6,17 ----
  1164.    *    License or the Artistic License, as specified in the README file.
  1165.    *
  1166.    * $Log:    perl.h,v $
  1167. +  * Revision 4.0.1.4  91/11/05  18:06:10  lwall
  1168. +  * patch11: various portability fixes
  1169. +  * patch11: added support for dbz
  1170. +  * patch11: added some support for 64-bit integers
  1171. +  * patch11: hex() didn't understand leading 0x
  1172. +  * 
  1173.    * Revision 4.0.1.3  91/06/10  01:25:10  lwall
  1174.    * patch10: certain pattern optimizations were botched
  1175.    * 
  1176. ***************
  1177. *** 25,30 ****
  1178. --- 31,53 ----
  1179.   #define VOIDWANT 1
  1180.   #include "config.h"
  1181.   
  1182. + #ifdef MYMALLOC
  1183. + #   ifdef HIDEMYMALLOC
  1184. + #    define malloc Mymalloc
  1185. + #    define realloc Myremalloc
  1186. + #    define free Myfree
  1187. + #   endif
  1188. + #   define safemalloc malloc
  1189. + #   define saferealloc realloc
  1190. + #   define safefree free
  1191. + #endif
  1192. + 
  1193. + /* work around some libPW problems */
  1194. + #define fatal Myfatal
  1195. + #ifdef DOINIT
  1196. + char Error[1];
  1197. + #endif
  1198. + 
  1199.   #ifdef MSDOS
  1200.   /* This stuff now in the MS-DOS config.h file. */
  1201.   #else /* !MSDOS */
  1202. ***************
  1203. *** 197,202 ****
  1204. --- 220,242 ----
  1205.   #endif
  1206.   #endif
  1207.   
  1208. + #ifdef WANT_DBZ
  1209. + #include <dbz.h>
  1210. + #define SOME_DBM
  1211. + #define dbm_fetch(db,dkey) fetch(dkey)
  1212. + #define dbm_delete(db,dkey) fatal("dbz doesn't implement delete")
  1213. + #define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent)
  1214. + #define dbm_close(db) dbmclose()
  1215. + #define dbm_firstkey(db) (fatal("dbz doesn't implement traversal"),fetch())
  1216. + #define nextkey() (fatal("dbz doesn't implement traversal"),fetch())
  1217. + #define dbm_nextkey(db) (fatal("dbz doesn't implement traversal"),fetch())
  1218. + #ifdef HAS_NDBM
  1219. + #undef HAS_NDBM
  1220. + #endif
  1221. + #ifndef HAS_ODBM
  1222. + #define HAS_ODBM
  1223. + #endif
  1224. + #else
  1225.   #ifdef HAS_GDBM
  1226.   #ifdef I_GDBM
  1227.   #include <gdbm.h>
  1228. ***************
  1229. *** 234,239 ****
  1230. --- 274,280 ----
  1231.   #endif /* HAS_ODBM */
  1232.   #endif /* HAS_NDBM */
  1233.   #endif /* HAS_GDBM */
  1234. + #endif /* WANT_DBZ */
  1235.   #ifdef SOME_DBM
  1236.   EXT char *dbmkey;
  1237.   EXT int dbmlen;
  1238. ***************
  1239. *** 303,308 ****
  1240. --- 344,353 ----
  1241.   #   endif
  1242.   #endif
  1243.   
  1244. + #if S_ISBLK(060000) == 060000
  1245. +     XXX Your sys/stat.h appears to be buggy.  Please fix it.
  1246. + #endif
  1247. + 
  1248.   #ifndef S_ISREG
  1249.   #   define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
  1250.   #endif
  1251. ***************
  1252. *** 377,382 ****
  1253. --- 422,447 ----
  1254.   #undef f_next
  1255.   #endif
  1256.   
  1257. + #if defined(cray) || defined(gould)
  1258. + #   define SLOPPYDIVIDE
  1259. + #endif
  1260. + 
  1261. + #if defined(cray) || defined(convex) || BYTEORDER > 0xffff
  1262. + #   define QUAD
  1263. + #endif
  1264. + 
  1265. + #ifdef QUAD
  1266. + #   ifdef cray
  1267. + #    define quad int
  1268. + #   else
  1269. + #    ifdef convex
  1270. + #        define quad long long
  1271. + #    else
  1272. + #        define quad long
  1273. + #    endif
  1274. + #   endif
  1275. + #endif
  1276. + 
  1277.   typedef unsigned int STRLEN;
  1278.   
  1279.   typedef struct arg ARG;
  1280. ***************
  1281. *** 631,637 ****
  1282.   EXT char **origenviron;
  1283.   extern char **environ;
  1284.   
  1285. ! EXT line_t subline INIT(0);
  1286.   EXT STR *subname INIT(Nullstr);
  1287.   EXT int arybase INIT(0);
  1288.   
  1289. --- 696,702 ----
  1290.   EXT char **origenviron;
  1291.   extern char **environ;
  1292.   
  1293. ! EXT long subline INIT(0);
  1294.   EXT STR *subname INIT(Nullstr);
  1295.   EXT int arybase INIT(0);
  1296.   
  1297. ***************
  1298. *** 676,682 ****
  1299.   EXT int lastspbase;
  1300.   EXT int lastsize;
  1301.   
  1302. ! EXT char *hexdigit INIT("0123456789abcdef0123456789ABCDEF");
  1303.   EXT char *origfilename;
  1304.   EXT FILE * VOLATILE rsfp;
  1305.   EXT char buf[1024];
  1306. --- 741,747 ----
  1307.   EXT int lastspbase;
  1308.   EXT int lastsize;
  1309.   
  1310. ! EXT char *hexdigit INIT("0123456789abcdef0123456789ABCDEFx");
  1311.   EXT char *origfilename;
  1312.   EXT FILE * VOLATILE rsfp;
  1313.   EXT char buf[1024];
  1314. ***************
  1315. *** 753,758 ****
  1316. --- 818,824 ----
  1317.   void free_arg();
  1318.   STIO *stio_new();
  1319.   void hoistmust();
  1320. + void scanconst();
  1321.   
  1322.   EXT struct stat statbuf;
  1323.   EXT struct stat statcache;
  1324.  
  1325. Index: perl.man
  1326. *** perl.man.old    Tue Nov  5 19:27:27 1991
  1327. --- perl.man    Tue Nov  5 19:27:30 1991
  1328. ***************
  1329. *** 1,7 ****
  1330.   .rn '' }`
  1331. ! ''' $RCSfile: perl.man,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:26:02 $
  1332.   ''' 
  1333.   ''' $Log:    perl.man,v $
  1334.   ''' Revision 4.0.1.3  91/06/10  01:26:02  lwall
  1335.   ''' patch10: documented some newer features in addenda
  1336.   ''' 
  1337. --- 1,13 ----
  1338.   .rn '' }`
  1339. ! ''' $RCSfile: perl.man,v $$Revision: 4.0.1.4 $$Date: 91/11/05 18:11:05 $
  1340.   ''' 
  1341.   ''' $Log:    perl.man,v $
  1342. + ''' Revision 4.0.1.4  91/11/05  18:11:05  lwall
  1343. + ''' patch11: added sort {} LIST
  1344. + ''' patch11: added eval {}
  1345. + ''' patch11: documented meaning of scalar(%foo)
  1346. + ''' patch11: sprintf() now supports any length of s field
  1347. + ''' 
  1348.   ''' Revision 4.0.1.3  91/06/10  01:26:02  lwall
  1349.   ''' patch10: documented some newer features in addenda
  1350.   ''' 
  1351. ***************
  1352. *** 449,456 ****
  1353.   allows
  1354.   .I perl
  1355.   to do unsafe operations.
  1356. ! Currently the only \*(L"unsafe\*(R" operation is the unlinking of directories while
  1357. ! running as superuser.
  1358.   .TP 5
  1359.   .B \-v
  1360.   prints the version and patchlevel of your
  1361. --- 455,463 ----
  1362.   allows
  1363.   .I perl
  1364.   to do unsafe operations.
  1365. ! Currently the only \*(L"unsafe\*(R" operations are the unlinking of directories while
  1366. ! running as superuser, and running setuid programs with fatal taint checks
  1367. ! turned into warnings.
  1368.   .TP 5
  1369.   .B \-v
  1370.   prints the version and patchlevel of your
  1371. ***************
  1372. *** 479,485 ****
  1373.   The
  1374.   .B \-x
  1375.   switch only controls the the disposal of leading garbage.
  1376. ! The script must be terminated with __END__ if there is trailing garbage
  1377.   to be ignored (the script can process any or all of the trailing garbage
  1378.   via the DATA filehandle if desired).
  1379.   .Sh "Data Types and Objects"
  1380. --- 486,492 ----
  1381.   The
  1382.   .B \-x
  1383.   switch only controls the the disposal of leading garbage.
  1384. ! The script must be terminated with _\|_END_\|_ if there is trailing garbage
  1385.   to be ignored (the script can process any or all of the trailing garbage
  1386.   via the DATA filehandle if desired).
  1387.   .Sh "Data Types and Objects"
  1388. ***************
  1389. *** 573,581 ****
  1390.   The following is always true:
  1391.   .nf
  1392.   
  1393. !     @whatever == $#whatever \- $[ + 1;
  1394.   
  1395.   .fi
  1396.   .PP
  1397.   Multi-dimensional arrays are not directly supported, but see the discussion
  1398.   of the $; variable later for a means of emulating multiple subscripts with
  1399. --- 580,593 ----
  1400.   The following is always true:
  1401.   .nf
  1402.   
  1403. !     scalar(@whatever) == $#whatever \- $[ + 1;
  1404.   
  1405.   .fi
  1406. + If you evaluate an associative array in a scalar context, it returns
  1407. + a value which is true if and only if the array contains any elements.
  1408. + (If there are any elements, the value returned is a string consisting
  1409. + of the number of used buckets and the number of allocated buckets, separated
  1410. + by a slash.)
  1411.   .PP
  1412.   Multi-dimensional arrays are not directly supported, but see the discussion
  1413.   of the $; variable later for a means of emulating multiple subscripts with
  1414. ***************
  1415. *** 666,679 ****
  1416.   word by a space, since single quote is a valid character in an identifier
  1417.   (see Packages).
  1418.   .PP
  1419. ! Two special literals are __LINE__ and __FILE__, which represent the current
  1420.   line number and filename at that point in your program.
  1421.   They may only be used as separate tokens; they will not be interpolated
  1422.   into strings.
  1423. ! In addition, the token __END__ may be used to indicate the logical end of the
  1424.   script before the actual end of file.
  1425.   Any following text is ignored (but may be read via the DATA filehandle).
  1426. ! The two control characters ^D and ^Z are synonyms for __END__.
  1427.   .PP
  1428.   A word that doesn't have any other interpretation in the grammar will be
  1429.   treated as if it had single quotes around it.
  1430. --- 678,691 ----
  1431.   word by a space, since single quote is a valid character in an identifier
  1432.   (see Packages).
  1433.   .PP
  1434. ! Two special literals are _\|_LINE_\|_ and _\|_FILE_\|_, which represent the current
  1435.   line number and filename at that point in your program.
  1436.   They may only be used as separate tokens; they will not be interpolated
  1437.   into strings.
  1438. ! In addition, the token _\|_END_\|_ may be used to indicate the logical end of the
  1439.   script before the actual end of file.
  1440.   Any following text is ignored (but may be read via the DATA filehandle).
  1441. ! The two control characters ^D and ^Z are synonyms for _\|_END_\|_.
  1442.   .PP
  1443.   A word that doesn't have any other interpretation in the grammar will be
  1444.   treated as if it had single quotes around it.
  1445. ***************
  1446. *** 1844,1850 ****
  1447.   DBNAME is the name of the database (without the .dir or .pag extension).
  1448.   If the database does not exist, it is created with protection specified
  1449.   by MODE (as modified by the umask).
  1450. ! If your system only supports the older dbm functions, you may only have one
  1451.   dbmopen in your program.
  1452.   If your system has neither dbm nor ndbm, calling dbmopen produces a fatal
  1453.   error.
  1454. --- 1856,1862 ----
  1455.   DBNAME is the name of the database (without the .dir or .pag extension).
  1456.   If the database does not exist, it is created with protection specified
  1457.   by MODE (as modified by the umask).
  1458. ! If your system only supports the older dbm functions, you may perform only one
  1459.   dbmopen in your program.
  1460.   If your system has neither dbm nor ndbm, calling dbmopen produces a fatal
  1461.   error.
  1462. ***************
  1463. *** 1896,1902 ****
  1464.           unless defined($value = readlink $sym);
  1465.       eval '@foo = ()' if defined(@foo);
  1466.       die "No XYZ package defined" unless defined %_XYZ;
  1467. !     sub foo { defined &bar ? &bar(@_) : die "No bar"; }
  1468.   
  1469.   .fi
  1470.   See also undef.
  1471. --- 1908,1914 ----
  1472.           unless defined($value = readlink $sym);
  1473.       eval '@foo = ()' if defined(@foo);
  1474.       die "No XYZ package defined" unless defined %_XYZ;
  1475. !     sub foo { defined &$bar ? &$bar(@_) : die "No bar"; }
  1476.   
  1477.   .fi
  1478.   See also undef.
  1479. ***************
  1480. *** 1984,2001 ****
  1481.   If you pass arrays as part of LIST you may wish to pass the length
  1482.   of the array in front of each array.
  1483.   (See the section on subroutines later on.)
  1484. - SUBROUTINE may be a scalar variable, in which case the variable contains
  1485. - the name of the subroutine to execute.
  1486.   The parentheses are required to avoid confusion with the \*(L"do EXPR\*(R"
  1487.   form.
  1488.   .Sp
  1489. ! As an alternate form, you may call a subroutine by prefixing the name with
  1490.   an ampersand: &foo(@args).
  1491.   If you aren't passing any arguments, you don't have to use parentheses.
  1492.   If you omit the parentheses, no @_ array is passed to the subroutine.
  1493.   The & form is also used to specify subroutines to the defined and undef
  1494. ! operators.
  1495. ! .Ip "do EXPR" 8 3
  1496.   Uses the value of EXPR as a filename and executes the contents of the file
  1497.   as a
  1498.   .I perl
  1499. --- 1996,2020 ----
  1500.   If you pass arrays as part of LIST you may wish to pass the length
  1501.   of the array in front of each array.
  1502.   (See the section on subroutines later on.)
  1503.   The parentheses are required to avoid confusion with the \*(L"do EXPR\*(R"
  1504.   form.
  1505.   .Sp
  1506. ! SUBROUTINE may also be a single scalar variable, in which case
  1507. ! the name of the subroutine to execute is taken from the variable.
  1508. ! .Sp
  1509. ! As an alternate (and preferred) form,
  1510. ! you may call a subroutine by prefixing the name with
  1511.   an ampersand: &foo(@args).
  1512.   If you aren't passing any arguments, you don't have to use parentheses.
  1513.   If you omit the parentheses, no @_ array is passed to the subroutine.
  1514.   The & form is also used to specify subroutines to the defined and undef
  1515. ! operators:
  1516. ! .nf
  1517. ! 
  1518. !     if (defined &$var) { &$var($parm); undef &$var; }
  1519. ! 
  1520. ! .fi
  1521. ! :Ip "do EXPR" 8 3
  1522.   Uses the value of EXPR as a filename and executes the contents of the file
  1523.   as a
  1524.   .I perl
  1525. ***************
  1526. *** 2128,2133 ****
  1527. --- 2147,2153 ----
  1528.   .fi
  1529.   .Ip "eval(EXPR)" 8 6
  1530.   .Ip "eval EXPR" 8 6
  1531. + .Ip "eval BLOCK" 8 6
  1532.   EXPR is parsed and executed as if it were a little
  1533.   .I perl
  1534.   program.
  1535. ***************
  1536. *** 2149,2154 ****
  1537. --- 2169,2201 ----
  1538.   (such as dbmopen or symlink) is implemented.
  1539.   It is also Perl's exception trapping mechanism, where the die operator is
  1540.   used to raise exceptions.
  1541. + .Sp
  1542. + If the code to be executed doesn't vary, you may use
  1543. + the eval-BLOCK form to trap run-time errors without incurring
  1544. + the penalty of recompiling each time.
  1545. + The error, if any, is still returned in $@.
  1546. + Evaluating a single-quoted string (as EXPR) has the same effect, except that
  1547. + the eval-EXPR form reports syntax errors at run time via $@, whereas the
  1548. + eval-BLOCK form reports syntax errors at compile time.  The eval-EXPR form
  1549. + is optimized to eval-BLOCK the first time it succeeds.  (Since the replacement
  1550. + side of a substitution is considered a single-quoted string when you
  1551. + use the e modifier, the same optimization occurs there.)  Examples:
  1552. + .nf
  1553. + 
  1554. + .ne 11
  1555. +     # make divide-by-zero non-fatal
  1556. +     eval { $answer = $a / $b; }; warn $@ if $@;
  1557. + 
  1558. +     # optimized to same thing after first use
  1559. +     eval '$answer = $a / $b'; warn $@ if $@;
  1560. + 
  1561. +     # a compile-time error
  1562. +     eval { $answer = };
  1563. + 
  1564. +     # a run-time error
  1565. +     eval '$answer =';    # sets $@
  1566. + 
  1567. + .fi
  1568.   .Ip "exec(LIST)" 8 8
  1569.   .Ip "exec LIST" 8 6
  1570.   If there is more than one argument in LIST, or if LIST is an array with
  1571. ***************
  1572. *** 3558,3565 ****
  1573.   .Ip "sleep EXPR" 8
  1574.   .Ip "sleep" 8
  1575.   Causes the script to sleep for EXPR seconds, or forever if no EXPR.
  1576. ! May be interrupted by sending the process a SIGALARM.
  1577.   Returns the number of seconds actually slept.
  1578.   .Ip "socket(SOCKET,DOMAIN,TYPE,PROTOCOL)" 8 3
  1579.   Opens a socket of the specified kind and attaches it to filehandle SOCKET.
  1580.   DOMAIN, TYPE and PROTOCOL are specified the same as for the system call
  1581. --- 3605,3614 ----
  1582.   .Ip "sleep EXPR" 8
  1583.   .Ip "sleep" 8
  1584.   Causes the script to sleep for EXPR seconds, or forever if no EXPR.
  1585. ! May be interrupted by sending the process a SIGALRM.
  1586.   Returns the number of seconds actually slept.
  1587. + You probably cannot mix alarm() and sleep() calls, since sleep() is
  1588. + often implemented using alarm().
  1589.   .Ip "socket(SOCKET,DOMAIN,TYPE,PROTOCOL)" 8 3
  1590.   Opens a socket of the specified kind and attaches it to filehandle SOCKET.
  1591.   DOMAIN, TYPE and PROTOCOL are specified the same as for the system call
  1592. ***************
  1593. *** 3578,3602 ****
  1594.   .Ip "sort(SUBROUTINE LIST)" 8 9
  1595.   .Ip "sort(LIST)" 8
  1596.   .Ip "sort SUBROUTINE LIST" 8
  1597.   .Ip "sort LIST" 8
  1598.   Sorts the LIST and returns the sorted array value.
  1599.   Nonexistent values of arrays are stripped out.
  1600. ! If SUBROUTINE is omitted, sorts in standard string comparison order.
  1601.   If SUBROUTINE is specified, gives the name of a subroutine that returns
  1602.   an integer less than, equal to, or greater than 0,
  1603.   depending on how the elements of the array are to be ordered.
  1604.   (The <=> and cmp operators are extremely useful in such routines.)
  1605.   In the interests of efficiency the normal calling code for subroutines
  1606.   is bypassed, with the following effects: the subroutine may not be a recursive
  1607.   subroutine, and the two elements to be compared are passed into the subroutine
  1608.   not via @_ but as $a and $b (see example below).
  1609.   They are passed by reference so don't modify $a and $b.
  1610. ! SUBROUTINE may be a scalar variable name, in which case the value provides
  1611. ! the name of the subroutine to use.
  1612.   Examples:
  1613.   .nf
  1614.   
  1615. ! .ne 4
  1616.       sub byage {
  1617.           $age{$a} <=> $age{$b};    # presuming integers
  1618.       }
  1619. --- 3627,3677 ----
  1620.   .Ip "sort(SUBROUTINE LIST)" 8 9
  1621.   .Ip "sort(LIST)" 8
  1622.   .Ip "sort SUBROUTINE LIST" 8
  1623. + .Ip "sort BLOCK LIST" 8
  1624.   .Ip "sort LIST" 8
  1625.   Sorts the LIST and returns the sorted array value.
  1626.   Nonexistent values of arrays are stripped out.
  1627. ! If SUBROUTINE or BLOCK is omitted, sorts in standard string comparison order.
  1628.   If SUBROUTINE is specified, gives the name of a subroutine that returns
  1629.   an integer less than, equal to, or greater than 0,
  1630.   depending on how the elements of the array are to be ordered.
  1631.   (The <=> and cmp operators are extremely useful in such routines.)
  1632. + SUBROUTINE may be a scalar variable name, in which case the value provides
  1633. + the name of the subroutine to use.
  1634. + In place of a SUBROUTINE name, you can provide a BLOCK as an anonymous,
  1635. + in-line sort subroutine.
  1636. + .Sp
  1637.   In the interests of efficiency the normal calling code for subroutines
  1638.   is bypassed, with the following effects: the subroutine may not be a recursive
  1639.   subroutine, and the two elements to be compared are passed into the subroutine
  1640.   not via @_ but as $a and $b (see example below).
  1641.   They are passed by reference so don't modify $a and $b.
  1642. ! .Sp
  1643.   Examples:
  1644.   .nf
  1645.   
  1646. ! .ne 2
  1647. !     # sort lexically
  1648. !     @articles = sort @files;
  1649. ! 
  1650. ! .ne 2
  1651. !     # same thing, but with explicit sort routine
  1652. !     @articles = sort {$a cmp $b;} @files;
  1653. ! 
  1654. ! .ne 2
  1655. !     # same thing in reversed order
  1656. !     @articles = sort {$b cmp $a;} @files;
  1657. ! 
  1658. ! .ne 2
  1659. !     # sort numerically ascending
  1660. !     @articles = sort {$a <=> $b;} @files;
  1661. ! 
  1662. ! .ne 2
  1663. !     # sort numerically descending
  1664. !     @articles = sort {$b <=> $a;} @files;
  1665. ! 
  1666. ! .ne 5
  1667. !     # sort using explicit subroutine name
  1668.       sub byage {
  1669.           $age{$a} <=> $age{$b};    # presuming integers
  1670.       }
  1671. ***************
  1672. *** 4175,4183 ****
  1673.   record, the page is advanced by writing a form feed,
  1674.   a special top-of-page format is used
  1675.   to format the new page header, and then the record is written.
  1676. ! By default the top-of-page format is \*(L"top\*(R", but it
  1677. ! may be set to the
  1678. ! format of your choice by assigning the name to the $^ variable.
  1679.   The number of lines remaining on the current page is in variable $-, which
  1680.   can be set to 0 to force a new page.
  1681.   .Sp
  1682. --- 4250,4259 ----
  1683.   record, the page is advanced by writing a form feed,
  1684.   a special top-of-page format is used
  1685.   to format the new page header, and then the record is written.
  1686. ! By default the top-of-page format is the name of the filehandle with
  1687. ! \*(L"_TOP\*(R" appended, but it may be dynamicallly set to the
  1688. ! format of your choice by assigning the name to the $^ variable while
  1689. ! the filehandle is selected.
  1690.   The number of lines remaining on the current page is in variable $-, which
  1691.   can be set to 0 to force a new page.
  1692.   .Sp
  1693. ***************
  1694. *** 5574,5580 ****
  1695.   
  1696.   .fi
  1697.   .SH AUTHOR
  1698. ! Larry Wall <lwall@jpl-devvax.Jpl.Nasa.Gov>
  1699.   .br
  1700.   MS-DOS port by Diomidis Spinellis <dds@cc.ic.ac.uk>
  1701.   .SH FILES
  1702. --- 5650,5656 ----
  1703.   
  1704.   .fi
  1705.   .SH AUTHOR
  1706. ! Larry Wall <lwall@netlabs.com>
  1707.   .br
  1708.   MS-DOS port by Diomidis Spinellis <dds@cc.ic.ac.uk>
  1709.   .SH FILES
  1710. ***************
  1711. *** 5775,5780 ****
  1712. --- 5851,5859 ----
  1713.   
  1714.   .fi
  1715.   .PP
  1716. + The descriptions of alarm and sleep refer to signal SIGALARM.  These
  1717. + should refer to SIGALRM.
  1718. + .PP
  1719.   The
  1720.   .B \-0
  1721.   switch to set the initial value of $/ was added to Perl after the book
  1722. ***************
  1723. *** 5810,5815 ****
  1724. --- 5889,5899 ----
  1725.   to iterate through a string finding multiple matches.
  1726.   .PP
  1727.   All of the $^X variables are new except for $^T.
  1728. + .PP
  1729. + The default top-of-form format for FILEHANDLE is now FILEHANDLE_TOP rather
  1730. + than top.
  1731. + .PP
  1732. + The eval {} and sort {} constructs were added in version 4.011.
  1733.   .SH BUGS
  1734.   .PP
  1735.   .I Perl
  1736. ***************
  1737. *** 5823,5831 ****
  1738.   .PP
  1739.   While none of the built-in data types have any arbitrary size limits (apart
  1740.   from memory size), there are still a few arbitrary limits:
  1741. ! a given identifier may not be longer than 255 characters;
  1742. ! sprintf is limited on many machines to 128 characters per field (unless the format
  1743. ! specifier is exactly %s);
  1744.   and no component of your PATH may be longer than 255 if you use \-S.
  1745.   .PP
  1746.   .I Perl
  1747. --- 5907,5913 ----
  1748.   .PP
  1749.   While none of the built-in data types have any arbitrary size limits (apart
  1750.   from memory size), there are still a few arbitrary limits:
  1751. ! a given identifier may not be longer than 255 characters,
  1752.   and no component of your PATH may be longer than 255 if you use \-S.
  1753.   .PP
  1754.   .I Perl
  1755.  
  1756. *** End of Patch 15 ***
  1757. exit 0 # Just in case...
  1758. -- 
  1759. Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
  1760. Sterling Software, IMD           UUCP:     uunet!sparky!kent
  1761. Phone:    (402) 291-8300         FAX:      (402) 291-4362
  1762. Please send comp.sources.misc-related mail to kent@uunet.uu.net.
  1763.