aboutsummaryrefslogblamecommitdiffstats
path: root/erts/emulator/hipe/hipe_bif0.c
blob: e7fb850530bd10a37ec741fc68e15b20f013b4b8 (plain) (tree)
1
2
3
4
5
6
7
8
9
10
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158

                   
  
                                                        
  




                                                                      
  



                                                                         
  

                 
  






































































































































































































































































































































































































































                                                                              

                               

                                                 

                                                                                            



                                           
                                                                  
   
                                     


                                                   
                                             





























                                                               
                    





                              

                                                                         
 
                                                                                    




























































































































                                                                                      
                                                                  



















































































































































































































































































































































































































































































































































                                                                                                  







                                                                

                      














                                                                    



































































                                                                                            

                                    

 
                                                                                                        
























                                                                  
                                                                                                 

























                                                                                                 



                                                    







                                                                              
                                 




                                                                                          







                                                    



                                                                                    



                                                    
                               
                                 





























                                                                        
                               


                                                   
                  
                                 
                                                                      





















                                                                                
                                 












                                                                                  

                                                          






                                                                              
                                     

























                                                                                
                                                                                       



                            
                                                












                                                                   
                                                    





                                                            









                                                                                


















































































                                                                              

                                                                     














                                                            






                                 










































































                                                                                        


                                                                                    












                                                                
                                 


















                                                                           

                                                                  


                                                                  
                                 











                                                         

                                                                           




























                                                                 
                                 
















                                                                                          

                                                                  





                                                            
                                                                                     





















                                                                                        
                                 










































































































































































                                                                                
/*
 * %CopyrightBegin%
 *
 * Copyright Ericsson AB 2001-2011. All Rights Reserved.
 *
 * The contents of this file are subject to the Erlang Public License,
 * Version 1.1, (the "License"); you may not use this file except in
 * compliance with the License. You should have received a copy of the
 * Erlang Public License along with this software. If not, it can be
 * retrieved online at http://www.erlang.org/.
 *
 * Software distributed under the License is distributed on an "AS IS"
 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 * the License for the specific language governing rights and limitations
 * under the License.
 *
 * %CopyrightEnd%
 */
/*
 * hipe_bif0.c
 *
 * Compiler and linker support.
 */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "sys.h"
#include "error.h"
#include "erl_vm.h"
#include "global.h"
#include "erl_process.h"
#include "bif.h"
#include "big.h"
#include "beam_load.h"
#include "erl_db.h"
#include "hash.h"
#include "erl_bits.h"
#include "erl_binary.h"
#ifdef HIPE
#include <stddef.h>	/* offsetof() */
#include "hipe_arch.h"
#include "hipe_stack.h"
#include "hipe_mode_switch.h"
#include "hipe_native_bif.h"
#include "hipe_bif0.h"
/* We need hipe_literals.h for HIPE_SYSTEM_CRC, but it redefines
   a few constants. #undef them here to avoid warnings. */
#undef F_TIMO
#undef THE_NON_VALUE
#undef ERL_FUN_SIZE
#include "hipe_literals.h"
#endif

#define BeamOpCode(Op)	((Uint)BeamOp(Op))

int term_to_Sint32(Eterm term, Sint *sp)
{
    Sint val;

    if (!term_to_Sint(term, &val))
	return 0;
    if ((Sint)(Sint32)val != val)
	return 0;
    *sp = val;
    return 1;
}

static Eterm Uint_to_term(Uint x, Process *p)
{
    if (IS_USMALL(0, x)) {
	return make_small(x);
    } else {
	Eterm *hp = HAlloc(p, BIG_UINT_HEAP_SIZE);
	return uint_to_big(x, hp);
    }
}

void *term_to_address(Eterm arg)
{
    Uint u;
    return term_to_Uint(arg, &u) ? (void*)u : NULL;
}

static Eterm address_to_term(const void *address, Process *p)
{
    return Uint_to_term((Uint)address, p);
}

/*
 * BIFs for reading and writing memory. Used internally by HiPE.
 */
#if 0 /* XXX: unused */
BIF_RETTYPE hipe_bifs_read_u8_1(BIF_ALIST_1)
{
    unsigned char *address = term_to_address(BIF_ARG_1);
    if (!address)
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(make_small(*address));
}
#endif

#if 0 /* XXX: unused */
BIF_RETTYPE hipe_bifs_read_u32_1(BIF_ALIST_1)
{
    Uint32 *address = term_to_address(BIF_ARG_1);
    if (!address || !hipe_word32_address_ok(address))
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(Uint_to_term(*address, BIF_P));
}
#endif

BIF_RETTYPE hipe_bifs_write_u8_2(BIF_ALIST_2)
{
    unsigned char *address;

    address = term_to_address(BIF_ARG_1);
    if (!address || is_not_small(BIF_ARG_2))
	BIF_ERROR(BIF_P, BADARG);
    *address = unsigned_val(BIF_ARG_2);
    BIF_RET(NIL);
}

#if 0 /* XXX: unused */
BIF_RETTYPE hipe_bifs_write_s32_2(BIF_ALIST_2)
{
    Sint32 *address;
    Sint value;

    address = term_to_address(BIF_ARG_1);
    if (!address || !hipe_word32_address_ok(address))
	BIF_ERROR(BIF_P, BADARG);
    if (!term_to_Sint32(BIF_ARG_2, &value))
	BIF_ERROR(BIF_P, BADARG);
    *address = value;
    BIF_RET(NIL);
}
#endif

BIF_RETTYPE hipe_bifs_write_u32_2(BIF_ALIST_2)
{
    Uint32 *address;
    Uint value;

    address = term_to_address(BIF_ARG_1);
    if (!address || !hipe_word32_address_ok(address))
	BIF_ERROR(BIF_P, BADARG);
    if (!term_to_Uint(BIF_ARG_2, &value))
	BIF_ERROR(BIF_P, BADARG);
    if ((Uint)(Uint32)value != value)
	BIF_ERROR(BIF_P, BADARG);
    *address = value;
    hipe_flush_icache_word(address);
    BIF_RET(NIL);
}

/*
 * BIFs for mutable bytearrays.
 */
BIF_RETTYPE hipe_bifs_bytearray_2(BIF_ALIST_2)
{
    Sint nelts;
    Eterm bin;

    if (is_not_small(BIF_ARG_1) ||
	(nelts = signed_val(BIF_ARG_1)) < 0 ||
	!is_byte(BIF_ARG_2))
	BIF_ERROR(BIF_P, BADARG);
    bin = new_binary(BIF_P, NULL, nelts);
    memset(binary_bytes(bin), unsigned_val(BIF_ARG_2), nelts);
    BIF_RET(bin);
}

static inline unsigned char *bytearray_lvalue(Eterm bin, Eterm idx)
{
    Sint i;
    unsigned char *bytes;
    Uint bitoffs;
    Uint bitsize;

    if (is_not_binary(bin) ||
	is_not_small(idx) ||
	(i = unsigned_val(idx)) >= binary_size(bin))
	return NULL;
    ERTS_GET_BINARY_BYTES(bin, bytes, bitoffs, bitsize);
    ASSERT(bitoffs == 0);
    ASSERT(bitsize == 0);
    return bytes + i;
}

BIF_RETTYPE hipe_bifs_bytearray_sub_2(BIF_ALIST_2)
{
    unsigned char *bytep;

    bytep = bytearray_lvalue(BIF_ARG_1, BIF_ARG_2);
    if (!bytep)
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(make_small(*bytep));
}

BIF_RETTYPE hipe_bifs_bytearray_update_3(BIF_ALIST_3)
{
    unsigned char *bytep;

    bytep = bytearray_lvalue(BIF_ARG_1, BIF_ARG_2);
    if (!bytep || !is_byte(BIF_ARG_3))
	BIF_ERROR(BIF_P, BADARG);
    *bytep = unsigned_val(BIF_ARG_3);
    BIF_RET(BIF_ARG_1);
}

BIF_RETTYPE hipe_bifs_bitarray_2(BIF_ALIST_2)
{
    Sint nbits;
    Uint nbytes;
    Eterm bin;
    int bytemask;

    if (is_not_small(BIF_ARG_1))
	BIF_ERROR(BIF_P, BADARG);
    nbits = signed_val(BIF_ARG_1);
    if (nbits < 0)
	BIF_ERROR(BIF_P, BADARG);
    if (BIF_ARG_2 == am_false)
	bytemask = 0;
    else if (BIF_ARG_2 == am_true)
	bytemask = ~0;
    else
	BIF_ERROR(BIF_P, BADARG);
    nbytes = ((Uint)nbits + ((1 << 3) - 1)) >> 3;
    bin = new_binary(BIF_P, NULL, nbytes);
    memset(binary_bytes(bin), bytemask, nbytes);
    BIF_RET(bin);
}

