source: release/1.9/source/lisp-kernel/arm-macros.s @ 16083

Last change on this file since 16083 was 15425, checked in by gb, 7 years ago

armcl. armcl.image: new binaries
compiler/ARM/arm-arch.lisp: add tcr.architecture-version. Bump fasl version,

image version.

compiler/ARM/arm-asm.lisp: don't define ARMv7-specific instructions.
compiler/ARM/arm-lap.lisp: new :opcode directive, assembles arbitrary word

in code section.

compiler/ARM/arm-lapmacros.lisp: don't use v7-specific instructions. Define

clrex, dmb as macros which test architecture version at runtime. Remove
some unused things.

compiler/ARM/arm-vinsns.lisp: don't use v7-specific instructions. Remove

some more unused things.

compiler/ARM/arm2.lisp: Remove still more unused things.
level-0/ARM/arm-bignum.lisp: don't use v7-specific instructions.
level-0/l0-cfm-support.lisp: hack to try to avoid treating dynamic linker

as a shared library on Linux. (Different dynamic linkers are used for
softfp/hard float on ARM; we don't a saved image to try to re-open the
wrong one.

level-1/arm-callback-support.lisp: don't use movw instruction in callback

trampolines.

lisp-kernel/arm-asmutils.s: don't use v7-specific instructions (unless we're

sure that we're on v7 or later.)

lisp-kernel/arm-constants.h: tcr.architecture_version. Bump image version.

Define ARM CPU architecture constants.

lisp-kernel/arm-constants.s: tcr.architecture_version.
lisp-kernel/arm-macros.s: define _clrex and _dmb macros which test

tcr.arm_architecture_version at runtime.

lisp-kernel/arm-spentry.s: use _clrex macro. In _SPcheck_fpu_exception,

look for offending instuction 4 bytes further before lr (change in
subprim call mechanism.)

lisp-kernel/linuxarm/Makefile: compile/assemble for ARMv6.
lisp-kernel/lisp_globals.s: don't need to define NUM_LISP_GLOBALS anymore.
lisp-kernel/pmcl-kernel.c: check_arm_cpu() accepts ARMv6 or later.
lisp-kernel/thread-manager.c: when creating a TCR on ARM, set

tcr.architecture_version to fixnum representation of architecture - 7 (so
ARMv6 is -1, ARMv7 is 0, etc.)

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