1.0.19.16: derive the type of (AREF (THE STRING X) Y) as CHARACTER
[sbcl.git] / src / runtime / sparc-assem.S
1 #define _ASM
2
3 #include "sparc-funcdef.h"
4
5 #define LANGUAGE_ASSEMBLY
6 #include "lispregs.h"
7 #include "globals.h"
8 #include "sbcl.h"
9 #include "genesis/closure.h"
10 #include "genesis/funcallable-instance.h"
11 #include "genesis/fdefn.h"
12 #include "genesis/static-symbols.h"
13 #include "genesis/simple-fun.h" 
14
15 #define load(sym, reg) \
16         sethi %hi(sym), reg; ld [reg+%lo(sym)], reg
17 #define store(reg, sym) \
18         sethi %hi(sym), reg_L0; st reg, [reg_L0+%lo(sym)]
19
20 /* FIXME */
21 #define FRAMESIZE 0x48
22 #define ST_FLUSH_WINDOWS 0x03
23         .seg    "text"
24         .global call_into_lisp
25         FUNCDEF(call_into_lisp)
26 call_into_lisp:
27         save    %sp, -FRAMESIZE, %sp
28
29         /* Flush all of C's register windows to the stack. */
30         ta      ST_FLUSH_WINDOWS
31
32         /* Save the return address. */
33         st      %i7, [%fp-4]
34
35         /* Clear the descriptor regs. (See sparc/vm.lisp) */
36         mov     reg_ZERO, reg_A0
37         mov     reg_ZERO, reg_A1
38         mov     reg_ZERO, reg_A2
39         mov     reg_ZERO, reg_A3
40         mov     reg_ZERO, reg_A4
41         mov     reg_ZERO, reg_A5
42         mov     reg_ZERO, reg_OCFP
43         mov     reg_ZERO, reg_LRA
44         mov     reg_ZERO, reg_CODE
45
46         /* Establish NIL */
47         set     NIL, reg_NIL
48
49         /* Set the pseudo-atomic flag. */
50         set     4, reg_ALLOC
51
52         /* Turn off foreign function call. */
53         sethi   %hi(foreign_function_call_active), reg_NL0
54         st      reg_ZERO, [reg_NL0+%lo(foreign_function_call_active)]
55
56         /* Load the rest of lisp state. */
57         load(dynamic_space_free_pointer, reg_NL0)
58         add     reg_NL0, reg_ALLOC, reg_ALLOC
59         load(current_binding_stack_pointer, reg_BSP)
60         load(current_control_stack_pointer, reg_CSP)
61         load(current_control_frame_pointer, reg_OCFP)
62
63         /* No longer atomic, and check for interrupt. */
64         sub     reg_ALLOC, 4, reg_ALLOC
65         andcc   reg_ALLOC, 3, reg_ZERO
66         
67         tne     PSEUDO_ATOMIC_TRAP
68         /* Pass in the args. */
69         sll     %i2, 2, reg_NARGS
70         mov     %i1, reg_CFP
71         mov     %i0, reg_LEXENV
72         ld      [reg_CFP+0], reg_A0
73         ld      [reg_CFP+4], reg_A1
74         ld      [reg_CFP+8], reg_A2
75         ld      [reg_CFP+12], reg_A3
76         ld      [reg_CFP+16], reg_A4
77         ld      [reg_CFP+20], reg_A5
78
79         /* Calculate LRA */
80         set     lra + OTHER_POINTER_LOWTAG, reg_LRA
81
82         /* Indirect closure */
83         ld      [reg_LEXENV+CLOSURE_FUN_OFFSET], reg_CODE
84
85         jmp     reg_CODE+SIMPLE_FUN_CODE_OFFSET
86         nop
87
88         .align  8
89 lra:
90         .word   RETURN_PC_HEADER_WIDETAG
91
92         /* Blow off any extra values. */
93         mov     reg_OCFP, reg_CSP
94         nop
95
96         /* Return the one value. */
97         mov     reg_A0, %i0
98
99         /* Turn on pseudo_atomic */
100         add     reg_ALLOC, 4, reg_ALLOC
101
102         /* Store LISP state */
103         andn    reg_ALLOC, 7, reg_NL1
104         store(reg_NL1,dynamic_space_free_pointer)
105         store(reg_BSP,current_binding_stack_pointer)
106         store(reg_CSP,current_control_stack_pointer)
107         store(reg_CFP,current_control_frame_pointer)
108
109         /* No longer in Lisp. */
110         store(reg_NL1,foreign_function_call_active)
111
112         /* Were we interrupted? */
113         sub     reg_ALLOC, 4, reg_ALLOC
114         andcc   reg_ALLOC, 3, reg_ZERO
115         tne     PSEUDO_ATOMIC_TRAP
116
117         /* Back to C we go. */
118         ld      [%sp+FRAMESIZE-4], %i7
119         ret
120         restore %sp, FRAMESIZE, %sp
121
122         .global call_into_c
123         FUNCDEF(call_into_c)
124 call_into_c:
125         /* Build a lisp stack frame */
126         mov     reg_CFP, reg_OCFP
127         mov     reg_CSP, reg_CFP
128         add     reg_CSP, 32, reg_CSP
129         st      reg_OCFP, [reg_CFP]
130         st      reg_CODE, [reg_CFP+8]
131
132         /* Turn on pseudo-atomic. */
133         add     reg_ALLOC, 4, reg_ALLOC
134
135         /* Convert the return address to an offset and save it on the stack. */
136         sub     reg_LIP, reg_CODE, reg_L0
137         add     reg_L0, OTHER_POINTER_LOWTAG, reg_L0
138         st      reg_L0, [reg_CFP+4]
139
140         /* Store LISP state */
141         store(reg_BSP,current_binding_stack_pointer)
142         store(reg_CSP,current_control_stack_pointer)
143         store(reg_CFP,current_control_frame_pointer)
144         /* Use reg_CFP as a work register, and restore it */
145         andn    reg_ALLOC, 7, reg_CFP
146         store(reg_CFP,dynamic_space_free_pointer)
147                 load(current_control_frame_pointer, reg_CFP)
148
149         /* No longer in Lisp. */
150         store(reg_CSP,foreign_function_call_active)
151
152         /* Were we interrupted? */
153         sub     reg_ALLOC, 4, reg_ALLOC
154         andcc   reg_ALLOC, 3, reg_ZERO
155         tne     PSEUDO_ATOMIC_TRAP
156
157         /* Into C we go. */
158         call    reg_CFUNC
159         nop
160
161         /*
162          * Note: C calling conventions (32-bit) say that %o0 and %o1
163          * are used to return function results.  In particular 64-bit
164          * results are in %o0 (hi) and %o1 (low).  
165          */
166         
167         /* Re-establish NIL */
168         set     NIL, reg_NIL
169
170         /* Atomic. */
171         set     4, reg_ALLOC
172
173         /* No longer in foreign function call. */
174         sethi   %hi(foreign_function_call_active), reg_NL2
175         st      reg_ZERO, [reg_NL2+%lo(foreign_function_call_active)]
176
177         /* Load the rest of lisp state. */
178         load(dynamic_space_free_pointer, reg_NL2)
179         add     reg_NL2, reg_ALLOC, reg_ALLOC
180         load(current_binding_stack_pointer, reg_BSP)
181         load(current_control_stack_pointer, reg_CSP)
182         load(current_control_frame_pointer, reg_CFP)
183
184         /* Get the return address back. */
185         ld      [reg_CFP+4], reg_LIP
186         ld      [reg_CFP+8], reg_CODE
187         add     reg_LIP, reg_CODE, reg_LIP
188         sub     reg_LIP, OTHER_POINTER_LOWTAG, reg_LIP
189
190         /* No longer atomic. */
191         sub     reg_ALLOC, 4, reg_ALLOC
192         andcc   reg_ALLOC, 3, reg_ZERO
193         tne     PSEUDO_ATOMIC_TRAP
194
195         /* Reset the lisp stack. */
196         /* Note: OCFP is in one of the locals, it gets preserved across C. */
197         mov     reg_CFP, reg_CSP
198         mov     reg_OCFP, reg_CFP
199
200         /* And back into lisp. */
201         ret
202         nop
203
204 /* Lisp calling convention. notice the first .byte line.
205  */             
206         .global undefined_tramp
207         FUNCDEF(undefined_tramp)
208         .align  8
209         .byte   0, 0, 0, SIMPLE_FUN_HEADER_WIDETAG
210 undefined_tramp = . + 1
211         .word   undefined_tramp
212         .word   NIL
213         .word   NIL
214         .word   NIL
215         .word   NIL
216         .word   NIL
217
218         b       1f
219         unimp   trap_Cerror
220         .byte   4
221         .byte   UNDEFINED_FUN_ERROR
222         .byte   254, sc_DescriptorReg, 3
223         .align  4
224 1:
225         ld      [reg_FDEFN+FDEFN_RAW_ADDR_OFFSET], reg_CODE
226         jmp     reg_CODE+SIMPLE_FUN_CODE_OFFSET
227         nop
228
229 /* Lisp calling convention. Notice the first .byte line.
230  */             
231         .global closure_tramp
232         FUNCDEF(closure_tramp)
233         .align  8
234         .byte   0, 0, 0, SIMPLE_FUN_HEADER_WIDETAG
235 closure_tramp = . + 1
236         .word   closure_tramp
237         .word   NIL
238         .word   NIL
239         .word   NIL
240         .word   NIL
241         .word   NIL
242
243         ld      [reg_FDEFN+FDEFN_FUN_OFFSET], reg_LEXENV
244         ld      [reg_LEXENV+CLOSURE_FUN_OFFSET], reg_CODE
245         jmp     reg_CODE+SIMPLE_FUN_CODE_OFFSET
246         nop
247
248         .global funcallable_instance_tramp
249         FUNCDEF(funcallable_instance_tramp)
250         .align 8
251         .word SIMPLE_FUN_HEADER_WIDETAG
252 funcallable_instance_tramp = . + 1
253         .word funcallable_instance_tramp
254         .word NIL
255         .word NIL
256         .word NIL
257         .word NIL
258         .word NIL
259
260         ld      [reg_LEXENV+FUNCALLABLE_INSTANCE_FUNCTION_OFFSET], reg_LEXENV
261         ld      [reg_LEXENV+CLOSURE_FUN_OFFSET], reg_CODE
262         jmp     reg_CODE+SIMPLE_FUN_CODE_OFFSET
263         nop
264 /*
265  * Function-end breakpoint magic.
266  */
267
268         .text
269         .align  8
270         .global fun_end_breakpoint_guts
271 fun_end_breakpoint_guts:
272         .word   RETURN_PC_HEADER_WIDETAG
273         b       1f
274         nop
275         mov     reg_CSP, reg_OCFP
276         add     4, reg_CSP, reg_CSP
277         mov     4, reg_NARGS
278         mov     reg_NIL, reg_A1
279         mov     reg_NIL, reg_A2
280         mov     reg_NIL, reg_A3
281         mov     reg_NIL, reg_A4
282         mov     reg_NIL, reg_A5
283 1:
284
285         .global fun_end_breakpoint_trap
286 fun_end_breakpoint_trap:
287         unimp   trap_FunEndBreakpoint
288         b       1b
289         nop
290
291         .global fun_end_breakpoint_end
292 fun_end_breakpoint_end:
293
294         .global sparc_flush_icache
295         FUNCDEF(sparc_flush_icache)
296 sparc_flush_icache:
297         add %o0,%o1,%o2
298 1:      iflush %o0                      ! flush instruction cache
299         add %o0,8,%o0
300         cmp %o0,%o2
301         blt 1b
302         nop
303         retl                            ! return from leaf routine
304         nop
305
306         .global save_context
307         FUNCDEF(save_context)
308 save_context:
309         ta      ST_FLUSH_WINDOWS        ! flush register windows
310         retl                            ! return from leaf routine
311         nop