BIF_RETTYPE hipe_bifs_bitarray_update_3(BIF_ALIST_3)
{
    unsigned char *bytes, bytemask;
    Uint bitoffs, bitsize;
    Uint bitnr, bytenr;
    int set;

    if (is_not_binary(BIF_ARG_1))
	BIF_ERROR(BIF_P, BADARG);
    if (is_not_small(BIF_ARG_2))
	BIF_ERROR(BIF_P, BADARG);
    bitnr = unsigned_val(BIF_ARG_2);
    bytenr = bitnr >> 3;
    if (bytenr >= binary_size(BIF_ARG_1))
	BIF_ERROR(BIF_P, BADARG);
    if (BIF_ARG_3 == am_false)
	set = 0;
    else if (BIF_ARG_3 == am_true)
	set = 1;
    else
	BIF_ERROR(BIF_P, BADARG);
    ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize);
    ASSERT(bitoffs == 0);
    ASSERT(bitsize == 0);
    bytemask = 1 << (bitnr & ((1 << 3) - 1));
    if (set)
	bytes[bytenr] |= bytemask;
    else
	bytes[bytenr] &= ~bytemask;
    BIF_RET(BIF_ARG_1);
}

BIF_RETTYPE hipe_bifs_bitarray_sub_2(BIF_ALIST_2)
{
    unsigned char *bytes, bytemask;
    Uint bitoffs, bitsize;
    Uint bitnr, bytenr;

    if (is_not_binary(BIF_ARG_1))
	BIF_ERROR(BIF_P, BADARG);
    if (is_not_small(BIF_ARG_2))
	BIF_ERROR(BIF_P, BADARG);
    bitnr = unsigned_val(BIF_ARG_2);
    bytenr = bitnr >> 3;
    if (bytenr >= binary_size(BIF_ARG_1))
	BIF_ERROR(BIF_P, BADARG);
    ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize);
    ASSERT(bitoffs == 0);
    ASSERT(bitsize == 0);
    bytemask = 1 << (bitnr & ((1 << 3) - 1));
    if ((bytes[bytenr] & bytemask) == 0)
	BIF_RET(am_false);
    else
	BIF_RET(am_true);
}

/*
 * BIFs for SML-like mutable arrays and reference cells.
 * For now, limited to containing immediate data.
 */
#if 1	/* use bignums as carriers, easier on the gc */
#define make_array_header(sz)	make_pos_bignum_header((sz))
#define array_header_arity(h)	header_arity((h))
#define make_array(hp)		make_big((hp))
#define is_not_array(x)		is_not_big((x))
#define array_val(x)		big_val((x))
#else	/* use tuples as carriers, easier debugging, harder on the gc */
#define make_array_header(sz)	make_arityval((sz))
#define array_header_arity(h)	arityval((h))
#define make_array(hp)		make_tuple((hp))
#define is_not_array(x)		is_not_tuple((x))
#define array_val(x)		tuple_val((x))
#endif
#define array_length(a)		array_header_arity(array_val((a))[0])

BIF_RETTYPE hipe_bifs_array_2(BIF_ALIST_2)
{
    Eterm *hp;
    Sint nelts, i;

    if (is_not_small(BIF_ARG_1) ||
	(nelts = signed_val(BIF_ARG_1)) < 0 ||
	is_not_immed(BIF_ARG_2))
	BIF_ERROR(BIF_P, BADARG);
    if (nelts == 0)	/* bignums must not be empty */
	BIF_RET(make_small(0));
    hp = HAlloc(BIF_P, 1+nelts);
    hp[0] = make_array_header(nelts);
    for (i = 1; i <= nelts; ++i)
	hp[i] = BIF_ARG_2;
    BIF_RET(make_array(hp));
}

BIF_RETTYPE hipe_bifs_array_length_1(BIF_ALIST_1)
{
    if (is_not_array(BIF_ARG_1)) {
	if (BIF_ARG_1 == make_small(0))	/* fixnum 0 represents empty arrays */
	    BIF_RET(make_small(0));
	BIF_ERROR(BIF_P, BADARG);
    }
    BIF_RET(make_small(array_header_arity(array_val(BIF_ARG_1)[0])));
}

BIF_RETTYPE hipe_bifs_array_sub_2(BIF_ALIST_2)
{
    Uint i;

    if (is_not_small(BIF_ARG_2) ||
	is_not_array(BIF_ARG_1) ||
	(i = unsigned_val(BIF_ARG_2)) >= array_length(BIF_ARG_1))
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(array_val(BIF_ARG_1)[i+1]);
}

BIF_RETTYPE hipe_bifs_array_update_3(BIF_ALIST_3)
{
    Uint i;

    if (is_not_immed(BIF_ARG_3) ||
	is_not_small(BIF_ARG_2) ||
	is_not_array(BIF_ARG_1) ||
	(i = unsigned_val(BIF_ARG_2)) >= array_length(BIF_ARG_1))
	BIF_ERROR(BIF_P, BADARG);
    array_val(BIF_ARG_1)[i+1] = BIF_ARG_3;
    BIF_RET(BIF_ARG_1);
}

BIF_RETTYPE hipe_bifs_ref_1(BIF_ALIST_1)
{
    Eterm *hp;

    if (is_not_immed(BIF_ARG_1))
	BIF_RET(BADARG);
    hp = HAlloc(BIF_P, 1+1);
    hp[0] = make_array_header(1);
    hp[1] = BIF_ARG_1;
    BIF_RET(make_array(hp));
}

BIF_RETTYPE hipe_bifs_ref_get_1(BIF_ALIST_1)
{
    if (is_not_array(BIF_ARG_1) ||
	array_val(BIF_ARG_1)[0] != make_array_header(1))
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(array_val(BIF_ARG_1)[1]);
}

BIF_RETTYPE hipe_bifs_ref_set_2(BIF_ALIST_2)
{
    if (is_not_immed(BIF_ARG_2) ||
	is_not_array(BIF_ARG_1) ||
	array_val(BIF_ARG_1)[0] != make_array_header(1))
	BIF_ERROR(BIF_P, BADARG);
    array_val(BIF_ARG_1)[1] = BIF_ARG_2;
    BIF_RET(BIF_ARG_1);
}

/*
 * Allocate memory and copy machine code to it.
 */
BIF_RETTYPE hipe_bifs_enter_code_2(BIF_ALIST_2)
{
    Uint nrbytes;
    void *bytes;
    void *address;
    Uint bitoffs;
    Uint bitsize;
    Eterm trampolines;
    Eterm *hp;

    if (is_not_binary(BIF_ARG_1))
	BIF_ERROR(BIF_P, BADARG);
    nrbytes = binary_size(BIF_ARG_1);
    ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize);
    ASSERT(bitoffs == 0);
    ASSERT(bitsize == 0);
    trampolines = NIL;
#ifdef HIPE_ALLOC_CODE
    address = HIPE_ALLOC_CODE(nrbytes, BIF_ARG_2, &trampolines, BIF_P);
    if (!address)
	BIF_ERROR(BIF_P, BADARG);
#else
    if (is_not_nil(BIF_ARG_2))
	BIF_ERROR(BIF_P, BADARG);
    address = erts_alloc(ERTS_ALC_T_HIPE, nrbytes);
#endif
    memcpy(address, bytes, nrbytes);
    hipe_flush_icache_range(address, nrbytes);
    hp = HAlloc(BIF_P, 3);
    hp[0] = make_arityval(2);
    hp[1] = address_to_term(address, BIF_P);
    hp[2] = trampolines;
    BIF_RET(make_tuple(hp));
}

/*
 * Allocate memory for arbitrary non-Erlang data.
 */
BIF_RETTYPE hipe_bifs_alloc_data_2(BIF_ALIST_2)
{
    Uint align, nrbytes;
    void *block;

    if (is_not_small(BIF_ARG_1) || is_not_small(BIF_ARG_2) ||
	(align = unsigned_val(BIF_ARG_1),
	 align != sizeof(long) && align != sizeof(double)))
	BIF_ERROR(BIF_P, BADARG);
    nrbytes = unsigned_val(BIF_ARG_2);
    if (nrbytes == 0)
	BIF_RET(make_small(0));
    block = erts_alloc(ERTS_ALC_T_HIPE, nrbytes);
    if ((unsigned long)block & (align-1))
	fprintf(stderr, "%s: erts_alloc(%lu) returned %p which is not %lu-byte aligned\r\n",
		__FUNCTION__, (unsigned long)nrbytes, block, (unsigned long)align);
    BIF_RET(address_to_term(block, BIF_P));
}

