|
111
|
1 /* Implement the SELECT statement for character variables.
|
|
131
|
2 Copyright (C) 2008-2018 Free Software Foundation, Inc.
|
|
111
|
3
|
|
|
4 This file is part of the GNU Fortran runtime library (libgfortran).
|
|
|
5
|
|
|
6 Libgfortran is free software; you can redistribute it and/or modify
|
|
|
7 it under the terms of the GNU General Public License as published by
|
|
|
8 the Free Software Foundation; either version 3, or (at your option)
|
|
|
9 any later version.
|
|
|
10
|
|
|
11 Libgfortran is distributed in the hope that it will be useful,
|
|
|
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
14 GNU General Public License for more details.
|
|
|
15
|
|
|
16 Under Section 7 of GPL version 3, you are granted additional
|
|
|
17 permissions described in the GCC Runtime Library Exception, version
|
|
|
18 3.1, as published by the Free Software Foundation.
|
|
|
19
|
|
|
20 You should have received a copy of the GNU General Public License and
|
|
|
21 a copy of the GCC Runtime Library Exception along with this program;
|
|
|
22 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
|
|
|
23 <http://www.gnu.org/licenses/>. */
|
|
|
24
|
|
|
25 #define select_string SUFFIX(select_string)
|
|
|
26 #define select_struct SUFFIX(select_struct)
|
|
|
27 #define compare_string SUFFIX(compare_string)
|
|
|
28
|
|
|
29 typedef struct
|
|
|
30 {
|
|
|
31 CHARTYPE *low;
|
|
|
32 gfc_charlen_type low_len;
|
|
|
33 CHARTYPE *high;
|
|
|
34 gfc_charlen_type high_len;
|
|
|
35 int address;
|
|
|
36 }
|
|
|
37 select_struct;
|
|
|
38
|
|
|
39 extern int select_string (select_struct *table, int table_len,
|
|
|
40 const CHARTYPE *selector,
|
|
|
41 gfc_charlen_type selector_len);
|
|
|
42 export_proto(select_string);
|
|
|
43
|
|
|
44
|
|
|
45 /* select_string()-- Given a selector string and a table of
|
|
|
46 * select_struct structures, return the address to jump to. */
|
|
|
47
|
|
|
48 int
|
|
|
49 select_string (select_struct *table, int table_len, const CHARTYPE *selector,
|
|
|
50 gfc_charlen_type selector_len)
|
|
|
51 {
|
|
|
52 select_struct *t;
|
|
|
53 int i, low, high, mid;
|
|
|
54 int default_jump = -1;
|
|
|
55
|
|
|
56 if (table_len == 0)
|
|
|
57 return -1;
|
|
|
58
|
|
|
59 /* Record the default address if present */
|
|
|
60
|
|
|
61 if (table->low == NULL && table->high == NULL)
|
|
|
62 {
|
|
|
63 default_jump = table->address;
|
|
|
64
|
|
|
65 table++;
|
|
|
66 table_len--;
|
|
|
67 if (table_len == 0)
|
|
|
68 return default_jump;
|
|
|
69 }
|
|
|
70
|
|
|
71 /* Try the high and low bounds if present. */
|
|
|
72
|
|
|
73 if (table->low == NULL)
|
|
|
74 {
|
|
|
75 if (compare_string (table->high_len, table->high,
|
|
|
76 selector_len, selector) >= 0)
|
|
|
77 return table->address;
|
|
|
78
|
|
|
79 table++;
|
|
|
80 table_len--;
|
|
|
81 if (table_len == 0)
|
|
|
82 return default_jump;
|
|
|
83 }
|
|
|
84
|
|
|
85 t = table + table_len - 1;
|
|
|
86
|
|
|
87 if (t->high == NULL)
|
|
|
88 {
|
|
|
89 if (compare_string (t->low_len, t->low, selector_len, selector) <= 0)
|
|
|
90 return t->address;
|
|
|
91
|
|
|
92 table_len--;
|
|
|
93 if (table_len == 0)
|
|
|
94 return default_jump;
|
|
|
95 }
|
|
|
96
|
|
|
97 /* At this point, the only table entries are bounded entries. Find
|
|
|
98 the right entry with a binary chop. */
|
|
|
99
|
|
|
100 low = -1;
|
|
|
101 high = table_len;
|
|
|
102
|
|
|
103 while (low + 1 < high)
|
|
|
104 {
|
|
|
105 mid = (low + high) / 2;
|
|
|
106
|
|
|
107 t = table + mid;
|
|
|
108 i = compare_string (t->low_len, t->low, selector_len, selector);
|
|
|
109
|
|
|
110 if (i == 0)
|
|
|
111 return t->address;
|
|
|
112
|
|
|
113 if (i < 0)
|
|
|
114 low = mid;
|
|
|
115 else
|
|
|
116 high = mid;
|
|
|
117 }
|
|
|
118
|
|
|
119 /* The string now lies between the low indeces of the now-adjacent
|
|
|
120 high and low entries. Because it is less than the low entry of
|
|
|
121 'high', it can't be that one. If low is still -1, then no
|
|
|
122 entries match. Otherwise, we have to check the high entry of
|
|
|
123 'low'. */
|
|
|
124
|
|
|
125 if (low == -1)
|
|
|
126 return default_jump;
|
|
|
127
|
|
|
128 t = table + low;
|
|
|
129 if (compare_string (selector_len, selector, t->high_len, t->high) <= 0)
|
|
|
130 return t->address;
|
|
|
131
|
|
|
132 return default_jump;
|
|
|
133 }
|
