1 /* Copyright (C) 2002-2016 Free Software Foundation, Inc.
2 Contributed by Andy Vaught
3 F2003 I/O support contributed by Jerry DeLisle
5 This file is part of the GNU Fortran runtime library (libgfortran).
7 Libgfortran is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3, or (at your option)
12 Libgfortran is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 Under Section 7 of GPL version 3, you are granted additional
18 permissions described in the GCC Runtime Library Exception, version
19 3.1, as published by the Free Software Foundation.
21 You should have received a copy of the GNU General Public License and
22 a copy of the GCC Runtime Library Exception along with this program;
23 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24 <http://www.gnu.org/licenses/>. */
35 UNIT_LOCK is a master lock, protecting UNIT_ROOT tree and UNIT_CACHE.
36 Concurrent use of different units should be supported, so
37 each unit has its own lock, LOCK.
38 Open should be atomic with its reopening of units and list_read.c
39 in several places needs find_unit another unit while holding stdin
40 unit's lock, so it must be possible to acquire UNIT_LOCK while holding
41 some unit's lock. Therefore to avoid deadlocks, it is forbidden
42 to acquire unit's private locks while holding UNIT_LOCK, except
43 for freshly created units (where no other thread can get at their
44 address yet) or when using just trylock rather than lock operation.
45 In addition to unit's private lock each unit has a WAITERS counter
46 and CLOSED flag. WAITERS counter must be either only
47 atomically incremented/decremented in all places (if atomic builtins
48 are supported), or protected by UNIT_LOCK in all places (otherwise).
49 CLOSED flag must be always protected by unit's LOCK.
50 After finding a unit in UNIT_CACHE or UNIT_ROOT with UNIT_LOCK held,
51 WAITERS must be incremented to avoid concurrent close from freeing
52 the unit between unlocking UNIT_LOCK and acquiring unit's LOCK.
53 Unit freeing is always done under UNIT_LOCK. If close_unit sees any
54 WAITERS, it doesn't free the unit but instead sets the CLOSED flag
55 and the thread that decrements WAITERS to zero while CLOSED flag is
56 set is responsible for freeing it (while holding UNIT_LOCK).
57 flush_all_units operation is iterating over the unit tree with
58 increasing UNIT_NUMBER while holding UNIT_LOCK and attempting to
59 flush each unit (and therefore needs the unit's LOCK held as well).
60 To avoid deadlocks, it just trylocks the LOCK and if unsuccessful,
61 remembers the current unit's UNIT_NUMBER, unlocks UNIT_LOCK, acquires
62 unit's LOCK and after flushing reacquires UNIT_LOCK and restarts with
63 the smallest UNIT_NUMBER above the last one flushed.
65 If find_unit/find_or_create_unit/find_file/get_unit routines return
66 non-NULL, the returned unit has its private lock locked and when the
67 caller is done with it, it must call either unlock_unit or close_unit
68 on it. unlock_unit or close_unit must be always called only with the
71 /* Subroutines related to units */
73 /* Unit number to be assigned when NEWUNIT is used in an OPEN statement. */
74 #define GFC_FIRST_NEWUNIT -10
75 #define NEWUNIT_STACK_SIZE 16
76 static GFC_INTEGER_4 next_available_newunit
= GFC_FIRST_NEWUNIT
;
78 /* A stack to save previously used newunit-assigned unit numbers to
79 allow them to be reused without reallocating the gfc_unit structure
80 which is still in the treap. */
81 static gfc_saved_unit newunit_stack
[NEWUNIT_STACK_SIZE
];
82 static int newunit_tos
= 0; /* Index to Top of Stack. */
85 static gfc_unit
*unit_cache
[CACHE_SIZE
];
86 gfc_offset max_offset
;
88 #ifdef __GTHREAD_MUTEX_INIT
89 __gthread_mutex_t unit_lock
= __GTHREAD_MUTEX_INIT
;
91 __gthread_mutex_t unit_lock
;
94 /* We use these filenames for error reporting. */
96 static char stdin_name
[] = "stdin";
97 static char stdout_name
[] = "stdout";
98 static char stderr_name
[] = "stderr";
101 #ifdef HAVE_NEWLOCALE
104 /* If we don't have POSIX 2008 per-thread locales, we need to use the
105 traditional setlocale(). To prevent multiple concurrent threads
106 doing formatted I/O from messing up the locale, we need to store a
107 global old_locale, and a counter keeping track of how many threads
108 are currently doing formatted I/O. The first thread saves the old
109 locale, and the last one restores it. */
112 #ifdef __GTHREAD_MUTEX_INIT
113 __gthread_mutex_t old_locale_lock
= __GTHREAD_MUTEX_INIT
;
115 __gthread_mutex_t old_locale_lock
;
120 /* This implementation is based on Stefan Nilsson's article in the
121 * July 1997 Doctor Dobb's Journal, "Treaps in Java". */
123 /* pseudo_random()-- Simple linear congruential pseudorandom number
124 * generator. The period of this generator is 44071, which is plenty
125 * for our purposes. */
130 static int x0
= 5341;
132 x0
= (22611 * x0
+ 10) % 44071;
137 /* rotate_left()-- Rotate the treap left */
140 rotate_left (gfc_unit
* t
)
145 t
->right
= t
->right
->left
;
152 /* rotate_right()-- Rotate the treap right */
155 rotate_right (gfc_unit
* t
)
160 t
->left
= t
->left
->right
;
168 compare (int a
, int b
)
179 /* insert()-- Recursive insertion function. Returns the updated treap. */
182 insert (gfc_unit
*new, gfc_unit
*t
)
189 c
= compare (new->unit_number
, t
->unit_number
);
193 t
->left
= insert (new, t
->left
);
194 if (t
->priority
< t
->left
->priority
)
195 t
= rotate_right (t
);
200 t
->right
= insert (new, t
->right
);
201 if (t
->priority
< t
->right
->priority
)
206 internal_error (NULL
, "insert(): Duplicate key found!");
212 /* insert_unit()-- Create a new node, insert it into the treap. */
217 gfc_unit
*u
= xcalloc (1, sizeof (gfc_unit
));
219 #ifdef __GTHREAD_MUTEX_INIT
221 __gthread_mutex_t tmp
= __GTHREAD_MUTEX_INIT
;
225 __GTHREAD_MUTEX_INIT_FUNCTION (&u
->lock
);
227 __gthread_mutex_lock (&u
->lock
);
228 u
->priority
= pseudo_random ();
229 unit_root
= insert (u
, unit_root
);
234 /* destroy_unit_mutex()-- Destroy the mutex and free memory of unit. */
237 destroy_unit_mutex (gfc_unit
* u
)
239 __gthread_mutex_destroy (&u
->lock
);
245 delete_root (gfc_unit
* t
)
251 if (t
->right
== NULL
)
254 if (t
->left
->priority
> t
->right
->priority
)
256 temp
= rotate_right (t
);
257 temp
->right
= delete_root (t
);
261 temp
= rotate_left (t
);
262 temp
->left
= delete_root (t
);
269 /* delete_treap()-- Delete an element from a tree. The 'old' value
270 * does not necessarily have to point to the element to be deleted, it
271 * must just point to a treap structure with the key to be deleted.
272 * Returns the new root node of the tree. */
275 delete_treap (gfc_unit
* old
, gfc_unit
* t
)
282 c
= compare (old
->unit_number
, t
->unit_number
);
285 t
->left
= delete_treap (old
, t
->left
);
287 t
->right
= delete_treap (old
, t
->right
);
295 /* delete_unit()-- Delete a unit from a tree */
298 delete_unit (gfc_unit
* old
)
300 unit_root
= delete_treap (old
, unit_root
);
304 /* get_gfc_unit()-- Given an integer, return a pointer to the unit
305 * structure. Returns NULL if the unit does not exist,
306 * otherwise returns a locked unit. */
309 get_gfc_unit (int n
, int do_create
)
314 __gthread_mutex_lock (&unit_lock
);
316 for (c
= 0; c
< CACHE_SIZE
; c
++)
317 if (unit_cache
[c
] != NULL
&& unit_cache
[c
]->unit_number
== n
)
326 c
= compare (n
, p
->unit_number
);
335 if (p
== NULL
&& do_create
)
343 for (c
= 0; c
< CACHE_SIZE
- 1; c
++)
344 unit_cache
[c
] = unit_cache
[c
+ 1];
346 unit_cache
[CACHE_SIZE
- 1] = p
;
351 /* Newly created units have their lock held already
352 from insert_unit. Just unlock UNIT_LOCK and return. */
353 __gthread_mutex_unlock (&unit_lock
);
358 if (p
!= NULL
&& (p
->child_dtio
== 0))
361 if (! __gthread_mutex_trylock (&p
->lock
))
363 /* assert (p->closed == 0); */
364 __gthread_mutex_unlock (&unit_lock
);
368 inc_waiting_locked (p
);
372 __gthread_mutex_unlock (&unit_lock
);
374 if (p
!= NULL
&& (p
->child_dtio
== 0))
376 __gthread_mutex_lock (&p
->lock
);
379 __gthread_mutex_lock (&unit_lock
);
380 __gthread_mutex_unlock (&p
->lock
);
381 if (predec_waiting_locked (p
) == 0)
382 destroy_unit_mutex (p
);
386 dec_waiting_unlocked (p
);
395 return get_gfc_unit (n
, 0);
400 find_or_create_unit (int n
)
402 return get_gfc_unit (n
, 1);
406 /* Helper function to check rank, stride, format string, and namelist.
407 This is used for optimization. You can't trim out blanks or shorten
408 the string if trailing spaces are significant. */
410 is_trim_ok (st_parameter_dt
*dtp
)
412 /* Check rank and stride. */
413 if (dtp
->internal_unit_desc
)
415 /* Format strings can not have 'BZ' or '/'. */
416 if (dtp
->common
.flags
& IOPARM_DT_HAS_FORMAT
)
418 char *p
= dtp
->format
;
420 if (dtp
->common
.flags
& IOPARM_DT_HAS_BLANK
)
422 for (i
= 0; i
< dtp
->format_len
; i
++)
424 if (p
[i
] == '/') return false;
425 if (p
[i
] == 'b' || p
[i
] == 'B')
426 if (p
[i
+1] == 'z' || p
[i
+1] == 'Z')
430 if (dtp
->u
.p
.ionml
) /* A namelist. */
437 set_internal_unit (st_parameter_dt
*dtp
, gfc_unit
*iunit
, int kind
)
439 gfc_offset start_record
= 0;
441 iunit
->recl
= dtp
->internal_unit_len
;
442 iunit
->internal_unit
= dtp
->internal_unit
;
443 iunit
->internal_unit_len
= dtp
->internal_unit_len
;
444 iunit
->internal_unit_kind
= kind
;
446 /* As an optimization, adjust the unit record length to not
447 include trailing blanks. This will not work under certain conditions
448 where trailing blanks have significance. */
449 if (dtp
->u
.p
.mode
== READING
&& is_trim_ok (dtp
))
453 len
= string_len_trim (iunit
->internal_unit_len
,
454 iunit
->internal_unit
);
456 len
= string_len_trim_char4 (iunit
->internal_unit_len
,
457 (const gfc_char4_t
*) iunit
->internal_unit
);
458 iunit
->internal_unit_len
= len
;
459 iunit
->recl
= iunit
->internal_unit_len
;
462 /* Set up the looping specification from the array descriptor, if any. */
464 if (is_array_io (dtp
))
466 iunit
->rank
= GFC_DESCRIPTOR_RANK (dtp
->internal_unit_desc
);
467 iunit
->ls
= (array_loop_spec
*)
468 xmallocarray (iunit
->rank
, sizeof (array_loop_spec
));
469 iunit
->internal_unit_len
*=
470 init_loop_spec (dtp
->internal_unit_desc
, iunit
->ls
, &start_record
);
472 start_record
*= iunit
->recl
;
475 /* Set initial values for unit parameters. */
477 iunit
->s
= open_internal4 (iunit
->internal_unit
- start_record
,
478 iunit
->internal_unit_len
, -start_record
);
480 iunit
->s
= open_internal (iunit
->internal_unit
- start_record
,
481 iunit
->internal_unit_len
, -start_record
);
483 iunit
->bytes_left
= iunit
->recl
;
484 iunit
->last_record
=0;
486 iunit
->current_record
=0;
488 iunit
->endfile
= NO_ENDFILE
;
490 /* Set flags for the internal unit. */
492 iunit
->flags
.access
= ACCESS_SEQUENTIAL
;
493 iunit
->flags
.action
= ACTION_READWRITE
;
494 iunit
->flags
.blank
= BLANK_NULL
;
495 iunit
->flags
.form
= FORM_FORMATTED
;
496 iunit
->flags
.pad
= PAD_YES
;
497 iunit
->flags
.status
= STATUS_UNSPECIFIED
;
498 iunit
->flags
.sign
= SIGN_UNSPECIFIED
;
499 iunit
->flags
.decimal
= DECIMAL_POINT
;
500 iunit
->flags
.delim
= DELIM_UNSPECIFIED
;
501 iunit
->flags
.encoding
= ENCODING_DEFAULT
;
502 iunit
->flags
.async
= ASYNC_NO
;
503 iunit
->flags
.round
= ROUND_UNSPECIFIED
;
505 /* Initialize the data transfer parameters. */
507 dtp
->u
.p
.advance_status
= ADVANCE_YES
;
508 dtp
->u
.p
.seen_dollar
= 0;
510 dtp
->u
.p
.pending_spaces
= 0;
511 dtp
->u
.p
.max_pos
= 0;
517 /* stash_internal_unit()-- Push the internal unit number onto the
520 stash_internal_unit (st_parameter_dt
*dtp
)
522 __gthread_mutex_lock (&unit_lock
);
524 if (newunit_tos
>= NEWUNIT_STACK_SIZE
)
525 internal_error (&dtp
->common
, "stash_internal_unit(): Stack Size Exceeded");
526 newunit_stack
[newunit_tos
].unit_number
= dtp
->common
.unit
;
527 newunit_stack
[newunit_tos
].unit
= dtp
->u
.p
.current_unit
;
528 __gthread_mutex_unlock (&unit_lock
);
533 /* get_unit()-- Returns the unit structure associated with the integer
534 unit or the internal file. */
537 get_unit (st_parameter_dt
*dtp
, int do_create
)
541 if ((dtp
->common
.flags
& IOPARM_DT_HAS_INTERNAL_UNIT
) != 0)
544 if (dtp
->common
.unit
== GFC_INTERNAL_UNIT
)
546 else if (dtp
->common
.unit
== GFC_INTERNAL_UNIT4
)
549 internal_error (&dtp
->common
, "get_unit(): Bad internal unit KIND");
551 if ((dtp
->common
.flags
& IOPARM_DT_HAS_UDTIO
) != 0)
553 dtp
->u
.p
.unit_is_internal
= 1;
554 dtp
->common
.unit
= get_unique_unit_number (&dtp
->common
);
555 unit
= get_gfc_unit (dtp
->common
.unit
, do_create
);
556 set_internal_unit (dtp
, unit
, kind
);
557 fbuf_init (unit
, 128);
564 dtp
->common
.unit
= newunit_stack
[newunit_tos
].unit_number
;
565 unit
= newunit_stack
[newunit_tos
--].unit
;
566 unit
->fbuf
->act
= unit
->fbuf
->pos
= 0;
570 dtp
->common
.unit
= get_unique_unit_number (&dtp
->common
);
571 unit
= xcalloc (1, sizeof (gfc_unit
));
572 fbuf_init (unit
, 128);
574 set_internal_unit (dtp
, unit
, kind
);
578 /* Has to be an external unit. */
579 dtp
->u
.p
.unit_is_internal
= 0;
580 dtp
->internal_unit
= NULL
;
581 dtp
->internal_unit_desc
= NULL
;
582 unit
= get_gfc_unit (dtp
->common
.unit
, do_create
);
587 /*************************/
588 /* Initialize everything. */
596 #ifdef HAVE_NEWLOCALE
597 c_locale
= newlocale (0, "C", 0);
599 #ifndef __GTHREAD_MUTEX_INIT
600 __GTHREAD_MUTEX_INIT_FUNCTION (&old_locale_lock
);
604 #ifndef __GTHREAD_MUTEX_INIT
605 __GTHREAD_MUTEX_INIT_FUNCTION (&unit_lock
);
608 if (options
.stdin_unit
>= 0)
610 u
= insert_unit (options
.stdin_unit
);
611 u
->s
= input_stream ();
613 u
->flags
.action
= ACTION_READ
;
615 u
->flags
.access
= ACCESS_SEQUENTIAL
;
616 u
->flags
.form
= FORM_FORMATTED
;
617 u
->flags
.status
= STATUS_OLD
;
618 u
->flags
.blank
= BLANK_NULL
;
619 u
->flags
.pad
= PAD_YES
;
620 u
->flags
.position
= POSITION_ASIS
;
621 u
->flags
.sign
= SIGN_UNSPECIFIED
;
622 u
->flags
.decimal
= DECIMAL_POINT
;
623 u
->flags
.delim
= DELIM_UNSPECIFIED
;
624 u
->flags
.encoding
= ENCODING_DEFAULT
;
625 u
->flags
.async
= ASYNC_NO
;
626 u
->flags
.round
= ROUND_UNSPECIFIED
;
628 u
->recl
= options
.default_recl
;
629 u
->endfile
= NO_ENDFILE
;
631 u
->filename
= strdup (stdin_name
);
635 __gthread_mutex_unlock (&u
->lock
);
638 if (options
.stdout_unit
>= 0)
640 u
= insert_unit (options
.stdout_unit
);
641 u
->s
= output_stream ();
643 u
->flags
.action
= ACTION_WRITE
;
645 u
->flags
.access
= ACCESS_SEQUENTIAL
;
646 u
->flags
.form
= FORM_FORMATTED
;
647 u
->flags
.status
= STATUS_OLD
;
648 u
->flags
.blank
= BLANK_NULL
;
649 u
->flags
.position
= POSITION_ASIS
;
650 u
->flags
.sign
= SIGN_UNSPECIFIED
;
651 u
->flags
.decimal
= DECIMAL_POINT
;
652 u
->flags
.delim
= DELIM_UNSPECIFIED
;
653 u
->flags
.encoding
= ENCODING_DEFAULT
;
654 u
->flags
.async
= ASYNC_NO
;
655 u
->flags
.round
= ROUND_UNSPECIFIED
;
657 u
->recl
= options
.default_recl
;
658 u
->endfile
= AT_ENDFILE
;
660 u
->filename
= strdup (stdout_name
);
664 __gthread_mutex_unlock (&u
->lock
);
667 if (options
.stderr_unit
>= 0)
669 u
= insert_unit (options
.stderr_unit
);
670 u
->s
= error_stream ();
672 u
->flags
.action
= ACTION_WRITE
;
674 u
->flags
.access
= ACCESS_SEQUENTIAL
;
675 u
->flags
.form
= FORM_FORMATTED
;
676 u
->flags
.status
= STATUS_OLD
;
677 u
->flags
.blank
= BLANK_NULL
;
678 u
->flags
.position
= POSITION_ASIS
;
679 u
->flags
.sign
= SIGN_UNSPECIFIED
;
680 u
->flags
.decimal
= DECIMAL_POINT
;
681 u
->flags
.encoding
= ENCODING_DEFAULT
;
682 u
->flags
.async
= ASYNC_NO
;
683 u
->flags
.round
= ROUND_UNSPECIFIED
;
685 u
->recl
= options
.default_recl
;
686 u
->endfile
= AT_ENDFILE
;
688 u
->filename
= strdup (stderr_name
);
690 fbuf_init (u
, 256); /* 256 bytes should be enough, probably not doing
691 any kind of exotic formatting to stderr. */
693 __gthread_mutex_unlock (&u
->lock
);
696 /* Calculate the maximum file offset in a portable manner.
697 max will be the largest signed number for the type gfc_offset.
698 set a 1 in the LSB and keep a running sum, stopping at MSB-1 bit. */
700 for (i
= 0; i
< sizeof (max_offset
) * 8 - 1; i
++)
701 max_offset
= max_offset
+ ((gfc_offset
) 1 << i
);
703 /* Initialize the newunit stack. */
704 memset (newunit_stack
, 0, NEWUNIT_STACK_SIZE
* sizeof(gfc_saved_unit
));
710 close_unit_1 (gfc_unit
*u
, int locked
)
714 /* If there are previously written bytes from a write with ADVANCE="no"
715 Reposition the buffer before closing. */
716 if (u
->previous_nonadvancing_write
)
717 finish_last_advance_record (u
);
719 rc
= (u
->s
== NULL
) ? 0 : sclose (u
->s
) == -1;
723 __gthread_mutex_lock (&unit_lock
);
725 for (i
= 0; i
< CACHE_SIZE
; i
++)
726 if (unit_cache
[i
] == u
)
727 unit_cache
[i
] = NULL
;
734 free_format_hash_table (u
);
738 __gthread_mutex_unlock (&u
->lock
);
740 /* If there are any threads waiting in find_unit for this unit,
741 avoid freeing the memory, the last such thread will free it
744 destroy_unit_mutex (u
);
747 __gthread_mutex_unlock (&unit_lock
);
753 unlock_unit (gfc_unit
*u
)
755 __gthread_mutex_unlock (&u
->lock
);
758 /* close_unit()-- Close a unit. The stream is closed, and any memory
759 associated with the stream is freed. Returns nonzero on I/O error.
760 Should be called with the u->lock locked. */
763 close_unit (gfc_unit
*u
)
765 return close_unit_1 (u
, 0);
769 /* close_units()-- Delete units on completion. We just keep deleting
770 the root of the treap until there is nothing left.
771 Not sure what to do with locking here. Some other thread might be
772 holding some unit's lock and perhaps hold it indefinitely
773 (e.g. waiting for input from some pipe) and close_units shouldn't
774 delay the program too much. */
779 __gthread_mutex_lock (&unit_lock
);
780 while (unit_root
!= NULL
)
781 close_unit_1 (unit_root
, 1);
782 __gthread_mutex_unlock (&unit_lock
);
784 while (newunit_tos
!= 0)
785 if (newunit_stack
[newunit_tos
].unit
)
787 fbuf_destroy (newunit_stack
[newunit_tos
].unit
);
788 free (newunit_stack
[newunit_tos
].unit
->s
);
789 free (newunit_stack
[newunit_tos
--].unit
);
791 #ifdef HAVE_FREELOCALE
792 freelocale (c_locale
);
797 /* High level interface to truncate a file, i.e. flush format buffers,
798 and generate an error or set some flags. Just like POSIX
799 ftruncate, returns 0 on success, -1 on failure. */
802 unit_truncate (gfc_unit
* u
, gfc_offset pos
, st_parameter_common
* common
)
806 /* Make sure format buffer is flushed. */
807 if (u
->flags
.form
== FORM_FORMATTED
)
809 if (u
->mode
== READING
)
810 pos
+= fbuf_reset (u
);
812 fbuf_flush (u
, u
->mode
);
815 /* struncate() should flush the stream buffer if necessary, so don't
816 bother calling sflush() here. */
817 ret
= struncate (u
->s
, pos
);
820 generate_error (common
, LIBERROR_OS
, NULL
);
823 u
->endfile
= AT_ENDFILE
;
824 u
->flags
.position
= POSITION_APPEND
;
831 /* filename_from_unit()-- If the unit_number exists, return a pointer to the
832 name of the associated file, otherwise return the empty string. The caller
833 must free memory allocated for the filename string. */
836 filename_from_unit (int n
)
845 c
= compare (n
, u
->unit_number
);
854 /* Get the filename. */
855 if (u
!= NULL
&& u
->filename
!= NULL
)
856 return strdup (u
->filename
);
858 return (char *) NULL
;
862 finish_last_advance_record (gfc_unit
*u
)
865 if (u
->saved_pos
> 0)
866 fbuf_seek (u
, u
->saved_pos
, SEEK_CUR
);
868 if (!(u
->unit_number
== options
.stdout_unit
869 || u
->unit_number
== options
.stderr_unit
))
876 char *p
= fbuf_alloc (u
, len
);
878 os_error ("Completing record after ADVANCE_NO failed");
885 fbuf_flush (u
, u
->mode
);
888 /* Assign a negative number for NEWUNIT in OPEN statements or for
891 get_unique_unit_number (st_parameter_common
*common
)
895 #ifdef HAVE_SYNC_FETCH_AND_ADD
896 num
= __sync_fetch_and_add (&next_available_newunit
, -1);
898 __gthread_mutex_lock (&unit_lock
);
899 num
= next_available_newunit
--;
900 __gthread_mutex_unlock (&unit_lock
);
902 /* Do not allow NEWUNIT numbers to wrap. */
903 if (num
> GFC_FIRST_NEWUNIT
)
905 generate_error (common
, LIBERROR_INTERNAL
, "NEWUNIT exhausted");