/*
 * Statistics on hipe constants: size of HiPE constants, in words.
 */
unsigned int hipe_constants_size = 0;

BIF_RETTYPE hipe_bifs_constants_size_0(BIF_ALIST_0)
{
    BIF_RET(make_small(hipe_constants_size));
}

/*
 * Merging constant Erlang terms.
 * Uses the constants pool and a hash table of all top-level
 * terms merged so far. (Sub-terms are not merged.)
 */
struct const_term {
    HashBucket bucket;
    Eterm val;		/* tagged pointer to mem[0] */
    Eterm mem[1];	/* variable size */
};

static Hash const_term_table;
static ErlOffHeap const_term_table_off_heap;

static HashValue const_term_hash(void *tmpl)
{
    return make_hash2((Eterm)tmpl);
}

static int const_term_cmp(void *tmpl, void *bucket)
{
    return !eq((Eterm)tmpl, ((struct const_term*)bucket)->val);
}

static void *const_term_alloc(void *tmpl)
{
    Eterm obj;
    Uint size;
    Uint alloc_size;
    Eterm *hp;
    struct const_term *p;

    obj = (Eterm)tmpl;
    ASSERT(is_not_immed(obj));
    size = size_object(obj);
    alloc_size = size + (offsetof(struct const_term, mem)/sizeof(Eterm));
    hipe_constants_size += alloc_size;

    p = (struct const_term*)erts_alloc(ERTS_ALC_T_HIPE, alloc_size * sizeof(Eterm));

    /* I have absolutely no idea if having a private 'off_heap'
       works or not. _Some_ off_heap object is required for
       REFC_BINARY and FUN values, but _where_ it should be is
       a complete mystery to me. */
    hp = &p->mem[0];
    p->val = copy_struct(obj, size, &hp, &const_term_table_off_heap);

    return &p->bucket;
}

static void init_const_term_table(void)
{
    HashFunctions f;
    f.hash = (H_FUN) const_term_hash;
    f.cmp = (HCMP_FUN) const_term_cmp;
    f.alloc = (HALLOC_FUN) const_term_alloc;
    f.free = (HFREE_FUN) NULL;
    hash_init(ERTS_ALC_T_HIPE, &const_term_table, "const_term_table", 97, f);
}

BIF_RETTYPE hipe_bifs_merge_term_1(BIF_ALIST_1)
{
    static int init_done = 0;
    struct const_term *p;
    Eterm val;

    val = BIF_ARG_1;
    if (is_not_immed(val)) {
	if (!init_done) {
	    init_const_term_table();
	    init_done = 1;
	}
	p = (struct const_term*)hash_put(&const_term_table, (void*)val);
	val = p->val;
    }
    BIF_RET(val);
}

struct mfa {
    Eterm mod;
    Eterm fun;
    Uint  ari;
};

static int term_to_mfa(Eterm term, struct mfa *mfa)
{
    Eterm mod, fun, a;
    Uint ari;

    if (is_not_tuple(term))
	return 0;
    if (tuple_val(term)[0] != make_arityval(3))
	return 0;
    mod = tuple_val(term)[1];
    if (is_not_atom(mod))
	return 0;
    mfa->mod = mod;
    fun = tuple_val(term)[2];
    if (is_not_atom(fun))
	return 0;
    mfa->fun = fun;
    a = tuple_val(term)[3];
    if (is_not_small(a))
	return 0;
    ari = unsigned_val(a);
    if (ari > 255)
	return 0;
    mfa->ari = ari;
    return 1;
}

#ifdef DEBUG_LINKER
static void print_mfa(Eterm mod, Eterm fun, unsigned int ari)
{
    erts_printf("%T:%T/%u", mod, fun, ari);
}
#endif

/*
 * Convert {M,F,A} to pointer to first insn after initial func_info.
 */
static Uint *hipe_find_emu_address(Eterm mod, Eterm name, unsigned int arity)
{
    Module *modp;
    Uint *code_base;
    int i, n;

    modp = erts_get_module(mod);
    if (modp == NULL || (code_base = modp->code) == NULL)
	return NULL;
    n = code_base[MI_NUM_FUNCTIONS];
    for (i = 0; i < n; ++i) {
	Uint *code_ptr = (Uint*)code_base[MI_FUNCTIONS+i];
	ASSERT(code_ptr[0] == BeamOpCode(op_i_func_info_IaaI));
	if (code_ptr[3] == name && code_ptr[4] == arity)
	    return code_ptr+5;
    }
    return NULL;
}

Uint *hipe_bifs_find_pc_from_mfa(Eterm term)
{
    struct mfa mfa;

    if (!term_to_mfa(term, &mfa))
	return NULL;
    return hipe_find_emu_address(mfa.mod, mfa.fun, mfa.ari);
}

BIF_RETTYPE hipe_bifs_fun_to_address_1(BIF_ALIST_1)
{
    Eterm *pc = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
    if (!pc)
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(address_to_term(pc, BIF_P));
}

static void *hipe_get_emu_address(Eterm m, Eterm f, unsigned int arity, int is_remote)
{
    void *address = NULL;
    if (!is_remote)
	address = hipe_find_emu_address(m, f, arity);
    if (!address) {
	/* if not found, stub it via the export entry */
	/* no lock needed around erts_export_get_or_make_stub() */
	Export *export_entry = erts_export_get_or_make_stub(m, f, arity);
	address = export_entry->address;
    }
    return address;
}

#if 0 /* XXX: unused */
BIF_RETTYPE hipe_bifs_get_emu_address_1(BIF_ALIST_1)
{
    struct mfa mfa;
    void *address;

    if (!term_to_mfa(BIF_ARG_1, &mfa))
	BIF_ERROR(BIF_P, BADARG);
    address = hipe_get_emu_address(mfa.mod, mfa.fun, mfa.ari);
    BIF_RET(address_to_term(address, BIF_P));
}
#endif

BIF_RETTYPE hipe_bifs_set_native_address_3(BIF_ALIST_3)
{
    Eterm *pc;
    void *address;
    int is_closure;
    struct mfa mfa;

    switch (BIF_ARG_3) {
      case am_false:
	is_closure = 0;
	break;
      case am_true:
	is_closure = 1;
	break;
      default:
	BIF_ERROR(BIF_P, BADARG);
    }
    address = term_to_address(BIF_ARG_2);
    if (!address)
	BIF_ERROR(BIF_P, BADARG);

    /* The mfa is needed again later, otherwise we could
       simply have called hipe_bifs_find_pc_from_mfa(). */
    if (!term_to_mfa(BIF_ARG_1, &mfa))
	BIF_ERROR(BIF_P, BADARG);
    pc = hipe_find_emu_address(mfa.mod, mfa.fun, mfa.ari);

    if (pc) {
	hipe_mfa_save_orig_beam_op(mfa.mod, mfa.fun, mfa.ari, pc);
#if HIPE
#ifdef DEBUG_LINKER
	printf("%s: ", __FUNCTION__);
	print_mfa(mfa.mod, mfa.fun, mfa.ari);
	printf(": planting call trap to %p at BEAM pc %p\r\n", address, pc);
#endif
	hipe_set_call_trap(pc, address, is_closure);
	BIF_RET(am_true);
#endif
    }
#ifdef DEBUG_LINKER
    printf("%s: ", __FUNCTION__);
    print_mfa(mfa.mod, mfa.fun, mfa.ari);
    printf(": no BEAM pc found\r\n");
#endif
    BIF_RET(am_false);
}

#if 0 /* XXX: unused */
/*
 * hipe_bifs_address_to_fun(Address)
 *    - Address is the address of the start of a emu function's code
 *    - returns {Module, Function, Arity}
 */
BIF_RETTYPE hipe_bifs_address_to_fun_1(BIF_ALIST_1)
{
    Eterm *pc;
    Eterm *funcinfo;
    Eterm *hp;

    pc = term_to_address(BIF_ARG_1);
    if (!pc)
	BIF_ERROR(BIF_P, BADARG);
    funcinfo = find_function_from_pc(pc);
    if (!funcinfo)
	BIF_RET(am_false);
    hp = HAlloc(BIF_P, 4);
    hp[0] = make_arityval(3);
    hp[1] = funcinfo[0];
    hp[2] = funcinfo[1];
    hp[3] = make_small(funcinfo[2]);
    BIF_RET(make_tuple(hp));
}
#endif

