/[cmucl]/src/lisp/alpha-assem.S
ViewVC logotype

Contents of /src/lisp/alpha-assem.S

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6.2.1 - (show annotations)
Tue Jun 23 11:24:48 1998 UTC (15 years, 9 months ago) by pw
Branch: RELENG_18
CVS Tags: RELEASE_18b
Changes since 1.6: +2 -2 lines
This (huge) revision brings the RELENG_18 branch up to the current HEAD.
Note code/unix-glib2.lisp not yet included -- not sure it is ready to go.
1 /* $Header: /tiger/var/lib/cvsroots/cmucl/src/lisp/alpha-assem.S,v 1.6.2.1 1998/06/23 11:24:48 pw Exp $ */
2 #include <machine/regdef.h>
3 #include <machine/pal.h>
4
5 #include "internals.h"
6 #include "lispregs.h"
7
8 /*
9 * Function to transfer control into lisp.
10 */
11 .text
12 .align 4
13 .globl call_into_lisp
14 .ent call_into_lisp
15 call_into_lisp:
16 #define framesize 8*8
17 ldgp gp, 0($27) /* ### */
18 /* Save all the C regs. */
19 lda sp,-framesize(sp)
20 stq ra, framesize-8*8(sp)
21 stq s0, framesize-8*7(sp)
22 stq s1, framesize-8*6(sp)
23 stq s2, framesize-8*5(sp)
24 stq s3, framesize-8*4(sp)
25 stq s4, framesize-8*3(sp)
26 stq s5, framesize-8*2(sp)
27 stq s6, framesize-8*1(sp)
28 .mask 0x0fc001fe, -framesize
29 .frame sp,framesize,ra
30
31 /* Clear descriptor regs */
32 ldil reg_CODE,0
33 ldil reg_FDEFN,0
34 mov a0,reg_LEXENV
35 sll a2,2,reg_NARGS
36 ldil reg_OCFP,0
37 ldil reg_LRA,0
38 ldil reg_L0,0
39 ldil reg_L1,0
40
41
42 /* Establish NIL. */
43 ldil reg_NULL,NIL
44
45 /* Start pseudo-atomic. */
46
47 /* No longer in foreign call. */
48 stl zero,foreign_function_call_active
49
50 /* Load lisp state. */
51 ldl reg_ALLOC,current_dynamic_space_free_pointer
52 ldl reg_BSP,current_binding_stack_pointer
53 ldl reg_CSP,current_control_stack_pointer
54 ldl reg_OCFP,current_control_frame_pointer
55 mov a1,reg_CFP
56
57 .set noat
58 ldil reg_L2,0
59 /* End of pseudo-atomic. */
60
61 /* Establish lisp arguments. */
62 ldl reg_A0,0(reg_CFP)
63 ldl reg_A1,4(reg_CFP)
64 ldl reg_A2,8(reg_CFP)
65 ldl reg_A3,12(reg_CFP)
66 ldl reg_A4,16(reg_CFP)
67 ldl reg_A5,20(reg_CFP)
68
69 /* Calculate the LRA. */
70 lda reg_LRA,call_into_lisp_LRA_page+type_OtherPointer
71
72 /* Indirect the closure */
73 ldl reg_CODE,CLOSURE_FUNCTION_OFFSET(reg_LEXENV)
74 addl reg_CODE,6*4-type_FunctionPointer,reg_LIP
75
76 /* And into lisp we go. */
77 jsr reg_ZERO,(reg_LIP)
78
79 .set noreorder
80 .align 3
81 .globl call_into_lisp_LRA
82 call_into_lisp_LRA:
83
84 .long type_ReturnPcHeader
85
86 mov reg_OCFP,reg_CSP
87 nop
88
89 /* return value already there */
90 mov reg_A0,v0
91
92 /* Turn on pseudo-atomic. */
93
94 /* Save LISP registers */
95 stl reg_ALLOC,current_dynamic_space_free_pointer
96 stl reg_BSP,current_binding_stack_pointer
97 stl reg_CSP,current_control_stack_pointer
98 stl reg_CFP,current_control_frame_pointer
99
100 /* Back in C land. [CSP is just a handy non-zero value.] */
101 stl reg_CSP,foreign_function_call_active
102
103 /* Turn off pseudo-atomic and check for traps. */
104
105 /* Restore C regs */
106 ldq ra, framesize-8*8(sp)
107 ldq s0, framesize-8*7(sp)
108 ldq s1, framesize-8*6(sp)
109 ldq s2, framesize-8*5(sp)
110 ldq s3, framesize-8*4(sp)
111 ldq s4, framesize-8*3(sp)
112 ldq s5, framesize-8*2(sp)
113 ldq s6, framesize-8*1(sp)
114
115 /* Restore the C stack! */
116 lda sp, framesize(sp)
117
118 ret zero,(ra),1
119 .globl call_into_lisp_end
120 call_into_lisp_end:
121 .end call_into_lisp
122
123 /*
124 * Transfering control from Lisp into C
125 */
126 .set noreorder
127 .text
128 .align 4
129 .globl call_into_c
130 .ent call_into_c
131 call_into_c:
132 .mask 0x0fc001fe, -12
133 .frame sp,12,ra
134 mov reg_CFP, reg_OCFP
135 mov reg_CSP, reg_CFP
136 addq reg_CFP, 32, reg_CSP
137 stl reg_OCFP, 0(reg_CFP)
138 subl reg_LIP, reg_CODE, reg_L1
139 addl reg_L1, type_OtherPointer, reg_L1
140 stl reg_L1, 4(reg_CFP)
141 stl reg_CODE, 8(reg_CFP)
142 stl reg_NULL, 12(reg_CFP)
143
144 /* Set the pseudo-atomic flag. */
145 addq reg_ALLOC,1,reg_ALLOC
146
147 /* Get the top two register args and fix the NSP to point to arg 7 */
148 ldq reg_NL4,0(reg_NSP)
149 ldq reg_NL5,8(reg_NSP)
150 addq reg_NSP,16,reg_NSP
151
152 /* Save lisp state. */
153 subq reg_ALLOC,1,reg_L1
154 stl reg_L1, current_dynamic_space_free_pointer
155 stl reg_BSP, current_binding_stack_pointer
156 stl reg_CSP, current_control_stack_pointer
157 stl reg_CFP, current_control_frame_pointer
158
159 /* Mark us as in C land. */
160 stl reg_CSP, foreign_function_call_active
161
162 /* Were we interrupted? */
163 subq reg_ALLOC,1,reg_ALLOC
164 stl reg_ZERO,0(reg_ALLOC)
165
166 /* Into C land we go. */
167 mov reg_CFUNC, reg_L1 /* ### This line is a mystery */
168 jsr ra, (reg_CFUNC)
169 ldgp $29,0(ra)
170
171 /* restore NSP */
172 subq reg_NSP,16,reg_NSP
173
174 /* Clear unsaved descriptor regs */
175 mov reg_ZERO, reg_NARGS
176 mov reg_ZERO, reg_A0
177 mov reg_ZERO, reg_A1
178 mov reg_ZERO, reg_A2
179 mov reg_ZERO, reg_A3
180 mov reg_ZERO, reg_A4
181 mov reg_ZERO, reg_A5
182 mov reg_ZERO, reg_L0
183 mov reg_ZERO, reg_L2
184
185 /* Turn on pseudo-atomic. */
186 lda reg_ALLOC,1(reg_ZERO)
187
188 /* Mark us at in Lisp land. */
189 stl reg_ZERO, foreign_function_call_active
190
191 /* Restore ALLOC, preserving pseudo-atomic-atomic */
192 ldl reg_NL0,current_dynamic_space_free_pointer
193 addq reg_ALLOC,reg_NL0,reg_ALLOC
194
195 /* Check for interrupt */
196 subq reg_ALLOC,1,reg_ALLOC
197 stl reg_ZERO,0(reg_ALLOC)
198
199 ldl reg_NULL, 12(reg_CFP)
200
201 /* Restore LRA & CODE (they may have been GC'ed) */
202 ldl reg_CODE, 8(reg_CFP)
203 ldl reg_NL0, 4(reg_CFP)
204 subq reg_NL0, type_OtherPointer, reg_NL0
205 addq reg_CODE, reg_NL0, reg_NL0
206
207 mov reg_CFP, reg_CSP
208 mov reg_OCFP, reg_CFP
209
210 ret zero, (reg_NL0), 1
211
212 .end call_into_c
213
214 .text
215 .globl start_of_tramps
216 start_of_tramps:
217
218 /*
219 * The undefined-function trampoline.
220 */
221 .text
222 .globl undefined_tramp
223 .ent undefined_tramp_offset
224 undefined_tramp = /* ### undefined_tramp_offset-call_into_lisp_LRA*/ 0x140+call_into_lisp_LRA_page
225 undefined_tramp_offset:
226 call_pal PAL_gentrap
227 .long 10
228 .byte 4
229 .byte 23
230 .byte 254
231 .byte (0xe0 + sc_DescriptorReg)
232 .byte 2
233 .align 2
234 .end undefined_tramp
235
236
237 /*
238 * The closure trampoline.
239 */
240 .text
241 .globl closure_tramp
242 .ent closure_tramp_offset
243 closure_tramp = /* ### */ 0x150 + call_into_lisp_LRA_page
244 closure_tramp_offset:
245 ldl reg_LEXENV, FDEFN_FUNCTION_OFFSET(reg_FDEFN)
246 ldl reg_L0, CLOSURE_FUNCTION_OFFSET(reg_LEXENV)
247 addl reg_L0, FUNCTION_CODE_OFFSET, reg_LIP
248 jmp reg_ZERO,(reg_LIP)
249 .end closure_tramp
250
251 .text
252 .globl end_of_tramps
253 end_of_tramps:
254
255
256 /*
257 * Function-end breakpoint magic.
258 */
259
260 .text
261 .align 2
262 .set noreorder
263 .globl function_end_breakpoint_guts
264 function_end_breakpoint_guts:
265 .long type_ReturnPcHeader
266 br zero, function_end_breakpoint_trap
267 nop
268 mov reg_CSP, reg_OCFP
269 addl reg_CSP, 4, reg_CSP
270 addl zero, 4, reg_NARGS
271 mov reg_NULL, reg_A1
272 mov reg_NULL, reg_A2
273 mov reg_NULL, reg_A3
274 mov reg_NULL, reg_A4
275 mov reg_NULL, reg_A5
276 1:
277
278 .globl function_end_breakpoint_trap
279 function_end_breakpoint_trap:
280 call_pal PAL_gentrap
281 .long trap_FunctionEndBreakpoint
282 br zero, function_end_breakpoint_trap
283
284 .globl function_end_breakpoint_end
285 function_end_breakpoint_end:
286
287

  ViewVC Help
Powered by ViewVC 1.1.5