source: branches/arm/lisp-kernel/arm-macros.s @ 13844

Last change on this file since 13844 was 13844, checked in by gb, 9 years ago

Allow temp/dest to be the same reg in header-length.

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