BIF_RETTYPE hipe_bifs_enter_sdesc_1(BIF_ALIST_1)
{
    struct sdesc *sdesc;

    sdesc = hipe_decode_sdesc(BIF_ARG_1);
    if (!sdesc) {
	fprintf(stderr, "%s: bad sdesc!\r\n", __FUNCTION__);
	BIF_ERROR(BIF_P, BADARG);
    }
    if (hipe_put_sdesc(sdesc) != sdesc) {
	fprintf(stderr, "%s: duplicate entry!\r\n", __FUNCTION__);
	BIF_ERROR(BIF_P, BADARG);
    }
    BIF_RET(NIL);
}

/*
 * Hash table mapping {M,F,A} to nbif address.
 */
struct nbif {
    HashBucket bucket;
    Eterm mod;
    Eterm fun;
    unsigned arity;
    const void *address;
};

static struct nbif nbifs[BIF_SIZE] = {
#define BIF_LIST(MOD,FUN,ARY,CFUN,IX)	\
	{ {0,0}, MOD, FUN, ARY, &nbif_##CFUN },
#include "erl_bif_list.h"
#undef BIF_LIST
};

#define NBIF_HASH(m,f,a)	((m)*(f)+(a))
static Hash nbif_table;

static HashValue nbif_hash(struct nbif *x)
{
    return NBIF_HASH(x->mod, x->fun, x->arity);
}

static int nbif_cmp(struct nbif *x, struct nbif *y)
{
    return !(x->mod == y->mod && x->fun == y->fun && x->arity == y->arity);
}

static struct nbif *nbif_alloc(struct nbif *x)
{
    return x;	/* pre-allocated */
}

static void init_nbif_table(void)
{
    HashFunctions f;
    int i;

    f.hash = (H_FUN) nbif_hash;
    f.cmp = (HCMP_FUN) nbif_cmp;
    f.alloc = (HALLOC_FUN) nbif_alloc;
    f.free = NULL;

    hash_init(ERTS_ALC_T_NBIF_TABLE, &nbif_table, "nbif_table", 500, f);

    for (i = 0; i < BIF_SIZE; ++i)
	hash_put(&nbif_table, &nbifs[i]);
}

static const void *nbif_address(Eterm mod, Eterm fun, unsigned arity)
{
    struct nbif tmpl;
    struct nbif *nbif;

    tmpl.mod = mod;
    tmpl.fun = fun;
    tmpl.arity = arity;

    nbif = hash_get(&nbif_table, &tmpl);
    return nbif ? nbif->address : NULL;
}

/*
 * hipe_bifs_bif_address(M,F,A) -> address or false
 */
BIF_RETTYPE hipe_bifs_bif_address_3(BIF_ALIST_3)
{
    const void *address;
    static int init_done = 0;

    if (!init_done) {
	init_nbif_table();
	init_done = 1;
    }

    if (is_not_atom(BIF_ARG_1) ||
	is_not_atom(BIF_ARG_2) ||
	is_not_small(BIF_ARG_3) ||
	signed_val(BIF_ARG_3) < 0)
	BIF_RET(am_false);

    address = nbif_address(BIF_ARG_1, BIF_ARG_2, unsigned_val(BIF_ARG_3));
    if (address)
	BIF_RET(address_to_term(address, BIF_P));
    BIF_RET(am_false);
}

/*
 * Hash table mapping primops to their addresses.
 */
struct primop {
    HashBucket bucket;	/* bucket.hvalue == atom_val(name) */
    const void *address;
#if defined(__arm__)
    void *trampoline;
#endif
};

static struct primop primops[] = {
#define PRIMOP_LIST(ATOM,ADDRESS)	{ {0,_unchecked_atom_val(ATOM)}, ADDRESS },
#include "hipe_primops.h"
#undef PRIMOP_LIST
};

static Hash primop_table;

static HashValue primop_hash(void *tmpl)
{
    return ((struct primop*)tmpl)->bucket.hvalue;	/* pre-initialised */
}

static int primop_cmp(void *tmpl, void *bucket)
{
    return 0;	/* hvalue matched so nothing further to do */
}

static void *primop_alloc(void *tmpl)
{
    return tmpl;	/* pre-allocated */
}

static void init_primop_table(void)
{
    HashFunctions f;
    int i;
    static int init_done = 0;

    if (init_done)
	return;
    init_done = 1;

    f.hash = (H_FUN) primop_hash;
    f.cmp = (HCMP_FUN) primop_cmp;
    f.alloc = (HALLOC_FUN) primop_alloc;
    f.free = NULL;

    hash_init(ERTS_ALC_T_HIPE, &primop_table, "primop_table", 50, f);

    for (i = 0; i < sizeof(primops)/sizeof(primops[0]); ++i)
	hash_put(&primop_table, &primops[i]);
}

static struct primop *primop_table_get(Eterm name)
{
    struct primop tmpl;

    init_primop_table();
    tmpl.bucket.hvalue = atom_val(name);
    return hash_get(&primop_table, &tmpl);
}

#if defined(__arm__)
static struct primop *primop_table_put(Eterm name)
{
    struct primop tmpl;

    init_primop_table();
    tmpl.bucket.hvalue = atom_val(name);
    return hash_put(&primop_table, &tmpl);
}

void *hipe_primop_get_trampoline(Eterm name)
{
    struct primop *primop = primop_table_get(name);
    return primop ? primop->trampoline : NULL;
}

void hipe_primop_set_trampoline(Eterm name, void *trampoline)
{
    struct primop *primop = primop_table_put(name);
    primop->trampoline = trampoline;
}
#endif

/*
 * hipe_bifs_primop_address(Atom) -> address or false
 */
BIF_RETTYPE hipe_bifs_primop_address_1(BIF_ALIST_1)
{
    const struct primop *primop;

    if (is_not_atom(BIF_ARG_1))
	BIF_RET(am_false);
    primop = primop_table_get(BIF_ARG_1);
    if (!primop)
	BIF_RET(am_false);
    BIF_RET(address_to_term(primop->address, BIF_P));
}

#if 0 /* XXX: unused */
/*
 * hipe_bifs_gbif_address(F,A) -> address or false
 */
#define GBIF_LIST(ATOM,ARY,CFUN) extern Eterm gbif_##CFUN(void);
#include "hipe_gbif_list.h"
#undef GBIF_LIST

BIF_RETTYPE hipe_bifs_gbif_address_2(BIF_ALIST_2)
{
    Uint arity;
    void *address;

    if (is_not_atom(BIF_ARG_1) || is_not_small(BIF_ARG_2))
	BIF_RET(am_false);	/* error or false, does it matter? */
    arity = signed_val(BIF_ARG_2);
    /* XXX: replace with a hash table later */
    do { /* trick to let us use 'break' instead of 'goto' */
#define GBIF_LIST(ATOM,ARY,CFUN) if (BIF_ARG_1 == ATOM && arity == ARY) { address = CFUN; break; }
#include "hipe_gbif_list.h"
#undef GBIF_LIST
	printf("\r\n%s: guard BIF ", __FUNCTION__);
	fflush(stdout);
	erts_printf("%T", BIF_ARG_1);
	printf("/%lu isn't listed in hipe_gbif_list.h\r\n", arity);
	BIF_RET(am_false);
    } while (0);
    BIF_RET(address_to_term(address, BIF_P));
}
#endif

BIF_RETTYPE hipe_bifs_atom_to_word_1(BIF_ALIST_1)
{
    if (is_not_atom(BIF_ARG_1))
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(Uint_to_term(BIF_ARG_1, BIF_P));
}

BIF_RETTYPE hipe_bifs_term_to_word_1(BIF_ALIST_1)
{
    BIF_RET(Uint_to_term(BIF_ARG_1, BIF_P));
}

/* XXX: this is really a primop, not a BIF */
BIF_RETTYPE hipe_conv_big_to_float(BIF_ALIST_1)
{
    Eterm res;
    Eterm *hp;
    FloatDef f;

    if (is_not_big(BIF_ARG_1))
	BIF_ERROR(BIF_P, BADARG);
    if (big_to_double(BIF_ARG_1, &f.fd) < 0)
	BIF_ERROR(BIF_P, BADARG);
    hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT);
    res = make_float(hp);
    PUT_DOUBLE(f, hp);
    BIF_RET(res);
}

#if 0 /* XXX: unused */
/*
 * At least parts of this should be inlined in native code.
 * The rest could be made a primop used by both the emulator and
 * native code...
 */
