1// -*- c -*-
2//
3// %CopyrightBegin%
4//
5// Copyright Ericsson AB 2020. All Rights Reserved.
6//
7// Licensed under the Apache License, Version 2.0 (the "License");
8// you may not use this file except in compliance with the License.
9// You may obtain a copy of the License at
10//
11//     http://www.apache.org/licenses/LICENSE-2.0
12//
13// Unless required by applicable law or agreed to in writing, software
14// distributed under the License is distributed on an "AS IS" BASIS,
15// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
16// See the License for the specific language governing permissions and
17// limitations under the License.
18//
19// %CopyrightEnd%
20//
21
22pred.never() {
23    return 0;
24}
25
26pred.compiled_with_otp_20_or_higher() {
27    return S->otp_20_or_higher;
28}
29
30// Test whether a jump table can be used.
31pred.use_jump_tab(Size, Rest, MinSize) {
32    Sint min, max;
33    Sint i;
34
35    if (Size.val < 2 * MinSize || Size.val % 2 != 0) {
36        return 0;
37    }
38
39    if (Rest[0].type != TAG_i || Rest[1].type != TAG_f) {
40        /* Atoms. Can't use a jump table. */
41        return 0;
42    }
43
44    min = max = Rest[0].val;
45    for (i = 2; i < Size.val; i += 2) {
46        if (Rest[i].type != TAG_i || Rest[i+1].type != TAG_f) {
47            return 0;
48        }
49        if (Rest[i].val < min) {
50            min = Rest[i].val;
51        } else if (max < Rest[i].val) {
52            max = Rest[i].val;
53        }
54    }
55
56    return max - min <= Size.val;
57}
58
59// Test whether all values in a table are either floats or bignums.
60pred.floats_or_bignums(Size, Rest) {
61    int i;
62
63    if (Size.val < 2 || Size.val % 2 != 0) {
64        return 0;
65    }
66
67    for (i = 0; i < Size.val; i += 2) {
68        if (Rest[i].type != TAG_q) {
69            return 0;
70        }
71        if (Rest[i+1].type != TAG_f) {
72            return 0;
73        }
74    }
75
76    return 1;
77}
78
79
80// Test whether all values in a table have a fixed size.
81pred.fixed_size_values(Size, Rest) {
82    int i;
83
84    if (Size.val < 2 || Size.val % 2 != 0) {
85        return 0;
86    }
87
88    for (i = 0; i < Size.val; i += 2) {
89        if (Rest[i+1].type != TAG_f) {
90            return 0;
91        }
92        switch (Rest[i].type) {
93        case TAG_a:
94        case TAG_i:
95        case TAG_v:
96            break;
97        case TAG_q:
98            return is_float(beamfile_get_literal(&S->beam, Rest[i].val));
99        default:
100            return 0;
101        }
102    }
103
104    return 1;
105}
106
107// Test whether a table has mixe types.
108pred.mixed_types(Size, Rest) {
109    int i;
110    Uint type;
111
112    if (Size.val < 2 || Size.val % 2 != 0) {
113        return 0;
114    }
115
116    type = Rest[0].type;
117    for (i = 0; i < Size.val; i += 2) {
118        if (Rest[i].type != type) {
119            return 1;
120        }
121    }
122
123    return 0;
124}
125
126// Test whether Bif is "heavy" and should always go through its export entry.
127pred.is_heavy_bif(Bif) {
128    BeamFile_ImportEntry *import;
129    Export *export;
130
131    if (Bif.type != TAG_u || Bif.val >= S->beam.imports.count) {
132        return 0;
133    }
134
135    import = &S->beam.imports.entries[Bif.val];
136    export = erts_active_export_entry(import->module,
137                                      import->function,
138                                      import->arity);
139
140    if (export->bif_number != -1) {
141        return bif_table[export->bif_number].kind == BIF_KIND_HEAVY;
142    }
143
144    return 0;
145}
146
147// Test whether the given literal is a map.
148pred.literal_is_map(Lit) {
149    Eterm term;
150
151    ASSERT(Lit.type == TAG_q);
152    term = beamfile_get_literal(&S->beam, Lit.val);
153    return is_map(term);
154}
155
156// Predicate to test whether all of the given new small map keys are literals
157pred.is_small_map_literal_keys(Size, Rest) {
158    if (Size.val > MAP_SMALL_MAP_LIMIT) {
159        return 0;
160    }
161
162    /*
163     * Operations with non-literals have always only one key.
164     */
165    if (Size.val != 2) {
166        return 1;
167    }
168
169    switch (Rest[0].type) {
170    case TAG_a:
171    case TAG_i:
172    case TAG_n:
173    case TAG_q:
174        return 1;
175    default:
176        return 0;
177    }
178}
179
180// Test whether the given literal is an empty map.
181pred.is_empty_map(Lit) {
182    Eterm term;
183
184    if (Lit.type != TAG_q) {
185        return 0;
186    }
187
188    term = beamfile_get_literal(&S->beam, Lit.val);
189    return is_flatmap(term) && flatmap_get_size(flatmap_val(term)) == 0;
190}
191
192// Test whether a binary construction is too big.
193pred.binary_too_big(Size) {
194    return Size.type == TAG_o ||
195        (Size.type == TAG_u && ((Size.val >> (8*sizeof(Uint)-3)) != 0));
196}
197
198
199// Test whether the negation of the given number is small.
200pred.negation_is_small(Int) {
201    /*
202     * Check for the rare case of overflow in BeamInstr (UWord) -> Sint.
203     * Cast to the correct type before using IS_SSMALL (Sint).
204     */
205    return Int.type == TAG_i &&
206        !(Int.val & ~((((BeamInstr)1) << ((sizeof(Sint)*8)-1))-1)) &&
207        IS_SSMALL(-((Sint)Int.val));
208}
209
210// Mark this label. Always succeeds.
211pred.smp_mark_target_label(L) {
212    ASSERT(L.type == TAG_f);
213    S->labels[L.val].looprec_targeted = 1;
214    return 1;
215}
216
217// Test whether this label was targeted by a loop_rec/2 instruction.
218pred.smp_already_locked(L) {
219    ASSERT(L.type == TAG_u);
220    return S->labels[L.val].looprec_targeted;
221}
222
223// Sort map keys. Always succeeds unless the instruction contains
224// invalid map keys (in which case loading will fail).
225pred.map_key_sort(Size, Rest) {
226    return beam_load_map_key_sort(S, Size, Rest);
227}
228
229// Test that the two registers are distinct.
230pred.distinct(Reg1, Reg2) {
231    return Reg1.type != Reg2.type || Reg1.val != Reg2.val;
232}
233