home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume30 / perl / patch28 < prev    next >
Encoding:
Text File  |  1992-06-11  |  49.3 KB  |  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. - 
  547.   # HISTORY 
  548.   # 20-Sep-1990        Johan Vromans    
  549.   #    Set options w/o argument to 1.
  550.   #    Correct the dreadful semicolon/require bug.
  551.   
  552.   
  553. ! package newgetopt;
  554.   
  555. ! $debug = 0;            # for debugging
  556.   
  557. ! sub main'NGetOpt {
  558. !     local (@optionlist) = @_;
  559.       local ($[) = 0;
  560. !     local ($genprefix) = "-";
  561.       local ($error) = 0;
  562. !     local ($opt, $optx, $arg, $type, $mand, @hits);
  563.   
  564.       # See if the first element of the optionlist contains option
  565.       # starter characters.
  566. !     $genprefix = shift (@optionlist) if $optionlist[0] =~ /^\W+$/;
  567.   
  568. -     # Turn into regexp.
  569. -     $genprefix =~ s/(\W)/\\\1/g;
  570. -     $genprefix = "[" . $genprefix . "]";
  571. - 
  572.       # Verify correctness of optionlist.
  573. !     @hits = grep ($_ !~ /^\w+([=:][infse])?$/, @optionlist);
  574. !     if ( $#hits >= 0 ) {
  575. !     foreach $opt ( @hits ) {
  576.           print STDERR ("Error in option spec: \"", $opt, "\"\n");
  577.           $error++;
  578.       }
  579. !     return 0;
  580.       }
  581.   
  582.       # Process argument list
  583.   
  584. !     while ( $#main'ARGV >= 0 ) {        #'){
  585.   
  586.       # >>> See also the continue block <<<
  587.   
  588.       # Get next argument
  589. !     $opt = shift (@main'ARGV);        #');
  590.       print STDERR ("=> option \"", $opt, "\"\n") if $debug;
  591.       $arg = undef;
  592.   
  593.       # Check for exhausted list.
  594. !     if ( $opt =~ /^$genprefix/o ) {
  595.           # Double occurrence is terminator
  596. !         return ($error == 0) if $opt eq "$+$+";
  597.           $opt = $';        # option name (w/o prefix)
  598.       }
  599.       else {
  600.           # Apparently not an option - push back and exit.
  601. !         unshift (@main'ARGV, $opt);        #');
  602.           return ($error == 0);
  603.       }
  604.   
  605. !     # Grep in option list. Hide regexp chars from option.
  606. !     ($optx = $opt) =~ s/(\W)/\\\1/g;
  607. !     @hits = grep (/^$optx([=:].+)?$/, @optionlist);
  608. !     if ( $#hits != 0 ) {
  609.           print STDERR ("Unknown option: ", $opt, "\n");
  610.           $error++;
  611.           next;
  612. --- 51,165 ----
  613.   #    -foo -bar        -> $opt_foo = '-bar'
  614.   #    -foo --        -> $opt_foo = '--'
  615.   #
  616.   # HISTORY 
  617. + # 2-Jun-1992        Johan Vromans    
  618. + #    Do not use //o to allow multiple NGetOpt calls with different delimeters.
  619. + #    Prevent typeless option from using previous $array state.
  620. + #    Prevent empty option from being eaten as a (negative) number.
  621. + 
  622. + # 25-May-1992        Johan Vromans    
  623. + #    Add array options. "foo=s@" will return an array @opt_foo that
  624. + #    contains all values that were supplied. E.g. "-foo one -foo -two" will
  625. + #    return @opt_foo = ("one", "-two");
  626. + #    Correct bug in handling options that allow for a argument when followed
  627. + #    by another option.
  628. + 
  629. + # 4-May-1992        Johan Vromans    
  630. + #    Add $ignorecase to match options in either case.
  631. + #    Allow '' option.
  632. + 
  633. + # 19-Mar-1992        Johan Vromans    
  634. + #    Allow require from packages.
  635. + #    NGetOpt is now defined in the package that requires it.
  636. + #    @ARGV and $opt_... are taken from the package that calls it.
  637. + #    Use standard (?) option prefixes: -, -- and +.
  638. + 
  639.   # 20-Sep-1990        Johan Vromans    
  640.   #    Set options w/o argument to 1.
  641.   #    Correct the dreadful semicolon/require bug.
  642.   
  643.   
  644. ! {   package newgetopt;
  645. !     $debug = 0;            # for debugging
  646. !     $ignorecase = 1;        # ignore case when matching options
  647. ! }
  648.   
  649. ! sub NGetOpt {
  650.   
  651. !     @newgetopt'optionlist = @_;
  652. !     *newgetopt'ARGV = *ARGV;
  653. ! 
  654. !     package newgetopt;
  655. ! 
  656.       local ($[) = 0;
  657. !     local ($genprefix) = "(--|-|\\+)";
  658. !     local ($argend) = "--";
  659.       local ($error) = 0;
  660. !     local ($opt, $optx, $arg, $type, $mand, %opctl);
  661. !     local ($pkg) = (caller)[0];
  662.   
  663. +     print STDERR "NGetOpt 1.13 -- called from $pkg\n" if $debug;
  664. + 
  665.       # See if the first element of the optionlist contains option
  666.       # starter characters.
  667. !     if ( $optionlist[0] =~ /^\W+$/ ) {
  668. !     $genprefix = shift (@optionlist);
  669. !     # Turn into regexp.
  670. !     $genprefix =~ s/(\W)/\\\1/g;
  671. !     $genprefix = "[" . $genprefix . "]";
  672. !     undef $argend;
  673. !     }
  674.   
  675.       # Verify correctness of optionlist.
  676. !     %opctl = ();
  677. !     foreach $opt ( @optionlist ) {
  678. !     $opt =~ tr/A-Z/a-z/ if $ignorecase;
  679. !     if ( $opt !~ /^(\w*)([=:][infse]@?)?$/ ) {
  680.           print STDERR ("Error in option spec: \"", $opt, "\"\n");
  681.           $error++;
  682. +         next;
  683.       }
  684. !     $opctl{$1} = defined $2 ? $2 : "";
  685.       }
  686.   
  687. +     return 0 if $error;
  688. + 
  689. +     if ( $debug ) {
  690. +     local ($arrow, $k, $v);
  691. +     $arrow = "=> ";
  692. +     while ( ($k,$v) = each(%opctl) ) {
  693. +         print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
  694. +         $arrow = "   ";
  695. +     }
  696. +     }
  697. + 
  698.       # Process argument list
  699.   
  700. !     while ( $#ARGV >= 0 ) {
  701.   
  702.       # >>> See also the continue block <<<
  703.   
  704.       # Get next argument
  705. !     $opt = shift (@ARGV);
  706.       print STDERR ("=> option \"", $opt, "\"\n") if $debug;
  707.       $arg = undef;
  708.   
  709.       # Check for exhausted list.
  710. !     if ( $opt =~ /^$genprefix/ ) {
  711.           # Double occurrence is terminator
  712. !         return ($error == 0) 
  713. !         if ($opt eq "$+$+") || ((defined $argend) && $opt eq $argend);
  714.           $opt = $';        # option name (w/o prefix)
  715.       }
  716.       else {
  717.           # Apparently not an option - push back and exit.
  718. !         unshift (@ARGV, $opt);
  719.           return ($error == 0);
  720.       }
  721.   
  722. !     # Look it up.
  723. !     $opt =~ tr/A-Z/a-z/ if $ignorecase;
  724. !     unless  ( defined ( $type = $opctl{$opt} ) ) {
  725.           print STDERR ("Unknown option: ", $opt, "\n");
  726.           $error++;
  727.           next;
  728. ***************
  729. *** 118,138 ****
  730.       }
  731.   
  732.       # Determine argument status.
  733. !     undef $type;
  734. !     $type = $+ if $hits[0] =~ /[=:].+$/;
  735. !     print STDERR ("=> found \"$hits[0]\" for ", $opt, "\n") if $debug;
  736.   
  737.       # If it is an option w/o argument, we're almost finished with it.
  738. !     if ( ! defined $type ) {
  739.           $arg = 1;        # supply explicit value
  740.           next;
  741.       }
  742.   
  743.       # Get mandatory status and type info.
  744. !     ($mand, $type) = $type =~ /^(.)(.)$/;
  745.   
  746.       # Check if the argument list is exhausted.
  747. !     if ( $#main'ARGV < 0 ) {        #'){
  748.   
  749.           # Complain if this option needs an argument.
  750.           if ( $mand eq "=" ) {
  751. --- 166,185 ----
  752.       }
  753.   
  754.       # Determine argument status.
  755. !     print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
  756.   
  757.       # If it is an option w/o argument, we're almost finished with it.
  758. !     if ( $type eq "" ) {
  759.           $arg = 1;        # supply explicit value
  760. +         $array = 0;
  761.           next;
  762.       }
  763.   
  764.       # Get mandatory status and type info.
  765. !     ($mand, $type, $array) = $type =~ /^(.)(.)(@?)$/;
  766.   
  767.       # Check if the argument list is exhausted.
  768. !     if ( $#ARGV < 0 ) {
  769.   
  770.           # Complain if this option needs an argument.
  771.           if ( $mand eq "=" ) {
  772. ***************
  773. *** 146,175 ****
  774.       }
  775.   
  776.       # Get (possibly optional) argument.
  777. !     $arg = shift (@main'ARGV);        #');
  778.   
  779.       # Check if it is a valid argument. A mandatory string takes
  780. !      # anything. 
  781. !     if ( "$mand$type" ne "=s" && $arg =~ /^$genprefix/o ) {
  782.   
  783.           # Check for option list terminator.
  784. !         if ( $arg eq "$+$+" ) {
  785.           # Complain if an argument is required.
  786.           if ($mand eq "=") {
  787.               print STDERR ("Option ", $opt, " requires an argument\n");
  788.               $error++;
  789.           }
  790. !         # Push back so the outer loop will terminate.
  791. !         unshift (@main'ARGV, $arg);    #');
  792. !         $arg = "";    # don't assign it
  793.           next;
  794.           }
  795.   
  796.           # Maybe the optional argument is the next option?
  797. !         if ( $mand eq ":" && $' =~ /[a-zA-Z_]/ ) {
  798.           # Yep. Push back.
  799. !         unshift (@main'ARGV, $arg);    #');
  800. !         $arg = "";    # don't assign it
  801.           next;
  802.           }
  803.       }
  804. --- 193,227 ----
  805.       }
  806.   
  807.       # Get (possibly optional) argument.
  808. !     $arg = shift (@ARGV);
  809.   
  810.       # Check if it is a valid argument. A mandatory string takes
  811. !     # anything. 
  812. !     if ( "$mand$type" ne "=s" && $arg =~ /^$genprefix/ ) {
  813.   
  814.           # Check for option list terminator.
  815. !         if ( $arg eq "$+$+" || 
  816. !          ((defined $argend) && $arg eq $argend)) {
  817. !         # Push back so the outer loop will terminate.
  818. !         unshift (@ARGV, $arg);
  819.           # Complain if an argument is required.
  820.           if ($mand eq "=") {
  821.               print STDERR ("Option ", $opt, " requires an argument\n");
  822.               $error++;
  823. +             undef $arg;    # don't assign it
  824.           }
  825. !         else {
  826. !             # Supply empty value.
  827. !             $arg = $type eq "s" ? "" : 0;
  828. !         }
  829.           next;
  830.           }
  831.   
  832.           # Maybe the optional argument is the next option?
  833. !         if ( $mand eq ":" && ($' eq "" || $' =~ /[a-zA-Z_]/) ) {
  834.           # Yep. Push back.
  835. !         unshift (@ARGV, $arg);
  836. !         $arg = $type eq "s" ? "" : 0;
  837.           next;
  838.           }
  839.       }
  840. ***************
  841. *** 177,184 ****
  842.       if ( $type eq "n" || $type eq "i" ) { # numeric/integer
  843.           if ( $arg !~ /^-?[0-9]+$/ ) {
  844.           print STDERR ("Value \"", $arg, "\" invalid for option ",
  845. !                    $opt, " (numeric required)\n");
  846.           $error++;
  847.           }
  848.           next;
  849.       }
  850. --- 229,237 ----
  851.       if ( $type eq "n" || $type eq "i" ) { # numeric/integer
  852.           if ( $arg !~ /^-?[0-9]+$/ ) {
  853.           print STDERR ("Value \"", $arg, "\" invalid for option ",
  854. !                   $opt, " (number expected)\n");
  855.           $error++;
  856. +         undef $arg;    # don't assign it
  857.           }
  858.           next;
  859.       }
  860. ***************
  861. *** 186,193 ****
  862.       if ( $type eq "f" ) { # fixed real number, int is also ok
  863.           if ( $arg !~ /^-?[0-9.]+$/ ) {
  864.           print STDERR ("Value \"", $arg, "\" invalid for option ",
  865. !                    $opt, " (real number required)\n");
  866.           $error++;
  867.           }
  868.           next;
  869.       }
  870. --- 239,247 ----
  871.       if ( $type eq "f" ) { # fixed real number, int is also ok
  872.           if ( $arg !~ /^-?[0-9.]+$/ ) {
  873.           print STDERR ("Value \"", $arg, "\" invalid for option ",
  874. !                   $opt, " (real number expected)\n");
  875.           $error++;
  876. +         undef $arg;    # don't assign it
  877.           }
  878.           next;
  879.       }
  880. ***************
  881. *** 198,205 ****
  882.   
  883.       }
  884.       continue {
  885. !     print STDERR ("=> \$main'opt_$opt = $arg\n") if $debug;
  886. !     eval ("\$main'opt_$opt = \$arg");
  887.       }
  888.   
  889.       return ($error == 0);
  890. --- 252,269 ----
  891.   
  892.       }
  893.       continue {
  894. !     if ( defined $arg ) {
  895. !         if ( $array ) {
  896. !         print STDERR ('=> push (@', $pkg, '\'opt_', $opt, ", \"$arg\")\n")
  897. !             if $debug;
  898. !             eval ('push(@' . $pkg . '\'opt_' . $opt . ", \$arg);");
  899. !         }
  900. !         else {
  901. !         print STDERR ('=> $', $pkg, '\'opt_', $opt, " = \"$arg\"\n")
  902. !             if $debug;
  903. !             eval ('$' . $pkg . '\'opt_' . $opt . " = \$arg;");
  904. !         }
  905. !     }
  906.       }
  907.   
  908.       return ($error == 0);
  909.  
  910. Index: lib/open2.pl
  911. *** lib/open2.pl.old    Mon Jun  8 17:49:03 1992
  912. --- lib/open2.pl    Mon Jun  8 17:49:04 1992
  913. ***************
  914. *** 0 ****
  915. --- 1,54 ----
  916. + # &open2: tom christiansen, <tchrist@convex.com>
  917. + #
  918. + # usage: $pid = &open2('rdr', 'wtr', 'some cmd and args');
  919. + #    or  $pid = &open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args');
  920. + #
  921. + # spawn the given $cmd and connect $rdr for
  922. + # reading and $wtr for writing.  return pid
  923. + # of child, or 0 on failure.  
  924. + # 
  925. + # WARNING: this is dangerous, as you may block forever
  926. + # unless you are very careful.  
  927. + # 
  928. + # $wtr is left unbuffered.
  929. + # 
  930. + # abort program if
  931. + #    rdr or wtr are null
  932. + #     pipe or fork or exec fails
  933. + 
  934. + package open2;
  935. + $fh = 'FHOPEN000';  # package static in case called more than once
  936. + 
  937. + sub main'open2 {
  938. +     local($kidpid);
  939. +     local($dad_rdr, $dad_wtr, @cmd) = @_;
  940. + 
  941. +     $dad_rdr ne ''         || die "open2: rdr should not be null";
  942. +     $dad_wtr ne ''         || die "open2: wtr should not be null";
  943. + 
  944. +     # force unqualified filehandles into callers' package
  945. +     local($package) = caller;
  946. +     $dad_rdr =~ s/^[^']+$/$package'$&/;
  947. +     $dad_wtr =~ s/^[^']+$/$package'$&/;
  948. + 
  949. +     local($kid_rdr) = ++$fh;
  950. +     local($kid_wtr) = ++$fh;
  951. + 
  952. +     pipe($dad_rdr, $kid_wtr)     || die "open2: pipe 1 failed: $!";
  953. +     pipe($kid_rdr, $dad_wtr)     || die "open2: pipe 2 failed: $!";
  954. + 
  955. +     if (($kidpid = fork) < 0) {
  956. +     die "open2: fork failed: $!";
  957. +     } elsif ($kidpid == 0) {
  958. +     close $dad_rdr; close $dad_wtr;
  959. +     open(STDIN,  "<&$kid_rdr");
  960. +     open(STDOUT, ">&$kid_wtr");
  961. +     warn "execing @cmd\n" if $debug;
  962. +     exec @cmd;
  963. +     die "open2: exec of @cmd failed";   
  964. +     } 
  965. +     close $kid_rdr; close $kid_wtr;
  966. +     select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
  967. +     $kidpid;
  968. + }
  969. + 1; # so require is happy
  970.  
  971. Index: os2/os2.c
  972. *** os2/os2.c.old    Mon Jun  8 17:49:59 1992
  973. --- os2/os2.c    Mon Jun  8 17:49:59 1992
  974. ***************
  975. *** 1,4 ****
  976. ! /* $RCSfile: os2.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:23:06 $
  977.    *
  978.    *    (C) Copyright 1989, 1990 Diomidis Spinellis.
  979.    *
  980. --- 1,4 ----
  981. ! /* $RCSfile: os2.c,v $$Revision: 4.0.1.2 $$Date: 92/06/08 14:32:30 $
  982.    *
  983.    *    (C) Copyright 1989, 1990 Diomidis Spinellis.
  984.    *
  985. ***************
  986. *** 6,11 ****
  987. --- 6,14 ----
  988.    *    License or the Artistic License, as specified in the README file.
  989.    *
  990.    * $Log:    os2.c,v $
  991. +  * Revision 4.0.1.2  92/06/08  14:32:30  lwall
  992. +  * patch20: new OS/2 support
  993. +  * 
  994.    * Revision 4.0.1.1  91/06/07  11:23:06  lwall
  995.    * patch4: new copyright notice
  996.    * 
  997. ***************
  998. *** 54,67 ****
  999.   { return -1; }
  1000.   
  1001.   
  1002. ! /* extendd chdir() */
  1003.   
  1004.   int chdir(char *path)
  1005.   {
  1006.     if ( path[0] != 0 && path[1] == ':' )
  1007. !     DosSelectDisk(toupper(path[0]) - '@');
  1008.   
  1009. !   DosChDir(path, 0L);
  1010.   }
  1011.   
  1012.   
  1013. --- 57,71 ----
  1014.   { return -1; }
  1015.   
  1016.   
  1017. ! /* extended chdir() */
  1018.   
  1019.   int chdir(char *path)
  1020.   {
  1021.     if ( path[0] != 0 && path[1] == ':' )
  1022. !     if ( DosSelectDisk(toupper(path[0]) - '@') )
  1023. !       return -1;
  1024.   
  1025. !   return DosChDir(path, 0L);
  1026.   }
  1027.   
  1028.   
  1029. ***************
  1030. *** 102,107 ****
  1031. --- 106,122 ----
  1032.   }
  1033.   
  1034.   
  1035. + /* wait for specific pid */
  1036. + int wait4pid(int pid, int *status, int flags)
  1037. + {
  1038. +   RESULTCODES res;
  1039. +   int endpid, rc;
  1040. +   if ( DosCwait(DCWA_PROCESS, flags ? DCWW_NOWAIT : DCWW_WAIT,
  1041. +                 &res, &endpid, pid) )
  1042. +     return -1;
  1043. +   *status = res.codeResult;
  1044. +   return endpid;
  1045. + }
  1046.   /* kill */
  1047.   
  1048.   int kill(int pid, int sig)
  1049. ***************
  1050. *** 251,257 ****
  1051.   usage(char *myname)
  1052.   {
  1053.   #ifdef MSDOS
  1054. !   printf("\nUsage: %s [-acdnpsSvw] [-0[octal]] [-Dnumber] [-i[extension]] [-Idirectory]"
  1055.   #else
  1056.     printf("\nUsage: %s [-acdnpPsSuUvw] [-Dnumber] [-i[extension]] [-Idirectory]"
  1057.   #endif
  1058. --- 266,272 ----
  1059.   usage(char *myname)
  1060.   {
  1061.   #ifdef MSDOS
  1062. !   printf("\nUsage: %s [-acdnpPsSvw] [-0[octal]] [-Dnumber] [-i[extension]] [-Idirectory]"
  1063.   #else
  1064.     printf("\nUsage: %s [-acdnpPsSuUvw] [-Dnumber] [-i[extension]] [-Idirectory]"
  1065.   #endif
  1066. ***************
  1067. *** 262,270 ****
  1068.            "\n  -d  run scripts under debugger"
  1069.            "\n  -n  assume 'while (<>) { ...script... }' loop arround your script"
  1070.            "\n  -p  assume loop like -n but print line also like sed"
  1071. - #ifndef MSDOS
  1072.            "\n  -P  run script through C preprocessor befor compilation"
  1073. - #endif
  1074.            "\n  -s  enable some switch parsing for switches after script name"
  1075.            "\n  -S  look for the script using PATH environment variable");
  1076.   #ifndef MSDOS
  1077. --- 277,283 ----
  1078.  
  1079. Index: atarist/osbind.pl
  1080. *** atarist/osbind.pl.old    Mon Jun  8 17:35:21 1992
  1081. --- atarist/osbind.pl    Mon Jun  8 17:35:22 1992
  1082. ***************
  1083. *** 0 ****
  1084. --- 1,382 ----
  1085. + #
  1086. + #    gemdos/xbios/bios interface on the atari
  1087. + #
  1088. + #  ++jrb    bammi@cadence.com
  1089. + #
  1090. + 
  1091. + # camel book pp204
  1092. + sub enum {
  1093. +     local($_) = @_;
  1094. +     local(@specs) = split(/,/);
  1095. +     local($val);
  1096. +     for(@specs) {
  1097. +         if(/=/) {
  1098. +         $val = eval $_;
  1099. +         } else {
  1100. +         eval $_ . ' = ++$val';
  1101. +     }
  1102. +     }
  1103. + }
  1104. + 
  1105. + # these must match the defines in atarist.c
  1106. + 
  1107. + &enum(<<'EOL');
  1108. + $_trap_1_w=1, $_trap_1_ww, $_trap_1_wl, $_trap_1_wlw, $_trap_1_www,
  1109. + $_trap_1_wll, $_trap_1_wwll, $_trap_1_wlww, $_trap_1_wwlll, $_trap_13_w,
  1110. + $_trap_13_ww, $_trap_13_wl, $_trap_13_www, $_trap_13_wwl, $_trap_13_wwlwww,
  1111. + $_trap_14_w, $_trap_14_ww, $_trap_14_wl, $_trap_14_www, $_trap_14_wwl,
  1112. + $_trap_14_wwll, $_trap_14_wllw, $_trap_14_wlll, $_trap_14_wwwl,
  1113. + $_trap_14_wwwwl, $_trap_14_wllww, $_trap_14_wwwwwww, $_trap_14_wllwwwww,
  1114. + $_trap_14_wllwwwwlw, $_trap_14_wllwwwwwlw
  1115. + EOL
  1116. + 
  1117. + sub Pterm0 {
  1118. +   syscall($_trap_1_w, 0x00);
  1119. + }
  1120. + sub Cconin {
  1121. +   syscall($_trap_1_w, 0x01);
  1122. + }
  1123. + sub Cconout {
  1124. +   syscall($_trap_1_ww, 0x02, @_);
  1125. + }
  1126. + sub Cauxin {
  1127. +   syscall($_trap_1_w, 0x03);
  1128. + }
  1129. + sub Cauxout {
  1130. +   syscall($_trap_1_ww, 0x04, @_);
  1131. + }
  1132. + sub Cprnout {
  1133. +   syscall($_trap_1_ww, 0x05, @_);
  1134. + }
  1135. + sub Crawio {
  1136. +   syscall($_trap_1_ww, 0x06, @_);
  1137. + }
  1138. + sub Crawcin {
  1139. +   syscall($_trap_1_w, 0x07);
  1140. + }
  1141. + sub Cnecin {
  1142. +   syscall($_trap_1_w, 0x08);
  1143. + }
  1144. + sub Cconws {
  1145. +   syscall($_trap_1_wl, 0x09, @_);
  1146. + }
  1147. + sub Cconrs {
  1148. +   syscall($_trap_1_wl, 0x0A, @_);
  1149. + }
  1150. + sub Cconis {
  1151. +   syscall($_trap_1_w, 0x0B);
  1152. + }
  1153. + sub Dsetdrv {
  1154. +   syscall($_trap_1_ww, 0x0E, @_);
  1155. + }
  1156. + sub Cconos {
  1157. +   syscall($_trap_1_w, 0x10);
  1158. + }
  1159. + sub Cprnos {
  1160. +   syscall($_trap_1_w, 0x11);
  1161. + }
  1162. + sub Cauxis {
  1163. +   syscall($_trap_1_w, 0x12);
  1164. + }
  1165. + sub Cauxos {
  1166. +   syscall($_trap_1_w, 0x13);
  1167. + }
  1168. + sub Dgetdrv {
  1169. +   syscall($_trap_1_w, 0x19);
  1170. + }
  1171. + sub Fsetdta {
  1172. +   syscall($_trap_1_wl, 0x1A, @_);
  1173. + }
  1174. + sub Super {
  1175. +   syscall($_trap_1_wl, 0x20, @_);
  1176. + }
  1177. + sub Tgetdate {
  1178. +   syscall($_trap_1_w, 0x2A);
  1179. + }
  1180. + sub Tsetdate {
  1181. +   syscall($_trap_1_ww, 0x2B, @_);
  1182. + }
  1183. + sub Tgettime {
  1184. +   syscall($_trap_1_w, 0x2C);
  1185. + }
  1186. + sub Tsettime {
  1187. +   syscall($_trap_1_ww, 0x2D, @_);
  1188. + }
  1189. + sub Fgetdta {
  1190. +   syscall($_trap_1_w, 0x2F);
  1191. + }
  1192. + sub Sversion {
  1193. +   syscall($_trap_1_w, 0x30);
  1194. + }
  1195. + sub Ptermres {
  1196. +   syscall($_trap_1_wlw, 0x31, @_);
  1197. + }
  1198. + sub Dfree {
  1199. +   syscall($_trap_1_wlw, 0x36, @_);
  1200. + }
  1201. + sub Dcreate {
  1202. +   syscall($_trap_1_wl, 0x39, @_);
  1203. + }
  1204. + sub Ddelete {
  1205. +   syscall($_trap_1_wl, 0x3A, @_);
  1206. + }
  1207. + sub Dsetpath {
  1208. +   syscall($_trap_1_wl, 0x3B, @_);
  1209. + }
  1210. + sub Fcreate {
  1211. +   syscall($_trap_1_wlw, 0x3C, @_);
  1212. + }
  1213. + sub Fopen {
  1214. +   syscall($_trap_1_wlw, 0x3D, @_);
  1215. + }
  1216. + sub Fclose {
  1217. +   syscall($_trap_1_ww, 0x3E, @_);
  1218. + }
  1219. + sub Fread {
  1220. +   syscall($_trap_1_wwll, 0x3F, @_);
  1221. + }
  1222. + sub Fwrite {
  1223. +   syscall($_trap_1_wwll, 0x40, @_);
  1224. + }
  1225. + sub Fdelete {
  1226. +   syscall($_trap_1_wl, 0x41, @_);
  1227. + }
  1228. + sub Fseek {
  1229. +   syscall($_trap_1_wlww, 0x42, @_);
  1230. + }
  1231. + sub Fattrib {
  1232. +   syscall($_trap_1_wlww, 0x43, @_);
  1233. + }
  1234. + sub Fdup {
  1235. +   syscall($_trap_1_ww, 0x45, @_);
  1236. + }
  1237. + sub Fforce {
  1238. +   syscall($_trap_1_www, 0x46, @_);
  1239. + }
  1240. + sub Dgetpath {
  1241. +   syscall($_trap_1_wlw, 0x47, @_);
  1242. + }
  1243. + sub Malloc {
  1244. +   syscall($_trap_1_wl, 0x48, @_);
  1245. + }
  1246. + sub Mfree {
  1247. +   syscall($_trap_1_wl, 0x49, @_);
  1248. + }
  1249. + sub Mshrink {
  1250. +   syscall($_trap_1_wwll, 0x4A, @_);
  1251. + }
  1252. + sub Pexec {
  1253. +   syscall($_trap_1_wwlll, 0x4B, @_);
  1254. + }
  1255. + sub Pterm {
  1256. +   syscall($_trap_1_ww, 0x4C, @_);
  1257. + }
  1258. + sub Fsfirst {
  1259. +   syscall($_trap_1_wlw, 0x4E, @_);
  1260. + }
  1261. + sub Fsnext {
  1262. +   syscall($_trap_1_w, 0x4F);
  1263. + }
  1264. + sub Frename {
  1265. +   syscall($_trap_1_wwll, 0x56, @_);
  1266. + }
  1267. + sub Fdatime {
  1268. +   syscall($_trap_1_wlww, 0x57, @_);
  1269. + }
  1270. + sub Getmpb {
  1271. +   syscall($_trap_13_wl, 0x00, @_);
  1272. + }
  1273. + sub Bconstat {
  1274. +   syscall($_trap_13_ww, 0x01, @_);
  1275. + }
  1276. + sub Bconin {
  1277. +   syscall($_trap_13_ww, 0x02, @_);
  1278. + }
  1279. + sub Bconout {
  1280. +   syscall($_trap_13_www, 0x03, @_);
  1281. + }
  1282. + sub Rwabs {
  1283. +   syscall($_trap_13_wwlwww, 0x04, @_);
  1284. + }
  1285. + sub Setexc {
  1286. +   syscall($_trap_13_wwl, 0x05, @_);
  1287. + }
  1288. + sub Tickcal {
  1289. +   syscall($_trap_13_w, 0x06);
  1290. + }
  1291. + sub Getbpb {
  1292. +   syscall($_trap_13_ww, 0x07, @_);
  1293. + }
  1294. + sub Bcostat {
  1295. +   syscall($_trap_13_ww, 0x08, @_);
  1296. + }
  1297. + sub Mediach {
  1298. +   syscall($_trap_13_ww, 0x09, @_);
  1299. + }
  1300. + sub Drvmap {
  1301. +   syscall($_trap_13_w, 0x0A);
  1302. + }
  1303. + sub Kbshift {
  1304. +   syscall($_trap_13_ww, 0x0B, @_);
  1305. + }
  1306. + sub Getshift {
  1307. +   &Kbshift(-1);
  1308. + }
  1309. + sub Initmous {
  1310. +   syscall($_trap_14_wwll, 0x00, @_);
  1311. + }
  1312. + sub Ssbrk {
  1313. +   syscall($_trap_14_ww, 0x01, @_);
  1314. + }
  1315. + sub Physbase {
  1316. +   syscall($_trap_14_w, 0x02);
  1317. + }
  1318. + sub Logbase {
  1319. +   syscall($_trap_14_w, 0x03);
  1320. + }
  1321. + sub Getrez {
  1322. +   syscall($_trap_14_w, 0x04);
  1323. + }
  1324. + sub Setscreen {
  1325. +   syscall($_trap_14_wllw, 0x05, @_);
  1326. + }
  1327. + sub Setpallete {
  1328. +   syscall($_trap_14_wl, 0x06, @_);
  1329. + }
  1330. + sub Setcolor {
  1331. +   syscall($_trap_14_www, 0x07, @_);
  1332. + }
  1333. + sub Floprd {
  1334. +   syscall($_trap_14_wllwwwww, 0x08, @_);
  1335. + }
  1336. + sub Flopwr {
  1337. +   syscall($_trap_14_wllwwwww, 0x09, @_);
  1338. + }
  1339. + sub Flopfmt {
  1340. +   syscall($_trap_14_wllwwwwwlw, 0x0A, @_);
  1341. + }
  1342. + sub Midiws {
  1343. +   syscall($_trap_14_wwl, 0x0C, @_);
  1344. + }
  1345. + sub Mfpint {
  1346. +   syscall($_trap_14_wwl, 0x0D, @_);
  1347. + }
  1348. + sub Iorec {
  1349. +   syscall($_trap_14_ww, 0x0E, @_);
  1350. + }
  1351. + sub Rsconf {
  1352. +   syscall($_trap_14_wwwwwww, 0x0F, @_);
  1353. + }
  1354. + sub Keytbl {
  1355. +   syscall($_trap_14_wlll, 0x10, @_);
  1356. + }
  1357. + sub Random {
  1358. +   syscall($_trap_14_w, 0x11);
  1359. + }
  1360. + sub Protobt {
  1361. +   syscall($_trap_14_wllww, 0x12, @_);
  1362. + }
  1363. + sub Flopver {
  1364. +   syscall($_trap_14_wllwwwww, 0x13, @_);
  1365. + }
  1366. + sub Scrdmp {
  1367. +   syscall($_trap_14_w, 0x14);
  1368. + }
  1369. + sub Cursconf {
  1370. +   syscall($_trap_14_www, 0x15, @_);
  1371. + }
  1372. + sub Settime {
  1373. +   syscall($_trap_14_wl, 0x16, @_);
  1374. + }
  1375. + sub Gettime {
  1376. +   syscall($_trap_14_w, 0x17);
  1377. + }
  1378. + sub Bioskeys {
  1379. +   syscall($_trap_14_w, 0x18);
  1380. + }
  1381. + sub Ikbdws {
  1382. +   syscall($_trap_14_wwl, 0x19, @_);
  1383. + }
  1384. + sub Jdisint {
  1385. +   syscall($_trap_14_ww, 0x1A, @_);
  1386. + }
  1387. + sub Jenabint {
  1388. +   syscall($_trap_14_ww, 0x1B, @_);
  1389. + }
  1390. + sub Giaccess {
  1391. +   syscall($_trap_14_www, 0x1C, @_);
  1392. + }
  1393. + sub Offgibit {
  1394. +   syscall($_trap_14_ww, 0x1D, @_);
  1395. + }
  1396. + sub Ongibit {
  1397. +   syscall($_trap_14_ww, 0x1E, @_);
  1398. + }
  1399. + sub Xbtimer {
  1400. +   syscall($_trap_14_wwwwl, 0x1E, @_);
  1401. + }
  1402. + sub Dosound {
  1403. +   syscall($_trap_14_wl, 0x20, @_);
  1404. + }
  1405. + sub Setprt {
  1406. +   syscall($_trap_14_ww, 0x21, @_);
  1407. + }
  1408. + sub Kbdvbase {
  1409. +   syscall($_trap_14_w, 0x22);
  1410. + }
  1411. + sub Kbrate {
  1412. +   syscall($_trap_14_www, 0x23, @_);
  1413. + }
  1414. + sub Prtblk {
  1415. +   syscall($_trap_14_wl, 0x24, @_);
  1416. + }
  1417. + sub Vsync {
  1418. +   syscall($_trap_14_w, 0x25);
  1419. + }
  1420. + sub Supexec {
  1421. +   syscall($_trap_14_wl, 0x26, @_);
  1422. + }
  1423. + sub Blitmode {
  1424. +   syscall($_trap_14_ww, 0x40, @_);
  1425. + }
  1426. + sub Mxalloc {
  1427. +   syscall($_trap_1_wlw, 0x44, @_);
  1428. + }
  1429. + sub Maddalt {
  1430. +   syscall($_trap_1_wll, 0x14, @_);
  1431. + }
  1432. + sub Setpalette {
  1433. +   syscall($_trap_14_wl, 0x06, @_);
  1434. + }
  1435. + sub EsetShift {
  1436. +   syscall($_trap_14_ww, 80, @_);
  1437. + }
  1438. + sub EgetShift {
  1439. +   syscall($_trap_14_w, 81);
  1440. + }
  1441. + sub EsetBank {
  1442. +   syscall($_trap_14_ww, 82, @_);
  1443. + }
  1444. + sub EsetColor {
  1445. +   syscall($_trap_14_www, 83, @_);
  1446. + }
  1447. + sub EsetPalette {
  1448. +   syscall($_trap_14_wwwl, 84, @_);
  1449. + }
  1450. + sub EgetPalette {
  1451. +   syscall($_trap_14_wwwl, 85, @_);
  1452. + }
  1453. + sub EsetGray {
  1454. +   syscall($_trap_14_ww, 86, @_);
  1455. + }
  1456. + sub EsetSmear {
  1457. +   syscall($_trap_14_ww, 87, @_);
  1458. + }
  1459. + sub Bconmap {
  1460. +   syscall($_trap_14_ww, 0x2b, @_);
  1461. + }
  1462. + sub Bconctl {
  1463. +   syscall($_trap_14_wwl, 0x2d, @_);
  1464. + }
  1465. + 
  1466. + 1;
  1467.  
  1468. Index: hints/osf1.sh
  1469. *** hints/osf1.sh.old    Mon Jun  8 17:48:10 1992
  1470. --- hints/osf1.sh    Mon Jun  8 17:48:11 1992
  1471. ***************
  1472. *** 0 ****
  1473. --- 1,25 ----
  1474. + ccflags="$ccflags -Olimit 2900"
  1475. + libswanted=m
  1476. + tmp=`(uname -a) 2>/dev/null`
  1477. + case "$tmp" in
  1478. + OSF1*)
  1479. +     case "$tmp" in
  1480. +     *mips)
  1481. +     d_volatile=define
  1482. +     ;;
  1483. +     *)
  1484. +     cat <<EOFM
  1485. + You are not supposed to know about that machine...
  1486. + EOFM
  1487. +     ;; 
  1488. +     esac
  1489. +     ;;
  1490. + esac
  1491. + #eval_cflags='optimize="-g"'
  1492. + #teval_cflags='optimize="-g"'
  1493. + #toke_cflags='optimize="-g"'
  1494. + #ttoke_cflags='optimize="-g"'
  1495. + regcomp_cflags='optimize="-g -O0"'
  1496. + tregcomp_cflags='optimize="-g -O0"'
  1497. + regexec_cflags='optimize="-g -O0"'
  1498. + tregexec_cflags='optimize="-g -O0"'
  1499.  
  1500. Index: os2/perl.cs
  1501. *** os2/perl.cs.old    Mon Jun  8 17:50:01 1992
  1502. --- os2/perl.cs    Mon Jun  8 17:50:02 1992
  1503. ***************
  1504. *** 1,15 ****
  1505.   (-W1 -Od -Olt -DDEBUGGING -Gt2048
  1506.   array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c form.c
  1507. ! hash.c perl.c perly.c regcomp.c regexec.c stab.c str.c util.c
  1508.   )
  1509. ! (-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c{evalargs.xc} toke.c)
  1510.   (-W1 -Od -Olt -I. -Ios2
  1511. ! os2\os2.c os2\popen.c os2\mktemp.c os2\director.c os2\suffix.c os2\alarm.c
  1512.   )
  1513.   
  1514.   ; link with this library if you have GNU gdbm for OS/2
  1515. ! ; remember to enable the NDBM symbol in config.h before compiling
  1516. ! lgdbm.lib
  1517.   setargv.obj
  1518.   os2\perl.def
  1519.   os2\perl.bad
  1520. --- 1,18 ----
  1521.   (-W1 -Od -Olt -DDEBUGGING -Gt2048
  1522.   array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c form.c
  1523. ! hash.c perl.c regcomp.c regexec.c stab.c str.c util.c
  1524.   )
  1525. ! (-W1 -Od -Olt -DDEBUGGING -Gt2048 (-d perly.y))
  1526. ! (-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c toke.c)
  1527.   (-W1 -Od -Olt -I. -Ios2
  1528. ! os2\os2.c os2\popen.c os2\suffix.c
  1529. ! os2\director.c os2\alarm.c os2\crypt.c
  1530.   )
  1531.   
  1532.   ; link with this library if you have GNU gdbm for OS/2
  1533. ! ; remember to enable the GDBM symbol in config.h before compiling
  1534. ! llibgdbm.lib
  1535. ! 
  1536.   setargv.obj
  1537.   os2\perl.def
  1538.   os2\perl.bad
  1539.  
  1540. Index: os2/perl.def
  1541. *** os2/perl.def.old    Mon Jun  8 17:50:04 1992
  1542. --- os2/perl.def    Mon Jun  8 17:50:04 1992
  1543. ***************
  1544. *** 1,2 ****
  1545. ! NAME PERL WINDOWCOMPAT NEWFILES
  1546. ! DESCRIPTION 'PERL 3.0 - for MS-DOS and OS/2'
  1547. --- 1,2 ----
  1548. ! NAME WINDOWCOMPAT NEWFILES
  1549. ! DESCRIPTION 'PERL 4.0 - for MS-DOS and OS/2'
  1550.  
  1551. Index: perl.h
  1552. *** perl.h.old    Mon Jun  8 17:50:29 1992
  1553. --- perl.h    Mon Jun  8 17:50:30 1992
  1554. ***************
  1555. *** 1,4 ****
  1556. ! /* $RCSfile: perl.h,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:41:07 $
  1557.    *
  1558.    *    Copyright (c) 1991, Larry Wall
  1559.    *
  1560. --- 1,4 ----
  1561. ! /* $RCSfile: perl.h,v $$Revision: 4.0.1.6 $$Date: 92/06/08 14:55:10 $
  1562.    *
  1563.    *    Copyright (c) 1991, Larry Wall
  1564.    *
  1565. ***************
  1566. *** 6,11 ****
  1567. --- 6,17 ----
  1568.    *    License or the Artistic License, as specified in the README file.
  1569.    *
  1570.    * $Log:    perl.h,v $
  1571. +  * Revision 4.0.1.6  92/06/08  14:55:10  lwall
  1572. +  * patch20: added Atari ST portability
  1573. +  * patch20: bcopy() and memcpy() now tested for overlap safety
  1574. +  * patch20: Perl now distinguishes overlapped copies from non-overlapped
  1575. +  * patch20: removed implicit int declarations on functions
  1576. +  * 
  1577.    * Revision 4.0.1.5  91/11/11  16:41:07  lwall
  1578.    * patch19: uts wrongly defines S_ISDIR() et al
  1579.    * patch19: too many preprocessors can't expand a macro right in #if
  1580. ***************
  1581. *** 53,59 ****
  1582.   char Error[1];
  1583.   #endif
  1584.   
  1585. ! #ifdef MSDOS
  1586.   /* This stuff now in the MS-DOS config.h file. */
  1587.   #else /* !MSDOS */
  1588.   
  1589. --- 59,70 ----
  1590.   char Error[1];
  1591.   #endif
  1592.   
  1593. ! /* define this once if either system, instead of cluttering up the src */
  1594. ! #if defined(MSDOS) || defined(atarist)
  1595. ! #define DOSISH 1
  1596. ! #endif
  1597. ! 
  1598. ! #ifdef DOSISH
  1599.   /* This stuff now in the MS-DOS config.h file. */
  1600.   #else /* !MSDOS */
  1601.   
  1602. ***************
  1603. *** 130,163 ****
  1604.   /* Use all the "standard" definitions */
  1605.   #include <stdlib.h>
  1606.   #include <string.h>
  1607.   #endif /* STANDARD_C */
  1608.   
  1609. ! #if defined(HAS_MEMCMP) && defined(mips) && BYTEORDER == 0x1234
  1610.   #undef HAS_MEMCMP
  1611.   #endif
  1612.   
  1613.   #ifdef HAS_MEMCPY
  1614. - 
  1615.   #  ifndef STANDARD_C
  1616.   #    ifndef memcpy
  1617. ! extern char * memcpy(), *memset();
  1618. ! extern int memcmp();
  1619. ! #    endif /* ndef memcpy */
  1620. ! #  endif /* ndef STANDARD_C */
  1621.   
  1622. ! #   ifndef bcopy
  1623. ! #    define bcopy(s1,s2,l) memcpy(s2,s1,l)
  1624.   #   endif
  1625. ! #   ifndef bzero
  1626. ! #    define bzero(s,l) memset(s,0,l)
  1627.   #   endif
  1628. ! #endif /* HAS_MEMCPY */
  1629.   
  1630. ! #ifndef HAS_BCMP        /* prefer bcmp slightly 'cuz it doesn't order */
  1631.   #   ifndef bcmp
  1632.   #    define bcmp(s1,s2,l) memcmp(s1,s2,l)
  1633.   #   endif
  1634.   #endif
  1635.   
  1636.   #ifndef _TYPES_        /* If types.h defines this it's easy. */
  1637.   #ifndef major        /* Does everyone's types.h define this? */
  1638. --- 141,218 ----
  1639.   /* Use all the "standard" definitions */
  1640.   #include <stdlib.h>
  1641.   #include <string.h>
  1642. + #define MEM_SIZE size_t
  1643. + #else
  1644. + typedef unsigned int MEM_SIZE;
  1645.   #endif /* STANDARD_C */
  1646.   
  1647. ! #if defined(HAS_MEMCMP) && defined(mips) && defined(ultrix)
  1648.   #undef HAS_MEMCMP
  1649.   #endif
  1650.   
  1651.   #ifdef HAS_MEMCPY
  1652.   #  ifndef STANDARD_C
  1653.   #    ifndef memcpy
  1654. !     extern char * memcpy();
  1655. ! #    endif
  1656. ! #  endif
  1657. ! #else
  1658. ! #   ifndef memcpy
  1659. ! #    ifdef HAS_BCOPY
  1660. ! #        define memcpy(d,s,l) bcopy(s,d,l)
  1661. ! #    else
  1662. ! #        define memcpy(d,s,l) my_bcopy(s,d,l)
  1663. ! #    endif
  1664. ! #   endif
  1665. ! #endif /* HAS_MEMCPY */
  1666.   
  1667. ! #ifdef HAS_MEMSET
  1668. ! #  ifndef STANDARD_C
  1669. ! #    ifndef memset
  1670. !     extern char *memset();
  1671. ! #    endif
  1672. ! #  endif
  1673. ! #  define memzero(d,l) memset(d,0,l)
  1674. ! #else
  1675. ! #   ifndef memzero
  1676. ! #    ifdef HAS_BZERO
  1677. ! #        define memzero(d,l) bzero(d,l)
  1678. ! #    else
  1679. ! #        define memzero(d,l) my_bzero(d,l)
  1680. ! #    endif
  1681.   #   endif
  1682. ! #endif /* HAS_MEMSET */
  1683. ! 
  1684. ! #ifdef HAS_MEMCMP
  1685. ! #  ifndef STANDARD_C
  1686. ! #    ifndef memcmp
  1687. !     extern int memcmp();
  1688. ! #    endif
  1689. ! #  endif
  1690. ! #else
  1691. ! #   ifndef memcmp
  1692. ! #    define memcmp(s1,s2,l) my_memcmp(s1,s2,l)
  1693.   #   endif
  1694. ! #endif /* HAS_MEMCMP */
  1695.   
  1696. ! /* we prefer bcmp slightly for comparisons that don't care about ordering */
  1697. ! #ifndef HAS_BCMP
  1698.   #   ifndef bcmp
  1699.   #    define bcmp(s1,s2,l) memcmp(s1,s2,l)
  1700.   #   endif
  1701. + #endif /* HAS_BCMP */
  1702. + 
  1703. + #ifndef HAS_MEMMOVE
  1704. + #if defined(HAS_BCOPY) && defined(SAFE_BCOPY)
  1705. + #define memmove(d,s,l) bcopy(s,d,l)
  1706. + #else
  1707. + #if defined(HAS_MEMCPY) && defined(SAFE_MEMCPY)
  1708. + #define memmove(d,s,l) memcpy(d,s,l)
  1709. + #else
  1710. + #define memmove(d,s,l) my_bcopy(s,d,l)
  1711.   #endif
  1712. + #endif
  1713. + #endif
  1714.   
  1715.   #ifndef _TYPES_        /* If types.h defines this it's easy. */
  1716.   #ifndef major        /* Does everyone's types.h define this? */
  1717. ***************
  1718. *** 170,176 ****
  1719.   #endif
  1720.   
  1721.   #include <sys/stat.h>
  1722. ! #ifdef uts
  1723.   #undef S_ISDIR
  1724.   #undef S_ISCHR
  1725.   #undef S_ISBLK
  1726. --- 225,231 ----
  1727.   #endif
  1728.   
  1729.   #include <sys/stat.h>
  1730. ! #if defined(uts) || defined(UTekV)
  1731.   #undef S_ISDIR
  1732.   #undef S_ISCHR
  1733.   #undef S_ISBLK
  1734. ***************
  1735. *** 182,189 ****
  1736. --- 237,246 ----
  1737.   #define S_ISBLK(P) (((P)&S_IFMT)==S_IFBLK)
  1738.   #define S_ISREG(P) (((P)&S_IFMT)==S_IFREG)
  1739.   #define S_ISFIFO(P) (((P)&S_IFMT)==S_IFIFO)
  1740. + #ifdef S_IFLNK
  1741.   #define S_ISLNK(P) (((P)&S_IFMT)==S_IFLNK)
  1742.   #endif
  1743. + #endif
  1744.   
  1745.   #ifdef I_TIME
  1746.   #   include <time.h>
  1747. ***************
  1748. *** 230,236 ****
  1749.   #endif
  1750.   #endif
  1751.   
  1752. ! #if defined(mc300) || defined(mc500) || defined(mc700)    /* MASSCOMP */
  1753.   #ifdef HAS_SOCKETPAIR
  1754.   #undef HAS_SOCKETPAIR
  1755.   #endif
  1756. --- 287,293 ----
  1757.   #endif
  1758.   #endif
  1759.   
  1760. ! #if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000)
  1761.   #ifdef HAS_SOCKETPAIR
  1762.   #undef HAS_SOCKETPAIR
  1763.   #endif
  1764. ***************
  1765. *** 437,443 ****
  1766.   #undef f_next
  1767.   #endif
  1768.   
  1769. ! #if defined(cray) || defined(gould)
  1770.   #   define SLOPPYDIVIDE
  1771.   #endif
  1772.   
  1773. --- 494,500 ----
  1774.   #undef f_next
  1775.   #endif
  1776.   
  1777. ! #if defined(cray) || defined(gould) || defined(i860)
  1778.   #   define SLOPPYDIVIDE
  1779.   #endif
  1780.   
  1781. ***************
  1782. *** 457,463 ****
  1783.   #   endif
  1784.   #endif
  1785.   
  1786. ! typedef unsigned int STRLEN;
  1787.   
  1788.   typedef struct arg ARG;
  1789.   typedef struct cmd CMD;
  1790. --- 514,520 ----
  1791.   #   endif
  1792.   #endif
  1793.   
  1794. ! typedef MEM_SIZE STRLEN;
  1795.   
  1796.   typedef struct arg ARG;
  1797.   typedef struct cmd CMD;
  1798. ***************
  1799. *** 553,559 ****
  1800.   
  1801.   #define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
  1802.   
  1803. ! #ifndef MSDOS
  1804.   #define STR_GROW(str,len) if ((str)->str_len < (len)) str_grow(str,len)
  1805.   #define Str_Grow str_grow
  1806.   #else
  1807. --- 610,616 ----
  1808.   
  1809.   #define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
  1810.   
  1811. ! #ifndef DOSISH
  1812.   #define STR_GROW(str,len) if ((str)->str_len < (len)) str_grow(str,len)
  1813.   #define Str_Grow str_grow
  1814.   #else
  1815. ***************
  1816. *** 561,567 ****
  1817.   #define STR_GROW(str,len) if ((str)->str_len < (unsigned long)len) \
  1818.           str_grow(str,(unsigned long)len)
  1819.   #define Str_Grow(str,len) str_grow(str,(unsigned long)(len))
  1820. ! #endif /* MSDOS */
  1821.   
  1822.   #ifndef BYTEORDER
  1823.   #define BYTEORDER 0x1234
  1824. --- 618,624 ----
  1825.   #define STR_GROW(str,len) if ((str)->str_len < (unsigned long)len) \
  1826.           str_grow(str,(unsigned long)len)
  1827.   #define Str_Grow(str,len) str_grow(str,(unsigned long)(len))
  1828. ! #endif /* DOSISH */
  1829.   
  1830.   #ifndef BYTEORDER
  1831.   #define BYTEORDER 0x1234
  1832. ***************
  1833. *** 670,675 ****
  1834. --- 727,733 ----
  1835.   STR *str_new();
  1836.   STR *stab_str();
  1837.   
  1838. + int apply();
  1839.   int do_each();
  1840.   int do_subr();
  1841.   int do_match();
  1842. ***************
  1843. *** 701,712 ****
  1844. --- 759,782 ----
  1845.   int do_subst();
  1846.   int cando();
  1847.   int ingroup();
  1848. + int whichsig();
  1849. + int userinit();
  1850. + #ifdef CRYPTSCRIPT
  1851. + void cryptswitch();
  1852. + #endif
  1853.   
  1854.   void str_replace();
  1855.   void str_inc();
  1856.   void str_dec();
  1857.   void str_free();
  1858. + void cmd_free();
  1859. + void arg_free();
  1860. + void spat_free();
  1861. + void regfree();
  1862.   void stab_clear();
  1863. + void do_chop();
  1864. + void do_vop();
  1865. + void do_write();
  1866.   void do_join();
  1867.   void do_sprintf();
  1868.   void do_accept();
  1869. ***************
  1870. *** 724,729 ****
  1871. --- 794,817 ----
  1872.   void savehptr();
  1873.   void restorelist();
  1874.   void repeatcpy();
  1875. + void make_form();
  1876. + void dehoist();
  1877. + void format();
  1878. + void my_unexec();
  1879. + void fatal();
  1880. + void warn();
  1881. + #ifdef DEBUGGING
  1882. + void dump_all();
  1883. + void dump_cmd();
  1884. + void dump_arg();
  1885. + void dump_flags();
  1886. + void dump_stab();
  1887. + void dump_spat();
  1888. + #endif
  1889. + #ifdef MSTATS
  1890. + void mstats();
  1891. + #endif
  1892. + 
  1893.   HASH *savehash();
  1894.   ARRAY *saveary();
  1895.   
  1896. ***************
  1897. *** 773,778 ****
  1898. --- 861,867 ----
  1899.   EXT STR *DBsingle INIT(Nullstr);
  1900.   EXT STR *DBtrace INIT(Nullstr);
  1901.   EXT STR *DBsignal INIT(Nullstr);
  1902. + EXT STR *formfeed INIT(Nullstr);
  1903.   
  1904.   EXT int lastspbase;
  1905.   EXT int lastsize;
  1906. ***************
  1907. *** 791,796 ****
  1908. --- 880,886 ----
  1909.   EXT char *rs INIT("\n");
  1910.   EXT int rschar INIT('\n');    /* final char of rs, or 0777 if none */
  1911.   EXT int rslen INIT(1);
  1912. + EXT bool rspara INIT(FALSE);
  1913.   EXT char *ofs INIT(Nullch);
  1914.   EXT int ofslen INIT(0);
  1915.   EXT char *ors INIT(Nullch);
  1916. ***************
  1917. *** 820,834 ****
  1918.   EXT int maxsysfd INIT(MAXSYSFD);    /* top fd to pass to subprocesses */
  1919.   
  1920.   #ifdef CSH
  1921. ! char *cshname INIT(CSH);
  1922. ! int cshlen INIT(0);
  1923.   #endif /* CSH */
  1924.   
  1925.   #ifdef TAINT
  1926.   EXT bool tainted INIT(FALSE);        /* using variables controlled by $< */
  1927.   #endif
  1928.   
  1929. ! #ifndef MSDOS
  1930.   #define TMPPATH "/tmp/perl-eXXXXXX"
  1931.   #else
  1932.   #define TMPPATH "plXXXXXX"
  1933. --- 910,927 ----
  1934.   EXT int maxsysfd INIT(MAXSYSFD);    /* top fd to pass to subprocesses */
  1935.   
  1936.   #ifdef CSH
  1937. ! EXT char *cshname INIT(CSH);
  1938. ! EXT int cshlen INIT(0);
  1939.   #endif /* CSH */
  1940.   
  1941.   #ifdef TAINT
  1942.   EXT bool tainted INIT(FALSE);        /* using variables controlled by $< */
  1943. + EXT bool taintanyway INIT(FALSE);    /* force taint checks when !set?id */
  1944.   #endif
  1945.   
  1946. ! EXT bool nomemok INIT(FALSE);        /* let malloc context handle nomem */
  1947. ! 
  1948. ! #ifndef DOSISH
  1949.   #define TMPPATH "/tmp/perl-eXXXXXX"
  1950.   #else
  1951.   #define TMPPATH "plXXXXXX"
  1952. ***************
  1953. *** 858,865 ****
  1954.   
  1955.   EXT struct stat statbuf;
  1956.   EXT struct stat statcache;
  1957. ! STAB *statstab INIT(Nullstab);
  1958. ! STR *statname;
  1959.   #ifndef MSDOS
  1960.   EXT struct tms timesbuf;
  1961.   #endif
  1962. --- 951,958 ----
  1963.   
  1964.   EXT struct stat statbuf;
  1965.   EXT struct stat statcache;
  1966. ! EXT STAB *statstab INIT(Nullstab);
  1967. ! EXT STR *statname;
  1968.   #ifndef MSDOS
  1969.   EXT struct tms timesbuf;
  1970.   #endif
  1971. ***************
  1972. *** 928,934 ****
  1973.   EXT short *ds;
  1974.   
  1975.   /* Fix these up for __STDC__ */
  1976. ! EXT long basetime INIT(0);
  1977.   char *mktemp();
  1978.   #ifndef STANDARD_C
  1979.   /* All of these are in stdlib.h or time.h for ANSI C */
  1980. --- 1021,1027 ----
  1981.   EXT short *ds;
  1982.   
  1983.   /* Fix these up for __STDC__ */
  1984. ! EXT time_t basetime INIT(0);
  1985.   char *mktemp();
  1986.   #ifndef STANDARD_C
  1987.   /* All of these are in stdlib.h or time.h for ANSI C */
  1988. ***************
  1989. *** 958,960 ****
  1990. --- 1051,1057 ----
  1991.   #define HAS_SETREGID
  1992.   #endif
  1993.   #endif
  1994. + 
  1995. + #define SCAN_DEF 0
  1996. + #define SCAN_TR 1
  1997. + #define SCAN_REPL 2
  1998.  
  1999. Index: os2/perldb.dif
  2000. *** os2/perldb.dif.old    Mon Jun  8 17:50:07 1992
  2001. --- os2/perldb.dif    Mon Jun  8 17:50:07 1992
  2002. ***************
  2003. *** 1,52 ****
  2004. - *** lib/perldb.pl    Tue Oct 23 23:14:20 1990
  2005. - --- os2/perldb.pl    Tue Nov 06 21:13:42 1990
  2006. - ***************
  2007. - *** 36,43 ****
  2008. -   #
  2009. -   #
  2010. - 
  2011. - ! open(IN, "</dev/tty") || open(IN,  "<&STDIN");    # so we don't dingle stdin
  2012. - ! open(OUT,">/dev/tty") || open(OUT, ">&STDOUT");    # so we don't dongle stdout
  2013. -   select(OUT);
  2014. -   $| = 1;                # for DB'OUT
  2015. -   select(STDOUT);
  2016. - --- 36,43 ----
  2017. -   #
  2018. -   #
  2019. - 
  2020. - ! open(IN, "<con") || open(IN,  "<&STDIN");    # so we don't dingle stdin
  2021. - ! open(OUT,">con") || open(OUT, ">&STDOUT");    # so we don't dongle stdout
  2022. -   select(OUT);
  2023. -   $| = 1;                # for DB'OUT
  2024. -   select(STDOUT);
  2025. - ***************
  2026. - *** 517,530 ****
  2027. -       s/(.*)/'$1'/ unless /^-?[\d.]+$/;
  2028. -   }
  2029. - 
  2030. - ! if (-f '.perldb') {
  2031. - !     do './.perldb';
  2032. -   }
  2033. - ! elsif (-f "$ENV{'LOGDIR'}/.perldb") {
  2034. - !     do "$ENV{'LOGDIR'}/.perldb";
  2035. -   }
  2036. - ! elsif (-f "$ENV{'HOME'}/.perldb") {
  2037. - !     do "$ENV{'HOME'}/.perldb";
  2038. -   }
  2039. - 
  2040. -   1;
  2041. - --- 517,530 ----
  2042. -       s/(.*)/'$1'/ unless /^-?[\d.]+$/;
  2043. -   }
  2044. - 
  2045. - ! if (-f 'perldb.ini') {
  2046. - !     do './perldb.ini';
  2047. -   }
  2048. - ! elsif (-f "$ENV{'INIT'}/perldb.ini") {
  2049. - !     do "$ENV{'INIT'}/perldb.ini";
  2050. -   }
  2051. - ! elsif (-f "$ENV{'HOME'}/perldb.ini") {
  2052. - !     do "$ENV{'HOME'}/perldb.ini";
  2053. -   }
  2054. - 
  2055. -   1;
  2056. --- 0 ----
  2057.  
  2058. Index: os2/perlglob.bad
  2059. *** os2/perlglob.bad.old    Mon Jun  8 17:50:09 1992
  2060. --- os2/perlglob.bad    Mon Jun  8 17:50:09 1992
  2061. ***************
  2062. *** 1 ****
  2063. ! DOSQFSATTACH
  2064. --- 1 ----
  2065. ! (deprecated)
  2066.  
  2067. *** End of Patch 28 ***
  2068. exit 0 # Just in case...
  2069.