BIF_RETTYPE hipe_bifs_make_fun_3(BIF_ALIST_3)
{
    Eterm free_vars;
    Eterm mod;
    Eterm *tp;
    Uint index;
    Uint uniq;
    Uint num_free;
    Eterm tmp_var;
    Uint *tmp_ptr;
    unsigned needed;
    ErlFunThing *funp;
    Eterm *hp;
    int i;

    if (is_not_list(BIF_ARG_1) && is_not_nil(BIF_ARG_1))
	BIF_ERROR(BIF_P, BADARG);
    free_vars = BIF_ARG_1;

    if (is_not_atom(BIF_ARG_2))
	BIF_ERROR(BIF_P, BADARG);
    mod = BIF_ARG_2;

    if (is_not_tuple(BIF_ARG_3) ||
	(arityval(*tuple_val(BIF_ARG_3)) != 3))
	BIF_ERROR(BIF_P, BADARG);
    tp = tuple_val(BIF_ARG_3);

    if (term_to_Uint(tp[1], &index) == 0)
	BIF_ERROR(BIF_P, BADARG);
    if (term_to_Uint(tp[2], &uniq) == 0)
	BIF_ERROR(BIF_P, BADARG);
    if (term_to_Uint(tp[3], &num_free) == 0)
	BIF_ERROR(BIF_P, BADARG);

    needed = ERL_FUN_SIZE + num_free;
    funp = (ErlFunThing *) HAlloc(BIF_P, needed);
    hp = funp->env;

    funp->thing_word = HEADER_FUN;

    /* Need a ErlFunEntry *fe
     * fe->refc++;
     * funp->fe = fe;
     */

    funp->num_free = num_free;
    funp->creator = BIF_P->id;
    for (i = 0; i < num_free; i++) {
	if (is_nil(free_vars))
	    BIF_ERROR(BIF_P, BADARG);
	tmp_ptr = list_val(free_vars);
	tmp_var = CAR(tmp_ptr);
	free_vars = CDR(tmp_ptr);
	*hp++ = tmp_var;
    }
    if (is_not_nil(free_vars))
	BIF_ERROR(BIF_P, BADARG);

#ifndef HYBRID /* FIND ME! */
    funp->next = MSO(BIF_P).funs;
    MSO(BIF_P).funs = funp;
#endif

    BIF_RET(make_fun(funp));
}
#endif

/*
 * args: Nativecodeaddress, Module, {Uniq, Index, BeamAddress}
 */
BIF_RETTYPE hipe_bifs_make_fe_3(BIF_ALIST_3)
{
    Eterm mod;
    Uint index;
    Uint uniq;
    void *beam_address;
    ErlFunEntry *fe;
    Eterm *tp;
    void *native_address;

    native_address = term_to_address(BIF_ARG_1);
    if (!native_address)
	BIF_ERROR(BIF_P, BADARG);

    if (is_not_atom(BIF_ARG_2))
	BIF_ERROR(BIF_P, BADARG);
    mod = BIF_ARG_2;

    if (is_not_tuple(BIF_ARG_3) ||
	(arityval(*tuple_val(BIF_ARG_3)) != 3))
	BIF_ERROR(BIF_P, BADARG);
    tp = tuple_val(BIF_ARG_3);
    if (term_to_Uint(tp[1], &uniq) == 0)
	BIF_ERROR(BIF_P, BADARG);
    if (term_to_Uint(tp[2], &index) == 0)
	BIF_ERROR(BIF_P, BADARG);

    beam_address = term_to_address(tp[3]);
    if (!beam_address)
	BIF_ERROR(BIF_P, BADARG);

    fe = erts_get_fun_entry(mod, uniq, index);
    if (fe == NULL) {
	int i = atom_val(mod);
	char atom_buf[256];

	atom_buf[0] = '\0';
	strncat(atom_buf, (char*)atom_tab(i)->name, atom_tab(i)->len);
	printf("no fun entry for %s %ld:%ld\n", atom_buf, uniq, index);
	BIF_ERROR(BIF_P, BADARG);
    }
    fe->native_address = native_address;
    if (erts_refc_dectest(&fe->refc, 0) == 0)
	erts_erase_fun_entry(fe);
    BIF_RET(address_to_term((void *)fe, BIF_P));
}

#if 0 /* XXX: unused */
BIF_RETTYPE hipe_bifs_make_native_stub_2(BIF_ALIST_2)
{
    void *beamAddress;
    Uint beamArity;
    void *stubAddress;

    if ((beamAddress = term_to_address(BIF_ARG_1)) == 0 ||
	is_not_small(BIF_ARG_2) ||
	(beamArity = unsigned_val(BIF_ARG_2)) >= 256)
	BIF_ERROR(BIF_P, BADARG);
    stubAddress = hipe_make_native_stub(beamAddress, beamArity);
    BIF_RET(address_to_term(stubAddress, BIF_P));
}
#endif

/*
 * MFA info hash table:
 * - maps MFA to native code entry point
 * - the MFAs it calls (refers_to)
 * - the references to it (referred_from)
 * - maps MFA to most recent trampoline [if powerpc or arm]
 */
struct hipe_mfa_info {
    struct {
	unsigned long hvalue;
	struct hipe_mfa_info *next;
    } bucket;
    Eterm m;	/* atom */
    Eterm f;	/* atom */
    unsigned int a;
    void *remote_address;
    void *local_address;
    Eterm *beam_code;
    Uint orig_beam_op;
    struct hipe_mfa_info_list *refers_to;
    struct ref *referred_from;
#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__)
    void *trampoline;
#endif
};

static struct {
    unsigned int log2size;
    unsigned int mask;		/* INV: mask == (1 << log2size)-1 */
    unsigned int used;
    struct hipe_mfa_info **bucket;
    /*
     * The mfa info table is normally updated by the loader,
     * which runs in non-concurrent mode. Unfortunately runtime
     * apply operations (get_na_nofail) update the table if
     * they create a new stub for the mfa, which forces locking.
     * XXX: Redesign apply et al to avoid those updates.
     */
    erts_smp_mtx_t lock;
} hipe_mfa_info_table;

static inline void hipe_mfa_info_table_init_lock(void)
{
    erts_smp_mtx_init(&hipe_mfa_info_table.lock, "hipe_mfait_lock");
}

static inline void hipe_mfa_info_table_lock(void)
{
    erts_smp_mtx_lock(&hipe_mfa_info_table.lock);
}

static inline void hipe_mfa_info_table_unlock(void)
{
    erts_smp_mtx_unlock(&hipe_mfa_info_table.lock);
}

#define HIPE_MFA_HASH(M,F,A)	((M) * (F) + (A))

static struct hipe_mfa_info **hipe_mfa_info_table_alloc_bucket(unsigned int size)
{
    unsigned long nbytes = size * sizeof(struct hipe_mfa_info*);
    struct hipe_mfa_info **bucket = erts_alloc(ERTS_ALC_T_HIPE, nbytes);
    sys_memzero(bucket, nbytes);
    return bucket;
}

static void hipe_mfa_info_table_grow(void)
{
    unsigned int old_size, new_size, new_mask;
    struct hipe_mfa_info **old_bucket, **new_bucket;
    unsigned int i;

    old_size = 1 << hipe_mfa_info_table.log2size;
    hipe_mfa_info_table.log2size += 1;
    new_size = 1 << hipe_mfa_info_table.log2size;
    new_mask = new_size - 1;
    hipe_mfa_info_table.mask = new_mask;
    old_bucket = hipe_mfa_info_table.bucket;
    new_bucket = hipe_mfa_info_table_alloc_bucket(new_size);
    hipe_mfa_info_table.bucket = new_bucket;
    for (i = 0; i < old_size; ++i) {
	struct hipe_mfa_info *b = old_bucket[i];
	while (b != NULL) {
	    struct hipe_mfa_info *next = b->bucket.next;
	    unsigned int j = b->bucket.hvalue & new_mask;
	    b->bucket.next = new_bucket[j];
	    new_bucket[j] = b;
	    b = next;
	}
    }
    erts_free(ERTS_ALC_T_HIPE, old_bucket);
}

static struct hipe_mfa_info *hipe_mfa_info_table_alloc(Eterm m, Eterm f, unsigned int arity)
{
    struct hipe_mfa_info *res;

    res = (struct hipe_mfa_info*)erts_alloc(ERTS_ALC_T_HIPE, sizeof(*res));
    res->m = m;
    res->f = f;
    res->a = arity;
    res->remote_address = NULL;
    res->local_address = NULL;
    res->beam_code = NULL;
    res->orig_beam_op = 0;
    res->refers_to = NULL;
    res->referred_from = NULL;
#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__)
    res->trampoline = NULL;
#endif

    return res;
}

