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

Last change on this file since 15111 was 15111, checked in by gb, 8 years ago

ARM-specific changes, mostly.

When running lisp code (in almost all cases), keep the constant 0.0d0
in the d7 register (and therefore 0.0s0 in s14 and s15). We use d7 as
a vector header when saving non-volatile FPRs on the stack; we
actually only modify s14, so we now restore s14 after it's been used
this way. The value used in the header in lisp and kernel code is
loaded from PC-relative memory, which means that we no longer use
fmsr/fmdrr or similar instructions.

When starting a lisp thread or entering one via a callback, initialize
d7.

This all basically means that we can get 0.0[d|s]0 into an FPR (or
exploit the fact that it's already in one) a bit easier, and that's
generally a good thing. It's an ABI change, which means that the
FASL and image versions (for the ARM port only) changed; new binaries
are included in this commit.

The kernel changes to support the use of d7 are mostly pretty obvious.
In working on them, I noticed that "local labels" and "macro labels"
were in the same namespace, and we were only avoiding conflicts by
accident. For 10 years or so. (I also noticed that GAS doesn't fully
support PC-relative operands, so did that by hand.)

File size: 15.0 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        new_macro_labels()
258        __(extract_lisptag($3,$1))
259        __(cmp $3,#$2)
260        __(beq macro_label(ok))
261        __(uuo_error_reg_not_lisptag(al,$3,$2))
262macro_label(ok):               
263')
264
265define(`trap_unless_list',`
266        __(trap_unless_lisptag_equal($1,tag_list,$2))
267')
268
269define(`trap_unless_fixnum',`
270        __(new_macro_labels())
271        __(test_fixnum($1))
272        __(beq macro_label(ok))
273        __(uuo_error_reg_not_lisptag(al,$1,tag_fixnum))
274macro_label(ok):       
275        ')
276               
277define(`trap_unless_fulltag_equal',`
278        new_macro_labels()
279        __(extract_fulltag($3,$1))
280        __(cmp $3,#$2)
281        __(beq macro_label(ok))
282        __(uuo_error_reg_not_fulltag(al,$1,$2))
283macro_label(ok):       
284')
285       
286define(`trap_unless_typecode_equal',`
287        new_macro_labels()
288        __(extract_typecode($3,$1))
289        __(cmp $3,#$2)
290        __(beq macro_label(ok))
291        __(uuo_error_reg_not_xtype(al,$2))
292macro_label(ok):               
293')
294       
295/* "jump" to the code-vector of the function in nfn. */
296define(`jump_nfn',`
297        __(ldr pc,[nfn,#_function.entrypoint])
298')
299
300/* "call the code-vector of the function in nfn. */
301define(`call_nfn',`
302        __(ldr lr,[nfn,#_function.entrypoint])
303        __(blx lr)
304')
305       
306
307/* "jump" to the function in fnames function cell. */
308define(`jump_fname',`
309        __(ldr nfn,[fname,#symbol.fcell])
310        __(jump_nfn())
311')
312
313/* call the function in fnames function cell. */
314define(`call_fname',`
315        __(ldr nfn,[fname,#symbol.fcell])
316        __(call_nfn())
317')
318
319define(`funcall_nfn',`
320        __(extract_typecode(imm0,nfn))
321        __(cmp imm0,#subtag_symbol)
322        __(moveq fname,nfn)
323        __(ldreq nfn,[fname,#symbol.fcell])
324        __(cmpne imm0,#subtag_function)
325        __(ldreq pc,[nfn,#_function.entrypoint])
326        __(uuo_error_not_callable(al,nfn))
327
328')
329
330/* Save the non-volatile FPRs (d8-d15) in a stack-allocated vector.
331   Clobber d7.  Note that d7/s14 wind up looking like denormalized
332   floats (we effectively load a vector header into d7.)
333*/       
334   
335define(`push_foreign_fprs',`
336        __(b macro_label(next))
337        .align 3
338macro_label(data):     
339        .long make_header(8,subtag_double_float_vector)
340        .long 0
341macro_label(next):
342        __(fldd d7,[pc,#-16])
343        __(fstmfdd sp!,{d7-d15})
344')
345
346/* Save the lisp non-volatile FPRs. These are exactly the same as the foreign
347   FPRs. */
348define(`push_lisp_fprs',`
349        new_macro_labels()
350        __(b macro_label(next))
351macro_label(data):     
352        .long make_header(8,subtag_double_float_vector)
353macro_label(next):
354        __(flds single_float_zero,[pc,#-12])
355        __(fstmfdd sp!,{d7-d15})
356        __(fcpys single_float_zero,s15)
357')
358       
359/* Pop the non-volatile FPRs (d8-d15) from the stack-consed vector
360   on top of the stack.  This loads the vector header
361   into d7 as a side-effect. */
362define(`pop_foreign_fprs',`
363        __(fldmfdd sp!,{d7-d15})
364')
365
366/* Pop the lisp non-volatile FPRs */       
367define(`pop_lisp_fprs',`
368        __(fldmfdd sp!,{d7-d15})
369        __(fcpys single_float_zero,s15)
370')
371
372/* Reload the non-volatile lisp FPRs (d8-d15) from the stack-consed vector
373   on top of the stack, leaving the vector in place.  d7 winds up with
374   a denormalized float in it, if anything cares. */
375define(`restore_lisp_fprs',`
376        __(fldmfdd $1,{d7-d15})
377        __(fcpys single_float_zero,s15)
378')               
379
380/* discard the stack-consed vector which contains a set of 8 non-volatile
381   FPRs. */
382define(`discard_lisp_fprs',`
383        __(add sp,sp,#9*8)
384')                       
385       
386define(`mkcatch',`
387        new_macro_labels()
388        __(push_lisp_fprs())
389        __(build_lisp_frame(imm0))
390        __(movc16(imm0,make_header(catch_frame.element_count,subtag_u32_vector)))
391        __(mov imm1,#catch_frame.element_count<<word_shift)
392        __(dnode_align(imm1,imm1,node_size))
393        __(stack_allocate_zeroed_ivector(imm0,imm1))
394        __(movc16(imm0,make_header(catch_frame.element_count,subtag_catch_frame)))
395        __(movs temp2,fn)
396        __(ldrne temp2,[temp2,_function.codevector])
397        __(ldr temp1,[rcontext,#tcr.last_lisp_frame])
398        __(ldr imm1,[rcontext,#tcr.catch_top])
399        /* imm2 is mvflag */
400        /* arg_z is tag */
401        __(ldr arg_x,[rcontext,#tcr.db_link])
402        __(ldr temp0,[rcontext,#tcr.xframe])
403        __(stmia sp,{imm0,imm1,imm2,arg_z,arg_x,temp0,temp1,temp2})
404        __(add imm0,sp,#fulltag_misc)
405        __(str imm0,[rcontext,#tcr.catch_top])
406        __(add lr,lr,#4)
407')     
408
409
410
411
412define(`stack_align',`((($1)+STACK_ALIGN_MASK)&~STACK_ALIGN_MASK)')
413
414define(`clear_alloc_tag',`
415        __(bic allocptr,allocptr,#fulltagmask)
416')
417
418define(`Cons',`
419        new_macro_labels()
420        __(add allocptr,allocptr,#-cons.size+fulltag_cons)
421        __(ldr allocbase,[rcontext,#tcr.save_allocbase])
422        __(cmp allocptr,allocbase)
423        __(bhi macro_label(ok))
424        __(uuo_alloc_trap(al))
425macro_label(ok):               
426        __(str $3,[allocptr,#cons.cdr])
427        __(str $2,[allocptr,#cons.car])
428        __(mov $1,allocptr)
429        __(clear_alloc_tag())
430')
431
432
433/* This is probably only used once or twice in the entire kernel, but */
434/* I wanted a place to describe the constraints on the mechanism. */
435
436/* Those constaints are (not surprisingly) similar to those which apply */
437/* to cons cells, except for the fact that the header (and any length */
438/* field that might describe large arrays) has to have been stored in */
439/* the object if the trap has succeeded on entry to the GC.  It follows */
440/* that storing the register containing the header must immediately */
441/* follow the allocation trap (and an auxiliary length register must */
442/* be stored immediately after the header.)  Successfully falling */
443/* through the trap must emulate any header initialization: it would */
444/* be a bad idea to have allocptr pointing to a zero header ... */
445
446
447
448/* Parameters: */
449
450/* $1 = dest reg */
451/* $2 = header.
452/* $3 = register containing size in bytes.  (We're going to subtract */
453/* fulltag_misc from this; do it in the macro body, rather than force the
454/* (1 ?) caller to do it. */
455
456
457define(`Misc_Alloc',`
458        new_macro_labels()
459        __(sub $3,$3,#fulltag_misc)
460        __(sub allocptr,allocptr,$3)
461        __(ldr allocbase,[rcontext,#tcr.save_allocbase])
462        __(cmp allocptr,allocbase)
463        __(bhi macro_label(ok))
464        __(uuo_alloc_trap(al))
465macro_label(ok):               
466        __(str $2,[allocptr,#misc_header_offset])
467        __(mov $1,allocptr)
468        __(clear_alloc_tag())
469')
470
471/*  Parameters $1, $2 as above; $3 = physical size constant. */
472define(`Misc_Alloc_Fixed',`
473        new_macro_labels()
474        __(add allocptr,allocptr,#(-$3)+fulltag_misc)
475        __(ldr allocbase,[rcontext,#tcr.save_allocbase])
476        __(cmp allocptr,allocbase)
477        __(bhi macro_label(ok))
478        __(uuo_alloc_trap(al))
479macro_label(ok):               
480        __(str $2,[allocptr,#misc_header_offset])
481        __(mov $1,allocptr)
482        __(clear_alloc_tag())
483')
484
485/* Stack-allocate an ivector; $1 = header, $0 = dnode-aligned
486   size in bytes. */
487define(`stack_allocate_ivector',`
488        __(str $1,[sp,-$2]!)
489        ')
490       
491                       
492/* Stack-allocate an ivector and zero its contents; caller may
493   change subtag of header after it's zeroed.
494   $1 = header (tagged as subtag_u32_vector until zeroed), $2 = dnode-
495   aligned size in bytes).  Both $1 and $2 are modified here. */
496define(`stack_allocate_zeroed_ivector',`
497       new_macro_labels()
498        __(str $1,[sp,-$2]!)
499        __(mov $1,#0)
500        __(add $2,sp,$2)
501        __(b macro_label(test))
502macro_label(loop):     
503        __(str $1,[$2])
504macro_label(test):                     
505        __(sub $2,#dnode_size)
506        __(cmp $2,sp)
507        __(str $1,[$2,#node_size])
508        __(bne macro_label(loop))
509        ')
510   
511
512define(`check_enabled_pending_interrupt',`
513        __(ldr $1,[rcontext,#tcr.interrupt_pending])
514        __(cmp $1,0)
515        __(ble $2)
516        __(uuo_interrupt_now(al))
517        ')
518       
519define(`check_pending_interrupt',`
520        new_macro_labels()
521        __(ldr $1,[rcontext,#tcr.tlb_pointer])
522        __(ldr $1,[$1,$INTERRUPT_LEVEL_BINDING_INDEX])
523        __(cmp $1,#0)
524        __(blt macro_label(done))
525        __(check_enabled_pending_interrupt($1,macro_label(done)))
526macro_label(done):
527')
528
529/* $1 = ndigits.  Assumes 4-byte digits */       
530define(`aligned_bignum_size',`((~(dnode_size-1)&(node_size+(dnode_size-1)+(4*$1))))')
531
532define(`suspend_now',`
533        __(uuo_suspend_now(al))
534')
535
536/* $3 points to a uvector header.  Set $1 to the first dnode-aligned address */
537/* beyond the uvector, using imm regs $1 and $2 as temporaries. */
538define(`skip_stack_vector',`
539        new_macro_labels()
540        __(ldr $1,[$3])
541        __(extract_fulltag($2,$1))       
542        __(cmp $2,#fulltag_immheader)
543        __(extract_lowbyte($2,$1))
544        __(mov $1,$1,lsr #num_subtag_bits)
545        __(moveq $1,$1,lsl #2)
546        __(beq macro_label(bytes))
547        __(cmp $2,#max_32_bit_ivector_subtag)
548        __(movle $1,$1,lsl #2)
549        __(ble macro_label(bytes))
550        __(cmp $2,#max_8_bit_ivector_subtag)
551        __(ble macro_label(bytes))
552        __(cmp $2,#max_16_bit_ivector_subtag)
553        __(movle $1,$1,lsl #1)
554        __(ble macro_label(bytes))
555        __(cmp $2,subtag_double_float_vector)
556        __(moveq $1,$1,lsl #3)
557        __(addeq $1,$1,#4)
558        __(beq macro_label(bytes))
559        __(add $1,$1,#7)
560        __(mov $1,$1,lsr #3)
561macro_label(bytes):     
562        __(add $1,$1,#node_size+(dnode_size-1))
563        __(bic $1,$1,#fulltagmask)
564        __(add $1,$1,$3)
565        ')
566
567/* This may need to be inlined.  $1=link, $2=saved sym idx, $3 = tlb, $4 = value */
568define(`do_unbind_to',`
569        __(ldr $1,[rcontext,#tcr.db_link])
570        __(ldr $3,[rcontext,#tcr.tlb_pointer])
5711:      __(ldr $2,[$1,#binding.sym])
572        __(ldr $4,[$1,#binding.val])
573        __(ldr $1,[$1,#binding.link])
574        __(cmp imm0,$1)
575        __(str $4,[$3,$2])
576        __(bne 1b)
577        __(str $1,[rcontext,#tcr.db_link])
578        ')               
579
Note: See TracBrowser for help on using the repository browser.