home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume30 / perl / patch28 < prev    next >
Text File  |  1992-06-11  |  50KB  |  2,069 lines

  1. Newsgroups: comp.sources.misc
  2. From: lwall@netlabs.com (Larry Wall)
  3. Subject:  v30i039:  perl - The perl programming language, Patch28
  4. Message-ID: <1992Jun11.180644.956@sparky.imd.sterling.com>
  5. X-Md4-Signature: 5d7b331e1592819455b684f9aac3f3ab
  6. Date: Thu, 11 Jun 1992 18:06:44 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: lwall@netlabs.com (Larry Wall)
  10. Posting-number: Volume 30, Issue 39
  11. Archive-name: perl/patch28
  12. Environment: UNIX, MS-DOS, OS2
  13. Patch-To: perl: Volume 18, Issue 19-54
  14.  
  15. System: perl version 4.0
  16. Patch #: 28
  17. Priority: highish
  18. Subject: patch #20, continued
  19.  
  20. Description:
  21.     See patch #20.
  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 #33 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: 27
  56. 1c1
  57. < #define PATCHLEVEL 27
  58. ---
  59. > #define PATCHLEVEL 28
  60.  
  61. Index: malloc.c
  62. *** malloc.c.old    Mon Jun  8 17:49:27 1992
  63. --- malloc.c    Mon Jun  8 17:49:27 1992
  64. ***************
  65. *** 1,6 ****
  66. ! /* $RCSfile: malloc.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:57:40 $
  67.    *
  68.    * $Log:    malloc.c,v $
  69.    * Revision 4.0.1.3  91/11/05  17:57:40  lwall
  70.    * patch11: safe malloc code now integrated into Perl's malloc when possible
  71.    * 
  72. --- 1,11 ----
  73. ! /* $RCSfile: malloc.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 14:28:38 $
  74.    *
  75.    * $Log:    malloc.c,v $
  76. +  * Revision 4.0.1.4  92/06/08  14:28:38  lwall
  77. +  * patch20: removed implicit int declarations on functions
  78. +  * patch20: hash tables now split only if the memory is available to do so
  79. +  * patch20: realloc(0, size) now does malloc in case library routines call it
  80. +  * 
  81.    * Revision 4.0.1.3  91/11/05  17:57:40  lwall
  82.    * patch11: safe malloc code now integrated into Perl's malloc when possible
  83.    * 
  84. ***************
  85. *** 102,108 ****
  86.   
  87.   #ifdef debug
  88.   #define    ASSERT(p)   if (!(p)) botch("p"); else
  89. ! static
  90.   botch(s)
  91.       char *s;
  92.   {
  93. --- 107,113 ----
  94.   
  95.   #ifdef debug
  96.   #define    ASSERT(p)   if (!(p)) botch("p"); else
  97. ! static void
  98.   botch(s)
  99.       char *s;
  100.   {
  101. ***************
  102. *** 120,139 ****
  103.   
  104.   MALLOCPTRTYPE *
  105.   malloc(nbytes)
  106. !     register unsigned nbytes;
  107.   {
  108.         register union overhead *p;
  109.         register int bucket = 0;
  110. !       register unsigned shiftr;
  111.   
  112.   #ifdef safemalloc
  113.   #ifdef DEBUGGING
  114. !     int size = nbytes;
  115.   #endif
  116.   
  117.   #ifdef MSDOS
  118.       if (nbytes > 0xffff) {
  119. !         fprintf(stderr, "Allocation too large: %lx\n", nbytes);
  120.           exit(1);
  121.       }
  122.   #endif /* MSDOS */
  123. --- 125,144 ----
  124.   
  125.   MALLOCPTRTYPE *
  126.   malloc(nbytes)
  127. !     register MEM_SIZE nbytes;
  128.   {
  129.         register union overhead *p;
  130.         register int bucket = 0;
  131. !       register MEM_SIZE shiftr;
  132.   
  133.   #ifdef safemalloc
  134.   #ifdef DEBUGGING
  135. !     MEM_SIZE size = nbytes;
  136.   #endif
  137.   
  138.   #ifdef MSDOS
  139.       if (nbytes > 0xffff) {
  140. !         fprintf(stderr, "Allocation too large: %lx\n", (long)nbytes);
  141.           exit(1);
  142.       }
  143.   #endif /* MSDOS */
  144. ***************
  145. *** 163,170 ****
  146.             morecore(bucket);
  147.         if ((p = (union overhead *)nextf[bucket]) == NULL) {
  148.   #ifdef safemalloc
  149. !         fputs("Out of memory!\n", stderr);
  150. !         exit(1);
  151.   #else
  152.             return (NULL);
  153.   #endif
  154. --- 168,177 ----
  155.             morecore(bucket);
  156.         if ((p = (union overhead *)nextf[bucket]) == NULL) {
  157.   #ifdef safemalloc
  158. !         if (!nomemok) {
  159. !             fputs("Out of memory!\n", stderr);
  160. !             exit(1);
  161. !         }
  162.   #else
  163.             return (NULL);
  164.   #endif
  165. ***************
  166. *** 172,183 ****
  167.   
  168.   #ifdef safemalloc
  169.   #ifdef DEBUGGING
  170. ! #  ifndef I286
  171.       if (debug & 128)
  172. !         fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",p+1,an++,size);
  173.   #  else
  174.       if (debug & 128)
  175. !         fprintf(stderr,"0x%lx: (%05d) malloc %d bytes\n",p+1,an++,size);
  176.   #  endif
  177.   #endif
  178.   #endif /* safemalloc */
  179. --- 179,190 ----
  180.   
  181.   #ifdef safemalloc
  182.   #ifdef DEBUGGING
  183. ! #  if !(defined(I286) || defined(atarist))
  184.       if (debug & 128)
  185. !         fprintf(stderr,"0x%x: (%05d) malloc %ld bytes\n",p+1,an++,(long)size);
  186.   #  else
  187.       if (debug & 128)
  188. !         fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",p+1,an++,(long)size);
  189.   #  endif
  190.   #endif
  191.   #endif /* safemalloc */
  192. ***************
  193. *** 185,191 ****
  194.       /* remove from linked list */
  195.   #ifdef RCHECK
  196.       if (*((int*)p) & (sizeof(union overhead) - 1))
  197. ! #ifndef I286
  198.           fprintf(stderr,"Corrupt malloc ptr 0x%x at 0x%x\n",*((int*)p),p);
  199.   #else
  200.           fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",*((int*)p),p);
  201. --- 192,198 ----
  202.       /* remove from linked list */
  203.   #ifdef RCHECK
  204.       if (*((int*)p) & (sizeof(union overhead) - 1))
  205. ! #if !(defined(I286) || defined(atarist))
  206.           fprintf(stderr,"Corrupt malloc ptr 0x%x at 0x%x\n",*((int*)p),p);
  207.   #else
  208.           fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",*((int*)p),p);
  209. ***************
  210. *** 220,226 ****
  211.         register union overhead *op;
  212.         register int rnu;       /* 2^rnu bytes will be requested */
  213.         register int nblks;     /* become nblks blocks of the desired size */
  214. !     register int siz;
  215.   
  216.         if (nextf[bucket])
  217.             return;
  218. --- 227,233 ----
  219.         register union overhead *op;
  220.         register int rnu;       /* 2^rnu bytes will be requested */
  221.         register int nblks;     /* become nblks blocks of the desired size */
  222. !     register MEM_SIZE siz;
  223.   
  224.         if (nextf[bucket])
  225.             return;
  226. ***************
  227. *** 229,234 ****
  228. --- 236,242 ----
  229.        * on a page boundary.  Should
  230.        * make getpageize call?
  231.        */
  232. + #ifndef atarist /* on the atari we dont have to worry about this */
  233.         op = (union overhead *)sbrk(0);
  234.   #ifndef I286
  235.         if ((int)op & 0x3ff)
  236. ***************
  237. *** 236,254 ****
  238.   #else
  239.       /* The sbrk(0) call on the I286 always returns the next segment */
  240.   #endif
  241.   
  242. ! #ifndef I286
  243.       /* take 2k unless the block is bigger than that */
  244.         rnu = (bucket <= 8) ? 11 : bucket + 3;
  245.   #else
  246.       /* take 16k unless the block is bigger than that 
  247. !        (80286s like large segments!)        */
  248.         rnu = (bucket <= 11) ? 14 : bucket + 3;
  249.   #endif
  250.         nblks = 1 << (rnu - (bucket + 3));  /* how many blocks to get */
  251.         if (rnu < bucket)
  252.           rnu = bucket;
  253. !     op = (union overhead *)sbrk(1 << rnu);
  254.       /* no more room! */
  255.         if ((int)op == -1)
  256.             return;
  257. --- 244,263 ----
  258.   #else
  259.       /* The sbrk(0) call on the I286 always returns the next segment */
  260.   #endif
  261. + #endif /* atarist */
  262.   
  263. ! #if !(defined(I286) || defined(atarist))
  264.       /* take 2k unless the block is bigger than that */
  265.         rnu = (bucket <= 8) ? 11 : bucket + 3;
  266.   #else
  267.       /* take 16k unless the block is bigger than that 
  268. !        (80286s like large segments!), probably good on the atari too */
  269.         rnu = (bucket <= 11) ? 14 : bucket + 3;
  270.   #endif
  271.         nblks = 1 << (rnu - (bucket + 3));  /* how many blocks to get */
  272.         if (rnu < bucket)
  273.           rnu = bucket;
  274. !     op = (union overhead *)sbrk(1L << rnu);
  275.       /* no more room! */
  276.         if ((int)op == -1)
  277.             return;
  278. ***************
  279. *** 258,264 ****
  280.        */
  281.   #ifndef I286
  282.         if ((int)op & 7) {
  283. !           op = (union overhead *)(((int)op + 8) &~ 7);
  284.             nblks--;
  285.         }
  286.   #else
  287. --- 267,273 ----
  288.        */
  289.   #ifndef I286
  290.         if ((int)op & 7) {
  291. !           op = (union overhead *)(((MEM_SIZE)op + 8) &~ 7);
  292.             nblks--;
  293.         }
  294.   #else
  295. ***************
  296. *** 280,292 ****
  297.   free(mp)
  298.       MALLOCPTRTYPE *mp;
  299.   {   
  300. !       register int size;
  301.       register union overhead *op;
  302.       char *cp = (char*)mp;
  303.   
  304.   #ifdef safemalloc
  305.   #ifdef DEBUGGING
  306. ! #  ifndef I286
  307.       if (debug & 128)
  308.           fprintf(stderr,"0x%x: (%05d) free\n",cp,an++);
  309.   #  else
  310. --- 289,301 ----
  311.   free(mp)
  312.       MALLOCPTRTYPE *mp;
  313.   {   
  314. !       register MEM_SIZE size;
  315.       register union overhead *op;
  316.       char *cp = (char*)mp;
  317.   
  318.   #ifdef safemalloc
  319.   #ifdef DEBUGGING
  320. ! #  if !(defined(I286) || defined(atarist))
  321.       if (debug & 128)
  322.           fprintf(stderr,"0x%x: (%05d) free\n",cp,an++);
  323.   #  else
  324. ***************
  325. *** 339,347 ****
  326.   MALLOCPTRTYPE *
  327.   realloc(mp, nbytes)
  328.       MALLOCPTRTYPE *mp; 
  329. !     unsigned nbytes;
  330.   {   
  331. !       register u_int onb;
  332.       union overhead *op;
  333.         char *res;
  334.       register int i;
  335. --- 348,356 ----
  336.   MALLOCPTRTYPE *
  337.   realloc(mp, nbytes)
  338.       MALLOCPTRTYPE *mp; 
  339. !     MEM_SIZE nbytes;
  340.   {   
  341. !       register MEM_SIZE onb;
  342.       union overhead *op;
  343.         char *res;
  344.       register int i;
  345. ***************
  346. *** 350,356 ****
  347.   
  348.   #ifdef safemalloc
  349.   #ifdef DEBUGGING
  350. !     int size = nbytes;
  351.   #endif
  352.   
  353.   #ifdef MSDOS
  354. --- 359,365 ----
  355.   
  356.   #ifdef safemalloc
  357.   #ifdef DEBUGGING
  358. !     MEM_SIZE size = nbytes;
  359.   #endif
  360.   
  361.   #ifdef MSDOS
  362. ***************
  363. *** 360,366 ****
  364.       }
  365.   #endif /* MSDOS */
  366.       if (!cp)
  367. !         fatal("Null realloc");
  368.   #ifdef DEBUGGING
  369.       if ((long)nbytes < 0)
  370.           fatal("panic: realloc");
  371. --- 369,375 ----
  372.       }
  373.   #endif /* MSDOS */
  374.       if (!cp)
  375. !         return malloc(nbytes);
  376.   #ifdef DEBUGGING
  377.       if ((long)nbytes < 0)
  378.           fatal("panic: realloc");
  379. ***************
  380. *** 367,374 ****
  381.   #endif
  382.   #endif /* safemalloc */
  383.   
  384. -       if (cp == NULL)
  385. -           return (malloc(nbytes));
  386.       op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
  387.       if (op->ov_magic == MAGIC) {
  388.           was_alloced++;
  389. --- 376,381 ----
  390. ***************
  391. *** 389,395 ****
  392.               (i = findbucket(op, reall_srchlen)) < 0)
  393.               i = 0;
  394.       }
  395. !     onb = (1 << (i + 3)) - sizeof (*op) - RSLOP;
  396.       /* avoid the copy if same size block */
  397.       if (was_alloced &&
  398.           nbytes <= onb && nbytes > (onb >> 1) - sizeof(*op) - RSLOP) {
  399. --- 396,402 ----
  400.               (i = findbucket(op, reall_srchlen)) < 0)
  401.               i = 0;
  402.       }
  403. !     onb = (1L << (i + 3)) - sizeof (*op) - RSLOP;
  404.       /* avoid the copy if same size block */
  405.       if (was_alloced &&
  406.           nbytes <= onb && nbytes > (onb >> 1) - sizeof(*op) - RSLOP) {
  407. ***************
  408. *** 417,423 ****
  409.           if ((res = (char*)malloc(nbytes)) == NULL)
  410.               return (NULL);
  411.           if (cp != res)            /* common optimization */
  412. !             bcopy(cp, res, (int)(nbytes < onb ? nbytes : onb));
  413.           if (was_alloced)
  414.               free(cp);
  415.       }
  416. --- 424,430 ----
  417.           if ((res = (char*)malloc(nbytes)) == NULL)
  418.               return (NULL);
  419.           if (cp != res)            /* common optimization */
  420. !             Copy(cp, res, (MEM_SIZE)(nbytes<onb?nbytes:onb), char);
  421.           if (was_alloced)
  422.               free(cp);
  423.       }
  424. ***************
  425. *** 424,438 ****
  426.   
  427.   #ifdef safemalloc
  428.   #ifdef DEBUGGING
  429. ! #  ifndef I286
  430.       if (debug & 128) {
  431.           fprintf(stderr,"0x%x: (%05d) rfree\n",res,an++);
  432. !         fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",res,an++,size);
  433.       }
  434.   #  else
  435.       if (debug & 128) {
  436.           fprintf(stderr,"0x%lx: (%05d) rfree\n",res,an++);
  437. !         fprintf(stderr,"0x%lx: (%05d) realloc %d bytes\n",res,an++,size);
  438.       }
  439.   #  endif
  440.   #endif
  441. --- 431,445 ----
  442.   
  443.   #ifdef safemalloc
  444.   #ifdef DEBUGGING
  445. ! #  if !(defined(I286) || defined(atarist))
  446.       if (debug & 128) {
  447.           fprintf(stderr,"0x%x: (%05d) rfree\n",res,an++);
  448. !         fprintf(stderr,"0x%x: (%05d) realloc %ld bytes\n",res,an++,(long)size);
  449.       }
  450.   #  else
  451.       if (debug & 128) {
  452.           fprintf(stderr,"0x%lx: (%05d) rfree\n",res,an++);
  453. !         fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",res,an++,(long)size);
  454.       }
  455.   #  endif
  456.   #endif
  457. ***************
  458. *** 445,451 ****
  459.    * header starts at ``freep''.  If srchlen is -1 search the whole list.
  460.    * Return bucket number, or -1 if not found.
  461.    */
  462. ! static
  463.   findbucket(freep, srchlen)
  464.       union overhead *freep;
  465.       int srchlen;
  466. --- 452,458 ----
  467.    * header starts at ``freep''.  If srchlen is -1 search the whole list.
  468.    * Return bucket number, or -1 if not found.
  469.    */
  470. ! static int
  471.   findbucket(freep, srchlen)
  472.       union overhead *freep;
  473.       int srchlen;
  474. ***************
  475. *** 472,477 ****
  476. --- 479,485 ----
  477.    * for each size category, the second showing the number of mallocs -
  478.    * frees for each size category.
  479.    */
  480. + void
  481.   mstats(s)
  482.       char *s;
  483.   {
  484.  
  485. Index: lib/newgetopt.pl
  486. *** lib/newgetopt.pl.old    Mon Jun  8 17:49:01 1992
  487. --- lib/newgetopt.pl    Mon Jun  8 17:49:01 1992
  488. ***************
  489. *** 1,11 ****
  490.   # newgetopt.pl -- new options parsing
  491.   
  492. ! # SCCS Status     : @(#)@ newgetopt.pl    1.8
  493.   # Author          : Johan Vromans
  494.   # Created On      : Tue Sep 11 15:00:12 1990
  495.   # Last Modified By: Johan Vromans
  496. ! # Last Modified On: Thu Sep 26 20:10:41 1991
  497. ! # Update Count    : 35
  498.   # Status          : Okay
  499.   
  500.   # This package implements a new getopt function. This function adheres
  501. --- 1,11 ----
  502.   # newgetopt.pl -- new options parsing
  503.   
  504. ! # SCCS Status     : @(#)@ newgetopt.pl    1.13
  505.   # Author          : Johan Vromans
  506.   # Created On      : Tue Sep 11 15:00:12 1990
  507.   # Last Modified By: Johan Vromans
  508. ! # Last Modified On: Tue Jun  2 11:24:03 1992
  509. ! # Update Count    : 75
  510.   # Status          : Okay
  511.   
  512.   # This package implements a new getopt function. This function adheres
  513. ***************
  514. *** 18,23 ****
  515. --- 18,25 ----
  516.   #    for mandatory arguments or ":" for optional arguments) and an
  517.   #    argument type specifier: "n" or "i" for integer numbers, "f" for
  518.   #    real (fix) numbers or "s" for strings.
  519. + #    If an "@" sign is appended, the option is treated as an array.
  520. + #    Value(s) are not set, but pushed.
  521.   #
  522.   #  - if the first option of the list consists of non-alphanumeric
  523.   #    characters only, it is interpreted as a generic option starter.
  524. ***************
  525. *** 25,31 ****
  526.   #    will be considered an option.
  527.   #    Likewise, a double occurrence (e.g. "--") signals end of
  528.   #    the options list.
  529. ! #    The default value for the starter is "-".
  530.   #
  531.   # Upon return, the option variables, prefixed with "opt_", are defined
  532.   # and set to the respective option arguments, if any.
  533. --- 27,33 ----
  534.   #    will be considered an option.
  535.   #    Likewise, a double occurrence (e.g. "--") signals end of
  536.   #    the options list.
  537. ! #    The default value for the starter is "-", "--" or "+".
  538.   #
  539.   # Upon return, the option variables, prefixed with "opt_", are defined
  540.   # and set to the respective option arguments, if any.
  541. ***************
  542. *** 49,117 ****
  543.   #    -foo -bar        -> $opt_foo = '-bar'
  544.   #    -foo --        -> $opt_foo = '--'
  545.   #
  546.   # HISTORY 
  547.   # 20-Sep-1990        Johan Vromans    
  548.   #    Set options w/o argument to 1.
  549.   #    Correct the dreadful semicolon/require bug.
  550.   
  551.   
  552. ! package newgetopt;
  553.   
  554. ! $debug = 0;            # for debugging
  555.   
  556. ! sub main'NGetOpt {
  557. !     local (@optionlist) = @_;
  558.       local ($[) = 0;
  559. !     local ($genprefix) = "-";
  560.       local ($error) = 0;
  561. !     local ($opt, $optx, $arg, $type, $mand, @hits);
  562.   
  563.       # See if the first element of the optionlist contains option
  564.       # starter characters.
  565. !     $genprefix = shift (@optionlist) if $optionlist[0] =~ /^\W+$/;
  566.   
  567. -     # Turn into regexp.
  568. -     $genprefix =~ s/(\W)/\\\1/g;
  569. -     $genprefix = "[" . $genprefix . "]";
  570.       # Verify correctness of optionlist.
  571. !     @hits = grep ($_ !~ /^\w+([=:][infse])?$/, @optionlist);
  572. !     if ( $#hits >= 0 ) {
  573. !     foreach $opt ( @hits ) {
  574.           print STDERR ("Error in option spec: \"", $opt, "\"\n");
  575.           $error++;
  576.       }
  577. !     return 0;
  578.       }
  579.   
  580.       # Process argument list
  581.   
  582. !     while ( $#main'ARGV >= 0 ) {        #'){
  583.   
  584.       # >>> See also the continue block <<<
  585.   
  586.       # Get next argument
  587. !     $opt = shift (@main'ARGV);        #');
  588.       print STDERR ("=> option \"", $opt, "\"\n") if $debug;
  589.       $arg = undef;
  590.   
  591.       # Check for exhausted list.
  592. !     if ( $opt =~ /^$genprefix/o ) {
  593.           # Double occurrence is terminator
  594. !         return ($error == 0) if $opt eq "$+$+";
  595.           $opt = $';        # option name (w/o prefix)
  596.       }
  597.       else {
  598.           # Apparently not an option - push back and exit.
  599. !         unshift (@main'ARGV, $opt);        #');
  600.           return ($error == 0);
  601.       }
  602.   
  603. !     # Grep in option list. Hide regexp chars from option.
  604. !     ($optx = $opt) =~ s/(\W)/\\\1/g;
  605. !     @hits = grep (/^$optx([=:].+)?$/, @optionlist);
  606. !     if ( $#hits != 0 ) {
  607.           print STDERR ("Unknown option: ", $opt, "\n");
  608.           $error++;
  609.           next;
  610. --- 51,165 ----
  611.   #    -foo -bar        -> $opt_foo = '-bar'
  612.   #    -foo --        -> $opt_foo = '--'
  613.   #
  614.   # HISTORY 
  615. + # 2-Jun-1992        Johan Vromans    
  616. + #    Do not use //o to allow multiple NGetOpt calls with different delimeters.
  617. + #    Prevent typeless option from using previous $array state.
  618. + #    Prevent empty option from being eaten as a (negative) number.
  619. + # 25-May-1992        Johan Vromans    
  620. + #    Add array options. "foo=s@" will return an array @opt_foo that
  621. + #    contains all values that were supplied. E.g. "-foo one -foo -two" will
  622. + #    return @opt_foo = ("one", "-two");
  623. + #    Correct bug in handling options that allow for a argument when followed
  624. + #    by another option.
  625. + # 4-May-1992        Johan Vromans    
  626. + #    Add $ignorecase to match options in either case.
  627. + #    Allow '' option.
  628. + # 19-Mar-1992        Johan Vromans    
  629. + #    Allow require from packages.
  630. + #    NGetOpt is now defined in the package that requires it.
  631. + #    @ARGV and $opt_... are taken from the package that calls it.
  632. + #    Use standard (?) option prefixes: -, -- and +.
  633.   # 20-Sep-1990        Johan Vromans    
  634.   #    Set options w/o argument to 1.
  635.   #    Correct the dreadful semicolon/require bug.
  636.   
  637.   
  638. ! {   package newgetopt;
  639. !     $debug = 0;            # for debugging
  640. !     $ignorecase = 1;        # ignore case when matching options
  641. ! }
  642.   
  643. ! sub NGetOpt {
  644.   
  645. !     @newgetopt'optionlist = @_;
  646. !     *newgetopt'ARGV = *ARGV;
  647. !     package newgetopt;
  648.       local ($[) = 0;
  649. !     local ($genprefix) = "(--|-|\\+)";
  650. !     local ($argend) = "--";
  651.       local ($error) = 0;
  652. !     local ($opt, $optx, $arg, $type, $mand, %opctl);
  653. !     local ($pkg) = (caller)[0];
  654.   
  655. +     print STDERR "NGetOpt 1.13 -- called from $pkg\n" if $debug;
  656.       # See if the first element of the optionlist contains option
  657.       # starter characters.
  658. !     if ( $optionlist[0] =~ /^\W+$/ ) {
  659. !     $genprefix = shift (@optionlist);
  660. !     # Turn into regexp.
  661. !     $genprefix =~ s/(\W)/\\\1/g;
  662. !     $genprefix = "[" . $genprefix . "]";
  663. !     undef $argend;
  664. !     }
  665.   
  666.       # Verify correctness of optionlist.
  667. !     %opctl = ();
  668. !     foreach $opt ( @optionlist ) {
  669. !     $opt =~ tr/A-Z/a-z/ if $ignorecase;
  670. !     if ( $opt !~ /^(\w*)([=:][infse]@?)?$/ ) {
  671.           print STDERR ("Error in option spec: \"", $opt, "\"\n");
  672.           $error++;
  673. +         next;
  674.       }
  675. !     $opctl{$1} = defined $2 ? $2 : "";
  676.       }
  677.   
  678. +     return 0 if $error;
  679. +     if ( $debug ) {
  680. +     local ($arrow, $k, $v);
  681. +     $arrow = "=> ";
  682. +     while ( ($k,$v) = each(%opctl) ) {
  683. +         print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
  684. +         $arrow = "   ";
  685. +     }
  686. +     }
  687.       # Process argument list
  688.   
  689. !     while ( $#ARGV >= 0 ) {
  690.   
  691.       # >>> See also the continue block <<<
  692.   
  693.       # Get next argument
  694. !     $opt = shift (@ARGV);
  695.       print STDERR ("=> option \"", $opt, "\"\n") if $debug;
  696.       $arg = undef;
  697.   
  698.       # Check for exhausted list.
  699. !     if ( $opt =~ /^$genprefix/ ) {
  700.           # Double occurrence is terminator
  701. !         return ($error == 0) 
  702. !         if ($opt eq "$+$+") || ((defined $argend) && $opt eq $argend);
  703.           $opt = $';        # option name (w/o prefix)
  704.       }
  705.       else {
  706.           # Apparently not an option - push back and exit.
  707. !         unshift (@ARGV, $opt);
  708.           return ($error == 0);
  709.       }
  710.   
  711. !     # Look it up.
  712. !     $opt =~ tr/A-Z/a-z/ if $ignorecase;
  713. !     unless  ( defined ( $type = $opctl{$opt} ) ) {
  714.           print STDERR ("Unknown option: ", $opt, "\n");
  715.           $error++;
  716.           next;
  717. ***************
  718. *** 118,138 ****
  719.       }
  720.   
  721.       # Determine argument status.
  722. !     undef $type;
  723. !     $type = $+ if $hits[0] =~ /[=:].+$/;
  724. !     print STDERR ("=> found \"$hits[0]\" for ", $opt, "\n") if $debug;
  725.   
  726.       # If it is an option w/o argument, we're almost finished with it.
  727. !     if ( ! defined $type ) {
  728.           $arg = 1;        # supply explicit value
  729.           next;
  730.       }
  731.   
  732.       # Get mandatory status and type info.
  733. !     ($mand, $type) = $type =~ /^(.)(.)$/;
  734.   
  735.       # Check if the argument list is exhausted.
  736. !     if ( $#main'ARGV < 0 ) {        #'){
  737.   
  738.           # Complain if this option needs an argument.
  739.           if ( $mand eq "=" ) {
  740. --- 166,185 ----
  741.       }
  742.   
  743.       # Determine argument status.
  744. !     print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
  745.   
  746.       # If it is an option w/o argument, we're almost finished with it.
  747. !     if ( $type eq "" ) {
  748.           $arg = 1;        # supply explicit value
  749. +         $array = 0;
  750.           next;
  751.       }
  752.   
  753.       # Get mandatory status and type info.
  754. !     ($mand, $type, $array) = $type =~ /^(.)(.)(@?)$/;
  755.   
  756.       # Check if the argument list is exhausted.
  757. !     if ( $#ARGV < 0 ) {
  758.   
  759.           # Complain if this option needs an argument.
  760.           if ( $mand eq "=" ) {
  761. ***************
  762. *** 146,175 ****
  763.       }
  764.   
  765.       # Get (possibly optional) argument.
  766. !     $arg = shift (@main'ARGV);        #');
  767.   
  768.       # Check if it is a valid argument. A mandatory string takes
  769. !      # anything. 
  770. !     if ( "$mand$type" ne "=s" && $arg =~ /^$genprefix/o ) {
  771.   
  772.           # Check for option list terminator.
  773. !         if ( $arg eq "$+$+" ) {
  774.           # Complain if an argument is required.
  775.           if ($mand eq "=") {
  776.               print STDERR ("Option ", $opt, " requires an argument\n");
  777.               $error++;
  778.           }
  779. !         # Push back so the outer loop will terminate.
  780. !         unshift (@main'ARGV, $arg);    #');
  781. !         $arg = "";    # don't assign it
  782.           next;
  783.           }
  784.   
  785.           # Maybe the optional argument is the next option?
  786. !         if ( $mand eq ":" && $' =~ /[a-zA-Z_]/ ) {
  787.           # Yep. Push back.
  788. !         unshift (@main'ARGV, $arg);    #');
  789. !         $arg = "";    # don't assign it
  790.           next;
  791.           }
  792.       }
  793. --- 193,227 ----
  794.       }
  795.   
  796.       # Get (possibly optional) argument.
  797. !     $arg = shift (@ARGV);
  798.   
  799.       # Check if it is a valid argument. A mandatory string takes
  800. !     # anything. 
  801. !     if ( "$mand$type" ne "=s" && $arg =~ /^$genprefix/ ) {
  802.   
  803.           # Check for option list terminator.
  804. !         if ( $arg eq "$+$+" || 
  805. !          ((defined $argend) && $arg eq $argend)) {
  806. !         # Push back so the outer loop will terminate.
  807. !         unshift (@ARGV, $arg);
  808.           # Complain if an argument is required.
  809.           if ($mand eq "=") {
  810.               print STDERR ("Option ", $opt, " requires an argument\n");
  811.               $error++;
  812. +             undef $arg;    # don't assign it
  813.           }
  814. !         else {
  815. !             # Supply empty value.
  816. !             $arg = $type eq "s" ? "" : 0;
  817. !         }
  818.           next;
  819.           }
  820.   
  821.           # Maybe the optional argument is the next option?
  822. !         if ( $mand eq ":" && ($' eq "" || $' =~ /[a-zA-Z_]/) ) {
  823.           # Yep. Push back.
  824. !         unshift (@ARGV, $arg);
  825. !         $arg = $type eq "s" ? "" : 0;
  826.           next;
  827.           }
  828.       }
  829. ***************
  830. *** 177,184 ****
  831.       if ( $type eq "n" || $type eq "i" ) { # numeric/integer
  832.           if ( $arg !~ /^-?[0-9]+$/ ) {
  833.           print STDERR ("Value \"", $arg, "\" invalid for option ",
  834. !                    $opt, " (numeric required)\n");
  835.           $error++;
  836.           }
  837.           next;
  838.       }
  839. --- 229,237 ----
  840.       if ( $type eq "n" || $type eq "i" ) { # numeric/integer
  841.           if ( $arg !~ /^-?[0-9]+$/ ) {
  842.           print STDERR ("Value \"", $arg, "\" invalid for option ",
  843. !                   $opt, " (number expected)\n");
  844.           $error++;
  845. +         undef $arg;    # don't assign it
  846.           }
  847.           next;
  848.       }
  849. ***************
  850. *** 186,193 ****
  851.       if ( $type eq "f" ) { # fixed real number, int is also ok
  852.           if ( $arg !~ /^-?[0-9.]+$/ ) {
  853.           print STDERR ("Value \"", $arg, "\" invalid for option ",
  854. !                    $opt, " (real number required)\n");
  855.           $error++;
  856.           }
  857.           next;
  858.       }
  859. --- 239,247 ----
  860.       if ( $type eq "f" ) { # fixed real number, int is also ok
  861.           if ( $arg !~ /^-?[0-9.]+$/ ) {
  862.           print STDERR ("Value \"", $arg, "\" invalid for option ",
  863. !                   $opt, " (real number expected)\n");
  864.           $error++;
  865. +         undef $arg;    # don't assign it
  866.           }
  867.           next;
  868.       }
  869. ***************
  870. *** 198,205 ****
  871.   
  872.       }
  873.       continue {
  874. !     print STDERR ("=> \$main'opt_$opt = $arg\n") if $debug;
  875. !     eval ("\$main'opt_$opt = \$arg");
  876.       }
  877.   
  878.       return ($error == 0);
  879. --- 252,269 ----
  880.   
  881.       }
  882.       continue {
  883. !     if ( defined $arg ) {
  884. !         if ( $array ) {
  885. !         print STDERR ('=> push (@', $pkg, '\'opt_', $opt, ", \"$arg\")\n")
  886. !             if $debug;
  887. !             eval ('push(@' . $pkg . '\'opt_' . $opt . ", \$arg);");
  888. !         }
  889. !         else {
  890. !         print STDERR ('=> $', $pkg, '\'opt_', $opt, " = \"$arg\"\n")
  891. !             if $debug;
  892. !             eval ('$' . $pkg . '\'opt_' . $opt . " = \$arg;");
  893. !         }
  894. !     }
  895.       }
  896.   
  897.       return ($error == 0);
  898.  
  899. Index: lib/open2.pl
  900. *** lib/open2.pl.old    Mon Jun  8 17:49:03 1992
  901. --- lib/open2.pl    Mon Jun  8 17:49:04 1992
  902. ***************
  903. *** 0 ****
  904. --- 1,54 ----
  905. + # &open2: tom christiansen, <tchrist@convex.com>
  906. + #
  907. + # usage: $pid = &open2('rdr', 'wtr', 'some cmd and args');
  908. + #    or  $pid = &open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args');
  909. + #
  910. + # spawn the given $cmd and connect $rdr for
  911. + # reading and $wtr for writing.  return pid
  912. + # of child, or 0 on failure.  
  913. + # 
  914. + # WARNING: this is dangerous, as you may block forever
  915. + # unless you are very careful.  
  916. + # 
  917. + # $wtr is left unbuffered.
  918. + # 
  919. + # abort program if
  920. + #    rdr or wtr are null
  921. + #     pipe or fork or exec fails
  922. + package open2;
  923. + $fh = 'FHOPEN000';  # package static in case called more than once
  924. + sub main'open2 {
  925. +     local($kidpid);
  926. +     local($dad_rdr, $dad_wtr, @cmd) = @_;
  927. +     $dad_rdr ne ''         || die "open2: rdr should not be null";
  928. +     $dad_wtr ne ''         || die "open2: wtr should not be null";
  929. +     # force unqualified filehandles into callers' package
  930. +     local($package) = caller;
  931. +     $dad_rdr =~ s/^[^']+$/$package'$&/;
  932. +     $dad_wtr =~ s/^[^']+$/$package'$&/;
  933. +     local($kid_rdr) = ++$fh;
  934. +     local($kid_wtr) = ++$fh;
  935. +     pipe($dad_rdr, $kid_wtr)     || die "open2: pipe 1 failed: $!";
  936. +     pipe($kid_rdr, $dad_wtr)     || die "open2: pipe 2 failed: $!";
  937. +     if (($kidpid = fork) < 0) {
  938. +     die "open2: fork failed: $!";
  939. +     } elsif ($kidpid == 0) {
  940. +     close $dad_rdr; close $dad_wtr;
  941. +     open(STDIN,  "<&$kid_rdr");
  942. +     open(STDOUT, ">&$kid_wtr");
  943. +     warn "execing @cmd\n" if $debug;
  944. +     exec @cmd;
  945. +     die "open2: exec of @cmd failed";   
  946. +     } 
  947. +     close $kid_rdr; close $kid_wtr;
  948. +     select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
  949. +     $kidpid;
  950. + }
  951. + 1; # so require is happy
  952.  
  953. Index: os2/os2.c
  954. *** os2/os2.c.old    Mon Jun  8 17:49:59 1992
  955. --- os2/os2.c    Mon Jun  8 17:49:59 1992
  956. ***************
  957. *** 1,4 ****
  958. ! /* $RCSfile: os2.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:23:06 $
  959.    *
  960.    *    (C) Copyright 1989, 1990 Diomidis Spinellis.
  961.    *
  962. --- 1,4 ----
  963. ! /* $RCSfile: os2.c,v $$Revision: 4.0.1.2 $$Date: 92/06/08 14:32:30 $
  964.    *
  965.    *    (C) Copyright 1989, 1990 Diomidis Spinellis.
  966.    *
  967. ***************
  968. *** 6,11 ****
  969. --- 6,14 ----
  970.    *    License or the Artistic License, as specified in the README file.
  971.    *
  972.    * $Log:    os2.c,v $
  973. +  * Revision 4.0.1.2  92/06/08  14:32:30  lwall
  974. +  * patch20: new OS/2 support
  975. +  * 
  976.    * Revision 4.0.1.1  91/06/07  11:23:06  lwall
  977.    * patch4: new copyright notice
  978.    * 
  979. ***************
  980. *** 54,67 ****
  981.   { return -1; }
  982.   
  983.   
  984. ! /* extendd chdir() */
  985.   
  986.   int chdir(char *path)
  987.   {
  988.     if ( path[0] != 0 && path[1] == ':' )
  989. !     DosSelectDisk(toupper(path[0]) - '@');
  990.   
  991. !   DosChDir(path, 0L);
  992.   }
  993.   
  994.   
  995. --- 57,71 ----
  996.   { return -1; }
  997.   
  998.   
  999. ! /* extended chdir() */
  1000.   
  1001.   int chdir(char *path)
  1002.   {
  1003.     if ( path[0] != 0 && path[1] == ':' )
  1004. !     if ( DosSelectDisk(toupper(path[0]) - '@') )
  1005. !       return -1;
  1006.   
  1007. !   return DosChDir(path, 0L);
  1008.   }
  1009.   
  1010.   
  1011. ***************
  1012. *** 102,107 ****
  1013. --- 106,122 ----
  1014.   }
  1015.   
  1016.   
  1017. + /* wait for specific pid */
  1018. + int wait4pid(int pid, int *status, int flags)
  1019. + {
  1020. +   RESULTCODES res;
  1021. +   int endpid, rc;
  1022. +   if ( DosCwait(DCWA_PROCESS, flags ? DCWW_NOWAIT : DCWW_WAIT,
  1023. +                 &res, &endpid, pid) )
  1024. +     return -1;
  1025. +   *status = res.codeResult;
  1026. +   return endpid;
  1027. + }
  1028.   /* kill */
  1029.   
  1030.   int kill(int pid, int sig)
  1031. ***************
  1032. *** 251,257 ****
  1033.   usage(char *myname)
  1034.   {
  1035.   #ifdef MSDOS
  1036. !   printf("\nUsage: %s [-acdnpsSvw] [-0[octal]] [-Dnumber] [-i[extension]] [-Idirectory]"
  1037.   #else
  1038.     printf("\nUsage: %s [-acdnpPsSuUvw] [-Dnumber] [-i[extension]] [-Idirectory]"
  1039.   #endif
  1040. --- 266,272 ----
  1041.   usage(char *myname)
  1042.   {
  1043.   #ifdef MSDOS
  1044. !   printf("\nUsage: %s [-acdnpPsSvw] [-0[octal]] [-Dnumber] [-i[extension]] [-Idirectory]"
  1045.   #else
  1046.     printf("\nUsage: %s [-acdnpPsSuUvw] [-Dnumber] [-i[extension]] [-Idirectory]"
  1047.   #endif
  1048. ***************
  1049. *** 262,270 ****
  1050.            "\n  -d  run scripts under debugger"
  1051.            "\n  -n  assume 'while (<>) { ...script... }' loop arround your script"
  1052.            "\n  -p  assume loop like -n but print line also like sed"
  1053. - #ifndef MSDOS
  1054.            "\n  -P  run script through C preprocessor befor compilation"
  1055. - #endif
  1056.            "\n  -s  enable some switch parsing for switches after script name"
  1057.            "\n  -S  look for the script using PATH environment variable");
  1058.   #ifndef MSDOS
  1059. --- 277,283 ----
  1060.  
  1061. Index: atarist/osbind.pl
  1062. *** atarist/osbind.pl.old    Mon Jun  8 17:35:21 1992
  1063. --- atarist/osbind.pl    Mon Jun  8 17:35:22 1992
  1064. ***************
  1065. *** 0 ****
  1066. --- 1,382 ----
  1067. + #
  1068. + #    gemdos/xbios/bios interface on the atari
  1069. + #
  1070. + #  ++jrb    bammi@cadence.com
  1071. + #
  1072. + # camel book pp204
  1073. + sub enum {
  1074. +     local($_) = @_;
  1075. +     local(@specs) = split(/,/);
  1076. +     local($val);
  1077. +     for(@specs) {
  1078. +         if(/=/) {
  1079. +         $val = eval $_;
  1080. +         } else {
  1081. +         eval $_ . ' = ++$val';
  1082. +     }
  1083. +     }
  1084. + }
  1085. + # these must match the defines in atarist.c
  1086. + &enum(<<'EOL');
  1087. + $_trap_1_w=1, $_trap_1_ww, $_trap_1_wl, $_trap_1_wlw, $_trap_1_www,
  1088. + $_trap_1_wll, $_trap_1_wwll, $_trap_1_wlww, $_trap_1_wwlll, $_trap_13_w,
  1089. + $_trap_13_ww, $_trap_13_wl, $_trap_13_www, $_trap_13_wwl, $_trap_13_wwlwww,
  1090. + $_trap_14_w, $_trap_14_ww, $_trap_14_wl, $_trap_14_www, $_trap_14_wwl,
  1091. + $_trap_14_wwll, $_trap_14_wllw, $_trap_14_wlll, $_trap_14_wwwl,
  1092. + $_trap_14_wwwwl, $_trap_14_wllww, $_trap_14_wwwwwww, $_trap_14_wllwwwww,
  1093. + $_trap_14_wllwwwwlw, $_trap_14_wllwwwwwlw
  1094. + EOL
  1095. + sub Pterm0 {
  1096. +   syscall($_trap_1_w, 0x00);
  1097. + }
  1098. + sub Cconin {
  1099. +   syscall($_trap_1_w, 0x01);
  1100. + }
  1101. + sub Cconout {
  1102. +   syscall($_trap_1_ww, 0x02, @_);
  1103. + }
  1104. + sub Cauxin {
  1105. +   syscall($_trap_1_w, 0x03);
  1106. + }
  1107. + sub Cauxout {
  1108. +   syscall($_trap_1_ww, 0x04, @_);
  1109. + }
  1110. + sub Cprnout {
  1111. +   syscall($_trap_1_ww, 0x05, @_);
  1112. + }
  1113. + sub Crawio {
  1114. +   syscall($_trap_1_ww, 0x06, @_);
  1115. + }
  1116. + sub Crawcin {
  1117. +   syscall($_trap_1_w, 0x07);
  1118. + }
  1119. + sub Cnecin {
  1120. +   syscall($_trap_1_w, 0x08);
  1121. + }
  1122. + sub Cconws {
  1123. +   syscall($_trap_1_wl, 0x09, @_);
  1124. + }
  1125. + sub Cconrs {
  1126. +   syscall($_trap_1_wl, 0x0A, @_);
  1127. + }
  1128. + sub Cconis {
  1129. +   syscall($_trap_1_w, 0x0B);
  1130. + }
  1131. + sub Dsetdrv {
  1132. +   syscall($_trap_1_ww, 0x0E, @_);
  1133. + }
  1134. + sub Cconos {
  1135. +   syscall($_trap_1_w, 0x10);
  1136. + }
  1137. + sub Cprnos {
  1138. +   syscall($_trap_1_w, 0x11);
  1139. + }
  1140. + sub Cauxis {
  1141. +   syscall($_trap_1_w, 0x12);
  1142. + }
  1143. + sub Cauxos {
  1144. +   syscall($_trap_1_w, 0x13);
  1145. + }
  1146. + sub Dgetdrv {
  1147. +   syscall($_trap_1_w, 0x19);
  1148. + }
  1149. + sub Fsetdta {
  1150. +   syscall($_trap_1_wl, 0x1A, @_);
  1151. + }
  1152. + sub Super {
  1153. +   syscall($_trap_1_wl, 0x20, @_);
  1154. + }
  1155. + sub Tgetdate {
  1156. +   syscall($_trap_1_w, 0x2A);
  1157. + }
  1158. + sub Tsetdate {
  1159. +   syscall($_trap_1_ww, 0x2B, @_);
  1160. + }
  1161. + sub Tgettime {
  1162. +   syscall($_trap_1_w, 0x2C);
  1163. + }
  1164. + sub Tsettime {
  1165. +   syscall($_trap_1_ww, 0x2D, @_);
  1166. + }
  1167. + sub Fgetdta {
  1168. +   syscall($_trap_1_w, 0x2F);
  1169. + }
  1170. + sub Sversion {
  1171. +   syscall($_trap_1_w, 0x30);
  1172. + }
  1173. + sub Ptermres {
  1174. +   syscall($_trap_1_wlw, 0x31, @_);
  1175. + }
  1176. + sub Dfree {
  1177. +   syscall($_trap_1_wlw, 0x36, @_);
  1178. + }
  1179. + sub Dcreate {
  1180. +   syscall($_trap_1_wl, 0x39, @_);
  1181. + }
  1182. + sub Ddelete {
  1183. +   syscall($_trap_1_wl, 0x3A, @_);
  1184. + }
  1185. + sub Dsetpath {
  1186. +   syscall($_trap_1_wl, 0x3B, @_);
  1187. + }
  1188. + sub Fcreate {
  1189. +   syscall($_trap_1_wlw, 0x3C, @_);
  1190. + }
  1191. + sub Fopen {
  1192. +   syscall($_trap_1_wlw, 0x3D, @_);
  1193. + }
  1194. + sub Fclose {
  1195. +   syscall($_trap_1_ww, 0x3E, @_);
  1196. + }
  1197. + sub Fread {
  1198. +   syscall($_trap_1_wwll, 0x3F, @_);
  1199. + }
  1200. + sub Fwrite {
  1201. +   syscall($_trap_1_wwll, 0x40, @_);
  1202. + }
  1203. + sub Fdelete {
  1204. +   syscall($_trap_1_wl, 0x41, @_);
  1205. + }
  1206. + sub Fseek {
  1207. +   syscall($_trap_1_wlww, 0x42, @_);
  1208. + }
  1209. + sub Fattrib {
  1210. +   syscall($_trap_1_wlww, 0x43, @_);
  1211. + }
  1212. + sub Fdup {
  1213. +   syscall($_trap_1_ww, 0x45, @_);
  1214. + }
  1215. + sub Fforce {
  1216. +   syscall($_trap_1_www, 0x46, @_);
  1217. + }
  1218. + sub Dgetpath {
  1219. +   syscall($_trap_1_wlw, 0x47, @_);
  1220. + }
  1221. + sub Malloc {
  1222. +   syscall($_trap_1_wl, 0x48, @_);
  1223. + }
  1224. + sub Mfree {
  1225. +   syscall($_trap_1_wl, 0x49, @_);
  1226. + }
  1227. + sub Mshrink {
  1228. +   syscall($_trap_1_wwll, 0x4A, @_);
  1229. + }
  1230. + sub Pexec {
  1231. +   syscall($_trap_1_wwlll, 0x4B, @_);
  1232. + }
  1233. + sub Pterm {
  1234. +   syscall($_trap_1_ww, 0x4C, @_);
  1235. + }
  1236. + sub Fsfirst {
  1237. +   syscall($_trap_1_wlw, 0x4E, @_);
  1238. + }
  1239. + sub Fsnext {
  1240. +   syscall($_trap_1_w, 0x4F);
  1241. + }
  1242. + sub Frename {
  1243. +   syscall($_trap_1_wwll, 0x56, @_);
  1244. + }
  1245. + sub Fdatime {
  1246. +   syscall($_trap_1_wlww, 0x57, @_);
  1247. + }
  1248. + sub Getmpb {
  1249. +   syscall($_trap_13_wl, 0x00, @_);
  1250. + }
  1251. + sub Bconstat {
  1252. +   syscall($_trap_13_ww, 0x01, @_);
  1253. + }
  1254. + sub Bconin {
  1255. +   syscall($_trap_13_ww, 0x02, @_);
  1256. + }
  1257. + sub Bconout {
  1258. +   syscall($_trap_13_www, 0x03, @_);
  1259. + }
  1260. + sub Rwabs {
  1261. +   syscall($_trap_13_wwlwww, 0x04, @_);
  1262. + }
  1263. + sub Setexc {
  1264. +   syscall($_trap_13_wwl, 0x05, @_);
  1265. + }
  1266. + sub Tickcal {
  1267. +   syscall($_trap_13_w, 0x06);
  1268. + }
  1269. + sub Getbpb {
  1270. +   syscall($_trap_13_ww, 0x07, @_);
  1271. + }
  1272. + sub Bcostat {
  1273. +   syscall($_trap_13_ww, 0x08, @_);
  1274. + }
  1275. + sub Mediach {
  1276. +   syscall($_trap_13_ww, 0x09, @_);
  1277. + }
  1278. + sub Drvmap {
  1279. +   syscall($_trap_13_w, 0x0A);
  1280. + }
  1281. + sub Kbshift {
  1282. +   syscall($_trap_13_ww, 0x0B, @_);
  1283. + }
  1284. + sub Getshift {
  1285. +   &Kbshift(-1);
  1286. + }
  1287. + sub Initmous {
  1288. +   syscall($_trap_14_wwll, 0x00, @_);
  1289. + }
  1290. + sub Ssbrk {
  1291. +   syscall($_trap_14_ww, 0x01, @_);
  1292. + }
  1293. + sub Physbase {
  1294. +   syscall($_trap_14_w, 0x02);
  1295. + }
  1296. + sub Logbase {
  1297. +   syscall($_trap_14_w, 0x03);
  1298. + }
  1299. + sub Getrez {
  1300. +   syscall($_trap_14_w, 0x04);
  1301. + }
  1302. + sub Setscreen {
  1303. +   syscall($_trap_14_wllw, 0x05, @_);
  1304. + }
  1305. + sub Setpallete {
  1306. +   syscall($_trap_14_wl, 0x06, @_);
  1307. + }
  1308. + sub Setcolor {
  1309. +   syscall($_trap_14_www, 0x07, @_);
  1310. + }
  1311. + sub Floprd {
  1312. +   syscall($_trap_14_wllwwwww, 0x08, @_);
  1313. + }
  1314. + sub Flopwr {
  1315. +   syscall($_trap_14_wllwwwww, 0x09, @_);
  1316. + }
  1317. + sub Flopfmt {
  1318. +   syscall($_trap_14_wllwwwwwlw, 0x0A, @_);
  1319. + }
  1320. + sub Midiws {
  1321. +   syscall($_trap_14_wwl, 0x0C, @_);
  1322. + }
  1323. + sub Mfpint {
  1324. +   syscall($_trap_14_wwl, 0x0D, @_);
  1325. + }
  1326. + sub Iorec {
  1327. +   syscall($_trap_14_ww, 0x0E, @_);
  1328. + }
  1329. + sub Rsconf {
  1330. +   syscall($_trap_14_wwwwwww, 0x0F, @_);
  1331. + }
  1332. + sub Keytbl {
  1333. +   syscall($_trap_14_wlll, 0x10, @_);
  1334. + }
  1335. + sub Random {
  1336. +   syscall($_trap_14_w, 0x11);
  1337. + }
  1338. + sub Protobt {
  1339. +   syscall($_trap_14_wllww, 0x12, @_);
  1340. + }
  1341. + sub Flopver {
  1342. +   syscall($_trap_14_wllwwwww, 0x13, @_);
  1343. + }
  1344. + sub Scrdmp {
  1345. +   syscall($_trap_14_w, 0x14);
  1346. + }
  1347. + sub Cursconf {
  1348. +   syscall($_trap_14_www, 0x15, @_);
  1349. + }
  1350. + sub Settime {
  1351. +   syscall($_trap_14_wl, 0x16, @_);
  1352. + }
  1353. + sub Gettime {
  1354. +   syscall($_trap_14_w, 0x17);
  1355. + }
  1356. + sub Bioskeys {
  1357. +   syscall($_trap_14_w, 0x18);
  1358. + }
  1359. + sub Ikbdws {
  1360. +   syscall($_trap_14_wwl, 0x19, @_);
  1361. + }
  1362. + sub Jdisint {
  1363. +   syscall($_trap_14_ww, 0x1A, @_);
  1364. + }
  1365. + sub Jenabint {
  1366. +   syscall($_trap_14_ww, 0x1B, @_);
  1367. + }
  1368. + sub Giaccess {
  1369. +   syscall($_trap_14_www, 0x1C, @_);
  1370. + }
  1371. + sub Offgibit {
  1372. +   syscall($_trap_14_ww, 0x1D, @_);
  1373. + }
  1374. + sub Ongibit {
  1375. +   syscall($_trap_14_ww, 0x1E, @_);
  1376. + }
  1377. + sub Xbtimer {
  1378. +   syscall($_trap_14_wwwwl, 0x1E, @_);
  1379. + }
  1380. + sub Dosound {
  1381. +   syscall($_trap_14_wl, 0x20, @_);
  1382. + }
  1383. + sub Setprt {
  1384. +   syscall($_trap_14_ww, 0x21, @_);
  1385. + }
  1386. + sub Kbdvbase {
  1387. +   syscall($_trap_14_w, 0x22);
  1388. + }
  1389. + sub Kbrate {
  1390. +   syscall($_trap_14_www, 0x23, @_);
  1391. + }
  1392. + sub Prtblk {
  1393. +   syscall($_trap_14_wl, 0x24, @_);
  1394. + }
  1395. + sub Vsync {
  1396. +   syscall($_trap_14_w, 0x25);
  1397. + }
  1398. + sub Supexec {
  1399. +   syscall($_trap_14_wl, 0x26, @_);
  1400. + }
  1401. + sub Blitmode {
  1402. +   syscall($_trap_14_ww, 0x40, @_);
  1403. + }
  1404. + sub Mxalloc {
  1405. +   syscall($_trap_1_wlw, 0x44, @_);
  1406. + }
  1407. + sub Maddalt {
  1408. +   syscall($_trap_1_wll, 0x14, @_);
  1409. + }
  1410. + sub Setpalette {
  1411. +   syscall($_trap_14_wl, 0x06, @_);
  1412. + }
  1413. + sub EsetShift {
  1414. +   syscall($_trap_14_ww, 80, @_);
  1415. + }
  1416. + sub EgetShift {
  1417. +   syscall($_trap_14_w, 81);
  1418. + }
  1419. + sub EsetBank {
  1420. +   syscall($_trap_14_ww, 82, @_);
  1421. + }
  1422. + sub EsetColor {
  1423. +   syscall($_trap_14_www, 83, @_);
  1424. + }
  1425. + sub EsetPalette {
  1426. +   syscall($_trap_14_wwwl, 84, @_);
  1427. + }
  1428. + sub EgetPalette {
  1429. +   syscall($_trap_14_wwwl, 85, @_);
  1430. + }
  1431. + sub EsetGray {
  1432. +   syscall($_trap_14_ww, 86, @_);
  1433. + }
  1434. + sub EsetSmear {
  1435. +   syscall($_trap_14_ww, 87, @_);
  1436. + }
  1437. + sub Bconmap {
  1438. +   syscall($_trap_14_ww, 0x2b, @_);
  1439. + }
  1440. + sub Bconctl {
  1441. +   syscall($_trap_14_wwl, 0x2d, @_);
  1442. + }
  1443. + 1;
  1444.  
  1445. Index: hints/osf1.sh
  1446. *** hints/osf1.sh.old    Mon Jun  8 17:48:10 1992
  1447. --- hints/osf1.sh    Mon Jun  8 17:48:11 1992
  1448. ***************
  1449. *** 0 ****
  1450. --- 1,25 ----
  1451. + ccflags="$ccflags -Olimit 2900"
  1452. + libswanted=m
  1453. + tmp=`(uname -a) 2>/dev/null`
  1454. + case "$tmp" in
  1455. + OSF1*)
  1456. +     case "$tmp" in
  1457. +     *mips)
  1458. +     d_volatile=define
  1459. +     ;;
  1460. +     *)
  1461. +     cat <<EOFM
  1462. + You are not supposed to know about that machine...
  1463. + EOFM
  1464. +     ;; 
  1465. +     esac
  1466. +     ;;
  1467. + esac
  1468. + #eval_cflags='optimize="-g"'
  1469. + #teval_cflags='optimize="-g"'
  1470. + #toke_cflags='optimize="-g"'
  1471. + #ttoke_cflags='optimize="-g"'
  1472. + regcomp_cflags='optimize="-g -O0"'
  1473. + tregcomp_cflags='optimize="-g -O0"'
  1474. + regexec_cflags='optimize="-g -O0"'
  1475. + tregexec_cflags='optimize="-g -O0"'
  1476.  
  1477. Index: os2/perl.cs
  1478. *** os2/perl.cs.old    Mon Jun  8 17:50:01 1992
  1479. --- os2/perl.cs    Mon Jun  8 17:50:02 1992
  1480. ***************
  1481. *** 1,15 ****
  1482.   (-W1 -Od -Olt -DDEBUGGING -Gt2048
  1483.   array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c form.c
  1484. ! hash.c perl.c perly.c regcomp.c regexec.c stab.c str.c util.c
  1485.   )
  1486. ! (-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c{evalargs.xc} toke.c)
  1487.   (-W1 -Od -Olt -I. -Ios2
  1488. ! os2\os2.c os2\popen.c os2\mktemp.c os2\director.c os2\suffix.c os2\alarm.c
  1489.   )
  1490.   
  1491.   ; link with this library if you have GNU gdbm for OS/2
  1492. ! ; remember to enable the NDBM symbol in config.h before compiling
  1493. ! lgdbm.lib
  1494.   setargv.obj
  1495.   os2\perl.def
  1496.   os2\perl.bad
  1497. --- 1,18 ----
  1498.   (-W1 -Od -Olt -DDEBUGGING -Gt2048
  1499.   array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c form.c
  1500. ! hash.c perl.c regcomp.c regexec.c stab.c str.c util.c
  1501.   )
  1502. ! (-W1 -Od -Olt -DDEBUGGING -Gt2048 (-d perly.y))
  1503. ! (-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c toke.c)
  1504.   (-W1 -Od -Olt -I. -Ios2
  1505. ! os2\os2.c os2\popen.c os2\suffix.c
  1506. ! os2\director.c os2\alarm.c os2\crypt.c
  1507.   )
  1508.   
  1509.   ; link with this library if you have GNU gdbm for OS/2
  1510. ! ; remember to enable the GDBM symbol in config.h before compiling
  1511. ! llibgdbm.lib
  1512.   setargv.obj
  1513.   os2\perl.def
  1514.   os2\perl.bad
  1515.  
  1516. Index: os2/perl.def
  1517. *** os2/perl.def.old    Mon Jun  8 17:50:04 1992
  1518. --- os2/perl.def    Mon Jun  8 17:50:04 1992
  1519. ***************
  1520. *** 1,2 ****
  1521. ! NAME PERL WINDOWCOMPAT NEWFILES
  1522. ! DESCRIPTION 'PERL 3.0 - for MS-DOS and OS/2'
  1523. --- 1,2 ----
  1524. ! NAME WINDOWCOMPAT NEWFILES
  1525. ! DESCRIPTION 'PERL 4.0 - for MS-DOS and OS/2'
  1526.  
  1527. Index: perl.h
  1528. *** perl.h.old    Mon Jun  8 17:50:29 1992
  1529. --- perl.h    Mon Jun  8 17:50:30 1992
  1530. ***************
  1531. *** 1,4 ****
  1532. ! /* $RCSfile: perl.h,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:41:07 $
  1533.    *
  1534.    *    Copyright (c) 1991, Larry Wall
  1535.    *
  1536. --- 1,4 ----
  1537. ! /* $RCSfile: perl.h,v $$Revision: 4.0.1.6 $$Date: 92/06/08 14:55:10 $
  1538.    *
  1539.    *    Copyright (c) 1991, Larry Wall
  1540.    *
  1541. ***************
  1542. *** 6,11 ****
  1543. --- 6,17 ----
  1544.    *    License or the Artistic License, as specified in the README file.
  1545.    *
  1546.    * $Log:    perl.h,v $
  1547. +  * Revision 4.0.1.6  92/06/08  14:55:10  lwall
  1548. +  * patch20: added Atari ST portability
  1549. +  * patch20: bcopy() and memcpy() now tested for overlap safety
  1550. +  * patch20: Perl now distinguishes overlapped copies from non-overlapped
  1551. +  * patch20: removed implicit int declarations on functions
  1552. +  * 
  1553.    * Revision 4.0.1.5  91/11/11  16:41:07  lwall
  1554.    * patch19: uts wrongly defines S_ISDIR() et al
  1555.    * patch19: too many preprocessors can't expand a macro right in #if
  1556. ***************
  1557. *** 53,59 ****
  1558.   char Error[1];
  1559.   #endif
  1560.   
  1561. ! #ifdef MSDOS
  1562.   /* This stuff now in the MS-DOS config.h file. */
  1563.   #else /* !MSDOS */
  1564.   
  1565. --- 59,70 ----
  1566.   char Error[1];
  1567.   #endif
  1568.   
  1569. ! /* define this once if either system, instead of cluttering up the src */
  1570. ! #if defined(MSDOS) || defined(atarist)
  1571. ! #define DOSISH 1
  1572. ! #endif
  1573. ! #ifdef DOSISH
  1574.   /* This stuff now in the MS-DOS config.h file. */
  1575.   #else /* !MSDOS */
  1576.   
  1577. ***************
  1578. *** 130,163 ****
  1579.   /* Use all the "standard" definitions */
  1580.   #include <stdlib.h>
  1581.   #include <string.h>
  1582.   #endif /* STANDARD_C */
  1583.   
  1584. ! #if defined(HAS_MEMCMP) && defined(mips) && BYTEORDER == 0x1234
  1585.   #undef HAS_MEMCMP
  1586.   #endif
  1587.   
  1588.   #ifdef HAS_MEMCPY
  1589.   #  ifndef STANDARD_C
  1590.   #    ifndef memcpy
  1591. ! extern char * memcpy(), *memset();
  1592. ! extern int memcmp();
  1593. ! #    endif /* ndef memcpy */
  1594. ! #  endif /* ndef STANDARD_C */
  1595.   
  1596. ! #   ifndef bcopy
  1597. ! #    define bcopy(s1,s2,l) memcpy(s2,s1,l)
  1598.   #   endif
  1599. ! #   ifndef bzero
  1600. ! #    define bzero(s,l) memset(s,0,l)
  1601.   #   endif
  1602. ! #endif /* HAS_MEMCPY */
  1603.   
  1604. ! #ifndef HAS_BCMP        /* prefer bcmp slightly 'cuz it doesn't order */
  1605.   #   ifndef bcmp
  1606.   #    define bcmp(s1,s2,l) memcmp(s1,s2,l)
  1607.   #   endif
  1608.   #endif
  1609.   
  1610.   #ifndef _TYPES_        /* If types.h defines this it's easy. */
  1611.   #ifndef major        /* Does everyone's types.h define this? */
  1612. --- 141,218 ----
  1613.   /* Use all the "standard" definitions */
  1614.   #include <stdlib.h>
  1615.   #include <string.h>
  1616. + #define MEM_SIZE size_t
  1617. + #else
  1618. + typedef unsigned int MEM_SIZE;
  1619.   #endif /* STANDARD_C */
  1620.   
  1621. ! #if defined(HAS_MEMCMP) && defined(mips) && defined(ultrix)
  1622.   #undef HAS_MEMCMP
  1623.   #endif
  1624.   
  1625.   #ifdef HAS_MEMCPY
  1626.   #  ifndef STANDARD_C
  1627.   #    ifndef memcpy
  1628. !     extern char * memcpy();
  1629. ! #    endif
  1630. ! #  endif
  1631. ! #else
  1632. ! #   ifndef memcpy
  1633. ! #    ifdef HAS_BCOPY
  1634. ! #        define memcpy(d,s,l) bcopy(s,d,l)
  1635. ! #    else
  1636. ! #        define memcpy(d,s,l) my_bcopy(s,d,l)
  1637. ! #    endif
  1638. ! #   endif
  1639. ! #endif /* HAS_MEMCPY */
  1640.   
  1641. ! #ifdef HAS_MEMSET
  1642. ! #  ifndef STANDARD_C
  1643. ! #    ifndef memset
  1644. !     extern char *memset();
  1645. ! #    endif
  1646. ! #  endif
  1647. ! #  define memzero(d,l) memset(d,0,l)
  1648. ! #else
  1649. ! #   ifndef memzero
  1650. ! #    ifdef HAS_BZERO
  1651. ! #        define memzero(d,l) bzero(d,l)
  1652. ! #    else
  1653. ! #        define memzero(d,l) my_bzero(d,l)
  1654. ! #    endif
  1655.   #   endif
  1656. ! #endif /* HAS_MEMSET */
  1657. ! #ifdef HAS_MEMCMP
  1658. ! #  ifndef STANDARD_C
  1659. ! #    ifndef memcmp
  1660. !     extern int memcmp();
  1661. ! #    endif
  1662. ! #  endif
  1663. ! #else
  1664. ! #   ifndef memcmp
  1665. ! #    define memcmp(s1,s2,l) my_memcmp(s1,s2,l)
  1666.   #   endif
  1667. ! #endif /* HAS_MEMCMP */
  1668.   
  1669. ! /* we prefer bcmp slightly for comparisons that don't care about ordering */
  1670. ! #ifndef HAS_BCMP
  1671.   #   ifndef bcmp
  1672.   #    define bcmp(s1,s2,l) memcmp(s1,s2,l)
  1673.   #   endif
  1674. + #endif /* HAS_BCMP */
  1675. + #ifndef HAS_MEMMOVE
  1676. + #if defined(HAS_BCOPY) && defined(SAFE_BCOPY)
  1677. + #define memmove(d,s,l) bcopy(s,d,l)
  1678. + #else
  1679. + #if defined(HAS_MEMCPY) && defined(SAFE_MEMCPY)
  1680. + #define memmove(d,s,l) memcpy(d,s,l)
  1681. + #else
  1682. + #define memmove(d,s,l) my_bcopy(s,d,l)
  1683.   #endif
  1684. + #endif
  1685. + #endif
  1686.   
  1687.   #ifndef _TYPES_        /* If types.h defines this it's easy. */
  1688.   #ifndef major        /* Does everyone's types.h define this? */
  1689. ***************
  1690. *** 170,176 ****
  1691.   #endif
  1692.   
  1693.   #include <sys/stat.h>
  1694. ! #ifdef uts
  1695.   #undef S_ISDIR
  1696.   #undef S_ISCHR
  1697.   #undef S_ISBLK
  1698. --- 225,231 ----
  1699.   #endif
  1700.   
  1701.   #include <sys/stat.h>
  1702. ! #if defined(uts) || defined(UTekV)
  1703.   #undef S_ISDIR
  1704.   #undef S_ISCHR
  1705.   #undef S_ISBLK
  1706. ***************
  1707. *** 182,189 ****
  1708. --- 237,246 ----
  1709.   #define S_ISBLK(P) (((P)&S_IFMT)==S_IFBLK)
  1710.   #define S_ISREG(P) (((P)&S_IFMT)==S_IFREG)
  1711.   #define S_ISFIFO(P) (((P)&S_IFMT)==S_IFIFO)
  1712. + #ifdef S_IFLNK
  1713.   #define S_ISLNK(P) (((P)&S_IFMT)==S_IFLNK)
  1714.   #endif
  1715. + #endif
  1716.   
  1717.   #ifdef I_TIME
  1718.   #   include <time.h>
  1719. ***************
  1720. *** 230,236 ****
  1721.   #endif
  1722.   #endif
  1723.   
  1724. ! #if defined(mc300) || defined(mc500) || defined(mc700)    /* MASSCOMP */
  1725.   #ifdef HAS_SOCKETPAIR
  1726.   #undef HAS_SOCKETPAIR
  1727.   #endif
  1728. --- 287,293 ----
  1729.   #endif
  1730.   #endif
  1731.   
  1732. ! #if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000)
  1733.   #ifdef HAS_SOCKETPAIR
  1734.   #undef HAS_SOCKETPAIR
  1735.   #endif
  1736. ***************
  1737. *** 437,443 ****
  1738.   #undef f_next
  1739.   #endif
  1740.   
  1741. ! #if defined(cray) || defined(gould)
  1742.   #   define SLOPPYDIVIDE
  1743.   #endif
  1744.   
  1745. --- 494,500 ----
  1746.   #undef f_next
  1747.   #endif
  1748.   
  1749. ! #if defined(cray) || defined(gould) || defined(i860)
  1750.   #   define SLOPPYDIVIDE
  1751.   #endif
  1752.   
  1753. ***************
  1754. *** 457,463 ****
  1755.   #   endif
  1756.   #endif
  1757.   
  1758. ! typedef unsigned int STRLEN;
  1759.   
  1760.   typedef struct arg ARG;
  1761.   typedef struct cmd CMD;
  1762. --- 514,520 ----
  1763.   #   endif
  1764.   #endif
  1765.   
  1766. ! typedef MEM_SIZE STRLEN;
  1767.   
  1768.   typedef struct arg ARG;
  1769.   typedef struct cmd CMD;
  1770. ***************
  1771. *** 553,559 ****
  1772.   
  1773.   #define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
  1774.   
  1775. ! #ifndef MSDOS
  1776.   #define STR_GROW(str,len) if ((str)->str_len < (len)) str_grow(str,len)
  1777.   #define Str_Grow str_grow
  1778.   #else
  1779. --- 610,616 ----
  1780.   
  1781.   #define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
  1782.   
  1783. ! #ifndef DOSISH
  1784.   #define STR_GROW(str,len) if ((str)->str_len < (len)) str_grow(str,len)
  1785.   #define Str_Grow str_grow
  1786.   #else
  1787. ***************
  1788. *** 561,567 ****
  1789.   #define STR_GROW(str,len) if ((str)->str_len < (unsigned long)len) \
  1790.           str_grow(str,(unsigned long)len)
  1791.   #define Str_Grow(str,len) str_grow(str,(unsigned long)(len))
  1792. ! #endif /* MSDOS */
  1793.   
  1794.   #ifndef BYTEORDER
  1795.   #define BYTEORDER 0x1234
  1796. --- 618,624 ----
  1797.   #define STR_GROW(str,len) if ((str)->str_len < (unsigned long)len) \
  1798.           str_grow(str,(unsigned long)len)
  1799.   #define Str_Grow(str,len) str_grow(str,(unsigned long)(len))
  1800. ! #endif /* DOSISH */
  1801.   
  1802.   #ifndef BYTEORDER
  1803.   #define BYTEORDER 0x1234
  1804. ***************
  1805. *** 670,675 ****
  1806. --- 727,733 ----
  1807.   STR *str_new();
  1808.   STR *stab_str();
  1809.   
  1810. + int apply();
  1811.   int do_each();
  1812.   int do_subr();
  1813.   int do_match();
  1814. ***************
  1815. *** 701,712 ****
  1816. --- 759,782 ----
  1817.   int do_subst();
  1818.   int cando();
  1819.   int ingroup();
  1820. + int whichsig();
  1821. + int userinit();
  1822. + #ifdef CRYPTSCRIPT
  1823. + void cryptswitch();
  1824. + #endif
  1825.   
  1826.   void str_replace();
  1827.   void str_inc();
  1828.   void str_dec();
  1829.   void str_free();
  1830. + void cmd_free();
  1831. + void arg_free();
  1832. + void spat_free();
  1833. + void regfree();
  1834.   void stab_clear();
  1835. + void do_chop();
  1836. + void do_vop();
  1837. + void do_write();
  1838.   void do_join();
  1839.   void do_sprintf();
  1840.   void do_accept();
  1841. ***************
  1842. *** 724,729 ****
  1843. --- 794,817 ----
  1844.   void savehptr();
  1845.   void restorelist();
  1846.   void repeatcpy();
  1847. + void make_form();
  1848. + void dehoist();
  1849. + void format();
  1850. + void my_unexec();
  1851. + void fatal();
  1852. + void warn();
  1853. + #ifdef DEBUGGING
  1854. + void dump_all();
  1855. + void dump_cmd();
  1856. + void dump_arg();
  1857. + void dump_flags();
  1858. + void dump_stab();
  1859. + void dump_spat();
  1860. + #endif
  1861. + #ifdef MSTATS
  1862. + void mstats();
  1863. + #endif
  1864.   HASH *savehash();
  1865.   ARRAY *saveary();
  1866.   
  1867. ***************
  1868. *** 773,778 ****
  1869. --- 861,867 ----
  1870.   EXT STR *DBsingle INIT(Nullstr);
  1871.   EXT STR *DBtrace INIT(Nullstr);
  1872.   EXT STR *DBsignal INIT(Nullstr);
  1873. + EXT STR *formfeed INIT(Nullstr);
  1874.   
  1875.   EXT int lastspbase;
  1876.   EXT int lastsize;
  1877. ***************
  1878. *** 791,796 ****
  1879. --- 880,886 ----
  1880.   EXT char *rs INIT("\n");
  1881.   EXT int rschar INIT('\n');    /* final char of rs, or 0777 if none */
  1882.   EXT int rslen INIT(1);
  1883. + EXT bool rspara INIT(FALSE);
  1884.   EXT char *ofs INIT(Nullch);
  1885.   EXT int ofslen INIT(0);
  1886.   EXT char *ors INIT(Nullch);
  1887. ***************
  1888. *** 820,834 ****
  1889.   EXT int maxsysfd INIT(MAXSYSFD);    /* top fd to pass to subprocesses */
  1890.   
  1891.   #ifdef CSH
  1892. ! char *cshname INIT(CSH);
  1893. ! int cshlen INIT(0);
  1894.   #endif /* CSH */
  1895.   
  1896.   #ifdef TAINT
  1897.   EXT bool tainted INIT(FALSE);        /* using variables controlled by $< */
  1898.   #endif
  1899.   
  1900. ! #ifndef MSDOS
  1901.   #define TMPPATH "/tmp/perl-eXXXXXX"
  1902.   #else
  1903.   #define TMPPATH "plXXXXXX"
  1904. --- 910,927 ----
  1905.   EXT int maxsysfd INIT(MAXSYSFD);    /* top fd to pass to subprocesses */
  1906.   
  1907.   #ifdef CSH
  1908. ! EXT char *cshname INIT(CSH);
  1909. ! EXT int cshlen INIT(0);
  1910.   #endif /* CSH */
  1911.   
  1912.   #ifdef TAINT
  1913.   EXT bool tainted INIT(FALSE);        /* using variables controlled by $< */
  1914. + EXT bool taintanyway INIT(FALSE);    /* force taint checks when !set?id */
  1915.   #endif
  1916.   
  1917. ! EXT bool nomemok INIT(FALSE);        /* let malloc context handle nomem */
  1918. ! #ifndef DOSISH
  1919.   #define TMPPATH "/tmp/perl-eXXXXXX"
  1920.   #else
  1921.   #define TMPPATH "plXXXXXX"
  1922. ***************
  1923. *** 858,865 ****
  1924.   
  1925.   EXT struct stat statbuf;
  1926.   EXT struct stat statcache;
  1927. ! STAB *statstab INIT(Nullstab);
  1928. ! STR *statname;
  1929.   #ifndef MSDOS
  1930.   EXT struct tms timesbuf;
  1931.   #endif
  1932. --- 951,958 ----
  1933.   
  1934.   EXT struct stat statbuf;
  1935.   EXT struct stat statcache;
  1936. ! EXT STAB *statstab INIT(Nullstab);
  1937. ! EXT STR *statname;
  1938.   #ifndef MSDOS
  1939.   EXT struct tms timesbuf;
  1940.   #endif
  1941. ***************
  1942. *** 928,934 ****
  1943.   EXT short *ds;
  1944.   
  1945.   /* Fix these up for __STDC__ */
  1946. ! EXT long basetime INIT(0);
  1947.   char *mktemp();
  1948.   #ifndef STANDARD_C
  1949.   /* All of these are in stdlib.h or time.h for ANSI C */
  1950. --- 1021,1027 ----
  1951.   EXT short *ds;
  1952.   
  1953.   /* Fix these up for __STDC__ */
  1954. ! EXT time_t basetime INIT(0);
  1955.   char *mktemp();
  1956.   #ifndef STANDARD_C
  1957.   /* All of these are in stdlib.h or time.h for ANSI C */
  1958. ***************
  1959. *** 958,960 ****
  1960. --- 1051,1057 ----
  1961.   #define HAS_SETREGID
  1962.   #endif
  1963.   #endif
  1964. + #define SCAN_DEF 0
  1965. + #define SCAN_TR 1
  1966. + #define SCAN_REPL 2
  1967.  
  1968. Index: os2/perldb.dif
  1969. *** os2/perldb.dif.old    Mon Jun  8 17:50:07 1992
  1970. --- os2/perldb.dif    Mon Jun  8 17:50:07 1992
  1971. ***************
  1972. *** 1,52 ****
  1973. - *** lib/perldb.pl    Tue Oct 23 23:14:20 1990
  1974. - --- os2/perldb.pl    Tue Nov 06 21:13:42 1990
  1975. - ***************
  1976. - *** 36,43 ****
  1977. -   #
  1978. -   #
  1979. - ! open(IN, "</dev/tty") || open(IN,  "<&STDIN");    # so we don't dingle stdin
  1980. - ! open(OUT,">/dev/tty") || open(OUT, ">&STDOUT");    # so we don't dongle stdout
  1981. -   select(OUT);
  1982. -   $| = 1;                # for DB'OUT
  1983. -   select(STDOUT);
  1984. - --- 36,43 ----
  1985. -   #
  1986. -   #
  1987. - ! open(IN, "<con") || open(IN,  "<&STDIN");    # so we don't dingle stdin
  1988. - ! open(OUT,">con") || open(OUT, ">&STDOUT");    # so we don't dongle stdout
  1989. -   select(OUT);
  1990. -   $| = 1;                # for DB'OUT
  1991. -   select(STDOUT);
  1992. - ***************
  1993. - *** 517,530 ****
  1994. -       s/(.*)/'$1'/ unless /^-?[\d.]+$/;
  1995. -   }
  1996. - ! if (-f '.perldb') {
  1997. - !     do './.perldb';
  1998. -   }
  1999. - ! elsif (-f "$ENV{'LOGDIR'}/.perldb") {
  2000. - !     do "$ENV{'LOGDIR'}/.perldb";
  2001. -   }
  2002. - ! elsif (-f "$ENV{'HOME'}/.perldb") {
  2003. - !     do "$ENV{'HOME'}/.perldb";
  2004. -   }
  2005. -   1;
  2006. - --- 517,530 ----
  2007. -       s/(.*)/'$1'/ unless /^-?[\d.]+$/;
  2008. -   }
  2009. - ! if (-f 'perldb.ini') {
  2010. - !     do './perldb.ini';
  2011. -   }
  2012. - ! elsif (-f "$ENV{'INIT'}/perldb.ini") {
  2013. - !     do "$ENV{'INIT'}/perldb.ini";
  2014. -   }
  2015. - ! elsif (-f "$ENV{'HOME'}/perldb.ini") {
  2016. - !     do "$ENV{'HOME'}/perldb.ini";
  2017. -   }
  2018. -   1;
  2019. --- 0 ----
  2020.  
  2021. Index: os2/perlglob.bad
  2022. *** os2/perlglob.bad.old    Mon Jun  8 17:50:09 1992
  2023. --- os2/perlglob.bad    Mon Jun  8 17:50:09 1992
  2024. ***************
  2025. *** 1 ****
  2026. ! DOSQFSATTACH
  2027. --- 1 ----
  2028. ! (deprecated)
  2029.  
  2030. *** End of Patch 28 ***
  2031. exit 0 # Just in case...
  2032.