void hipe_mfa_info_table_init(void)
{
    unsigned int log2size, size;

    log2size = 10;
    size = 1 << log2size;
    hipe_mfa_info_table.log2size = log2size;
    hipe_mfa_info_table.mask = size - 1;
    hipe_mfa_info_table.used = 0;
    hipe_mfa_info_table.bucket = hipe_mfa_info_table_alloc_bucket(size);

    hipe_mfa_info_table_init_lock();
}

static inline struct hipe_mfa_info *hipe_mfa_info_table_get_locked(Eterm m, Eterm f, unsigned int arity)
{
    unsigned long h;
    unsigned int i;
    struct hipe_mfa_info *p;

    h = HIPE_MFA_HASH(m, f, arity);
    i = h & hipe_mfa_info_table.mask;
    p = hipe_mfa_info_table.bucket[i];
    for (; p; p = p->bucket.next)
	/* XXX: do we want to compare p->bucket.hvalue as well? */
	if (p->m == m && p->f == f && p->a == arity)
	    return p;
    return NULL;
}

#if 0 /* XXX: unused */
void *hipe_mfa_find_na(Eterm m, Eterm f, unsigned int arity)
{
    const struct hipe_mfa_info *p;

    p = hipe_mfa_info_table_get(m, f, arity);
    return p ? p->address : NULL;
}
#endif

static struct hipe_mfa_info *hipe_mfa_info_table_put_locked(Eterm m, Eterm f, unsigned int arity)
{
    unsigned long h;
    unsigned int i;
    struct hipe_mfa_info *p;
    unsigned int size;

    h = HIPE_MFA_HASH(m, f, arity);
    i = h & hipe_mfa_info_table.mask;
    p = hipe_mfa_info_table.bucket[i];
    for (; p; p = p->bucket.next)
	/* XXX: do we want to compare p->bucket.hvalue as well? */
	if (p->m == m && p->f == f && p->a == arity)
	    return p;
    p = hipe_mfa_info_table_alloc(m, f, arity);
    p->bucket.hvalue = h;
    p->bucket.next = hipe_mfa_info_table.bucket[i];
    hipe_mfa_info_table.bucket[i] = p;
    hipe_mfa_info_table.used += 1;
    size = 1 << hipe_mfa_info_table.log2size;
    if (hipe_mfa_info_table.used > (4*size/5))		/* rehash at 80% */
	hipe_mfa_info_table_grow();
    return p;
}

static void hipe_mfa_set_na(Eterm m, Eterm f, unsigned int arity, void *address, int is_exported)
{
    struct hipe_mfa_info *p;

    hipe_mfa_info_table_lock();
    p = hipe_mfa_info_table_put_locked(m, f, arity);
#ifdef DEBUG_LINKER
    printf("%s: ", __FUNCTION__);
    print_mfa(m, f, arity);
    printf(": changing address from %p to %p\r\n", p->local_address, address);
#endif
    p->local_address = address;
    if (is_exported)
	p->remote_address = address;
    hipe_mfa_info_table_unlock();
}

#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__)
void *hipe_mfa_get_trampoline(Eterm m, Eterm f, unsigned int arity)
{
    struct hipe_mfa_info *p;
    void *trampoline;

    hipe_mfa_info_table_lock();
    p = hipe_mfa_info_table_put_locked(m, f, arity);
    trampoline = p->trampoline;
    hipe_mfa_info_table_unlock();
    return trampoline;
}

void hipe_mfa_set_trampoline(Eterm m, Eterm f, unsigned int arity, void *trampoline)
{
    struct hipe_mfa_info *p;

    hipe_mfa_info_table_lock();
    p = hipe_mfa_info_table_put_locked(m, f, arity);
    p->trampoline = trampoline;
    hipe_mfa_info_table_unlock();
}
#endif

BIF_RETTYPE hipe_bifs_set_funinfo_native_address_3(BIF_ALIST_3)
{
    struct mfa mfa;
    void *address;
    int is_exported;

    if (!term_to_mfa(BIF_ARG_1, &mfa))
	BIF_ERROR(BIF_P, BADARG);
    address = term_to_address(BIF_ARG_2);
    if (!address)
	BIF_ERROR(BIF_P, BADARG);
    if (BIF_ARG_3 == am_true)
	is_exported = 1;
    else if (BIF_ARG_3 == am_false)
	is_exported = 0;
    else
	BIF_ERROR(BIF_P, BADARG);
    hipe_mfa_set_na(mfa.mod, mfa.fun, mfa.ari, address, is_exported);
    BIF_RET(NIL);
}

BIF_RETTYPE hipe_bifs_invalidate_funinfo_native_addresses_1(BIF_ALIST_1)
{
    Eterm lst;
    struct mfa mfa;
    struct hipe_mfa_info *p;

    hipe_mfa_info_table_lock();
    lst = BIF_ARG_1;
    while (is_list(lst)) {
	if (!term_to_mfa(CAR(list_val(lst)), &mfa))
	    break;
	lst = CDR(list_val(lst));
	p = hipe_mfa_info_table_get_locked(mfa.mod, mfa.fun, mfa.ari);
	if (p) {
	    p->remote_address = NULL;
	    p->local_address = NULL;
	    if (p->beam_code) {
#ifdef DEBUG_LINKER
		printf("%s: ", __FUNCTION__);
		print_mfa(mfa.mod, mfa.fun, mfa.ari);
		printf(": removing call trap from BEAM pc %p (new op %#lx)\r\n",
		       p->beam_code, p->orig_beam_op);
#endif
		p->beam_code[0] = p->orig_beam_op;
		p->beam_code = NULL;
		p->orig_beam_op = 0;
	    } else {
#ifdef DEBUG_LINKER
		printf("%s: ", __FUNCTION__);
		print_mfa(mfa.mod, mfa.fun, mfa.ari);
		printf(": no call trap to remove\r\n");
#endif
	    }
	}
    }
    hipe_mfa_info_table_unlock();
    if (is_not_nil(lst))
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(NIL);
}

void hipe_mfa_save_orig_beam_op(Eterm mod, Eterm fun, unsigned int ari, Eterm *pc)
{
    Uint orig_beam_op;
    struct hipe_mfa_info *p;

    orig_beam_op = pc[0];
    if (orig_beam_op != BeamOpCode(op_hipe_trap_call_closure) &&
	orig_beam_op != BeamOpCode(op_hipe_trap_call)) {
	hipe_mfa_info_table_lock();
	p = hipe_mfa_info_table_put_locked(mod, fun, ari);
#ifdef DEBUG_LINKER
	printf("%s: ", __FUNCTION__);
	print_mfa(mod, fun, ari);
	printf(": saving orig op %#lx from BEAM pc %p\r\n", orig_beam_op, pc);
#endif
	p->beam_code = pc;
	p->orig_beam_op = orig_beam_op;
	hipe_mfa_info_table_unlock();
    } else {
#ifdef DEBUG_LINKER
	printf("%s: ", __FUNCTION__);
	print_mfa(mod, fun, ari);
	printf(": orig op %#lx already saved\r\n", orig_beam_op);
#endif
    }
}

static void *hipe_make_stub(Eterm m, Eterm f, unsigned int arity, int is_remote)
{
    void *BEAMAddress;
    void *StubAddress;

#if 0
    if (is_not_atom(m) || is_not_atom(f) || arity > 255)
	return NULL;
#endif
    BEAMAddress = hipe_get_emu_address(m, f, arity, is_remote);
    StubAddress = hipe_make_native_stub(BEAMAddress, arity);
#if 0
    hipe_mfa_set_na(m, f, arity, StubAddress);
#endif
    return StubAddress;
}

static void *hipe_get_na_nofail_locked(Eterm m, Eterm f, unsigned int a, int is_remote)
{
    struct hipe_mfa_info *p;
    void *address;

    p = hipe_mfa_info_table_get_locked(m, f, a);
    if (p) {
	/* find address, predicting for a runtime apply call */
	address = p->remote_address;
	if (!is_remote)
	    address = p->local_address;
	if (address)
	    return address;

	/* bummer, install stub, checking if one already existed */
	address = p->remote_address;
	if (address)
	    return address;
    } else
	p = hipe_mfa_info_table_put_locked(m, f, a);
    address = hipe_make_stub(m, f, a, is_remote);
    /* XXX: how to tell if a BEAM MFA is exported or not? */
    p->remote_address = address;
    return address;
}

static void *hipe_get_na_nofail(Eterm m, Eterm f, unsigned int a, int is_remote)
{
    void *p;

    hipe_mfa_info_table_lock();
    p = hipe_get_na_nofail_locked(m, f, a, is_remote);
    hipe_mfa_info_table_unlock();
    return p;
}

