source: trunk/source/lisp-kernel/arm-macros.s @ 14261

Last change on this file since 14261 was 14169, checked in by gb, 10 years ago

Lots more changes, most of which have to do with Mach exception handling
on ARM.

File size: 12.6 KB
Line 
1/*   Copyright (C) 2009 Clozure Associates */
2/*   Copyright (C) 1994-2001 Digitool, Inc */
3/*   This file is part of Clozure CL.  */
4
5/*   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public */
6/*   License , known as the LLGPL and distributed with Clozure CL as the */
7/*   file "LICENSE".  The LLGPL consists of a preamble and the LGPL, */
8/*   which is distributed with Clozure CL as the file "LGPL".  Where these */
9/*   conflict, the preamble takes precedence.   */
10
11/*   Clozure CL is referenced in the preamble as the "LIBRARY." */
12
13/*   The LLGPL is also available online at */
14/*   http://opensource.franz.com/preamble.html */
15
16
17
18
19
20/* dnode_align(dest,src,delta) */
21        define(`dnode_align',`
22        __(add $1,$2,#$3+(dnode_size-1))
23        __(bic $1,$1,#((1<<dnode_align_bits)-1))
24')
25
26define(`make_header',`(($1<<num_subtag_bits)|($2&subtag_mask))')
27       
28/* Load a 16-bit constant into $1 */
29define(`movc16',`
30        __ifdef(`DARWIN')
31        __(mov $1,#$2&0xff)
32        __(orr $1,$1,#$2&0xff00)
33        __else
34        __(movw $1,#$2)
35        __endif
36        ')
37       
38define(`test_fixnum',`
39        __(tst $1,#fixnummask)
40        ')
41       
42define(`test_two_fixnums',`
43        __(orr $3,$1,$2)
44        __(test_fixnum($3))
45        ')
46               
47define(`extract_fulltag',`
48        __(and $1,$2,#fulltagmask)
49        ')
50
51define(`extract_lisptag',`
52        __(and $1,$2,#tagmask)
53        ')
54
55define(`extract_lisptag_',`
56        __(ands $1,$1,#tagmask)
57        ')
58
59define(`extract_subtag',`
60        __(ldrb $1,[$2,#misc_subtag_offset])
61        ')
62
63                               
64define(`extract_lowbyte',`
65        __(and $1,$2,#((1<<num_subtag_bits)-1))
66        ')
67
68define(`extract_header',`
69        __(ldr $1,[$2,#misc_header_offset])
70        ')
71
72define(`extract_typecode',`
73        __(extract_lisptag($1,$2))
74        __(cmp $1,#tag_misc)
75        __(ldrbeq $1,[$2,#misc_subtag_offset])
76        ')
77
78define(`box_fixnum',`
79        __(mov $1,$2, lsl #fixnumshift)
80        ')
81
82define(`unbox_fixnum',`
83        __(mov $1,$2, asr #fixnumshift)
84        ')
85
86define(`unbox_character',`
87        __(mov $1,$2, lsr #charcode_shift)
88        ')
89               
90define(`loaddf',`
91        __(lfd $1,dfloat.value($2))')
92       
93define(`storedf',`
94        __(stfd $1,dfloat.value($2))
95        ')
96
97define(`push1',`
98        __(str $1,[$2,#-node_size]!)
99        ')
100       
101        /* Generally not a great idea. */
102define(`pop1',`
103        __(ldr $1,[$2],#node_size)
104        ')
105       
106define(`vpush1',`
107        __(push1($1,vsp))
108        ')
109       
110define(`vpop1',`
111        __(pop1($1,vsp))
112        ')
113       
114               
115define(`unlink',`
116        __(ldr($1,0($1)))
117 ')
118
119       
120define(`set_nargs',`
121        __(mov nargs,#($1)<<fixnumshift)
122        ')
123       
124define(`bitclr',`
125        __(rlwinm $1,$2,0,0x1f&((31-($3))+1),0x1f&((31-($3))-1))
126        ')
127       
128
129define(`vref32',`
130        __(ldr $1,[$2,#misc_data_offset+(($3)<<2)])
131        ')
132       
133define(`vref16',`/* dest,src,n*/
134        __(lhz $1,misc_data_offset+(($3)<<1)($2))
135        ')
136       
137define(`vrefr',`
138        __(vref32($1,$2,$3))
139        ')
140
141
142       
143                       
144define(`getvheader',`
145        __(ldr $1,[$2,#vector.header])
146        ')
147       
148       
149        /* "Length" is fixnum element count */
150define(`header_length',`
151        __(bic $1,$2,#subtag_mask)
152        __(mov $1,$1,lsr #num_subtag_bits-fixnumshift)
153        ')
154
155
156
157define(`vector_length',`
158        __(getvheader($3,$2))
159        __(header_length($1,$3))
160        ')
161
162       
163define(`ref_global',`
164        __(mov ifelse($3,`',$1,$3),#nil_value)
165        __(ldr $1,[ifelse($3,`',$1,$3),#lisp_globals.$2])
166')
167
168
169define(`ref_nrs_value',`
170        __(mov $1,#nil_value)
171        __(ldr $1,[$1,#((nrs.$2)+(symbol.vcell))])
172')
173
174define(`ref_nrs_symbol',`
175        __(movc16($3,nrs.$2))
176        __(add $1,$3,#nil_value)
177        ')
178       
179define(`set_nrs_value',`
180        __(str($1,((nrs.$2)+(symbol.vcell))(0)))
181')
182
183
184        /* vpop argregs - nargs is known to be non-zero */
185define(`vpop_argregs_nz',`
186        __(cmp nargs,#node_size*2)
187        __(vpop1(arg_z))
188        __(ldrhs arg_y,[vsp],#node_size)
189        __(ldrhi arg_x,[vsp],#node_size)
190        ')
191
192               
193        /* vpush argregs */
194define(`vpush_argregs',`
195        new_macro_labels()
196        __(cmp nargs,#0)
197        __(beq macro_label(done))
198        __(cmp nargs,#node_size*2)
199        __(strhi arg_x,[vsp,#-node_size]!)
200        __(strhs arg_y,[vsp,#-node_size]!)
201        __(str arg_z,[vsp,#-node_size]!)
202macro_label(done):
203')
204
205define(`vpush_all_argregs',`
206        __(stmdb vsp!,{arg_z,arg_y,arg_x})
207        ')
208
209define(`vpop_all_argregs',`
210        __(ldmia vsp!,{arg_z,arg_y,arg_x})
211        ')
212                       
213               
214
215/* $1 = arg/temp reg for lisp_frame_marker, $2 = value for lisp_frame.savevsp */               
216define(`build_lisp_frame',`
217        __(mov $1,#lisp_frame_marker)
218        __(stmdb sp!,{$1,ifelse($2,`',vsp,$2),fn,lr})
219')
220
221/* This has the odd side effect of loading lisp_frame_marker into
222   the arg/temp/imm reg $1.  I think that that's probably better
223   than adjusting sp and loading the other regs ; it'd be good
224   to say (at interrupt time) that there's either a lisp frame
225   on the stack or there isn't. */
226define(`restore_lisp_frame',`
227        __(ldm sp!,{$1,vsp,fn,lr})
228        ')
229
230define(`return_lisp_frame',`
231        __(ldm sp!,{$1,vsp,fn,pc})
232        ')
233       
234define(`discard_lisp_frame',`
235        __(add sp,sp,#lisp_frame.size)
236        ')
237       
238       
239define(`_car',`
240        __(ldr $1,[$2,#cons.car])
241')
242       
243define(`_cdr',`
244        __(ldr $1,[$2,#cons.cdr])
245        ')
246       
247define(`_rplaca',`
248        __(str $2,[$1,#cons.car])
249        ')
250       
251define(`_rplacd',`
252        __(str $2,[$1,#cons.cdr])
253        ')
254
255
256define(`trap_unless_lisptag_equal',`
257        __(extract_lisptag($3,$1))
258        __(cmp $3,#$2)
259        __(uuo_error_reg_not_lisptag(ne,$3,$2))
260')
261
262define(`trap_unless_list',`
263        __(trap_unless_lisptag_equal($1,tag_list,$2))
264')
265
266define(`trap_unless_fixnum',`
267        __(test_fixnum($1))
268        __(uuo_error_reg_not_lisptag(ne,$1,tag_fixnum))
269        ')
270               
271define(`trap_unless_fulltag_equal',`
272        __(extract_fulltag($3,$1))
273        __(cmp $3,#$2)
274        __(uuo_error_reg_not_fulltag(ne,$1,$2))
275')
276       
277define(`trap_unless_typecode_equal',`
278        __(extract_typecode($3,$1))
279        __(cmp $3,#$2)
280        __(uuo_error_reg_not_xtype(ne,$2))
281')
282       
283/* "jump" to the code-vector of the function in nfn. */
284define(`jump_nfn',`
285        __(ldr pc,[nfn,#_function.entrypoint])
286')
287
288/* "call the code-vector of the function in nfn. */
289define(`call_nfn',`
290        __(ldr lr,[nfn,#_function.entrypoint])
291        __(blx lr)
292')
293       
294
295/* "jump" to the function in fnames function cell. */
296define(`jump_fname',`
297        __(ldr nfn,[fname,#symbol.fcell])
298        __(jump_nfn())
299')
300
301/* call the function in fnames function cell. */
302define(`call_fname',`
303        __(ldr nfn,[fname,#symbol.fcell])
304        __(call_nfn())
305')
306
307define(`funcall_nfn',`
308        __(extract_typecode(imm0,nfn))
309        __(cmp imm0,#subtag_symbol)
310        __(moveq fname,nfn)
311        __(ldreq nfn,[fname,#symbol.fcell])
312        __(cmpne imm0,#subtag_function)
313        __(ldreq pc,[nfn,#_function.entrypoint])
314        __(uuo_error_not_callable(ne,nfn))
315
316')
317
318
319define(`mkcatch',`
320        new_macro_labels()
321        __(build_lisp_frame(imm0))
322        __(movc16(imm0,make_header(catch_frame.element_count,subtag_catch_frame)))
323        __(movs temp2,fn)
324        __(ldrne temp2,[temp2,_function.codevector])
325        __(ldr temp1,[rcontext,#tcr.last_lisp_frame])
326        __(ldr imm1,[rcontext,#tcr.catch_top])
327        /* imm2 is mvflag */
328        /* arg_z is tag */
329        __(ldr arg_x,[rcontext,#tcr.db_link])
330        __(ldr temp0,[rcontext,#tcr.xframe])
331        __(stmdb sp!,{imm0,imm1,imm2,arg_z,arg_x,temp0,temp1,temp2})
332        __(add imm0,sp,#fulltag_misc)
333        __(str imm0,[rcontext,#tcr.catch_top])
334        __(add lr,lr,#4)
335')     
336
337
338       
339define(`check_stack_alignment',`
340        new_macro_labels()
341        __(andi. $1,sp,STACK_ALIGN_MASK)
342        __(beq+ macro_label(stack_ok))
343        __(.long 0)
344macro_label(stack_ok):
345')
346
347define(`stack_align',`((($1)+STACK_ALIGN_MASK)&~STACK_ALIGN_MASK)')
348
349define(`clear_alloc_tag',`
350        __(bic allocptr,allocptr,#fulltagmask)
351')
352
353define(`Cons',`
354        __(add allocptr,allocptr,#-cons.size+fulltag_cons)
355        __(ldr allocbase,[rcontext,#tcr.save_allocbase])
356        __(cmp allocptr,allocbase)
357        __(uuo_alloc_trap(lo))
358        __(str $3,[allocptr,#cons.cdr])
359        __(str $2,[allocptr,#cons.car])
360        __(mov $1,allocptr)
361        __(clear_alloc_tag())
362')
363
364
365/* This is probably only used once or twice in the entire kernel, but */
366/* I wanted a place to describe the constraints on the mechanism. */
367
368/* Those constaints are (not surprisingly) similar to those which apply */
369/* to cons cells, except for the fact that the header (and any length */
370/* field that might describe large arrays) has to have been stored in */
371/* the object if the trap has succeeded on entry to the GC.  It follows */
372/* that storing the register containing the header must immediately */
373/* follow the allocation trap (and an auxiliary length register must */
374/* be stored immediately after the header.)  Successfully falling */
375/* through the trap must emulate any header initialization: it would */
376/* be a bad idea to have allocptr pointing to a zero header ... */
377
378
379
380/* Parameters: */
381
382/* $1 = dest reg */
383/* $2 = header.
384/* $3 = register containing size in bytes.  (We're going to subtract */
385/* fulltag_misc from this; do it in the macro body, rather than force the
386/* (1 ?) caller to do it. */
387
388
389define(`Misc_Alloc',`
390        __(sub $3,$3,#fulltag_misc)
391        __(sub allocptr,allocptr,$3)
392        __(ldr allocbase,[rcontext,#tcr.save_allocbase])
393        __(cmp allocptr,allocbase)
394        __(uuo_alloc_trap(lo))
395        __(str $2,[allocptr,#misc_header_offset])
396        __(mov $1,allocptr)
397        __(clear_alloc_tag())
398')
399
400/*  Parameters $1, $2 as above; $3 = physical size constant. */
401define(`Misc_Alloc_Fixed',`
402        __(add allocptr,allocptr,#(-$3)+fulltag_misc)
403        __(ldr allocbase,[rcontext,#tcr.save_allocbase])
404        __(cmp allocptr,allocbase)
405        __(uuo_alloc_trap(lo))
406        __(str $2,[allocptr,#misc_header_offset])
407        __(mov $1,allocptr)
408        __(clear_alloc_tag())
409')
410
411/* Stack-allocate an ivector; $1 = header, $0 = dnode-aligned
412   size in bytes. */
413define(`stack_allocate_ivector',`
414        __(str $1,[sp,-$2]!)
415        ')
416       
417                       
418/* Stack-allocate an ivector and zero its contents; caller may
419   change subtag of header after it's zeroed.
420   $1 = header (tagged as subtag_u32_vector until zeroed), $2 = dnode-
421   aligned size in bytes).  Both $1 and $2 are modified here. */
422define(`stack_allocate_zeroed_ivector',`
423       new_macro_labels()
424        __(str $1,[sp,-$2]!)
425        __(mov $1,#0)
426        __(add $2,sp,$2)
427        __(b macro_label(test))
428macro_label(loop):     
429        __(str $1,[$2])
430macro_label(test):                     
431        __(sub $2,#dnode_size)
432        __(cmp $2,sp)
433        __(str $1,[$2,#node_size])
434        __(bne macro_label(loop))
435        ')
436   
437
438define(`check_enabled_pending_interrupt',`
439        __(ldr $1,[rcontext,#tcr.interrupt_pending])
440        __(cmp $1,0)
441        __(uuo_interrupt_now(gt))
442        ')
443       
444define(`check_pending_interrupt',`
445        new_macro_labels()
446        __(ldr $1,[rcontext,#tcr.tlb_pointer])
447        __(ldr $1,[$1,$INTERRUPT_LEVEL_BINDING_INDEX])
448        __(cmp $1,#0)
449        __(blt macro_label(done))
450        __(check_enabled_pending_interrupt($1))
451macro_label(done):
452')
453
454/* $1 = ndigits.  Assumes 4-byte digits */       
455define(`aligned_bignum_size',`((~(dnode_size-1)&(node_size+(dnode_size-1)+(4*$1))))')
456
457define(`suspend_now',`
458        __(uuo_suspend_now(al))
459')
460
461/* $3 points to a uvector header.  Set $1 to the first dnode-aligned address */
462/* beyond the uvector, using imm regs $1 and $2 as temporaries. */
463define(`skip_stack_vector',`
464        new_macro_labels()
465        __(ldr $1,[$3])
466        __(extract_fulltag($2,$1))       
467        __(cmp $2,#fulltag_immheader)
468        __(extract_lowbyte($2,$1))
469        __(mov $1,$1,lsr #num_subtag_bits)
470        __(moveq $1,$1,lsl #2)
471        __(beq macro_label(bytes))
472        __(cmp $2,#max_32_bit_ivector_subtag)
473        __(movle $1,$1,lsl #2)
474        __(ble macro_label(bytes))
475        __(cmp $2,#max_8_bit_ivector_subtag)
476        __(ble macro_label(bytes))
477        __(cmp $2,#max_16_bit_ivector_subtag)
478        __(movle $1,$1,lsl #1)
479        __(ble macro_label(bytes))
480        __(cmp $2,subtag_double_float_vector)
481        __(moveq $1,$1,lsl #3)
482        __(addeq $1,$1,#4)
483        __(beq macro_label(bytes))
484        __(add $1,$1,#7)
485        __(mov $1,$1,lsr #3)
486macro_label(bytes):     
487        __(add $1,$1,#node_size+(dnode_size-1))
488        __(bic $1,$1,#fulltagmask)
489        __(add $1,$1,$3)
490        ')
491
492/* This may need to be inlined.  $1=link, $2=saved sym idx, $3 = tlb, $4 = value */
493define(`do_unbind_to',`
494        __(ldr $1,[rcontext,#tcr.db_link])
495        __(ldr $3,[rcontext,#tcr.tlb_pointer])
4961:      __(ldr $2,[$1,#binding.sym])
497        __(ldr $4,[$1,#binding.val])
498        __(ldr $1,[$1,#binding.link])
499        __(cmp imm0,$1)
500        __(str $4,[$3,$2])
501        __(bne 1b)
502        __(str $1,[rcontext,#tcr.db_link])
503        ')               
504
Note: See TracBrowser for help on using the repository browser.