1 /**************************************************************************/
2 /*                                                                        */
3 /*                                 OCaml                                  */
4 /*                                                                        */
5 /*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
6 /*                                                                        */
7 /*   Copyright 1996 Institut National de Recherche en Informatique et     */
8 /*     en Automatique.                                                    */
9 /*                                                                        */
10 /*   All rights reserved.  This file is distributed under the terms of    */
11 /*   the GNU Lesser General Public License version 2.1, with the          */
12 /*   special exception on linking described in the file LICENSE.          */
13 /*                                                                        */
14 /**************************************************************************/
15 
16 /* Machine-dependent interface with the asm code */
17 
18 #ifndef CAML_STACK_H
19 #define CAML_STACK_H
20 
21 #ifdef CAML_INTERNALS
22 
23 /* Macros to access the stack frame */
24 
25 #ifdef TARGET_sparc
26 #define Saved_return_address(sp) *((intnat *)((sp) + 92))
27 #define Callback_link(sp) ((struct caml_context *)((sp) + 104))
28 #endif
29 
30 #ifdef TARGET_i386
31 #define Saved_return_address(sp) *((intnat *)((sp) - 4))
32 #ifndef SYS_win32
33 #define Callback_link(sp) ((struct caml_context *)((sp) + 16))
34 #else
35 #define Callback_link(sp) ((struct caml_context *)((sp) + 8))
36 #endif
37 #endif
38 
39 #ifdef TARGET_power
40 #if defined(MODEL_ppc)
41 #define Saved_return_address(sp) *((intnat *)((sp) - 4))
42 #define Callback_link(sp) ((struct caml_context *)((sp) + 16))
43 #elif _CALL_ELF == 1
44 #define Saved_return_address(sp) *((intnat *)((sp) + 16))
45 #define Callback_link(sp) ((struct caml_context *)((sp) + (48 + 32)))
46 #elif _CALL_ELF == 2
47 #define Saved_return_address(sp) *((intnat *)((sp) + 16))
48 #define Callback_link(sp) ((struct caml_context *)((sp) + (32 + 32)))
49 #else
50 #error "TARGET_power: wrong MODEL"
51 #endif
52 #define Already_scanned(sp, retaddr) ((retaddr) & 1)
53 #define Mask_already_scanned(retaddr) ((retaddr) & ~1)
54 #define Mark_scanned(sp, retaddr) Saved_return_address(sp) = (retaddr) | 1
55 #endif
56 
57 #ifdef TARGET_s390x
58 #define Saved_return_address(sp) *((intnat *)((sp) - SIZEOF_PTR))
59 #define Trap_frame_size 16
60 #define Callback_link(sp) ((struct caml_context *)((sp) + Trap_frame_size))
61 #endif
62 
63 #ifdef TARGET_arm
64 #define Saved_return_address(sp) *((intnat *)((sp) - 4))
65 #define Callback_link(sp) ((struct caml_context *)((sp) + 8))
66 #endif
67 
68 #ifdef TARGET_amd64
69 #define Saved_return_address(sp) *((intnat *)((sp) - 8))
70 #define Callback_link(sp) ((struct caml_context *)((sp) + 16))
71 #endif
72 
73 #ifdef TARGET_arm64
74 #define Saved_return_address(sp) *((intnat *)((sp) - 8))
75 #define Callback_link(sp) ((struct caml_context *)((sp) + 16))
76 #endif
77 
78 /* Structure of OCaml callback contexts */
79 
80 struct caml_context {
81   char * bottom_of_stack;       /* beginning of OCaml stack chunk */
82   uintnat last_retaddr;         /* last return address in OCaml code */
83   value * gc_regs;              /* pointer to register block */
84 #ifdef WITH_SPACETIME
85   void* trie_node;
86 #endif
87 };
88 
89 /* Structure of frame descriptors */
90 
91 typedef struct {
92   uintnat retaddr;
93   unsigned short frame_size;
94   unsigned short num_live;
95   unsigned short live_ofs[1];
96 } frame_descr;
97 
98 /* Hash table of frame descriptors */
99 
100 extern frame_descr ** caml_frame_descriptors;
101 extern int caml_frame_descriptors_mask;
102 
103 #define Hash_retaddr(addr) \
104   (((uintnat)(addr) >> 3) & caml_frame_descriptors_mask)
105 
106 extern void caml_init_frame_descriptors(void);
107 extern void caml_register_frametable(intnat *);
108 extern void caml_unregister_frametable(intnat *);
109 extern void caml_register_dyn_global(void *);
110 
111 extern uintnat caml_stack_usage (void);
112 extern uintnat (*caml_stack_usage_hook)(void);
113 
114 /* Declaration of variables used in the asm code */
115 extern char * caml_top_of_stack;
116 extern char * caml_bottom_of_stack;
117 extern uintnat caml_last_return_address;
118 extern value * caml_gc_regs;
119 extern char * caml_exception_pointer;
120 extern value * caml_globals[];
121 extern char caml_globals_map[];
122 extern intnat caml_globals_inited;
123 extern intnat * caml_frametable[];
124 
125 CAMLextern frame_descr * caml_next_frame_descriptor(uintnat * pc, char ** sp);
126 
127 #endif /* CAML_INTERNALS */
128 
129 #endif /* CAML_STACK_H */
130