/* used for apply/3 in hipe_mode_switch */
void *hipe_get_remote_na(Eterm m, Eterm f, unsigned int a)
{
    if (is_not_atom(m) || is_not_atom(f) || a > 255)
	return NULL;
    return hipe_get_na_nofail(m, f, a, 1);
}

/* primop, but called like a BIF for error handling purposes */
BIF_RETTYPE hipe_find_na_or_make_stub(BIF_ALIST_3)
{
    Uint arity;
    void *address;

    if (is_not_atom(BIF_ARG_1) || is_not_atom(BIF_ARG_2))
	BIF_ERROR(BIF_P, BADARG);
    arity = unsigned_val(BIF_ARG_3); /* no error check */
    address = hipe_get_na_nofail(BIF_ARG_1, BIF_ARG_2, arity, 1);
    BIF_RET((Eterm)address);	/* semi-Ok */
}

BIF_RETTYPE hipe_bifs_find_na_or_make_stub_2(BIF_ALIST_2)
{
    struct mfa mfa;
    void *address;
    int is_remote;

    if (!term_to_mfa(BIF_ARG_1, &mfa))
	BIF_ERROR(BIF_P, BADARG);
    if (BIF_ARG_2 == am_true)
	is_remote = 1;
    else if (BIF_ARG_2 == am_false)
	is_remote = 0;
    else
	BIF_ERROR(BIF_P, BADARG);
    address = hipe_get_na_nofail(mfa.mod, mfa.fun, mfa.ari, is_remote);
    BIF_RET(address_to_term(address, BIF_P));
}

/* primop, but called like a BIF for error handling purposes */
BIF_RETTYPE hipe_nonclosure_address(BIF_ALIST_2)
{
    Eterm hdr, m, f;
    void *address;

    if (!is_boxed(BIF_ARG_1))
	goto badfun;
    hdr = *boxed_val(BIF_ARG_1);
    if (is_export_header(hdr)) {
	Export *ep = (Export*)(export_val(BIF_ARG_1)[1]);
	unsigned int actual_arity = ep->code[2];
	if (actual_arity != BIF_ARG_2)
	    goto badfun;
	m = ep->code[0];
	f = ep->code[1];
    } else if (hdr == make_arityval(2)) {
	Eterm *tp = tuple_val(BIF_ARG_1);
	m = tp[1];
	f = tp[2];
	if (is_not_atom(m) || is_not_atom(f))
	    goto badfun;
	if (!erts_find_export_entry(m, f, BIF_ARG_2))
	    goto badfun;
    } else
	goto badfun;
    address = hipe_get_na_nofail(m, f, BIF_ARG_2, 1);
    BIF_RET((Eterm)address);

 badfun:
    BIF_P->current = NULL;
    BIF_P->fvalue = BIF_ARG_1;
    BIF_ERROR(BIF_P, EXC_BADFUN);
}

int hipe_find_mfa_from_ra(const void *ra, Eterm *m, Eterm *f, unsigned int *a)
{
    struct hipe_mfa_info *mfa;
    long mfa_offset, ra_offset;
    struct hipe_mfa_info **bucket;
    unsigned int i, nrbuckets;

    /* Note about locking: the table is only updated from the
       loader, which runs with the rest of the system suspended. */
    /* XXX: alas not true; see comment at hipe_mfa_info_table.lock */
    hipe_mfa_info_table_lock();
    bucket = hipe_mfa_info_table.bucket;
    nrbuckets = 1 << hipe_mfa_info_table.log2size;
    mfa = NULL;
    mfa_offset = LONG_MAX;
    for (i = 0; i < nrbuckets; ++i) {
	struct hipe_mfa_info *b = bucket[i];
	while (b != NULL) {
	    ra_offset = (char*)ra - (char*)b->local_address;
	    if (ra_offset > 0 && ra_offset < mfa_offset) {
		mfa_offset = ra_offset;
		mfa = b;
	    }
	    b = b->bucket.next;
	}
    }
    if (mfa) {
	*m = mfa->m;
	*f = mfa->f;
	*a = mfa->a;
    }
    hipe_mfa_info_table_unlock();
    return mfa ? 1 : 0;
}

/*
 * Patch Reference Handling.
 */
struct hipe_mfa_info_list {
    struct hipe_mfa_info *mfa;
    struct hipe_mfa_info_list *next;
};

struct ref {
    struct hipe_mfa_info *caller_mfa;
    void *address;
    void *trampoline;
    unsigned int flags;
    struct ref *next;
};
#define REF_FLAG_IS_LOAD_MFA		1	/* bit 0: 0 == call, 1 == load_mfa */
#define REF_FLAG_IS_REMOTE		2	/* bit 1: 0 == local, 1 == remote */
#define REF_FLAG_PENDING_REDIRECT	4	/* bit 2: 1 == pending redirect */
#define REF_FLAG_PENDING_REMOVE		8	/* bit 3: 1 == pending remove */

/* add_ref(CalleeMFA, {CallerMFA,Address,'call'|'load_mfa',Trampoline,'remote'|'local'})
 */
BIF_RETTYPE hipe_bifs_add_ref_2(BIF_ALIST_2)
{
    struct mfa callee;
    Eterm *tuple;
    struct mfa caller;
    void *address;
    void *trampoline;
    unsigned int flags;
    struct hipe_mfa_info *callee_mfa;
    struct hipe_mfa_info *caller_mfa;
    struct hipe_mfa_info_list *refers_to;
    struct ref *ref;

    if (!term_to_mfa(BIF_ARG_1, &callee))
	goto badarg;
    if (is_not_tuple(BIF_ARG_2))
	goto badarg;
    tuple = tuple_val(BIF_ARG_2);
    if (tuple[0] != make_arityval(5))
	goto badarg;
    if (!term_to_mfa(tuple[1], &caller))
	goto badarg;
    address = term_to_address(tuple[2]);
    if (!address)
	goto badarg;
    switch (tuple[3]) {
      case am_call:
	flags = 0;
	break;
      case am_load_mfa:
	flags = REF_FLAG_IS_LOAD_MFA;
	break;
      default:
	goto badarg;
    }
    if (is_nil(tuple[4]))
	trampoline = NULL;
    else {
	trampoline = term_to_address(tuple[4]);
	if (!trampoline)
	    goto badarg;
    }
    switch (tuple[5]) {
      case am_local:
	break;
      case am_remote:
	flags |= REF_FLAG_IS_REMOTE;
	break;
      default:
	goto badarg;
    }
    hipe_mfa_info_table_lock();
    callee_mfa = hipe_mfa_info_table_put_locked(callee.mod, callee.fun, callee.ari);
    caller_mfa = hipe_mfa_info_table_put_locked(caller.mod, caller.fun, caller.ari);

    refers_to = erts_alloc(ERTS_ALC_T_HIPE, sizeof(*refers_to));
    refers_to->mfa = callee_mfa;
    refers_to->next = caller_mfa->refers_to;
    caller_mfa->refers_to = refers_to;

    ref = erts_alloc(ERTS_ALC_T_HIPE, sizeof(*ref));
    ref->caller_mfa = caller_mfa;
    ref->address = address;
    ref->trampoline = trampoline;
    ref->flags = flags;
    ref->next = callee_mfa->referred_from;
    callee_mfa->referred_from = ref;
    hipe_mfa_info_table_unlock();

    BIF_RET(NIL);

 badarg:
    BIF_ERROR(BIF_P, BADARG);
}

/* Given a CalleeMFA, mark each ref to it as pending-redirect.
 * This ensures that remove_refs_from() won't remove them: any
 * removal is instead done at the end of redirect_referred_from().
 */
BIF_RETTYPE hipe_bifs_mark_referred_from_1(BIF_ALIST_1) /* get_refs_from */
{
    struct mfa mfa;
    const struct hipe_mfa_info *p;
    struct ref *ref;

    if (!term_to_mfa(BIF_ARG_1, &mfa))
	BIF_ERROR(BIF_P, BADARG);
    hipe_mfa_info_table_lock();
    p = hipe_mfa_info_table_get_locked(mfa.mod, mfa.fun, mfa.ari);
    if (p)
	for (ref = p->referred_from; ref != NULL; ref = ref->next)
	    ref->flags |= REF_FLAG_PENDING_REDIRECT;
    hipe_mfa_info_table_unlock();
    BIF_RET(NIL);
}

