1// Copyright (c) 2012, Google Inc.
2// All rights reserved.
3//
4// Redistribution and use in source and binary forms, with or without
5// modification, are permitted provided that the following conditions are
6// met:
7//
8//     * Redistributions of source code must retain the above copyright
9// notice, this list of conditions and the following disclaimer.
10//     * Redistributions in binary form must reproduce the above
11// copyright notice, this list of conditions and the following disclaimer
12// in the documentation and/or other materials provided with the
13// distribution.
14//     * Neither the name of Google Inc. nor the names of its
15// contributors may be used to endorse or promote products derived from
16// this software without specific prior written permission.
17//
18// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
19// "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
20// LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
21// A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
22// OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
23// SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
24// LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
25// DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
26// THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
27// (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
28// OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29
30// A minimalistic implementation of getcontext() to be used by
31// Google Breakpad on Android.
32
33#include "common/android/ucontext_constants.h"
34
35/* int getcontext (ucontext_t *ucp) */
36
37#if defined(__arm__)
38
39  .text
40  .global breakpad_getcontext
41  .hidden breakpad_getcontext
42  .type breakpad_getcontext, #function
43  .align 0
44  .fnstart
45breakpad_getcontext:
46
47  /* First, save r4-r11 */
48  add   r1, r0, #(MCONTEXT_GREGS_OFFSET + 4*4)
49  stm   r1, {r4-r11}
50
51  /* r12 is a scratch register, don't save it */
52
53  /* Save sp and lr explicitly. */
54  /* - sp can't be stored with stmia in Thumb-2 */
55  /* - STM instructions that store sp and pc are deprecated in ARM */
56  str   sp, [r0, #(MCONTEXT_GREGS_OFFSET + 13*4)]
57  str   lr, [r0, #(MCONTEXT_GREGS_OFFSET + 14*4)]
58
59  /* Save the caller's address in 'pc' */
60  str   lr, [r0, #(MCONTEXT_GREGS_OFFSET + 15*4)]
61
62  /* Save ucontext_t* pointer across next call */
63  mov   r4, r0
64
65  /* Call sigprocmask(SIG_BLOCK, NULL, &(ucontext->uc_sigmask)) */
66  mov   r0, #0  /* SIG_BLOCK */
67  mov   r1, #0  /* NULL */
68  add   r2, r4, #UCONTEXT_SIGMASK_OFFSET
69  bl    sigprocmask(PLT)
70
71  /* Intentionally do not save the FPU state here. This is because on
72   * Linux/ARM, one should instead use ptrace(PTRACE_GETFPREGS) or
73   * ptrace(PTRACE_GETVFPREGS) to get it.
74   *
75   * Note that a real implementation of getcontext() would need to save
76   * this here to allow setcontext()/swapcontext() to work correctly.
77   */
78
79  /* Restore the values of r4 and lr */
80  mov   r0, r4
81  ldr   lr, [r0, #(MCONTEXT_GREGS_OFFSET + 14*4)]
82  ldr   r4, [r0, #(MCONTEXT_GREGS_OFFSET +  4*4)]
83
84  /* Return 0 */
85  mov   r0, #0
86  bx    lr
87
88  .fnend
89  .size breakpad_getcontext, . - breakpad_getcontext
90
91#elif defined(__aarch64__)
92
93#define  _NSIG                       64
94#define  __NR_rt_sigprocmask         135
95
96  .text
97  .global breakpad_getcontext
98  .hidden breakpad_getcontext
99  .type breakpad_getcontext, #function
100  .align 4
101  .cfi_startproc
102breakpad_getcontext:
103
104  /* The saved context will return to the getcontext() call point
105     with a return value of 0 */
106  str     xzr,      [x0, MCONTEXT_GREGS_OFFSET +  0 * REGISTER_SIZE]
107
108  stp     x18, x19, [x0, MCONTEXT_GREGS_OFFSET + 18 * REGISTER_SIZE]
109  stp     x20, x21, [x0, MCONTEXT_GREGS_OFFSET + 20 * REGISTER_SIZE]
110  stp     x22, x23, [x0, MCONTEXT_GREGS_OFFSET + 22 * REGISTER_SIZE]
111  stp     x24, x25, [x0, MCONTEXT_GREGS_OFFSET + 24 * REGISTER_SIZE]
112  stp     x26, x27, [x0, MCONTEXT_GREGS_OFFSET + 26 * REGISTER_SIZE]
113  stp     x28, x29, [x0, MCONTEXT_GREGS_OFFSET + 28 * REGISTER_SIZE]
114  str     x30,      [x0, MCONTEXT_GREGS_OFFSET + 30 * REGISTER_SIZE]
115
116  /* Place LR into the saved PC, this will ensure that when
117     switching to this saved context with setcontext() control
118     will pass back to the caller of getcontext(), we have
119     already arranged to return the appropriate return value in x0
120     above.  */
121  str     x30, [x0, MCONTEXT_PC_OFFSET]
122
123  /* Save the current SP */
124  mov     x2, sp
125  str     x2, [x0, MCONTEXT_SP_OFFSET]
126
127  /* Initialize the pstate.  */
128  str     xzr, [x0, MCONTEXT_PSTATE_OFFSET]
129
130  /* Figure out where to place the first context extension
131     block.  */
132  add     x2, x0, #MCONTEXT_EXTENSION_OFFSET
133
134  /* Write the context extension fpsimd header.  */
135  mov     w3, #(FPSIMD_MAGIC & 0xffff)
136  movk    w3, #(FPSIMD_MAGIC >> 16), lsl #16
137  str     w3, [x2, #FPSIMD_CONTEXT_MAGIC_OFFSET]
138  mov     w3, #FPSIMD_CONTEXT_SIZE
139  str     w3, [x2, #FPSIMD_CONTEXT_SIZE_OFFSET]
140
141  /* Fill in the FP SIMD context.  */
142  add     x3, x2, #(FPSIMD_CONTEXT_VREGS_OFFSET + 8 * SIMD_REGISTER_SIZE)
143  stp     d8,  d9, [x3], #(2 * SIMD_REGISTER_SIZE)
144  stp     d10, d11, [x3], #(2 * SIMD_REGISTER_SIZE)
145  stp     d12, d13, [x3], #(2 * SIMD_REGISTER_SIZE)
146  stp     d14, d15, [x3], #(2 * SIMD_REGISTER_SIZE)
147
148  add     x3, x2, FPSIMD_CONTEXT_FPSR_OFFSET
149
150  mrs     x4, fpsr
151  str     w4, [x3]
152
153  mrs     x4, fpcr
154  str     w4, [x3, FPSIMD_CONTEXT_FPCR_OFFSET - FPSIMD_CONTEXT_FPSR_OFFSET]
155
156  /* Write the termination context extension header.  */
157  add     x2, x2, #FPSIMD_CONTEXT_SIZE
158
159  str     xzr, [x2, #FPSIMD_CONTEXT_MAGIC_OFFSET]
160  str     xzr, [x2, #FPSIMD_CONTEXT_SIZE_OFFSET]
161
162  /* Grab the signal mask */
163  /* rt_sigprocmask (SIG_BLOCK, NULL, &ucp->uc_sigmask, _NSIG8) */
164  add     x2, x0, #UCONTEXT_SIGMASK_OFFSET
165  mov     x0, #0  /* SIG_BLOCK */
166  mov     x1, #0  /* NULL */
167  mov     x3, #(_NSIG / 8)
168  mov     x8, #__NR_rt_sigprocmask
169  svc     0
170
171  /* Return x0 for success */
172  mov     x0, 0
173  ret
174
175  .cfi_endproc
176  .size breakpad_getcontext, . - breakpad_getcontext
177
178#elif defined(__i386__)
179
180  .text
181  .global breakpad_getcontext
182  .hidden breakpad_getcontext
183  .align 4
184  .type breakpad_getcontext, @function
185
186breakpad_getcontext:
187
188  movl 4(%esp), %eax   /* eax = uc */
189
190  /* Save register values */
191  movl %ecx, MCONTEXT_ECX_OFFSET(%eax)
192  movl %edx, MCONTEXT_EDX_OFFSET(%eax)
193  movl %ebx, MCONTEXT_EBX_OFFSET(%eax)
194  movl %edi, MCONTEXT_EDI_OFFSET(%eax)
195  movl %esi, MCONTEXT_ESI_OFFSET(%eax)
196  movl %ebp, MCONTEXT_EBP_OFFSET(%eax)
197
198  movl (%esp), %edx   /* return address */
199  lea  4(%esp), %ecx  /* exclude return address from stack */
200  mov  %edx, MCONTEXT_EIP_OFFSET(%eax)
201  mov  %ecx, MCONTEXT_ESP_OFFSET(%eax)
202
203  xorl %ecx, %ecx
204  movw %fs, %cx
205  mov  %ecx, MCONTEXT_FS_OFFSET(%eax)
206
207  movl $0, MCONTEXT_EAX_OFFSET(%eax)
208
209  /* Save floating point state to fpregstate, then update
210   * the fpregs pointer to point to it */
211  leal UCONTEXT_FPREGS_MEM_OFFSET(%eax), %ecx
212  fnstenv (%ecx)
213  fldenv  (%ecx)
214  mov %ecx, UCONTEXT_FPREGS_OFFSET(%eax)
215
216  /* Save signal mask: sigprocmask(SIGBLOCK, NULL, &uc->uc_sigmask) */
217  leal UCONTEXT_SIGMASK_OFFSET(%eax), %edx
218  xorl %ecx, %ecx
219  push %edx   /* &uc->uc_sigmask */
220  push %ecx   /* NULL */
221  push %ecx   /* SIGBLOCK == 0 on i386 */
222  call sigprocmask@PLT
223  addl $12, %esp
224
225  movl $0, %eax
226  ret
227
228  .size breakpad_getcontext, . - breakpad_getcontext
229
230#elif defined(__mips__)
231
232#if _MIPS_SIM != _ABIO32
233#error "Unsupported mips ISA. Only mips o32 is supported."
234#endif
235
236// This implementation is inspired by implementation of getcontext in glibc.
237#include <asm/asm.h>
238#include <asm/regdef.h>
239#include <asm/fpregdef.h>
240#include <asm/unistd.h> // for __NR_rt_sigprocmask
241
242#define _NSIG8 128 / 8
243#define SIG_BLOCK 1
244
245
246  .text
247LOCALS_NUM = 2	// save gp and ra on stack
248FRAME_SIZE = ((LOCALS_NUM * SZREG) + ALSZ) & ALMASK
249RA_FRAME_OFFSET = FRAME_SIZE - (1 * SZREG)
250GP_FRAME_OFFSET = FRAME_SIZE - (2 * SZREG)
251MCONTEXT_REG_SIZE = 8
252
253NESTED (breakpad_getcontext, FRAME_SIZE, ra)
254  .mask	0x00000000, 0
255  .fmask 0x00000000, 0
256
257  .set noreorder
258  .cpload t9
259  .set reorder
260
261  move a2, sp
262#define _SP a2
263
264  addiu sp, -FRAME_SIZE
265  sw ra, RA_FRAME_OFFSET(sp)
266  sw gp, GP_FRAME_OFFSET(sp)
267
268  sw s0, (16 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
269  sw s1, (17 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
270  sw s2, (18 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
271  sw s3, (19 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
272  sw s4, (20 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
273  sw s5, (21 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
274  sw s6, (22 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
275  sw s7, (23 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
276  sw _SP, (29 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
277  sw fp, (30 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
278  sw ra, (31 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
279  sw ra, MCONTEXT_PC_OFFSET(a0)
280
281#ifdef __mips_hard_float
282  s.d fs0, (20 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
283  s.d fs1, (22 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
284  s.d fs2, (24 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
285  s.d fs3, (26 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
286  s.d fs4, (28 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
287  s.d fs5, (30 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
288
289  cfc1 v1, fcr31
290  sw v1, MCONTEXT_FPC_CSR(a0)
291#endif  // __mips_hard_float
292
293  /* rt_sigprocmask (SIG_BLOCK, NULL, &ucp->uc_sigmask, _NSIG8) */
294  li a3, _NSIG8
295  addu a2, a0, UCONTEXT_SIGMASK_OFFSET
296  move a1, zero
297  li a0, SIG_BLOCK
298  li v0, __NR_rt_sigprocmask
299  syscall
300
301  lw ra, RA_FRAME_OFFSET(sp)
302  lw gp, GP_FRAME_OFFSET(sp)
303  addiu sp, FRAME_SIZE
304  jr ra
305
306END (breakpad_getcontext)
307
308#elif defined(__x86_64__)
309/* The x64 implementation of breakpad_getcontext was derived in part
310   from the implementation of libunwind which requires the following
311   notice. */
312/* libunwind - a platform-independent unwind library
313   Copyright (C) 2008 Google, Inc
314	Contributed by Paul Pluzhnikov <ppluzhnikov@google.com>
315   Copyright (C) 2010 Konstantin Belousov <kib@freebsd.org>
316
317This file is part of libunwind.
318
319Permission is hereby granted, free of charge, to any person obtaining
320a copy of this software and associated documentation files (the
321"Software"), to deal in the Software without restriction, including
322without limitation the rights to use, copy, modify, merge, publish,
323distribute, sublicense, and/or sell copies of the Software, and to
324permit persons to whom the Software is furnished to do so, subject to
325the following conditions:
326
327The above copyright notice and this permission notice shall be
328included in all copies or substantial portions of the Software.
329
330THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
331EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
332MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
333NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
334LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
335OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
336WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.  */
337
338  .text
339  .global breakpad_getcontext
340  .hidden breakpad_getcontext
341  .align 4
342  .type breakpad_getcontext, @function
343
344breakpad_getcontext:
345  .cfi_startproc
346
347  /* Callee saved: RBX, RBP, R12-R15  */
348  movq %r12, MCONTEXT_GREGS_R12(%rdi)
349  movq %r13, MCONTEXT_GREGS_R13(%rdi)
350  movq %r14, MCONTEXT_GREGS_R14(%rdi)
351  movq %r15, MCONTEXT_GREGS_R15(%rdi)
352  movq %rbp, MCONTEXT_GREGS_RBP(%rdi)
353  movq %rbx, MCONTEXT_GREGS_RBX(%rdi)
354
355  /* Save argument registers (not strictly needed, but setcontext
356     restores them, so don't restore garbage).  */
357  movq %r8,  MCONTEXT_GREGS_R8(%rdi)
358  movq %r9,  MCONTEXT_GREGS_R9(%rdi)
359  movq %rdi, MCONTEXT_GREGS_RDI(%rdi)
360  movq %rsi, MCONTEXT_GREGS_RSI(%rdi)
361  movq %rdx, MCONTEXT_GREGS_RDX(%rdi)
362  movq %rax, MCONTEXT_GREGS_RAX(%rdi)
363  movq %rcx, MCONTEXT_GREGS_RCX(%rdi)
364
365  /* Save fp state (not needed, except for setcontext not
366     restoring garbage).  */
367  leaq MCONTEXT_FPREGS_MEM(%rdi),%r8
368  movq %r8, MCONTEXT_FPREGS_PTR(%rdi)
369  fnstenv (%r8)
370  stmxcsr FPREGS_OFFSET_MXCSR(%r8)
371
372  leaq 8(%rsp), %rax /* exclude this call.  */
373  movq %rax, MCONTEXT_GREGS_RSP(%rdi)
374
375  movq 0(%rsp), %rax
376  movq %rax, MCONTEXT_GREGS_RIP(%rdi)
377
378  /* Save signal mask: sigprocmask(SIGBLOCK, NULL, &uc->uc_sigmask) */
379  leaq UCONTEXT_SIGMASK_OFFSET(%rdi), %rdx  // arg3
380  xorq %rsi, %rsi  // arg2 NULL
381  xorq %rdi, %rdi  // arg1 SIGBLOCK == 0
382  call sigprocmask@PLT
383
384  /* Always return 0 for success, even if sigprocmask failed. */
385  xorl %eax, %eax
386  ret
387  .cfi_endproc
388  .size breakpad_getcontext, . - breakpad_getcontext
389
390#else
391#error "This file has not been ported for your CPU!"
392#endif
393