home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume25 / perl / patch19 < prev    next >
Encoding:
Text File  |  1991-11-13  |  42.5 KB  |  1,697 lines
  1. Newsgroups: comp.sources.misc
  2. From: lwall@netlabs.com (Larry Wall)
  3. Subject:  v25i068:  perl - The perl programming language, Patch19
  4. Message-ID: <1991Nov13.214841.4272@sparky.imd.sterling.com>
  5. X-Md4-Signature: 7020affa705e9d173a8d35be360fc0b5
  6. Date: Wed, 13 Nov 1991 21:48:41 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: lwall@netlabs.com (Larry Wall)
  10. Posting-number: Volume 25, Issue 68
  11. Archive-name: perl/patch19
  12. Environment: UNIX, MS-DOS, OS2
  13. Patch-To: perl: Volume 18, Issue 19-54
  14.  
  15. System: perl version 4.0
  16. Patch #: 19
  17. Priority: HIGH
  18.  
  19. Ok, here's the cleanup patch I suggested you wait for.  Have at it...
  20.  
  21. Subject: added little-endian pack/unpack options
  22.     
  23.     This is the only enhancement in this patch, but it seemed unlikely
  24.     to bust anything else, and added functionality that it was very
  25.     difficult to do any other way.  Compliments of David W. Sanderson.
  26.  
  27. Subject: op/regexp.t failed from missing arg to bcmp()
  28. Subject: study was busted by 4.018
  29. Subject: sort $subname was busted by changes in 4.018
  30. Subject: default arg for shift was wrong after first subroutine definition
  31.  
  32.     Things that broke in 4.018.  Shame on me.
  33.  
  34. Subject: do {$foo ne "bar";} returned wrong value
  35.  
  36.     A bug of long standing.  How come nobody saw this one?  Or if you
  37.     did, why didn't you report it before now?  Or if you did, why did
  38.     I ignore you?  :-)
  39.  
  40. Subject: some machines need -lsocket before -lnsl
  41. Subject: some earlier patches weren't propagated to alternate 286 code
  42. Subject: compile in the x2p directory couldn't find cppstdin
  43. Subject: more hints for aix, isc, hp, sco, uts
  44. Subject: installperl no longer updates unchanged library files
  45. Subject: uts wrongly defines S_ISDIR() et al
  46. Subject: too many preprocessors can't expand a macro right in #if
  47.  
  48.     The usual pastiche of portability kludges.
  49.  
  50. Subject: deleted some unused functions from usersub.c
  51.  
  52.     And fixed the spelling of John Macdonald's name, and included his
  53.     suggested workaround for a certain vendor's stdio bug...
  54.  
  55. Subject: added readdir test
  56. Subject: made op/groups.t more reliable
  57. Subject: added test for sort $subname to op/sort.t
  58. Subject: added some hacks to op/stat.t for weird filesystem architectures
  59.  
  60.     Improvements (hopefully) to the regression tests.
  61.  
  62. Fix:    From rn, say "| patch -p -N -d DIR", where DIR is your perl source
  63.     directory.  Outside of rn, say "cd DIR; patch -p -N <thisarticle".
  64.     If you don't have the patch program, apply the following by hand,
  65.     or get patch (version 2.0, latest patchlevel).
  66.  
  67.     After patching:
  68.         Configure -d
  69.         make depend
  70.         make
  71.         make test
  72.         make install
  73.  
  74.     If patch indicates that patchlevel is the wrong version, you may need
  75.     to apply one or more previous patches, or the patch may already
  76.     have been applied.  See the patchlevel.h file to find out what has or
  77.     has not been applied.  In any event, don't continue with the patch.
  78.  
  79.     If you are missing previous patches they can be obtained from me:
  80.  
  81.     Larry Wall
  82.     lwall@netlabs.com
  83.  
  84.     If you send a mail message of the following form it will greatly speed
  85.     processing:
  86.  
  87.     Subject: Command
  88.     @SH mailpatch PATH perl 4.0 LIST
  89.            ^ note the c
  90.  
  91.     where PATH is a return path FROM ME TO YOU either in Internet notation,
  92.     or in bang notation from some well-known host, and LIST is the number
  93.     of one or more patches you need, separated by spaces, commas, and/or
  94.     hyphens.  Saying 35- says everything from 35 to the end.
  95.  
  96.  
  97. Index: patchlevel.h
  98. Prereq: 18
  99. 1c1
  100. < #define PATCHLEVEL 18
  101. ---
  102. > #define PATCHLEVEL 19
  103.  
  104. Index: Configure
  105. Prereq: 4.0.1.5
  106. *** Configure.old    Mon Nov 11 16:49:01 1991
  107. --- Configure    Mon Nov 11 16:49:03 1991
  108. ***************
  109. *** 8,14 ****
  110.   # and edit it to reflect your system.  Some packages may include samples
  111.   # of config.h for certain machines, so you might look for one of those.)
  112.   #
  113. ! # $RCSfile: Configure,v $$Revision: 4.0.1.5 $$Date: 91/11/05 23:11:32 $
  114.   #
  115.   # Yes, you may rip this off to use in other distribution packages.
  116.   # (Note: this Configure script was generated automatically.  Rather than
  117. --- 8,14 ----
  118.   # and edit it to reflect your system.  Some packages may include samples
  119.   # of config.h for certain machines, so you might look for one of those.)
  120.   #
  121. ! # $RCSfile: Configure,v $$Revision: 4.0.1.6 $$Date: 91/11/11 16:26:51 $
  122.   #
  123.   # Yes, you may rip this off to use in other distribution packages.
  124.   # (Note: this Configure script was generated automatically.  Rather than
  125. ***************
  126. *** 354,360 ****
  127.   d_ndir=ndir
  128.   voidwant=1
  129.   voidwant=7
  130. ! libswanted="c_s net_s net nsl_s nsl socket nm ndir ndbm dbm PW malloc sun m bsd BSD x posix ucb"
  131.   inclwanted='/usr/include /usr/netinclude /usr/include/sun /usr/include/bsd /usr/include/lan /usr/ucbinclude'
  132.   
  133.   : Now test for existence of everything in MANIFEST
  134. --- 354,360 ----
  135.   d_ndir=ndir
  136.   voidwant=1
  137.   voidwant=7
  138. ! libswanted="c_s net_s net socket nsl_s nsl nm ndir ndbm dbm PW malloc sun m bsd BSD x posix ucb"
  139.   inclwanted='/usr/include /usr/netinclude /usr/include/sun /usr/include/bsd /usr/include/lan /usr/ucbinclude'
  140.   
  141.   : Now test for existence of everything in MANIFEST
  142. ***************
  143. *** 596,602 ****
  144. --- 596,604 ----
  145.   cpp
  146.   csh
  147.   egrep
  148. + line
  149.   nroff
  150. + perl
  151.   test
  152.   uname
  153.   yacc
  154. ***************
  155. *** 2292,2298 ****
  156.   : index or strcpy
  157.   echo " "
  158.   case "$d_index" in
  159. ! n) dflt=n;;
  160.   *)  if $test -f /unix; then
  161.       dflt=n
  162.       else
  163. --- 2294,2300 ----
  164.   : index or strcpy
  165.   echo " "
  166.   case "$d_index" in
  167. ! undef) dflt=n;;
  168.   *)  if $test -f /unix; then
  169.       dflt=n
  170.       else
  171. ***************
  172. *** 2377,2382 ****
  173. --- 2379,2444 ----
  174.   set d_msg
  175.   eval $setvar
  176.   
  177. + : determine which malloc to compile in
  178. + echo " "
  179. + case "$d_mymalloc" in
  180. + '')
  181. +     case "$usemymalloc" in
  182. +     '')
  183. +     if bsd || v7; then
  184. +         dflt='y'
  185. +     else
  186. +         dflt='n'
  187. +     fi
  188. +     ;;
  189. +     n*) dflt=n;;
  190. +     *)  dflt=y;;
  191. +     esac
  192. +     ;;
  193. + define)  dflt="y"
  194. +     ;;
  195. + *)  dflt="n"
  196. +     ;;
  197. + esac
  198. + rp="Do you wish to attempt to use the malloc that comes with $package? [$dflt]"
  199. + $echo $n "$rp $c"
  200. + . myread
  201. + case "$ans" in
  202. + '') ans=$dflt;;
  203. + esac
  204. + case "$ans" in
  205. + y*) mallocsrc='malloc.c'; mallocobj='malloc.o'
  206. +     libs=`echo $libs | sed 's/-lmalloc//'`
  207. +     val="$define"
  208. +     case "$mallocptrtype" in
  209. +     '')
  210. +     cat >usemymalloc.c <<'END'
  211. + #ifdef __STDC__
  212. + #include <stdlib.h>
  213. + #else
  214. + #include <malloc.h>
  215. + #endif
  216. + void *malloc();
  217. + END
  218. +     if $cc $ccflags -c usemymalloc.c >/dev/null 2>&1; then
  219. +         mallocptrtype=void
  220. +     else
  221. +         mallocptrtype=char
  222. +     fi
  223. +     ;;
  224. +     esac
  225. +     echo " "
  226. +     echo "Your system wants malloc to return $mallocptrtype*, it would seem."
  227. +     ;;
  228. + *)  mallocsrc='';
  229. +     mallocobj='';
  230. +     mallocptrtype=void
  231. +     val="$define"
  232. +     ;;
  233. + esac
  234. + set d_mymalloc
  235. + eval $setvar
  236. + 
  237.   : see if ndbm is available
  238.   echo " "
  239.   xxx=`./loc ndbm.h x $usrinclude /usr/local/include $inclwanted`
  240. ***************
  241. *** 3052,3117 ****
  242.   $echo $n "$rp $c"
  243.   . myread
  244.   intsize="$ans"
  245. - 
  246. - : determine which malloc to compile in
  247. - echo " "
  248. - case "$d_mymalloc" in
  249. - '')
  250. -     case "$usemymalloc" in
  251. -     '')
  252. -     if bsd || v7; then
  253. -         dflt='y'
  254. -     else
  255. -         dflt='n'
  256. -     fi
  257. -     ;;
  258. -     n*) dflt=n;;
  259. -     *)  dflt=y;;
  260. -     esac
  261. -     ;;
  262. - define)  dflt="y"
  263. -     ;;
  264. - *)  dflt="n"
  265. -     ;;
  266. - esac
  267. - rp="Do you wish to attempt to use the malloc that comes with $package? [$dflt]"
  268. - $echo $n "$rp $c"
  269. - . myread
  270. - case "$ans" in
  271. - '') ans=$dflt;;
  272. - esac
  273. - case "$ans" in
  274. - y*) mallocsrc='malloc.c'; mallocobj='malloc.o'
  275. -     libs=`echo $libs | sed 's/-lmalloc//'`
  276. -     val="$define"
  277. -     case "$mallocptrtype" in
  278. -     '')
  279. -     cat >usemymalloc.c <<'END'
  280. - #ifdef __STDC__
  281. - #include <stdlib.h>
  282. - #else
  283. - #include <malloc.h>
  284. - #endif
  285. - void *malloc();
  286. - END
  287. -     if $cc $ccflags -c usemymalloc.c >/dev/null 2>&1; then
  288. -         mallocptrtype=void
  289. -     else
  290. -         mallocptrtype=char
  291. -     fi
  292. -     ;;
  293. -     esac
  294. -     echo " "
  295. -     echo "Your system wants malloc to return $mallocptrtype*, it would seem."
  296. -     ;;
  297. - *)  mallocsrc='';
  298. -     mallocobj='';
  299. -     mallocptrtype=void
  300. -     val="$define"
  301. -     ;;
  302. - esac
  303. - set d_mymalloc
  304. - eval $setvar
  305.   
  306.   : determine where private executables go
  307.   case "$privlib" in
  308. --- 3114,3119 ----
  309.  
  310. Index: MANIFEST
  311. *** MANIFEST.old    Mon Nov 11 16:49:07 1991
  312. --- MANIFEST    Mon Nov 11 16:49:07 1991
  313. ***************
  314. *** 109,114 ****
  315. --- 109,115 ----
  316.   hints/hp9000_800.sh    
  317.   hints/hpux.sh
  318.   hints/i386.sh
  319. + hints/isc_3_2_2.sh
  320.   hints/mips.sh
  321.   hints/mpc.sh    
  322.   hints/ncr_tower.sh
  323. ***************
  324. *** 287,292 ****
  325. --- 288,294 ----
  326.   t/op/range.t        See if .. works
  327.   t/op/re_tests        Input file for op.regexp
  328.   t/op/read.t        See if read() works
  329. + t/op/readdir.t        See if readdir() works
  330.   t/op/regexp.t        See if regular expressions work
  331.   t/op/repeat.t        See if x operator works
  332.   t/op/s.t        See if substitutions work
  333.  
  334. Index: hints/aix_rs.sh
  335. *** hints/aix_rs.sh.old    Mon Nov 11 16:49:25 1991
  336. --- hints/aix_rs.sh    Mon Nov 11 16:49:25 1991
  337. ***************
  338. *** 1,5 ****
  339. ! eval_cflags='optimize="-g"'
  340. ! toke_cflags='optimize="-g"'
  341. ! teval_cflags='optimize="-g"'
  342. ! ttoke_cflags='optimize="-g"';
  343.   ccflags="$ccflags -D_NO_PROTO"
  344. --- 1,7 ----
  345. ! eval_cflags='optimize=""'
  346. ! toke_cflags='optimize=""'
  347. ! teval_cflags='optimize=""'
  348. ! ttoke_cflags='optimize=""'
  349.   ccflags="$ccflags -D_NO_PROTO"
  350. + cppstdin='/lib/cpp -D_AIX -D_IBMR2'
  351. + cppminus=''
  352.  
  353. Index: cmd.c
  354. *** cmd.c.old    Mon Nov 11 16:49:10 1991
  355. --- cmd.c    Mon Nov 11 16:49:10 1991
  356. ***************
  357. *** 1,4 ****
  358. ! /* $RCSfile: cmd.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 16:07:43 $
  359.    *
  360.    *    Copyright (c) 1991, Larry Wall
  361.    *
  362. --- 1,4 ----
  363. ! /* $RCSfile: cmd.c,v $$Revision: 4.0.1.4 $$Date: 91/11/11 16:29:33 $
  364.    *
  365.    *    Copyright (c) 1991, Larry Wall
  366.    *
  367. ***************
  368. *** 6,11 ****
  369. --- 6,15 ----
  370.    *    License or the Artistic License, as specified in the README file.
  371.    *
  372.    * $Log:    cmd.c,v $
  373. +  * Revision 4.0.1.4  91/11/11  16:29:33  lwall
  374. +  * patch19: do {$foo ne "bar";} returned wrong value
  375. +  * patch19: some earlier patches weren't propagated to alternate 286 code
  376. +  * 
  377.    * Revision 4.0.1.3  91/11/05  16:07:43  lwall
  378.    * patch11: random cleanup
  379.    * patch11: "foo\0" eq "foo" was sometimes optimized to true
  380. ***************
  381. *** 367,379 ****
  382.               if (cmd->c_spat)
  383.               lastspat = cmd->c_spat;
  384.               match = !(cmdflags & CF_FIRSTNEG);
  385. !             retstr = &str_yes;
  386.               goto flipmaybe;
  387.           }
  388.           }
  389.           else if (cmdflags & CF_NESURE) {
  390.           match = cmdflags & CF_FIRSTNEG;
  391. !         retstr = &str_no;
  392.           goto flipmaybe;
  393.           }
  394.   #else
  395. --- 371,383 ----
  396.               if (cmd->c_spat)
  397.               lastspat = cmd->c_spat;
  398.               match = !(cmdflags & CF_FIRSTNEG);
  399. !             retstr = match ? &str_yes : &str_no;
  400.               goto flipmaybe;
  401.           }
  402.           }
  403.           else if (cmdflags & CF_NESURE) {
  404.           match = cmdflags & CF_FIRSTNEG;
  405. !         retstr = match ? &str_yes : &str_no;
  406.           goto flipmaybe;
  407.           }
  408.   #else
  409. ***************
  410. *** 380,385 ****
  411. --- 384,390 ----
  412.           {
  413.           char *zap1, *zap2, zap1c, zap2c;
  414.           int  zaplen;
  415. +         int lenok;
  416.   
  417.           zap1 = cmd->c_short->str_ptr;
  418.           zap2 = str_get(retstr);
  419. ***************
  420. *** 386,392 ****
  421.           zap1c = *zap1;
  422.           zap2c = *zap2;
  423.           zaplen = cmd->c_slen;
  424. !         if ((zap1c == zap2c) && (bcmp(zap1, zap2, zaplen) == 0)) {
  425.               if (cmdflags & CF_EQSURE) {
  426.               if (sawampersand &&
  427.                 (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
  428. --- 391,401 ----
  429.           zap1c = *zap1;
  430.           zap2c = *zap2;
  431.           zaplen = cmd->c_slen;
  432. !         if (match)
  433. !             lenok = (retstr->str_cur == cmd->c_slen - 1);
  434. !         else
  435. !             lenok = (retstr->str_cur >= cmd->c_slen);
  436. !         if ((zap1c == zap2c) && lenok && (bcmp(zap1, zap2, zaplen) == 0)) {
  437.               if (cmdflags & CF_EQSURE) {
  438.               if (sawampersand &&
  439.                 (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
  440. ***************
  441. *** 403,415 ****
  442.               if (cmd->c_spat)
  443.                   lastspat = cmd->c_spat;
  444.                match = !(cmdflags & CF_FIRSTNEG);
  445. !              retstr = &str_yes;
  446.                goto flipmaybe;
  447.               }
  448.           }
  449.           else if (cmdflags & CF_NESURE) {
  450.               match = cmdflags & CF_FIRSTNEG;
  451. !             retstr = &str_no;
  452.               goto flipmaybe;
  453.           }
  454.           }
  455. --- 412,424 ----
  456.               if (cmd->c_spat)
  457.                   lastspat = cmd->c_spat;
  458.                match = !(cmdflags & CF_FIRSTNEG);
  459. !             retstr = match ? &str_yes : &str_no;
  460.                goto flipmaybe;
  461.               }
  462.           }
  463.           else if (cmdflags & CF_NESURE) {
  464.               match = cmdflags & CF_FIRSTNEG;
  465. !             retstr = match ? &str_yes : &str_no;
  466.               goto flipmaybe;
  467.           }
  468.           }
  469. ***************
  470. *** 451,457 ****
  471.               }
  472.               lastspat = cmd->c_spat;
  473.               match = !(cmdflags & CF_FIRSTNEG);
  474. !             retstr = &str_yes;
  475.               goto flipmaybe;
  476.           }
  477.           else
  478. --- 460,466 ----
  479.               }
  480.               lastspat = cmd->c_spat;
  481.               match = !(cmdflags & CF_FIRSTNEG);
  482. !             retstr = match ? &str_yes : &str_no;
  483.               goto flipmaybe;
  484.           }
  485.           else
  486. ***************
  487. *** 461,467 ****
  488.           if (cmdflags & CF_NESURE) {
  489.               ++cmd->c_short->str_u.str_useful;
  490.               match = cmdflags & CF_FIRSTNEG;
  491. !             retstr = &str_no;
  492.               goto flipmaybe;
  493.           }
  494.           }
  495. --- 470,476 ----
  496.           if (cmdflags & CF_NESURE) {
  497.               ++cmd->c_short->str_u.str_useful;
  498.               match = cmdflags & CF_FIRSTNEG;
  499. !             retstr = match ? &str_yes : &str_no;
  500.               goto flipmaybe;
  501.           }
  502.           }
  503.  
  504. Index: doSH
  505. *** doSH.old    Mon Nov 11 16:49:13 1991
  506. --- doSH    Mon Nov 11 16:49:13 1991
  507. ***************
  508. *** 4,9 ****
  509. --- 4,10 ----
  510.   . ./config.sh
  511.   
  512.   rm -f x2p/config.sh
  513. + cp cppstdin x2p
  514.   
  515.   echo " "
  516.   echo "Doing variable substitutions on .SH files..."
  517.  
  518. Index: doarg.c
  519. *** doarg.c.old    Mon Nov 11 16:49:16 1991
  520. --- doarg.c    Mon Nov 11 16:49:17 1991
  521. ***************
  522. *** 1,4 ****
  523. ! /* $RCSfile: doarg.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 16:35:06 $
  524.    *
  525.    *    Copyright (c) 1991, Larry Wall
  526.    *
  527. --- 1,4 ----
  528. ! /* $RCSfile: doarg.c,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:31:58 $
  529.    *
  530.    *    Copyright (c) 1991, Larry Wall
  531.    *
  532. ***************
  533. *** 6,11 ****
  534. --- 6,14 ----
  535.    *    License or the Artistic License, as specified in the README file.
  536.    *
  537.    * $Log:    doarg.c,v $
  538. +  * Revision 4.0.1.5  91/11/11  16:31:58  lwall
  539. +  * patch19: added little-endian pack/unpack options
  540. +  * 
  541.    * Revision 4.0.1.4  91/11/05  16:35:06  lwall
  542.    * patch11: /$foo/o optimizer could access deallocated data
  543.    * patch11: minimum match length calculation in regexp is now cumulative
  544. ***************
  545. *** 661,666 ****
  546. --- 664,679 ----
  547.           str_ncat(str,(char*)&ashort,sizeof(short));
  548.           }
  549.           break;
  550. +     case 'v':
  551. +         while (len-- > 0) {
  552. +         fromstr = NEXTFROM;
  553. +         ashort = (short)str_gnum(fromstr);
  554. + #ifdef HAS_HTOVS
  555. +         ashort = htovs(ashort);
  556. + #endif
  557. +         str_ncat(str,(char*)&ashort,sizeof(short));
  558. +         }
  559. +         break;
  560.       case 'S':
  561.       case 's':
  562.           while (len-- > 0) {
  563. ***************
  564. *** 689,694 ****
  565. --- 702,717 ----
  566.           aulong = U_L(str_gnum(fromstr));
  567.   #ifdef HAS_HTONL
  568.           aulong = htonl(aulong);
  569. + #endif
  570. +         str_ncat(str,(char*)&aulong,sizeof(unsigned long));
  571. +         }
  572. +         break;
  573. +     case 'V':
  574. +         while (len-- > 0) {
  575. +         fromstr = NEXTFROM;
  576. +         aulong = U_L(str_gnum(fromstr));
  577. + #ifdef HAS_HTOVL
  578. +         aulong = htovl(aulong);
  579.   #endif
  580.           str_ncat(str,(char*)&aulong,sizeof(unsigned long));
  581.           }
  582.  
  583. Index: dolist.c
  584. *** dolist.c.old    Mon Nov 11 16:49:20 1991
  585. --- dolist.c    Mon Nov 11 16:49:21 1991
  586. ***************
  587. *** 1,4 ****
  588. ! /* $RCSfile: dolist.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:07:02 $
  589.    *
  590.    *    Copyright (c) 1991, Larry Wall
  591.    *
  592. --- 1,4 ----
  593. ! /* $RCSfile: dolist.c,v $$Revision: 4.0.1.4 $$Date: 91/11/11 16:33:19 $
  594.    *
  595.    *    Copyright (c) 1991, Larry Wall
  596.    *
  597. ***************
  598. *** 6,11 ****
  599. --- 6,15 ----
  600.    *    License or the Artistic License, as specified in the README file.
  601.    *
  602.    * $Log:    dolist.c,v $
  603. +  * Revision 4.0.1.4  91/11/11  16:33:19  lwall
  604. +  * patch19: added little-endian pack/unpack options
  605. +  * patch19: sort $subname was busted by changes in 4.018
  606. +  * 
  607.    * Revision 4.0.1.3  91/11/05  17:07:02  lwall
  608.    * patch11: prepared for ctype implementations that don't define isascii()
  609.    * patch11: /$foo/o optimizer could access deallocated data
  610. ***************
  611. *** 786,791 ****
  612. --- 790,796 ----
  613.           }
  614.           }
  615.           break;
  616. +     case 'v':
  617.       case 'n':
  618.       case 'S':
  619.           along = (strend - s) / sizeof(unsigned short);
  620. ***************
  621. *** 799,804 ****
  622. --- 804,813 ----
  623.               if (datumtype == 'n')
  624.               aushort = ntohs(aushort);
  625.   #endif
  626. + #ifdef HAS_VTOHS
  627. +             if (datumtype == 'v')
  628. +             aushort = vtohs(aushort);
  629. + #endif
  630.               culong += aushort;
  631.           }
  632.           }
  633. ***************
  634. *** 811,816 ****
  635. --- 820,829 ----
  636.               if (datumtype == 'n')
  637.               aushort = ntohs(aushort);
  638.   #endif
  639. + #ifdef HAS_VTOHS
  640. +             if (datumtype == 'v')
  641. +             aushort = vtohs(aushort);
  642. + #endif
  643.               str_numset(str,(double)aushort);
  644.               (void)astore(stack, ++sp, str_2mortal(str));
  645.           }
  646. ***************
  647. *** 888,893 ****
  648. --- 901,907 ----
  649.           }
  650.           }
  651.           break;
  652. +     case 'V':
  653.       case 'N':
  654.       case 'L':
  655.           along = (strend - s) / sizeof(unsigned long);
  656. ***************
  657. *** 901,906 ****
  658. --- 915,924 ----
  659.               if (datumtype == 'N')
  660.               aulong = ntohl(aulong);
  661.   #endif
  662. + #ifdef HAS_VTOHL
  663. +             if (datumtype == 'V')
  664. +             aulong = vtohl(aulong);
  665. + #endif
  666.               if (checksum > 32)
  667.               cdouble += (double)aulong;
  668.               else
  669. ***************
  670. *** 916,921 ****
  671. --- 934,943 ----
  672.               if (datumtype == 'N')
  673.               aulong = ntohl(aulong);
  674.   #endif
  675. + #ifdef HAS_VTOHL
  676. +             if (datumtype == 'V')
  677. +             aulong = vtohl(aulong);
  678. + #endif
  679.               str_numset(str,(double)aulong);
  680.               (void)astore(stack, ++sp, str_2mortal(str));
  681.           }
  682. ***************
  683. *** 1480,1485 ****
  684. --- 1502,1508 ----
  685.       STR *oldsecond;
  686.       ARRAY *oldstack;
  687.       HASH *stash;
  688. +     STR *sortsubvar;
  689.       static ARRAY *sortstack = Null(ARRAY*);
  690.   
  691.       if (gimme != G_ARRAY) {
  692. ***************
  693. *** 1489,1494 ****
  694. --- 1512,1518 ----
  695.       return sp;
  696.       }
  697.       up = &st[sp];
  698. +     sortsubvar = *up;
  699.       st += sp;        /* temporarily make st point to args */
  700.       for (i = 1; i <= max; i++) {
  701.       /*SUPPRESS 560*/
  702. ***************
  703. *** 1514,1520 ****
  704.           if ((arg[1].arg_type & A_MASK) == A_WORD)
  705.           stab = arg[1].arg_ptr.arg_stab;
  706.           else
  707. !         stab = stabent(str_get(st[sp+1]),TRUE);
  708.   
  709.           if (stab) {
  710.           if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
  711. --- 1538,1544 ----
  712.           if ((arg[1].arg_type & A_MASK) == A_WORD)
  713.           stab = arg[1].arg_ptr.arg_stab;
  714.           else
  715. !         stab = stabent(str_get(sortsubvar),TRUE);
  716.   
  717.           if (stab) {
  718.           if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
  719.  
  720. Index: t/op/groups.t
  721. *** t/op/groups.t.old    Mon Nov 11 16:49:59 1991
  722. --- t/op/groups.t    Mon Nov 11 16:49:59 1991
  723. ***************
  724. *** 5,12 ****
  725.       exit 0;
  726.   }
  727.   
  728. ! print "1..1\n";
  729.   
  730.   for (split(' ', $()) {
  731.       next if $seen{$_}++;
  732.       ($group) = getgrgid($_);
  733. --- 5,18 ----
  734.       exit 0;
  735.   }
  736.   
  737. ! print "1..2\n";
  738.   
  739. + $pwgid = $( + 0;
  740. + ($pwgnam) = getgrgid($pwgid);
  741. + @basegroup{$pwgid,$pwgnam} = (1,1);
  742. + 
  743. + $seen{$pwgid}++;
  744. + 
  745.   for (split(' ', $()) {
  746.       next if $seen{$_}++;
  747.       ($group) = getgrgid($_);
  748. ***************
  749. *** 17,24 ****
  750.       push(@gr, $_);
  751.       }
  752.   } 
  753. ! $gr1 = join(' ',sort @gr);
  754. ! $gr2 = join(' ', sort split(' ',`/usr/ucb/groups`));
  755. ! #print "gr1 is <$gr1>\n";
  756. ! #print "gr2 is <$gr2>\n";
  757. ! print +($gr1 eq $gr2) ? "ok 1\n" : "not ok 1\n";
  758. --- 23,47 ----
  759.       push(@gr, $_);
  760.       }
  761.   } 
  762. ! 
  763. ! $gr1 = join(' ', sort @gr);
  764. ! 
  765. ! $gr2 = join(' ', grep(!$basegroup{$_}, sort split(' ',`/usr/ucb/groups`)));
  766. ! 
  767. ! if ($gr1 eq $gr2) {
  768. !     print "ok 1\n";
  769. ! }
  770. ! else {
  771. !     print "#gr1 is <$gr1>\n";
  772. !     print "#gr2 is <$gr2>\n";
  773. !     print "not ok 1\n";
  774. ! }
  775. ! 
  776. ! # multiple 0's indicate GROUPSTYPE is currently long but should be short
  777. ! 
  778. ! if ($pwgid == 0 || $seen{0} < 2) {
  779. !     print "ok 2\n";
  780. ! }
  781. ! else {
  782. !     print "not ok 2 (groupstype should be type short, not long)\n";
  783. ! }
  784.  
  785. Index: hints/hp9000_800.sh
  786. *** hints/hp9000_800.sh.old    Mon Nov 11 16:49:27 1991
  787. --- hints/hp9000_800.sh    Mon Nov 11 16:49:27 1991
  788. ***************
  789. *** 1 ****
  790. ! libswanted=`echo $libswanted | sed 's/malloc //'`
  791. --- 1,2 ----
  792. ! libswanted=`echo $libswanted | sed -e 's/malloc //' -e 's/BSD //`
  793. ! optimize='+O1'
  794.  
  795. Index: installperl
  796. *** installperl.old    Mon Nov 11 16:49:34 1991
  797. --- installperl    Mon Nov 11 16:49:35 1991
  798. ***************
  799. *** 136,143 ****
  800.   
  801.       if ($pdev != $ldev || $pino != $lino) {
  802.       foreach $file (<*.pl>) {
  803. !         &unlink("$installprivlib/$file");
  804. !         &cmd("cp $file $installprivlib");
  805.       }
  806.       }
  807.       chdir ".." || die "Can't cd back to source directory: $!\n";
  808. --- 136,146 ----
  809.   
  810.       if ($pdev != $ldev || $pino != $lino) {
  811.       foreach $file (<*.pl>) {
  812. !         system "cmp", "-s", $file, "$privlib/$file";
  813. !         if ($?) {
  814. !         &unlink("$installprivlib/$file");
  815. !         &cmd("cp $file $installprivlib");
  816. !         }
  817.       }
  818.       }
  819.       chdir ".." || die "Can't cd back to source directory: $!\n";
  820.  
  821. Index: hints/isc_3_2_2.sh
  822. *** hints/isc_3_2_2.sh.old    Mon Nov 11 16:49:29 1991
  823. --- hints/isc_3_2_2.sh    Mon Nov 11 16:49:29 1991
  824. ***************
  825. *** 0 ****
  826. --- 1,7 ----
  827. + set `echo $libswanted | sed -e 's/ x / /' -e 's/ PW / /' -e s/ malloc / /`
  828. + libswanted="inet malloc $*"
  829. + doio_cflags='ccflags="$ccflags -DENOTSOCK=103"'
  830. + tdoio_cflags='ccflags="$ccflags -DENOTSOCK=103"'
  831. + echo "<net/errno.h> defines error numbers for network calls, but"
  832. + echo "the definitions for ENAMETOOLONG and ENOTEMPTY conflict with"
  833. + echo "those in <sys/errno.h>.  Instead just define ENOTSOCK here."
  834.  
  835. Index: perl.c
  836. *** perl.c.old    Mon Nov 11 16:49:38 1991
  837. --- perl.c    Mon Nov 11 16:49:39 1991
  838. ***************
  839. *** 1,4 ****
  840. ! char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.5 $$Date: 91/11/05 18:03:32 $\nPatch level: ###\n";
  841.   /*
  842.    *    Copyright (c) 1991, Larry Wall
  843.    *
  844. --- 1,4 ----
  845. ! char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.6 $$Date: 91/11/11 16:38:45 $\nPatch level: ###\n";
  846.   /*
  847.    *    Copyright (c) 1991, Larry Wall
  848.    *
  849. ***************
  850. *** 6,11 ****
  851. --- 6,15 ----
  852.    *    License or the Artistic License, as specified in the README file.
  853.    *
  854.    * $Log:    perl.c,v $
  855. +  * Revision 4.0.1.6  91/11/11  16:38:45  lwall
  856. +  * patch19: default arg for shift was wrong after first subroutine definition
  857. +  * patch19: op/regexp.t failed from missing arg to bcmp()
  858. +  * 
  859.    * Revision 4.0.1.5  91/11/05  18:03:32  lwall
  860.    * patch11: random cleanup
  861.    * patch11: $0 was being truncated at times
  862. ***************
  863. *** 634,639 ****
  864. --- 638,644 ----
  865.   
  866.       defstab = stabent("_",TRUE);
  867.   
  868. +     subname = str_make("main",4);
  869.       if (perldb) {
  870.       debstash = hnew(0);
  871.       stab_xhash(stabent("_DB",TRUE)) = debstash;
  872. ***************
  873. *** 641,647 ****
  874.       dbargs = stab_xarray(aadd((tmpstab = stabent("args",TRUE))));
  875.       tmpstab->str_pok |= SP_MULTI;
  876.       dbargs->ary_flags = 0;
  877. -     subname = str_make("main",4);
  878.       DBstab = stabent("DB",TRUE);
  879.       DBstab->str_pok |= SP_MULTI;
  880.       DBline = stabent("dbline",TRUE);
  881. --- 646,651 ----
  882. ***************
  883. *** 1030,1036 ****
  884.           retval |= error_count;
  885.       }
  886.       else if (last_root && last_elen == bufend - bufptr
  887. !       && *bufptr == *last_eval && !bcmp(bufptr,last_eval)){
  888.           retval = 0;
  889.           eval_root = last_root;    /* no point in reparsing */
  890.       }
  891. --- 1034,1040 ----
  892.           retval |= error_count;
  893.       }
  894.       else if (last_root && last_elen == bufend - bufptr
  895. !       && *bufptr == *last_eval && !bcmp(bufptr,last_eval,last_elen)){
  896.           retval = 0;
  897.           eval_root = last_root;    /* no point in reparsing */
  898.       }
  899.  
  900. Index: perl.h
  901. *** perl.h.old    Mon Nov 11 16:49:42 1991
  902. --- perl.h    Mon Nov 11 16:49:42 1991
  903. ***************
  904. *** 1,4 ****
  905. ! /* $RCSfile: perl.h,v $$Revision: 4.0.1.4 $$Date: 91/11/05 18:06:10 $
  906.    *
  907.    *    Copyright (c) 1991, Larry Wall
  908.    *
  909. --- 1,4 ----
  910. ! /* $RCSfile: perl.h,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:41:07 $
  911.    *
  912.    *    Copyright (c) 1991, Larry Wall
  913.    *
  914. ***************
  915. *** 6,11 ****
  916. --- 6,16 ----
  917.    *    License or the Artistic License, as specified in the README file.
  918.    *
  919.    * $Log:    perl.h,v $
  920. +  * Revision 4.0.1.5  91/11/11  16:41:07  lwall
  921. +  * patch19: uts wrongly defines S_ISDIR() et al
  922. +  * patch19: too many preprocessors can't expand a macro right in #if
  923. +  * patch19: added little-endian pack/unpack options
  924. +  * 
  925.    * Revision 4.0.1.4  91/11/05  18:06:10  lwall
  926.    * patch11: various portability fixes
  927.    * patch11: added support for dbz
  928. ***************
  929. *** 165,170 ****
  930. --- 170,189 ----
  931.   #endif
  932.   
  933.   #include <sys/stat.h>
  934. + #ifdef uts
  935. + #undef S_ISDIR
  936. + #undef S_ISCHR
  937. + #undef S_ISBLK
  938. + #undef S_ISREG
  939. + #undef S_ISFIFO
  940. + #undef S_ISLNK
  941. + #define S_ISDIR(P) (((P)&S_IFMT)==S_IFDIR)
  942. + #define S_ISCHR(P) (((P)&S_IFMT)==S_IFCHR)
  943. + #define S_ISBLK(P) (((P)&S_IFMT)==S_IFBLK)
  944. + #define S_ISREG(P) (((P)&S_IFMT)==S_IFREG)
  945. + #define S_ISFIFO(P) (((P)&S_IFMT)==S_IFIFO)
  946. + #define S_ISLNK(P) (((P)&S_IFMT)==S_IFLNK)
  947. + #endif
  948.   
  949.   #ifdef I_TIME
  950.   #   include <time.h>
  951. ***************
  952. *** 344,353 ****
  953.   #   endif
  954.   #endif
  955.   
  956. - #if S_ISBLK(060000) == 060000
  957. -     XXX Your sys/stat.h appears to be buggy.  Please fix it.
  958. - #endif
  959. - 
  960.   #ifndef S_ISREG
  961.   #   define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
  962.   #endif
  963. --- 363,368 ----
  964. ***************
  965. *** 426,432 ****
  966.   #   define SLOPPYDIVIDE
  967.   #endif
  968.   
  969. ! #if defined(cray) || defined(convex) || BYTEORDER > 0xffff
  970.   #   define QUAD
  971.   #endif
  972.   
  973. --- 441,447 ----
  974.   #   define SLOPPYDIVIDE
  975.   #endif
  976.   
  977. ! #if defined(cray) || defined(convex) || defined (uts) || BYTEORDER > 0xffff
  978.   #   define QUAD
  979.   #endif
  980.   
  981. ***************
  982. *** 434,440 ****
  983.   #   ifdef cray
  984.   #    define quad int
  985.   #   else
  986. ! #    ifdef convex
  987.   #        define quad long long
  988.   #    else
  989.   #        define quad long
  990. --- 449,455 ----
  991.   #   ifdef cray
  992.   #    define quad int
  993.   #   else
  994. ! #    if defined(convex) || defined (uts)
  995.   #        define quad long long
  996.   #    else
  997.   #        define quad long
  998. ***************
  999. *** 583,588 ****
  1000. --- 598,624 ----
  1001.   #undef HAS_NTOHS
  1002.   #undef HAS_NTOHL
  1003.   #endif
  1004. + #endif
  1005. + 
  1006. + /*
  1007. +  * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
  1008. +  * -DWS
  1009. +  */
  1010. + #if BYTEORDER != 0x1234
  1011. + # define HAS_VTOHL
  1012. + # define HAS_VTOHS
  1013. + # define HAS_HTOVL
  1014. + # define HAS_HTOVS
  1015. + # if BYTEORDER == 0x4321
  1016. + #  define vtohl(x)    ((((x)&0xFF)<<24)    \
  1017. +             +(((x)>>24)&0xFF)    \
  1018. +             +(((x)&0x0000FF00)<<8)    \
  1019. +             +(((x)&0x00FF0000)>>8)    )
  1020. + #  define vtohs(x)    ((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
  1021. + #  define htovl(x)    vtohl(x)
  1022. + #  define htovs(x)    vtohs(x)
  1023. + # endif
  1024. +     /* otherwise default to functions in util.c */
  1025.   #endif
  1026.   
  1027.   #ifdef CASTNEGFLOAT
  1028.  
  1029. Index: perl.man
  1030. *** perl.man.old    Mon Nov 11 16:49:50 1991
  1031. --- perl.man    Mon Nov 11 16:49:53 1991
  1032. ***************
  1033. *** 1,7 ****
  1034.   .rn '' }`
  1035. ! ''' $RCSfile: perl.man,v $$Revision: 4.0.1.4 $$Date: 91/11/05 18:11:05 $
  1036.   ''' 
  1037.   ''' $Log:    perl.man,v $
  1038.   ''' Revision 4.0.1.4  91/11/05  18:11:05  lwall
  1039.   ''' patch11: added sort {} LIST
  1040.   ''' patch11: added eval {}
  1041. --- 1,10 ----
  1042.   .rn '' }`
  1043. ! ''' $RCSfile: perl.man,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:42:00 $
  1044.   ''' 
  1045.   ''' $Log:    perl.man,v $
  1046. + ''' Revision 4.0.1.5  91/11/11  16:42:00  lwall
  1047. + ''' patch19: added little-endian pack/unpack options
  1048. + ''' 
  1049.   ''' Revision 4.0.1.4  91/11/05  18:11:05  lwall
  1050.   ''' patch11: added sort {} LIST
  1051.   ''' patch11: added eval {}
  1052. ***************
  1053. *** 2014,2020 ****
  1054.       if (defined &$var) { &$var($parm); undef &$var; }
  1055.   
  1056.   .fi
  1057. ! :Ip "do EXPR" 8 3
  1058.   Uses the value of EXPR as a filename and executes the contents of the file
  1059.   as a
  1060.   .I perl
  1061. --- 2017,2023 ----
  1062.       if (defined &$var) { &$var($parm); undef &$var; }
  1063.   
  1064.   .fi
  1065. ! .Ip "do EXPR" 8 3
  1066.   Uses the value of EXPR as a filename and executes the contents of the file
  1067.   as a
  1068.   .I perl
  1069. ***************
  1070. *** 3071,3076 ****
  1071. --- 3074,3081 ----
  1072.       f    A single-precision float in the native format.
  1073.       d    A double-precision float in the native format.
  1074.       p    A pointer to a string.
  1075. +     v    A short in \*(L"VAX\*(R" (little-endian) order.
  1076. +     V    A long in \*(L"VAX\*(R" (little-endian) order.
  1077.       x    A null byte.
  1078.       X    Back up a byte.
  1079.       @    Null fill to absolute position.
  1080. ***************
  1081. *** 5893,5899 ****
  1082.   The default top-of-form format for FILEHANDLE is now FILEHANDLE_TOP rather
  1083.   than top.
  1084.   .PP
  1085. ! The eval {} and sort {} constructs were added in version 4.011.
  1086.   .SH BUGS
  1087.   .PP
  1088.   .I Perl
  1089. --- 5898,5907 ----
  1090.   The default top-of-form format for FILEHANDLE is now FILEHANDLE_TOP rather
  1091.   than top.
  1092.   .PP
  1093. ! The eval {} and sort {} constructs were added in version 4.018.
  1094. ! .PP
  1095. ! The v and V (little-endian) template options for pack and unpack were
  1096. ! added in 4.019.
  1097.   .SH BUGS
  1098.   .PP
  1099.   .I Perl
  1100.  
  1101. Index: t/op/readdir.t
  1102. *** t/op/readdir.t.old    Mon Nov 11 16:50:00 1991
  1103. --- t/op/readdir.t    Mon Nov 11 16:50:01 1991
  1104. ***************
  1105. *** 0 ****
  1106. --- 1,20 ----
  1107. + #!./perl
  1108. + 
  1109. + eval 'opendir(NOSUCH, "no/such/directory");';
  1110. + if ($@) { print "1..0\n"; exit; }
  1111. + 
  1112. + print "1..3\n";
  1113. + 
  1114. + if (opendir(OP, "op")) { print "ok 1\n"; } else { print "not ok 1\n"; }
  1115. + @D = grep(/^[^\.]/, readdir(OP));
  1116. + closedir(OP);
  1117. + 
  1118. + if (@D > 20 && @D < 100) { print "ok 2\n"; } else { print "not ok 2\n"; }
  1119. + 
  1120. + @R = sort @D;
  1121. + @G = <op/*>;
  1122. + while (@R && @G && "op/".$R[0] eq $G[0]) {
  1123. +     shift(@R);
  1124. +     shift(@G);
  1125. + }
  1126. + if (@R == 0 && @G == 0) { print "ok 3\n"; } else { print "not ok 3\n"; }
  1127.  
  1128. Index: hints/sco_3.sh
  1129. *** hints/sco_3.sh.old    Mon Nov 11 16:49:31 1991
  1130. --- hints/sco_3.sh    Mon Nov 11 16:49:31 1991
  1131. ***************
  1132. *** 1,4 ****
  1133.   yacc='/usr/bin/yacc -Sm11000'
  1134.   libswanted=`echo $libswanted | sed 's/ x / /'`
  1135. - i_varargs=undef
  1136.   ccflags="$ccflags -U M_XENIX"
  1137. --- 1,7 ----
  1138.   yacc='/usr/bin/yacc -Sm11000'
  1139.   libswanted=`echo $libswanted | sed 's/ x / /'`
  1140.   ccflags="$ccflags -U M_XENIX"
  1141. + cppstdin='/lib/cpp -Di386 -DM_I386 -Dunix -DM_UNIX -DM_INTERNAT -DLAI_TCP'
  1142. + cppminus=''
  1143. + i_varargs=undef
  1144. + d_rename='undef'
  1145.  
  1146. Index: t/op/sort.t
  1147. *** t/op/sort.t.old    Mon Nov 11 16:50:02 1991
  1148. --- t/op/sort.t    Mon Nov 11 16:50:03 1991
  1149. ***************
  1150. *** 1,8 ****
  1151.   #!./perl
  1152.   
  1153. ! # $RCSfile: sort.t,v $$Revision: 4.0.1.1 $$Date: 91/11/05 18:43:47 $
  1154.   
  1155. ! print "1..9\n";
  1156.   
  1157.   sub reverse { $a lt $b ? 1 : $a gt $b ? -1 : 0; }
  1158.   
  1159. --- 1,8 ----
  1160.   #!./perl
  1161.   
  1162. ! # $RCSfile: sort.t,v $$Revision: 4.0.1.2 $$Date: 91/11/11 16:43:47 $
  1163.   
  1164. ! print "1..10\n";
  1165.   
  1166.   sub reverse { $a lt $b ? 1 : $a gt $b ? -1 : 0; }
  1167.   
  1168. ***************
  1169. *** 41,43 ****
  1170. --- 41,48 ----
  1171.   @a = (10,2,3,4);
  1172.   @b = sort {$a <=> $b;} @a;
  1173.   print ("@b" eq "2 3 4 10" ? "ok 9\n" : "not ok 9 (@b)\n");
  1174. + 
  1175. + $sub = 'reverse';
  1176. + $x = join('', sort $sub @harry);
  1177. + print ($x eq 'xdogcatCainAbel' ? "ok 10\n" : "not ok 10\n");
  1178. + 
  1179.  
  1180. Index: t/op/stat.t
  1181. *** t/op/stat.t.old    Mon Nov 11 16:50:04 1991
  1182. --- t/op/stat.t    Mon Nov 11 16:50:05 1991
  1183. ***************
  1184. *** 1,6 ****
  1185.   #!./perl
  1186.   
  1187. ! # $RCSfile: stat.t,v $$Revision: 4.0.1.2 $$Date: 91/11/05 18:44:44 $
  1188.   
  1189.   print "1..56\n";
  1190.   
  1191. --- 1,6 ----
  1192.   #!./perl
  1193.   
  1194. ! # $RCSfile: stat.t,v $$Revision: 4.0.1.3 $$Date: 91/11/11 16:44:49 $
  1195.   
  1196.   print "1..56\n";
  1197.   
  1198. ***************
  1199. *** 11,16 ****
  1200. --- 11,18 ----
  1201.   unlink "Op.stat.tmp";
  1202.   open(FOO, ">Op.stat.tmp");
  1203.   
  1204. + $junk = `ls Op.stat.tmp`;    # hack to make Apollo update link count
  1205. + 
  1206.   ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  1207.       $blksize,$blocks) = stat(FOO);
  1208.   if ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";}
  1209. ***************
  1210. *** 35,41 ****
  1211.   }
  1212.   print "#4    :$mtime: != :$ctime:\n";
  1213.   
  1214. ! `cp /dev/null Op.stat.tmp`;
  1215.   
  1216.   if (-z 'Op.stat.tmp') {print "ok 5\n";} else {print "not ok 5\n";}
  1217.   if (! -s 'Op.stat.tmp') {print "ok 6\n";} else {print "not ok 6\n";}
  1218. --- 37,44 ----
  1219.   }
  1220.   print "#4    :$mtime: != :$ctime:\n";
  1221.   
  1222. ! `rm -f Op.stat.tmp`;
  1223. ! `touch Op.stat.tmp`;
  1224.   
  1225.   if (-z 'Op.stat.tmp') {print "ok 5\n";} else {print "not ok 5\n";}
  1226.   if (! -s 'Op.stat.tmp') {print "ok 6\n";} else {print "not ok 6\n";}
  1227.  
  1228. Index: toke.c
  1229. *** toke.c.old    Mon Nov 11 16:50:08 1991
  1230. --- toke.c    Mon Nov 11 16:50:10 1991
  1231. ***************
  1232. *** 1,4 ****
  1233. ! /* $RCSfile: toke.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 19:02:48 $
  1234.    *
  1235.    *    Copyright (c) 1991, Larry Wall
  1236.    *
  1237. --- 1,4 ----
  1238. ! /* $RCSfile: toke.c,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:45:51 $
  1239.    *
  1240.    *    Copyright (c) 1991, Larry Wall
  1241.    *
  1242. ***************
  1243. *** 6,11 ****
  1244. --- 6,14 ----
  1245.    *    License or the Artistic License, as specified in the README file.
  1246.    *
  1247.    * $Log:    toke.c,v $
  1248. +  * Revision 4.0.1.5  91/11/11  16:45:51  lwall
  1249. +  * patch19: default arg for shift was wrong after first subroutine definition
  1250. +  * 
  1251.    * Revision 4.0.1.4  91/11/05  19:02:48  lwall
  1252.    * patch11: \x and \c were subject to double interpretation in regexps
  1253.    * patch11: prepared for ctype implementations that don't define isascii()
  1254. ***************
  1255. *** 1198,1207 ****
  1256.           FUN2x(O_SUBSTR);
  1257.           if (strEQ(d,"sub")) {
  1258.           yylval.ival = savestack->ary_fill; /* restore stuff on reduce */
  1259. !         if (perldb) {
  1260. !             savelong(&subline);
  1261. !             saveitem(subname);
  1262. !         }
  1263.   
  1264.           subline = curcmd->c_line;
  1265.           d = bufend;
  1266. --- 1201,1208 ----
  1267.           FUN2x(O_SUBSTR);
  1268.           if (strEQ(d,"sub")) {
  1269.           yylval.ival = savestack->ary_fill; /* restore stuff on reduce */
  1270. !         savelong(&subline);
  1271. !         saveitem(subname);
  1272.   
  1273.           subline = curcmd->c_line;
  1274.           d = bufend;
  1275. ***************
  1276. *** 1208,1226 ****
  1277.           while (s < d && isSPACE(*s))
  1278.               s++;
  1279.           if (isALPHA(*s) || *s == '_' || *s == '\'') {
  1280. !             if (perldb) {
  1281. !             str_sset(subname,curstname);
  1282. !             str_ncat(subname,"'",1);
  1283. !             for (d = s+1; isALNUM(*d) || *d == '\''; d++)
  1284. !                 /*SUPPRESS 530*/
  1285. !                 ;
  1286. !             if (d[-1] == '\'')
  1287. !                 d--;
  1288. !             str_ncat(subname,s,d-s);
  1289. !             }
  1290.               *(--s) = '\\';    /* force next ident to WORD */
  1291.           }
  1292. !         else if (perldb)
  1293.               str_set(subname,"?");
  1294.           OPERATOR(SUB);
  1295.           }
  1296. --- 1209,1225 ----
  1297.           while (s < d && isSPACE(*s))
  1298.               s++;
  1299.           if (isALPHA(*s) || *s == '_' || *s == '\'') {
  1300. !             str_sset(subname,curstname);
  1301. !             str_ncat(subname,"'",1);
  1302. !             for (d = s+1; isALNUM(*d) || *d == '\''; d++)
  1303. !             /*SUPPRESS 530*/
  1304. !             ;
  1305. !             if (d[-1] == '\'')
  1306. !             d--;
  1307. !             str_ncat(subname,s,d-s);
  1308.               *(--s) = '\\';    /* force next ident to WORD */
  1309.           }
  1310. !         else
  1311.               str_set(subname,"?");
  1312.           OPERATOR(SUB);
  1313.           }
  1314.  
  1315. Index: usersub.c
  1316. Prereq: 4.0
  1317. *** usersub.c.old    Mon Nov 11 16:50:12 1991
  1318. --- usersub.c    Mon Nov 11 16:50:13 1991
  1319. ***************
  1320. *** 1,4 ****
  1321. ! /* $Header: usersub.c,v 4.0 91/03/20 01:55:56 lwall Locked $
  1322.    *
  1323.    *  This file contains stubs for routines that the user may define to
  1324.    *  set up glue routines for C libraries or to decrypt encrypted scripts
  1325. --- 1,4 ----
  1326. ! /* $RCSfile: usersub.c,v $$Revision: 4.0.1.1 $$Date: 91/11/11 16:47:17 $
  1327.    *
  1328.    *  This file contains stubs for routines that the user may define to
  1329.    *  set up glue routines for C libraries or to decrypt encrypted scripts
  1330. ***************
  1331. *** 5,10 ****
  1332. --- 5,13 ----
  1333.    *  for execution.
  1334.    *
  1335.    * $Log:    usersub.c,v $
  1336. +  * Revision 4.0.1.1  91/11/11  16:47:17  lwall
  1337. +  * patch19: deleted some unused functions from usersub.c
  1338. +  * 
  1339.    * Revision 4.0  91/03/20  01:55:56  lwall
  1340.    * 4.0 baseline.
  1341.    * 
  1342. ***************
  1343. *** 19,25 ****
  1344.   }
  1345.   
  1346.   /*
  1347. !  * The following is supplied by John MacDonald as a means of decrypting
  1348.    * and executing (presumably proprietary) scripts that have been encrypted
  1349.    * by a (presumably secret) method.  The idea is that you supply your own
  1350.    * routine in place of cryptfilter (which is purposefully a very weak
  1351. --- 22,28 ----
  1352.   }
  1353.   
  1354.   /*
  1355. !  * The following is supplied by John Macdonald as a means of decrypting
  1356.    * and executing (presumably proprietary) scripts that have been encrypted
  1357.    * by a (presumably secret) method.  The idea is that you supply your own
  1358.    * routine in place of cryptfilter (which is purposefully a very weak
  1359. ***************
  1360. *** 34,39 ****
  1361. --- 37,48 ----
  1362.   #include <vfork.h>
  1363.   #endif
  1364.   
  1365. + #ifdef CRYPTLOCAL
  1366. + 
  1367. + #include "cryptlocal.h"
  1368. + 
  1369. + #else    /* ndef CRYPTLOCAL */
  1370. + 
  1371.   #define    CRYPT_MAGIC_1    0xfb
  1372.   #define    CRYPT_MAGIC_2    0xf1
  1373.   
  1374. ***************
  1375. *** 47,52 ****
  1376. --- 56,63 ----
  1377.       }
  1378.   }
  1379.   
  1380. + #endif    /* CRYPTLOCAL */
  1381. + 
  1382.   #ifndef MSDOS
  1383.   static FILE    *lastpipefile;
  1384.   static int    pipepid;
  1385. ***************
  1386. *** 95,100 ****
  1387. --- 106,112 ----
  1388.       _exit(0);
  1389.       }
  1390.       close(p[1]);
  1391. +     close(fileno(fil));
  1392.       fclose(fil);
  1393.       str = afetch(fdpid,p[0],TRUE);
  1394.       str->str_u.str_useful = pipepid;
  1395. ***************
  1396. *** 112,117 ****
  1397. --- 124,130 ----
  1398.       ch = getc(rsfp);
  1399.       if (ch == CRYPT_MAGIC_1) {
  1400.       if (getc(rsfp) == CRYPT_MAGIC_2) {
  1401. +         if( perldb ) fatal("can't debug an encrypted script");
  1402.           rsfp = mypfiopen( rsfp, cryptfilter );
  1403.           preprocess = 1;    /* force call to pclose when done */
  1404.       }
  1405. ***************
  1406. *** 120,182 ****
  1407.       }
  1408.       else
  1409.       ungetc(ch,rsfp);
  1410. - }
  1411. - 
  1412. - FILE *
  1413. - cryptopen(cmd)        /* open a (possibly encrypted) program for input */
  1414. - char    *cmd;
  1415. - {
  1416. -     FILE    *fil = fopen( cmd, "r" );
  1417. - 
  1418. -     lastpipefile = Nullfp;
  1419. -     pipepid = 0;
  1420. - 
  1421. -     if( fil ) {
  1422. -     int    ch = getc( fil );
  1423. -     int    lines = 0;
  1424. -     int    chars = 0;
  1425. - 
  1426. -     /* Search for the magic cookie that starts the encrypted script,
  1427. -     ** while still allowing a few lines of unencrypted text to let
  1428. -     ** '#!' and the nih hack both continue to work.  (These lines
  1429. -     ** will end up being ignored.)
  1430. -     */
  1431. -     while( ch != CRYPT_MAGIC_1 && ch != EOF && lines < 5 && chars < 300 ) {
  1432. -         if( ch == '\n' )
  1433. -         ++lines;
  1434. -         ch = getc( fil );
  1435. -         ++chars;
  1436. -     }
  1437. - 
  1438. -     if( ch == CRYPT_MAGIC_1 ) {
  1439. -         if( (ch = getc( fil ) ) == CRYPT_MAGIC_2 ) {
  1440. -         if( perldb ) fatal("can't debug an encrypted script");
  1441. -         /* we found it, decrypt the rest of the file */
  1442. -         fil = mypfiopen( fil, cryptfilter );
  1443. -         return( lastpipefile = fil );
  1444. -         } else
  1445. -         /* if its got MAGIC 1 without MAGIC 2, too bad */
  1446. -         fatal( "bad encryption format" );
  1447. -     }
  1448. - 
  1449. -     /* this file is not encrypted - rewind and process it normally */
  1450. -     rewind( fil );
  1451. -     }
  1452. - 
  1453. -     return( fil );
  1454. - }
  1455. - 
  1456. - VOID
  1457. - cryptclose(fil)
  1458. - FILE    *fil;
  1459. - {
  1460. -     if( fil == Nullfp )
  1461. -     return;
  1462. - 
  1463. -     if( fil == lastpipefile )
  1464. -     mypclose( fil );
  1465. -     else
  1466. -     fclose( fil );
  1467.   }
  1468.   #endif /* !MSDOS */
  1469.   
  1470. --- 133,138 ----
  1471.  
  1472. Index: util.c
  1473. *** util.c.old    Mon Nov 11 16:50:15 1991
  1474. --- util.c    Mon Nov 11 16:50:16 1991
  1475. ***************
  1476. *** 1,4 ****
  1477. ! /* $RCSfile: util.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 19:18:26 $
  1478.    *
  1479.    *    Copyright (c) 1991, Larry Wall
  1480.    *
  1481. --- 1,4 ----
  1482. ! /* $RCSfile: util.c,v $$Revision: 4.0.1.4 $$Date: 91/11/11 16:48:54 $
  1483.    *
  1484.    *    Copyright (c) 1991, Larry Wall
  1485.    *
  1486. ***************
  1487. *** 6,11 ****
  1488. --- 6,15 ----
  1489.    *    License or the Artistic License, as specified in the README file.
  1490.    *
  1491.    * $Log:    util.c,v $
  1492. +  * Revision 4.0.1.4  91/11/11  16:48:54  lwall
  1493. +  * patch19: study was busted by 4.018
  1494. +  * patch19: added little-endian pack/unpack options
  1495. +  * 
  1496.    * Revision 4.0.1.3  91/11/05  19:18:26  lwall
  1497.    * patch11: safe malloc code now integrated into Perl's malloc when possible
  1498.    * patch11: index("little", "longer string") could visit faraway places
  1499. ***************
  1500. *** 685,696 ****
  1501.   #ifdef POINTERRIGOR
  1502.       if (littlestr->str_pok & SP_CASEFOLD) {    /* case insignificant? */
  1503.       do {
  1504. ! #ifndef lint
  1505. !         while (big[pos-previous] != first && big[pos-previous] != fold[first]
  1506. !           && (pos += screamnext[pos]) )
  1507. !         /*SUPPRESS 530*/
  1508. !         ;
  1509. ! #endif
  1510.           for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
  1511.           if (x >= bigend)
  1512.               return Nullch;
  1513. --- 689,696 ----
  1514.   #ifdef POINTERRIGOR
  1515.       if (littlestr->str_pok & SP_CASEFOLD) {    /* case insignificant? */
  1516.       do {
  1517. !         if (big[pos-previous] != first && big[pos-previous] != fold[first])
  1518. !         continue;
  1519.           for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
  1520.           if (x >= bigend)
  1521.               return Nullch;
  1522. ***************
  1523. *** 715,725 ****
  1524.       }
  1525.       else {
  1526.       do {
  1527. ! #ifndef lint
  1528. !         while (big[pos-previous] != first && (pos += screamnext[pos]))
  1529. !         /*SUPPRESS 530*/
  1530. !         ;
  1531. ! #endif
  1532.           for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
  1533.           if (x >= bigend)
  1534.               return Nullch;
  1535. --- 715,722 ----
  1536.       }
  1537.       else {
  1538.       do {
  1539. !         if (big[pos-previous] != first)
  1540. !         continue;
  1541.           for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
  1542.           if (x >= bigend)
  1543.               return Nullch;
  1544. ***************
  1545. *** 746,757 ****
  1546.       big -= previous;
  1547.       if (littlestr->str_pok & SP_CASEFOLD) {    /* case insignificant? */
  1548.       do {
  1549. ! #ifndef lint
  1550. !         while (big[pos] != first && big[pos] != fold[first]
  1551. !           && (pos += screamnext[pos]) )
  1552. !         /*SUPPRESS 530*/
  1553. !         ;
  1554. ! #endif
  1555.           for (x=big+pos+1,s=little; s < littleend; /**/ ) {
  1556.           if (x >= bigend)
  1557.               return Nullch;
  1558. --- 743,750 ----
  1559.       big -= previous;
  1560.       if (littlestr->str_pok & SP_CASEFOLD) {    /* case insignificant? */
  1561.       do {
  1562. !         if (big[pos] != first && big[pos] != fold[first])
  1563. !         continue;
  1564.           for (x=big+pos+1,s=little; s < littleend; /**/ ) {
  1565.           if (x >= bigend)
  1566.               return Nullch;
  1567. ***************
  1568. *** 776,786 ****
  1569.       }
  1570.       else {
  1571.       do {
  1572. ! #ifndef lint
  1573. !         while (big[pos] != first && (pos += screamnext[pos]))
  1574. !         /*SUPPRESS 530*/
  1575. !         ;
  1576. ! #endif
  1577.           for (x=big+pos+1,s=little; s < littleend; /**/ ) {
  1578.           if (x >= bigend)
  1579.               return Nullch;
  1580. --- 769,776 ----
  1581.       }
  1582.       else {
  1583.       do {
  1584. !         if (big[pos] != first)
  1585. !         continue;
  1586.           for (x=big+pos+1,s=little; s < littleend; /**/ ) {
  1587.           if (x >= bigend)
  1588.               return Nullch;
  1589. ***************
  1590. *** 1236,1241 ****
  1591. --- 1226,1239 ----
  1592.   #endif /* HAS_VPRINTF */
  1593.   #endif /* I_VARARGS */
  1594.   
  1595. + /*
  1596. +  * I think my_swap(), htonl() and ntohl() have never been used.
  1597. +  * perl.h contains last-chance references to my_swap(), my_htonl()
  1598. +  * and my_ntohl().  I presume these are the intended functions;
  1599. +  * but htonl() and ntohl() have the wrong names.  There are no
  1600. +  * functions my_htonl() and my_ntohl() defined anywhere.
  1601. +  * -DWS
  1602. +  */
  1603.   #ifdef MYSWAP
  1604.   #if BYTEORDER != 0x4321
  1605.   short
  1606. ***************
  1607. *** 1315,1321 ****
  1608.   }
  1609.   
  1610.   #endif /* BYTEORDER != 0x4321 */
  1611. ! #endif /* HAS_HTONS */
  1612.   
  1613.   #ifndef MSDOS
  1614.   FILE *
  1615. --- 1313,1376 ----
  1616.   }
  1617.   
  1618.   #endif /* BYTEORDER != 0x4321 */
  1619. ! #endif /* MYSWAP */
  1620. ! 
  1621. ! /*
  1622. !  * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
  1623. !  * If these functions are defined,
  1624. !  * the BYTEORDER is neither 0x1234 nor 0x4321.
  1625. !  * However, this is not assumed.
  1626. !  * -DWS
  1627. !  */
  1628. ! 
  1629. ! #define HTOV(name,type)                        \
  1630. !     type                            \
  1631. !     name (n)                        \
  1632. !     register type n;                    \
  1633. !     {                            \
  1634. !         union {                        \
  1635. !         type value;                    \
  1636. !         char c[sizeof(type)];                \
  1637. !         } u;                        \
  1638. !         register int i;                    \
  1639. !         register int s;                    \
  1640. !         for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {    \
  1641. !         u.c[i] = (n >> s) & 0xFF;            \
  1642. !         }                            \
  1643. !         return u.value;                    \
  1644. !     }
  1645. ! 
  1646. ! #define VTOH(name,type)                        \
  1647. !     type                            \
  1648. !     name (n)                        \
  1649. !     register type n;                    \
  1650. !     {                            \
  1651. !         union {                        \
  1652. !         type value;                    \
  1653. !         char c[sizeof(type)];                \
  1654. !         } u;                        \
  1655. !         register int i;                    \
  1656. !         register int s;                    \
  1657. !         u.value = n;                    \
  1658. !         n = 0;                        \
  1659. !         for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {    \
  1660. !         n += (u.c[i] & 0xFF) << s;            \
  1661. !         }                            \
  1662. !         return n;                        \
  1663. !     }
  1664. ! 
  1665. ! #if defined(HAS_HTOVS) && !defined(htovs)
  1666. ! HTOV(htovs,short)
  1667. ! #endif
  1668. ! #if defined(HAS_HTOVL) && !defined(htovl)
  1669. ! HTOV(htovl,long)
  1670. ! #endif
  1671. ! #if defined(HAS_VTOHS) && !defined(vtohs)
  1672. ! VTOH(vtohs,short)
  1673. ! #endif
  1674. ! #if defined(HAS_VTOHL) && !defined(vtohl)
  1675. ! VTOH(vtohl,long)
  1676. ! #endif
  1677.   
  1678.   #ifndef MSDOS
  1679.   FILE *
  1680.  
  1681. Index: hints/uts.sh
  1682. *** hints/uts.sh.old    Mon Nov 11 16:49:33 1991
  1683. --- hints/uts.sh    Mon Nov 11 16:49:33 1991
  1684. ***************
  1685. *** 1,2 ****
  1686. ! ccflags="$ccflags -DCRIPPLED_CC -g"
  1687. ! d_lstat=$undef
  1688. --- 1,2 ----
  1689. ! ccflags="$ccflags -DCRIPPLED_CC"
  1690. ! d_lstat=$define
  1691. exit 0 # Just in case...
  1692. -- 
  1693. Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
  1694. Sterling Software, IMD           UUCP:     uunet!sparky!kent
  1695. Phone:    (402) 291-8300         FAX:      (402) 291-4362
  1696. Please send comp.sources.misc-related mail to kent@uunet.uu.net.
  1697.