BIF_RETTYPE hipe_bifs_remove_refs_from_1(BIF_ALIST_1)
{
    struct mfa mfa;
    struct hipe_mfa_info *caller_mfa, *callee_mfa;
    struct hipe_mfa_info_list *refers_to, *tmp_refers_to;
    struct ref **prev, *ref;

    if (!term_to_mfa(BIF_ARG_1, &mfa))
	BIF_ERROR(BIF_P, BADARG);
    hipe_mfa_info_table_lock();
    caller_mfa = hipe_mfa_info_table_get_locked(mfa.mod, mfa.fun, mfa.ari);
    if (caller_mfa) {
	refers_to = caller_mfa->refers_to;
	while (refers_to) {
	    callee_mfa = refers_to->mfa;
	    prev = &callee_mfa->referred_from;
	    ref = *prev;
	    while (ref) {
		if (ref->caller_mfa == caller_mfa) {
		    if (ref->flags & REF_FLAG_PENDING_REDIRECT) {
			ref->flags |= REF_FLAG_PENDING_REMOVE;
			prev = &ref->next;
			ref = ref->next;
		    } else {
			struct ref *tmp = ref;
			ref = ref->next;
			*prev = ref;
			erts_free(ERTS_ALC_T_HIPE, tmp);
		    }
		} else {
		    prev = &ref->next;
		    ref = ref->next;
		}
	    }
	    tmp_refers_to = refers_to;
	    refers_to = refers_to->next;
	    erts_free(ERTS_ALC_T_HIPE, tmp_refers_to);
	}
	caller_mfa->refers_to = NULL;
    }
    hipe_mfa_info_table_unlock();
    BIF_RET(NIL);
}

/* redirect_referred_from(CalleeMFA)
 * Redirect all pending-redirect refs in CalleeMFA's referred_from.
 * Then remove any pending-redirect && pending-remove refs from CalleeMFA's referred_from.
 */
BIF_RETTYPE hipe_bifs_redirect_referred_from_1(BIF_ALIST_1)
{
    struct mfa mfa;
    struct hipe_mfa_info *p;
    struct ref **prev, *ref;
    int is_remote, res;
    void *new_address;

    if (!term_to_mfa(BIF_ARG_1, &mfa))
	BIF_ERROR(BIF_P, BADARG);
    hipe_mfa_info_table_lock();
    p = hipe_mfa_info_table_get_locked(mfa.mod, mfa.fun, mfa.ari);
    if (p) {
	prev = &p->referred_from;
	ref = *prev;
	while (ref) {
	    if (ref->flags & REF_FLAG_PENDING_REDIRECT) {
		is_remote = ref->flags & REF_FLAG_IS_REMOTE;
		new_address = hipe_get_na_nofail_locked(p->m, p->f, p->a, is_remote);
		if (ref->flags & REF_FLAG_IS_LOAD_MFA)
		    res = hipe_patch_insn(ref->address, (Uint)new_address, am_load_mfa);
		else
		    res = hipe_patch_call(ref->address, new_address, ref->trampoline);
		if (res)
		    fprintf(stderr, "%s: patch failed\r\n", __FUNCTION__);
		ref->flags &= ~REF_FLAG_PENDING_REDIRECT;
		if (ref->flags & REF_FLAG_PENDING_REMOVE) {
		    struct ref *tmp = ref;
		    ref = ref->next;
		    *prev = ref;
		    erts_free(ERTS_ALC_T_HIPE, tmp);
		} else {
		    prev = &ref->next;
		    ref = ref->next;
		}
	    } else {
		prev = &ref->next;
		ref = ref->next;
	    }
	}
    }
    hipe_mfa_info_table_unlock();
    BIF_RET(NIL);
}

BIF_RETTYPE hipe_bifs_check_crc_1(BIF_ALIST_1)
{
    Uint crc;

    if (!term_to_Uint(BIF_ARG_1, &crc))
	BIF_ERROR(BIF_P, BADARG);
    if (crc == HIPE_SYSTEM_CRC)
	BIF_RET(am_true);
    BIF_RET(am_false);
}

BIF_RETTYPE hipe_bifs_system_crc_1(BIF_ALIST_1)
{
    Uint crc;

    if (!term_to_Uint(BIF_ARG_1, &crc))
	BIF_ERROR(BIF_P, BADARG);
    crc ^= (HIPE_SYSTEM_CRC ^ HIPE_LITERALS_CRC);
    BIF_RET(Uint_to_term(crc, BIF_P));
}

BIF_RETTYPE hipe_bifs_get_rts_param_1(BIF_ALIST_1)
{
    unsigned int is_defined;
    unsigned long value;

    if (is_not_small(BIF_ARG_1))
	BIF_ERROR(BIF_P, BADARG);
    is_defined = 1;
    value = 0;
    switch (unsigned_val(BIF_ARG_1)) {
	RTS_PARAMS_CASES
      default:
	BIF_ERROR(BIF_P, BADARG);
    }
    if (!is_defined)
	BIF_RET(NIL);
    BIF_RET(Uint_to_term(value, BIF_P));
}

void hipe_patch_address(Uint *address, Eterm patchtype, Uint value)
{
    switch (patchtype) {
      case am_load_fe:
	hipe_patch_load_fe(address, value);
	return;
      default:
	fprintf(stderr, "%s: unknown patchtype %#lx\r\n",
		__FUNCTION__, patchtype);
	return;
    }
}

struct modinfo {
    HashBucket bucket;		/* bucket.hvalue == atom_val(the module name) */
    unsigned int code_size;
};

static Hash modinfo_table;

static HashValue modinfo_hash(void *tmpl)
{
    Eterm mod = (Eterm)tmpl;
    return atom_val(mod);
}

static int modinfo_cmp(void *tmpl, void *bucket)
{
    /* bucket->hvalue == modinfo_hash(tmpl), so just return 0 (match) */
    return 0;
}

static void *modinfo_alloc(void *tmpl)
{
    struct modinfo *p;

    p = (struct modinfo*)erts_alloc(ERTS_ALC_T_HIPE, sizeof(*p));
    p->code_size = 0;
    return &p->bucket;
}

static void init_modinfo_table(void)
{
    HashFunctions f;
    static int init_done = 0;

    if (init_done)
	return;
    init_done = 1;
    f.hash = (H_FUN) modinfo_hash;
    f.cmp = (HCMP_FUN) modinfo_cmp;
    f.alloc = (HALLOC_FUN) modinfo_alloc;
    f.free = (HFREE_FUN) NULL;
    hash_init(ERTS_ALC_T_HIPE, &modinfo_table, "modinfo_table", 11, f);
}

BIF_RETTYPE hipe_bifs_update_code_size_3(BIF_ALIST_3)
{
    struct modinfo *p;
    Sint code_size;

    init_modinfo_table();

    if (is_not_atom(BIF_ARG_1) ||
	is_not_small(BIF_ARG_3) ||
	(code_size = signed_val(BIF_ARG_3)) < 0)
	BIF_ERROR(BIF_P, BADARG);

    p = (struct modinfo*)hash_put(&modinfo_table, (void*)BIF_ARG_1);

    if (is_nil(BIF_ARG_2))	/* some MFAs, not whole module */
	p->code_size += code_size;
    else			/* whole module */
	p->code_size = code_size;
    BIF_RET(NIL);
}

BIF_RETTYPE hipe_bifs_code_size_1(BIF_ALIST_1)
{
    struct modinfo *p;
    unsigned int code_size;

    init_modinfo_table();

    if (is_not_atom(BIF_ARG_1))
	BIF_ERROR(BIF_P, BADARG);

    p = (struct modinfo*)hash_get(&modinfo_table, (void*)BIF_ARG_1);

    code_size = p ? p->code_size : 0;
    BIF_RET(make_small(code_size));
}

BIF_RETTYPE hipe_bifs_patch_insn_3(BIF_ALIST_3)
{
    Uint *address, value;

    address = term_to_address(BIF_ARG_1);
    if (!address)
	BIF_ERROR(BIF_P, BADARG);
    if (!term_to_Uint(BIF_ARG_2, &value))
	BIF_ERROR(BIF_P, BADARG);
    if (hipe_patch_insn(address, value, BIF_ARG_3))
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(NIL);
}

BIF_RETTYPE hipe_bifs_patch_call_3(BIF_ALIST_3)
{
    Uint *callAddress, *destAddress, *trampAddress;

    callAddress = term_to_address(BIF_ARG_1);
    if (!callAddress)
	BIF_ERROR(BIF_P, BADARG);
    destAddress = term_to_address(BIF_ARG_2);
    if (!destAddress)
	BIF_ERROR(BIF_P, BADARG);
    if (is_nil(BIF_ARG_3))
	trampAddress = NULL;
    else {
	trampAddress = term_to_address(BIF_ARG_3);
	if (!trampAddress)
	    BIF_ERROR(BIF_P, BADARG);
    }
    if (hipe_patch_call(callAddress, destAddress, trampAddress))
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(NIL);
}