1 /* Copyright (C) 2002-2018 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
73 /* Table of allocated newunit values. A simple solution would be to
74 map OS file descriptors (fd's) to unit numbers, e.g. with newunit =
75 -fd - 2, however that doesn't work since Fortran allows an existing
76 unit number to be reassociated with a new file. Thus the simple
77 approach may lead to a situation where we'd try to assign a
78 (negative) unit number which already exists. Hence we must keep
79 track of allocated newunit values ourselves. This is the purpose of
80 the newunits array. The indices map to newunit values as newunit =
81 -index + NEWUNIT_FIRST. E.g. newunits[0] having the value true
82 means that a unit with number NEWUNIT_FIRST exists. Similar to
83 POSIX file descriptors, we always allocate the lowest (in absolute
84 value) available unit number.
86 static bool *newunits
;
87 static int newunit_size
; /* Total number of elements in the newunits array. */
88 /* Low water indicator for the newunits array. Below the LWI all the
89 units are allocated, above and equal to the LWI there may be both
90 allocated and free units. */
91 static int newunit_lwi
;
93 /* Unit numbers assigned with NEWUNIT start from here. */
94 #define NEWUNIT_START -10
97 static gfc_unit
*unit_cache
[CACHE_SIZE
];
99 gfc_offset max_offset
;
100 gfc_offset default_recl
;
103 #ifdef __GTHREAD_MUTEX_INIT
104 __gthread_mutex_t unit_lock
= __GTHREAD_MUTEX_INIT
;
106 __gthread_mutex_t unit_lock
;
109 /* We use these filenames for error reporting. */
111 static char stdin_name
[] = "stdin";
112 static char stdout_name
[] = "stdout";
113 static char stderr_name
[] = "stderr";
116 #ifdef HAVE_NEWLOCALE
119 /* If we don't have POSIX 2008 per-thread locales, we need to use the
120 traditional setlocale(). To prevent multiple concurrent threads
121 doing formatted I/O from messing up the locale, we need to store a
122 global old_locale, and a counter keeping track of how many threads
123 are currently doing formatted I/O. The first thread saves the old
124 locale, and the last one restores it. */
127 #ifdef __GTHREAD_MUTEX_INIT
128 __gthread_mutex_t old_locale_lock
= __GTHREAD_MUTEX_INIT
;
130 __gthread_mutex_t old_locale_lock
;
135 /* This implementation is based on Stefan Nilsson's article in the
136 July 1997 Doctor Dobb's Journal, "Treaps in Java". */
138 /* pseudo_random()-- Simple linear congruential pseudorandom number
139 generator. The period of this generator is 44071, which is plenty
145 static int x0
= 5341;
147 x0
= (22611 * x0
+ 10) % 44071;
152 /* rotate_left()-- Rotate the treap left */
155 rotate_left (gfc_unit
*t
)
160 t
->right
= t
->right
->left
;
167 /* rotate_right()-- Rotate the treap right */
170 rotate_right (gfc_unit
*t
)
175 t
->left
= t
->left
->right
;
183 compare (int a
, int b
)
194 /* insert()-- Recursive insertion function. Returns the updated treap. */
197 insert (gfc_unit
*new, gfc_unit
*t
)
204 c
= compare (new->unit_number
, t
->unit_number
);
208 t
->left
= insert (new, t
->left
);
209 if (t
->priority
< t
->left
->priority
)
210 t
= rotate_right (t
);
215 t
->right
= insert (new, t
->right
);
216 if (t
->priority
< t
->right
->priority
)
221 internal_error (NULL
, "insert(): Duplicate key found!");
227 /* insert_unit()-- Create a new node, insert it into the treap. */
232 gfc_unit
*u
= xcalloc (1, sizeof (gfc_unit
));
234 u
->internal_unit_kind
= 0;
235 #ifdef __GTHREAD_MUTEX_INIT
237 __gthread_mutex_t tmp
= __GTHREAD_MUTEX_INIT
;
241 __GTHREAD_MUTEX_INIT_FUNCTION (&u
->lock
);
243 __gthread_mutex_lock (&u
->lock
);
244 u
->priority
= pseudo_random ();
245 unit_root
= insert (u
, unit_root
);
250 /* destroy_unit_mutex()-- Destroy the mutex and free memory of unit. */
253 destroy_unit_mutex (gfc_unit
*u
)
255 __gthread_mutex_destroy (&u
->lock
);
261 delete_root (gfc_unit
*t
)
267 if (t
->right
== NULL
)
270 if (t
->left
->priority
> t
->right
->priority
)
272 temp
= rotate_right (t
);
273 temp
->right
= delete_root (t
);
277 temp
= rotate_left (t
);
278 temp
->left
= delete_root (t
);
285 /* delete_treap()-- Delete an element from a tree. The 'old' value
286 does not necessarily have to point to the element to be deleted, it
287 must just point to a treap structure with the key to be deleted.
288 Returns the new root node of the tree. */
291 delete_treap (gfc_unit
*old
, gfc_unit
*t
)
298 c
= compare (old
->unit_number
, t
->unit_number
);
301 t
->left
= delete_treap (old
, t
->left
);
303 t
->right
= delete_treap (old
, t
->right
);
311 /* delete_unit()-- Delete a unit from a tree */
314 delete_unit (gfc_unit
*old
)
316 unit_root
= delete_treap (old
, unit_root
);
320 /* get_gfc_unit()-- Given an integer, return a pointer to the unit
321 structure. Returns NULL if the unit does not exist,
322 otherwise returns a locked unit. */
325 get_gfc_unit (int n
, int do_create
)
330 __gthread_mutex_lock (&unit_lock
);
332 for (c
= 0; c
< CACHE_SIZE
; c
++)
333 if (unit_cache
[c
] != NULL
&& unit_cache
[c
]->unit_number
== n
)
342 c
= compare (n
, p
->unit_number
);
351 if (p
== NULL
&& do_create
)
359 for (c
= 0; c
< CACHE_SIZE
- 1; c
++)
360 unit_cache
[c
] = unit_cache
[c
+ 1];
362 unit_cache
[CACHE_SIZE
- 1] = p
;
367 /* Newly created units have their lock held already
368 from insert_unit. Just unlock UNIT_LOCK and return. */
369 __gthread_mutex_unlock (&unit_lock
);
374 if (p
!= NULL
&& (p
->child_dtio
== 0))
377 if (! __gthread_mutex_trylock (&p
->lock
))
379 /* assert (p->closed == 0); */
380 __gthread_mutex_unlock (&unit_lock
);
384 inc_waiting_locked (p
);
388 __gthread_mutex_unlock (&unit_lock
);
390 if (p
!= NULL
&& (p
->child_dtio
== 0))
392 __gthread_mutex_lock (&p
->lock
);
395 __gthread_mutex_lock (&unit_lock
);
396 __gthread_mutex_unlock (&p
->lock
);
397 if (predec_waiting_locked (p
) == 0)
398 destroy_unit_mutex (p
);
402 dec_waiting_unlocked (p
);
411 return get_gfc_unit (n
, 0);
416 find_or_create_unit (int n
)
418 return get_gfc_unit (n
, 1);
422 /* Helper function to check rank, stride, format string, and namelist.
423 This is used for optimization. You can't trim out blanks or shorten
424 the string if trailing spaces are significant. */
426 is_trim_ok (st_parameter_dt
*dtp
)
428 /* Check rank and stride. */
429 if (dtp
->internal_unit_desc
)
431 /* Format strings can not have 'BZ' or '/'. */
432 if (dtp
->common
.flags
& IOPARM_DT_HAS_FORMAT
)
434 char *p
= dtp
->format
;
435 if (dtp
->common
.flags
& IOPARM_DT_HAS_BLANK
)
437 for (gfc_charlen_type i
= 0; i
< dtp
->format_len
; i
++)
439 if (p
[i
] == '/') return false;
440 if (p
[i
] == 'b' || p
[i
] == 'B')
441 if (p
[i
+1] == 'z' || p
[i
+1] == 'Z')
445 if (dtp
->u
.p
.ionml
) /* A namelist. */
452 set_internal_unit (st_parameter_dt
*dtp
, gfc_unit
*iunit
, int kind
)
454 gfc_offset start_record
= 0;
456 iunit
->unit_number
= dtp
->common
.unit
;
457 iunit
->recl
= dtp
->internal_unit_len
;
458 iunit
->internal_unit
= dtp
->internal_unit
;
459 iunit
->internal_unit_len
= dtp
->internal_unit_len
;
460 iunit
->internal_unit_kind
= kind
;
462 /* As an optimization, adjust the unit record length to not
463 include trailing blanks. This will not work under certain conditions
464 where trailing blanks have significance. */
465 if (dtp
->u
.p
.mode
== READING
&& is_trim_ok (dtp
))
469 len
= string_len_trim (iunit
->internal_unit_len
,
470 iunit
->internal_unit
);
472 len
= string_len_trim_char4 (iunit
->internal_unit_len
,
473 (const gfc_char4_t
*) iunit
->internal_unit
);
474 iunit
->internal_unit_len
= len
;
475 iunit
->recl
= iunit
->internal_unit_len
;
478 /* Set up the looping specification from the array descriptor, if any. */
480 if (is_array_io (dtp
))
482 iunit
->rank
= GFC_DESCRIPTOR_RANK (dtp
->internal_unit_desc
);
483 iunit
->ls
= (array_loop_spec
*)
484 xmallocarray (iunit
->rank
, sizeof (array_loop_spec
));
485 iunit
->internal_unit_len
*=
486 init_loop_spec (dtp
->internal_unit_desc
, iunit
->ls
, &start_record
);
488 start_record
*= iunit
->recl
;
491 /* Set initial values for unit parameters. */
493 iunit
->s
= open_internal4 (iunit
->internal_unit
- start_record
,
494 iunit
->internal_unit_len
, -start_record
);
496 iunit
->s
= open_internal (iunit
->internal_unit
- start_record
,
497 iunit
->internal_unit_len
, -start_record
);
499 iunit
->bytes_left
= iunit
->recl
;
500 iunit
->last_record
=0;
502 iunit
->current_record
=0;
504 iunit
->endfile
= NO_ENDFILE
;
506 /* Set flags for the internal unit. */
508 iunit
->flags
.access
= ACCESS_SEQUENTIAL
;
509 iunit
->flags
.action
= ACTION_READWRITE
;
510 iunit
->flags
.blank
= BLANK_NULL
;
511 iunit
->flags
.form
= FORM_FORMATTED
;
512 iunit
->flags
.pad
= PAD_YES
;
513 iunit
->flags
.status
= STATUS_UNSPECIFIED
;
514 iunit
->flags
.sign
= SIGN_UNSPECIFIED
;
515 iunit
->flags
.decimal
= DECIMAL_POINT
;
516 iunit
->flags
.delim
= DELIM_UNSPECIFIED
;
517 iunit
->flags
.encoding
= ENCODING_DEFAULT
;
518 iunit
->flags
.async
= ASYNC_NO
;
519 iunit
->flags
.round
= ROUND_UNSPECIFIED
;
521 /* Initialize the data transfer parameters. */
523 dtp
->u
.p
.advance_status
= ADVANCE_YES
;
524 dtp
->u
.p
.seen_dollar
= 0;
526 dtp
->u
.p
.pending_spaces
= 0;
527 dtp
->u
.p
.max_pos
= 0;
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 dtp
->u
.p
.unit_is_internal
= 1;
552 dtp
->common
.unit
= newunit_alloc ();
553 unit
= get_gfc_unit (dtp
->common
.unit
, do_create
);
554 set_internal_unit (dtp
, unit
, kind
);
555 fbuf_init (unit
, 128);
559 /* Has to be an external unit. */
560 dtp
->u
.p
.unit_is_internal
= 0;
561 dtp
->internal_unit
= NULL
;
562 dtp
->internal_unit_desc
= NULL
;
564 /* For an external unit with unit number < 0 creating it on the fly
565 is not allowed, such units must be created with
566 OPEN(NEWUNIT=...). */
567 if (dtp
->common
.unit
< 0)
569 if (dtp
->common
.unit
> NEWUNIT_START
) /* Reserved units. */
571 return get_gfc_unit (dtp
->common
.unit
, 0);
574 return get_gfc_unit (dtp
->common
.unit
, do_create
);
578 /*************************/
579 /* Initialize everything. */
586 #ifdef HAVE_NEWLOCALE
587 c_locale
= newlocale (0, "C", 0);
589 #ifndef __GTHREAD_MUTEX_INIT
590 __GTHREAD_MUTEX_INIT_FUNCTION (&old_locale_lock
);
594 #ifndef __GTHREAD_MUTEX_INIT
595 __GTHREAD_MUTEX_INIT_FUNCTION (&unit_lock
);
598 if (sizeof (max_offset
) == 8)
600 max_offset
= GFC_INTEGER_8_HUGE
;
601 /* Why this weird value? Because if the recl specifier in the
602 inquire statement is a 4 byte value, u->recl is truncated,
603 and this trick ensures it becomes HUGE(0) rather than -1.
604 The full 8 byte value of default_recl is still 0.99999999 *
605 max_offset which is large enough for all practical
607 default_recl
= max_offset
& ~(1LL<<31);
609 else if (sizeof (max_offset
) == 4)
610 max_offset
= default_recl
= GFC_INTEGER_4_HUGE
;
612 internal_error (NULL
, "sizeof (max_offset) must be 4 or 8");
614 if (options
.stdin_unit
>= 0)
616 u
= insert_unit (options
.stdin_unit
);
617 u
->s
= input_stream ();
619 u
->flags
.action
= ACTION_READ
;
621 u
->flags
.access
= ACCESS_SEQUENTIAL
;
622 u
->flags
.form
= FORM_FORMATTED
;
623 u
->flags
.status
= STATUS_OLD
;
624 u
->flags
.blank
= BLANK_NULL
;
625 u
->flags
.pad
= PAD_YES
;
626 u
->flags
.position
= POSITION_ASIS
;
627 u
->flags
.sign
= SIGN_UNSPECIFIED
;
628 u
->flags
.decimal
= DECIMAL_POINT
;
629 u
->flags
.delim
= DELIM_UNSPECIFIED
;
630 u
->flags
.encoding
= ENCODING_DEFAULT
;
631 u
->flags
.async
= ASYNC_NO
;
632 u
->flags
.round
= ROUND_UNSPECIFIED
;
633 u
->flags
.share
= SHARE_UNSPECIFIED
;
634 u
->flags
.cc
= CC_LIST
;
636 u
->recl
= default_recl
;
637 u
->endfile
= NO_ENDFILE
;
639 u
->filename
= strdup (stdin_name
);
643 __gthread_mutex_unlock (&u
->lock
);
646 if (options
.stdout_unit
>= 0)
648 u
= insert_unit (options
.stdout_unit
);
649 u
->s
= output_stream ();
651 u
->flags
.action
= ACTION_WRITE
;
653 u
->flags
.access
= ACCESS_SEQUENTIAL
;
654 u
->flags
.form
= FORM_FORMATTED
;
655 u
->flags
.status
= STATUS_OLD
;
656 u
->flags
.blank
= BLANK_NULL
;
657 u
->flags
.position
= POSITION_ASIS
;
658 u
->flags
.sign
= SIGN_UNSPECIFIED
;
659 u
->flags
.decimal
= DECIMAL_POINT
;
660 u
->flags
.delim
= DELIM_UNSPECIFIED
;
661 u
->flags
.encoding
= ENCODING_DEFAULT
;
662 u
->flags
.async
= ASYNC_NO
;
663 u
->flags
.round
= ROUND_UNSPECIFIED
;
664 u
->flags
.share
= SHARE_UNSPECIFIED
;
665 u
->flags
.cc
= CC_LIST
;
667 u
->recl
= default_recl
;
668 u
->endfile
= AT_ENDFILE
;
670 u
->filename
= strdup (stdout_name
);
674 __gthread_mutex_unlock (&u
->lock
);
677 if (options
.stderr_unit
>= 0)
679 u
= insert_unit (options
.stderr_unit
);
680 u
->s
= error_stream ();
682 u
->flags
.action
= ACTION_WRITE
;
684 u
->flags
.access
= ACCESS_SEQUENTIAL
;
685 u
->flags
.form
= FORM_FORMATTED
;
686 u
->flags
.status
= STATUS_OLD
;
687 u
->flags
.blank
= BLANK_NULL
;
688 u
->flags
.position
= POSITION_ASIS
;
689 u
->flags
.sign
= SIGN_UNSPECIFIED
;
690 u
->flags
.decimal
= DECIMAL_POINT
;
691 u
->flags
.encoding
= ENCODING_DEFAULT
;
692 u
->flags
.async
= ASYNC_NO
;
693 u
->flags
.round
= ROUND_UNSPECIFIED
;
694 u
->flags
.share
= SHARE_UNSPECIFIED
;
695 u
->flags
.cc
= CC_LIST
;
697 u
->recl
= default_recl
;
698 u
->endfile
= AT_ENDFILE
;
700 u
->filename
= strdup (stderr_name
);
702 fbuf_init (u
, 256); /* 256 bytes should be enough, probably not doing
703 any kind of exotic formatting to stderr. */
705 __gthread_mutex_unlock (&u
->lock
);
707 /* The default internal units. */
708 u
= insert_unit (GFC_INTERNAL_UNIT
);
709 __gthread_mutex_unlock (&u
->lock
);
710 u
= insert_unit (GFC_INTERNAL_UNIT4
);
711 __gthread_mutex_unlock (&u
->lock
);
716 close_unit_1 (gfc_unit
*u
, int locked
)
720 /* If there are previously written bytes from a write with ADVANCE="no"
721 Reposition the buffer before closing. */
722 if (u
->previous_nonadvancing_write
)
723 finish_last_advance_record (u
);
725 rc
= (u
->s
== NULL
) ? 0 : sclose (u
->s
) == -1;
729 __gthread_mutex_lock (&unit_lock
);
731 for (i
= 0; i
< CACHE_SIZE
; i
++)
732 if (unit_cache
[i
] == u
)
733 unit_cache
[i
] = NULL
;
740 free_format_hash_table (u
);
743 if (u
->unit_number
<= NEWUNIT_START
)
744 newunit_free (u
->unit_number
);
747 __gthread_mutex_unlock (&u
->lock
);
749 /* If there are any threads waiting in find_unit for this unit,
750 avoid freeing the memory, the last such thread will free it
753 destroy_unit_mutex (u
);
756 __gthread_mutex_unlock (&unit_lock
);
762 unlock_unit (gfc_unit
*u
)
764 __gthread_mutex_unlock (&u
->lock
);
767 /* close_unit()-- Close a unit. The stream is closed, and any memory
768 associated with the stream is freed. Returns nonzero on I/O error.
769 Should be called with the u->lock locked. */
772 close_unit (gfc_unit
*u
)
774 return close_unit_1 (u
, 0);
778 /* close_units()-- Delete units on completion. We just keep deleting
779 the root of the treap until there is nothing left.
780 Not sure what to do with locking here. Some other thread might be
781 holding some unit's lock and perhaps hold it indefinitely
782 (e.g. waiting for input from some pipe) and close_units shouldn't
783 delay the program too much. */
788 __gthread_mutex_lock (&unit_lock
);
789 while (unit_root
!= NULL
)
790 close_unit_1 (unit_root
, 1);
791 __gthread_mutex_unlock (&unit_lock
);
795 #ifdef HAVE_FREELOCALE
796 freelocale (c_locale
);
801 /* High level interface to truncate a file, i.e. flush format buffers,
802 and generate an error or set some flags. Just like POSIX
803 ftruncate, returns 0 on success, -1 on failure. */
806 unit_truncate (gfc_unit
*u
, gfc_offset pos
, st_parameter_common
*common
)
810 /* Make sure format buffer is flushed. */
811 if (u
->flags
.form
== FORM_FORMATTED
)
813 if (u
->mode
== READING
)
814 pos
+= fbuf_reset (u
);
816 fbuf_flush (u
, u
->mode
);
819 /* struncate() should flush the stream buffer if necessary, so don't
820 bother calling sflush() here. */
821 ret
= struncate (u
->s
, pos
);
824 generate_error (common
, LIBERROR_OS
, NULL
);
827 u
->endfile
= AT_ENDFILE
;
828 u
->flags
.position
= POSITION_APPEND
;
835 /* filename_from_unit()-- If the unit_number exists, return a pointer to the
836 name of the associated file, otherwise return the empty string. The caller
837 must free memory allocated for the filename string. */
840 filename_from_unit (int n
)
849 c
= compare (n
, u
->unit_number
);
858 /* Get the filename. */
859 if (u
!= NULL
&& u
->filename
!= NULL
)
860 return strdup (u
->filename
);
862 return (char *) NULL
;
866 finish_last_advance_record (gfc_unit
*u
)
869 if (u
->saved_pos
> 0)
870 fbuf_seek (u
, u
->saved_pos
, SEEK_CUR
);
872 if (!(u
->unit_number
== options
.stdout_unit
873 || u
->unit_number
== options
.stderr_unit
))
880 char *p
= fbuf_alloc (u
, len
);
882 os_error ("Completing record after ADVANCE_NO failed");
889 fbuf_flush (u
, u
->mode
);
893 /* Assign a negative number for NEWUNIT in OPEN statements or for
898 __gthread_mutex_lock (&unit_lock
);
901 newunits
= xcalloc (16, 1);
905 /* Search for the next available newunit. */
906 for (int ii
= newunit_lwi
; ii
< newunit_size
; ii
++)
911 newunit_lwi
= ii
+ 1;
912 __gthread_mutex_unlock (&unit_lock
);
913 return -ii
+ NEWUNIT_START
;
917 /* Search failed, bump size of array and allocate the first
919 int old_size
= newunit_size
;
921 newunits
= xrealloc (newunits
, newunit_size
);
922 memset (newunits
+ old_size
, 0, old_size
);
923 newunits
[old_size
] = true;
924 newunit_lwi
= old_size
+ 1;
925 __gthread_mutex_unlock (&unit_lock
);
926 return -old_size
+ NEWUNIT_START
;
930 /* Free a previously allocated newunit= unit number. unit_lock must
931 be held when calling. */
934 newunit_free (int unit
)
936 int ind
= -unit
+ NEWUNIT_START
;
937 assert(ind
>= 0 && ind
< newunit_size
);
938 newunits
[ind
] = false;
939 if (ind
< newunit_lwi
)