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// This implementation is inspired by implementation of getcontext in glibc.
233#if _MIPS_SIM == _ABIO32
234#include <asm/asm.h>
235#include <asm/regdef.h>
236#include <asm/fpregdef.h>
237#else
238#include <machine/asm.h>
239#include <machine/regdef.h>
240#endif
241
242// from asm/asm.h
243#if _MIPS_SIM == _ABIO32
244#define ALSZ 7
245#define ALMASK ~7
246#define SZREG 4
247#else // _MIPS_SIM != _ABIO32
248#define ALSZ 15
249#define ALMASK ~15
250#define SZREG 8
251#endif
252
253#include <asm/unistd.h> // for __NR_rt_sigprocmask
254
255#define _NSIG8 128 / 8
256#define SIG_BLOCK 1
257
258
259  .text
260LOCALS_NUM = 1 // save gp on stack
261FRAME_SIZE = ((LOCALS_NUM * SZREG) + ALSZ) & ALMASK
262
263GP_FRAME_OFFSET = FRAME_SIZE - (1 * SZREG)
264MCONTEXT_REG_SIZE = 8
265
266#if _MIPS_SIM == _ABIO32
267
268NESTED (breakpad_getcontext, FRAME_SIZE, ra)
269  .mask	0x00000000, 0
270  .fmask 0x00000000, 0
271
272  .set noreorder
273  .cpload t9
274  .set reorder
275
276  move a2, sp
277#define _SP a2
278
279  addiu sp, -FRAME_SIZE
280  .cprestore GP_FRAME_OFFSET
281
282  sw s0, (16 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
283  sw s1, (17 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
284  sw s2, (18 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
285  sw s3, (19 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
286  sw s4, (20 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
287  sw s5, (21 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
288  sw s6, (22 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
289  sw s7, (23 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
290  sw _SP, (29 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
291  sw fp, (30 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
292  sw ra, (31 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
293  sw ra, MCONTEXT_PC_OFFSET(a0)
294
295#ifdef __mips_hard_float
296  s.d fs0, (20 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
297  s.d fs1, (22 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
298  s.d fs2, (24 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
299  s.d fs3, (26 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
300  s.d fs4, (28 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
301  s.d fs5, (30 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
302
303  cfc1 v1, fcr31
304  sw v1, MCONTEXT_FPC_CSR(a0)
305#endif  // __mips_hard_float
306
307  /* rt_sigprocmask (SIG_BLOCK, NULL, &ucp->uc_sigmask, _NSIG8) */
308  li a3, _NSIG8
309  addu a2, a0, UCONTEXT_SIGMASK_OFFSET
310  move a1, zero
311  li a0, SIG_BLOCK
312  li v0, __NR_rt_sigprocmask
313  syscall
314
315  addiu sp, FRAME_SIZE
316  jr ra
317
318END (breakpad_getcontext)
319#else
320
321#ifndef NESTED
322/*
323 * NESTED - declare nested routine entry point
324 */
325#define NESTED(symbol, framesize, rpc)  \
326    .globl  symbol;                     \
327    .align  2;                          \
328    .type symbol,@function;             \
329    .ent  symbol,0;                     \
330symbol:   .frame  sp, framesize, rpc;
331#endif
332
333/*
334 * END - mark end of function
335 */
336#ifndef END
337# define END(function)                  \
338    .end  function;                     \
339    .size function,.-function
340#endif
341
342/* int getcontext (ucontext_t *ucp) */
343
344NESTED (breakpad_getcontext, FRAME_SIZE, ra)
345  .mask   0x10000000, 0
346  .fmask  0x00000000, 0
347
348  move  a2, sp
349#define _SP a2
350  move  a3, gp
351#define _GP a3
352
353  daddiu sp, -FRAME_SIZE
354  .cpsetup $25, GP_FRAME_OFFSET, breakpad_getcontext
355
356  /* Store a magic flag.  */
357  li  v1, 1
358  sd v1, (0 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)  /* zero */
359
360  sd s0, (16 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
361  sd s1, (17 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
362  sd s2, (18 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
363  sd s3, (19 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
364  sd s4, (20 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
365  sd s5, (21 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
366  sd s6, (22 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
367  sd s7, (23 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
368  sd _GP, (28 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
369  sd _SP, (29 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
370  sd s8, (30 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
371  sd ra, (31 * MCONTEXT_REG_SIZE + MCONTEXT_GREGS_OFFSET)(a0)
372  sd ra, MCONTEXT_PC_OFFSET(a0)
373
374#ifdef __mips_hard_float
375  s.d $f24, (24 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
376  s.d $f25, (25 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
377  s.d $f26, (26 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
378  s.d $f27, (27 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
379  s.d $f28, (28 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
380  s.d $f29, (29 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
381  s.d $f30, (30 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
382  s.d $f31, (31 * MCONTEXT_REG_SIZE + MCONTEXT_FPREGS_OFFSET)(a0)
383
384  cfc1  v1, $31
385  sw  v1, MCONTEXT_FPC_CSR(a0)
386#endif /* __mips_hard_float */
387
388/* rt_sigprocmask (SIG_BLOCK, NULL, &ucp->uc_sigmask, _NSIG8) */
389  li  a3, _NSIG8
390  daddu a2, a0, UCONTEXT_SIGMASK_OFFSET
391  move  a1, zero
392  li  a0, SIG_BLOCK
393
394  li  v0, __NR_rt_sigprocmask
395  syscall
396
397  .cpreturn
398  daddiu sp, FRAME_SIZE
399  move  v0, zero
400  jr  ra
401
402END (breakpad_getcontext)
403#endif // _MIPS_SIM == _ABIO32
404
405#elif defined(__x86_64__)
406/* The x64 implementation of breakpad_getcontext was derived in part
407   from the implementation of libunwind which requires the following
408   notice. */
409/* libunwind - a platform-independent unwind library
410   Copyright (C) 2008 Google, Inc
411	Contributed by Paul Pluzhnikov <ppluzhnikov@google.com>
412   Copyright (C) 2010 Konstantin Belousov <kib@freebsd.org>
413
414This file is part of libunwind.
415
416Permission is hereby granted, free of charge, to any person obtaining
417a copy of this software and associated documentation files (the
418"Software"), to deal in the Software without restriction, including
419without limitation the rights to use, copy, modify, merge, publish,
420distribute, sublicense, and/or sell copies of the Software, and to
421permit persons to whom the Software is furnished to do so, subject to
422the following conditions:
423
424The above copyright notice and this permission notice shall be
425included in all copies or substantial portions of the Software.
426
427THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
428EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
429MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
430NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
431LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
432OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
433WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.  */
434
435  .text
436  .global breakpad_getcontext
437  .hidden breakpad_getcontext
438  .align 4
439  .type breakpad_getcontext, @function
440
441breakpad_getcontext:
442  .cfi_startproc
443
444  /* Callee saved: RBX, RBP, R12-R15  */
445  movq %r12, MCONTEXT_GREGS_R12(%rdi)
446  movq %r13, MCONTEXT_GREGS_R13(%rdi)
447  movq %r14, MCONTEXT_GREGS_R14(%rdi)
448  movq %r15, MCONTEXT_GREGS_R15(%rdi)
449  movq %rbp, MCONTEXT_GREGS_RBP(%rdi)
450  movq %rbx, MCONTEXT_GREGS_RBX(%rdi)
451
452  /* Save argument registers (not strictly needed, but setcontext
453     restores them, so don't restore garbage).  */
454  movq %r8,  MCONTEXT_GREGS_R8(%rdi)
455  movq %r9,  MCONTEXT_GREGS_R9(%rdi)
456  movq %rdi, MCONTEXT_GREGS_RDI(%rdi)
457  movq %rsi, MCONTEXT_GREGS_RSI(%rdi)
458  movq %rdx, MCONTEXT_GREGS_RDX(%rdi)
459  movq %rax, MCONTEXT_GREGS_RAX(%rdi)
460  movq %rcx, MCONTEXT_GREGS_RCX(%rdi)
461
462  /* Save fp state (not needed, except for setcontext not
463     restoring garbage).  */
464  leaq MCONTEXT_FPREGS_MEM(%rdi),%r8
465  movq %r8, MCONTEXT_FPREGS_PTR(%rdi)
466  fnstenv (%r8)
467  stmxcsr FPREGS_OFFSET_MXCSR(%r8)
468
469  leaq 8(%rsp), %rax /* exclude this call.  */
470  movq %rax, MCONTEXT_GREGS_RSP(%rdi)
471
472  movq 0(%rsp), %rax
473  movq %rax, MCONTEXT_GREGS_RIP(%rdi)
474
475  /* Save signal mask: sigprocmask(SIGBLOCK, NULL, &uc->uc_sigmask) */
476  leaq UCONTEXT_SIGMASK_OFFSET(%rdi), %rdx  // arg3
477  xorq %rsi, %rsi  // arg2 NULL
478  xorq %rdi, %rdi  // arg1 SIGBLOCK == 0
479  call sigprocmask@PLT
480
481  /* Always return 0 for success, even if sigprocmask failed. */
482  xorl %eax, %eax
483  ret
484  .cfi_endproc
485  .size breakpad_getcontext, . - breakpad_getcontext
486
487#else
488#error "This file has not been ported for your CPU!"
489#endif
490