source: rtems/c/src/lib/libbsp/sparc/shared/irq_asm.S @ 1045422

4.115
Last change on this file since 1045422 was 1045422, checked in by Sebastian Huber <sebastian.huber@…>, on 05/26/15 at 08:02:27

bsps/sparc: Delete unused local labels

  • Property mode set to 100644
File size: 25.2 KB
Line 
1/*  cpu_asm.s
2 *
3 *  This file contains the basic algorithms for all assembly code used
4 *  in an specific CPU port of RTEMS.  These algorithms must be implemented
5 *  in assembly language.
6 *
7 *  COPYRIGHT (c) 1989-2011.
8 *  On-Line Applications Research Corporation (OAR).
9 *
10 *  Copyright (c) 2014 embedded brains GmbH
11 *
12 *  The license and distribution terms for this file may be
13 *  found in the file LICENSE in this distribution or at
14 *  http://www.rtems.org/license/LICENSE.
15 *
16 *  Ported to ERC32 implementation of the SPARC by On-Line Applications
17 *  Research Corporation (OAR) under contract to the European Space
18 *  Agency (ESA).
19 *
20 *  ERC32 modifications of respective RTEMS file: COPYRIGHT (c) 1995.
21 *  European Space Agency.
22 */
23
24#include <rtems/asm.h>
25#include <rtems/score/percpu.h>
26#include <bspopts.h>
27
28/*
29 *  void _CPU_Context_switch(
30 *    Context_Control  *run,
31 *    Context_Control  *heir
32 *  )
33 *
34 *  This routine performs a normal non-FP context switch.
35 */
36
37        .align 4
38        PUBLIC(_CPU_Context_switch)
39SYM(_CPU_Context_switch):
40        st      %g5, [%o0 + G5_OFFSET]       ! save the global registers
41        st      %g7, [%o0 + G7_OFFSET]
42
43        std     %l0, [%o0 + L0_OFFSET]       ! save the local registers
44        std     %l2, [%o0 + L2_OFFSET]
45        std     %l4, [%o0 + L4_OFFSET]
46        std     %l6, [%o0 + L6_OFFSET]
47
48        std     %i0, [%o0 + I0_OFFSET]       ! save the input registers
49        std     %i2, [%o0 + I2_OFFSET]
50        std     %i4, [%o0 + I4_OFFSET]
51        std     %i6, [%o0 + I6_FP_OFFSET]
52
53        std     %o6, [%o0 + O6_SP_OFFSET]    ! save the output registers
54
55        ! load the ISR stack nesting prevention flag
56        ld      [%g6 + SPARC_PER_CPU_ISR_DISPATCH_DISABLE], %o4
57        ! save it a bit later so we do not waste a couple of cycles
58
59        rd      %psr, %o2
60        st      %o2, [%o0 + PSR_OFFSET]      ! save status register
61
62        ! Now actually save ISR stack nesting prevention flag
63        st       %o4, [%o0 + ISR_DISPATCH_DISABLE_STACK_OFFSET]
64
65        /*
66         *  This is entered from _CPU_Context_restore with:
67         *    o1 = context to restore
68         *    o2 = psr
69         */
70
71        PUBLIC(_CPU_Context_restore_heir)
72SYM(_CPU_Context_restore_heir):
73        /*
74         *  Flush all windows with valid contents except the current one.
75         *  In examining the set register windows, one may logically divide
76         *  the windows into sets (some of which may be empty) based on their
77         *  current status:
78         *
79         *    + current (i.e. in use),
80         *    + used (i.e. a restore would not trap)
81         *    + invalid (i.e. 1 in corresponding bit in WIM)
82         *    + unused
83         *
84         *  Either the used or unused set of windows may be empty.
85         *
86         *  NOTE: We assume only one bit is set in the WIM at a time.
87         *
88         *  Given a CWP of 5 and a WIM of 0x1, the registers are divided
89         *  into sets as follows:
90         *
91         *    + 0   - invalid
92         *    + 1-4 - unused
93         *    + 5   - current
94         *    + 6-7 - used
95         *
96         *  In this case, we only would save the used windows -- 6 and 7.
97         *
98         *   Traps are disabled for the same logical period as in a
99         *     flush all windows trap handler.
100         *
101         *    Register Usage while saving the windows:
102         *      g1 = current PSR
103         *      g2 = current wim
104         *      g3 = CWP
105         *      g4 = wim scratch
106         *      g5 = scratch
107         */
108
109        ld      [%o1 + PSR_OFFSET], %g1       ! g1 = saved psr
110
111        and     %o2, SPARC_PSR_CWP_MASK, %g3  ! g3 = CWP
112                                              ! g1 = psr w/o cwp
113        andn    %g1, SPARC_PSR_ET_MASK | SPARC_PSR_CWP_MASK, %g1
114        or      %g1, %g3, %g1                 ! g1 = heirs psr
115        mov     %g1, %psr                     ! restore status register and
116                                              ! **** DISABLE TRAPS ****
117        mov     %wim, %g2                     ! g2 = wim
118        mov     1, %g4
119        sll     %g4, %g3, %g4                 ! g4 = WIM mask for CW invalid
120
121save_frame_loop:
122        sll     %g4, 1, %g5                   ! rotate the "wim" left 1
123        srl     %g4, SPARC_NUMBER_OF_REGISTER_WINDOWS - 1, %g4
124        or      %g4, %g5, %g4                 ! g4 = wim if we do one restore
125
126        /*
127         *  If a restore would not underflow, then continue.
128         */
129
130        andcc   %g4, %g2, %g0                 ! Any windows to flush?
131        bnz     done_flushing                 ! No, then continue
132        nop
133
134        restore                               ! back one window
135
136        /*
137         *  Now save the window just as if we overflowed to it.
138         */
139
140        std     %l0, [%sp + CPU_STACK_FRAME_L0_OFFSET]
141        std     %l2, [%sp + CPU_STACK_FRAME_L2_OFFSET]
142        std     %l4, [%sp + CPU_STACK_FRAME_L4_OFFSET]
143        std     %l6, [%sp + CPU_STACK_FRAME_L6_OFFSET]
144
145        std     %i0, [%sp + CPU_STACK_FRAME_I0_OFFSET]
146        std     %i2, [%sp + CPU_STACK_FRAME_I2_OFFSET]
147        std     %i4, [%sp + CPU_STACK_FRAME_I4_OFFSET]
148        std     %i6, [%sp + CPU_STACK_FRAME_I6_FP_OFFSET]
149
150        ba      save_frame_loop
151        nop
152
153done_flushing:
154
155        add     %g3, 1, %g3                   ! calculate desired WIM
156        and     %g3, SPARC_NUMBER_OF_REGISTER_WINDOWS - 1, %g3
157        mov     1, %g4
158        sll     %g4, %g3, %g4                 ! g4 = new WIM
159        mov     %g4, %wim
160
161        or      %g1, SPARC_PSR_ET_MASK, %g1
162        mov     %g1, %psr                     ! **** ENABLE TRAPS ****
163                                              !   and restore CWP
164        nop
165        nop
166        nop
167
168#if defined(RTEMS_SMP)
169        ! The executing context no longer executes on this processor
170        st      %g0, [%o0 + SPARC_CONTEXT_CONTROL_IS_EXECUTING_OFFSET]
171
172        ! Try to update the is executing indicator of the heir context
173        mov     1, %g1
174
175try_update_is_executing:
176
177        swap    [%o1 + SPARC_CONTEXT_CONTROL_IS_EXECUTING_OFFSET], %g1
178        cmp     %g1, 0
179        bne     check_is_executing
180
181        ! The next load is in a delay slot, which is all right
182#endif
183
184        ld      [%o1 + G5_OFFSET], %g5        ! restore the global registers
185        ld      [%o1 + G7_OFFSET], %g7
186
187        ! Load thread specific ISR dispatch prevention flag
188        ld      [%o1 + ISR_DISPATCH_DISABLE_STACK_OFFSET], %o2
189        ! Store it to memory later to use the cycles
190
191        ldd     [%o1 + L0_OFFSET], %l0        ! restore the local registers
192        ldd     [%o1 + L2_OFFSET], %l2
193        ldd     [%o1 + L4_OFFSET], %l4
194        ldd     [%o1 + L6_OFFSET], %l6
195
196        ! Now restore thread specific ISR dispatch prevention flag
197        st      %o2, [%g6 + SPARC_PER_CPU_ISR_DISPATCH_DISABLE]
198
199        ldd     [%o1 + I0_OFFSET], %i0        ! restore the input registers
200        ldd     [%o1 + I2_OFFSET], %i2
201        ldd     [%o1 + I4_OFFSET], %i4
202        ldd     [%o1 + I6_FP_OFFSET], %i6
203
204        ldd     [%o1 + O6_SP_OFFSET], %o6     ! restore the output registers
205
206        jmp     %o7 + 8                       ! return
207        nop                                   ! delay slot
208
209#if defined(RTEMS_SMP)
210check_is_executing:
211
212        ! Check the is executing indicator of the heir context
213        ld      [%o1 + SPARC_CONTEXT_CONTROL_IS_EXECUTING_OFFSET], %g1
214        cmp     %g1, 0
215        beq     try_update_is_executing
216         mov    1, %g1
217
218        ! Check if a thread dispatch is necessary
219        ldub    [%g6 + PER_CPU_DISPATCH_NEEDED], %g1
220        cmp     %g1, 0
221        beq     check_is_executing
222         nop
223
224        ! We have a new heir
225
226        ! Clear the thread dispatch necessary flag
227        stub    %g0, [%g6 + PER_CPU_DISPATCH_NEEDED]
228
229        ! Here we assume a strong memory order, otherwise a memory barrier must
230        ! be inserted here
231
232        ! Read the executing and heir
233        ld      [%g6 + PER_CPU_OFFSET_EXECUTING], %g1
234        ld      [%g6 + PER_CPU_OFFSET_HEIR], %g2
235
236        ! Calculate the heir context pointer
237        sub     %o1, %g1, %g1
238        add     %g1, %g2, %o1
239
240        ! Update the executing
241        st      %g2, [%g6 + PER_CPU_OFFSET_EXECUTING]
242
243        ba      try_update_is_executing
244         mov    1, %g1
245#endif
246
247/*
248 *  void _CPU_Context_restore(
249 *    Context_Control *new_context
250 *  )
251 *
252 *  This routine is generally used only to perform restart self.
253 *
254 *  NOTE: It is unnecessary to reload some registers.
255 */
256        .align 4
257        PUBLIC(_CPU_Context_restore)
258SYM(_CPU_Context_restore):
259        save    %sp, -CPU_MINIMUM_STACK_FRAME_SIZE, %sp
260        rd      %psr, %o2
261#if defined(RTEMS_SMP)
262        ! On SPARC the restore path needs also a valid executing context on SMP
263        ! to update the is executing indicator.
264        mov     %i0, %o0
265#endif
266        ba      SYM(_CPU_Context_restore_heir)
267        mov     %i0, %o1                      ! in the delay slot
268
269/*
270 *  void _ISR_Handler()
271 *
272 *  This routine provides the RTEMS interrupt management.
273 *
274 *  We enter this handler from the 4 instructions in the trap table with
275 *  the following registers assumed to be set as shown:
276 *
277 *    l0 = PSR
278 *    l1 = PC
279 *    l2 = nPC
280 *    l3 = trap type
281 *
282 *  NOTE: By an executive defined convention, trap type is between 0 and 255 if
283 *        it is an asynchonous trap and 256 and 511 if it is synchronous.
284 */
285
286        .align 4
287        PUBLIC(_ISR_Handler)
288SYM(_ISR_Handler):
289        /*
290         *  Fix the return address for synchronous traps.
291         */
292
293        andcc   %l3, SPARC_SYNCHRONOUS_TRAP_BIT_MASK, %g0
294                                      ! Is this a synchronous trap?
295        be,a    win_ovflow            ! No, then skip the adjustment
296        nop                           ! DELAY
297        mov     %l1, %l6              ! save trapped pc for debug info
298        mov     %l2, %l1              ! do not return to the instruction
299        add     %l2, 4, %l2           ! indicated
300
301win_ovflow:
302        /*
303         *  Save the globals this block uses.
304         *
305         *  These registers are not restored from the locals.  Their contents
306         *  are saved directly from the locals into the ISF below.
307         */
308
309        mov     %g4, %l4                 ! save the globals this block uses
310        mov     %g5, %l5
311
312        /*
313         *  When at a "window overflow" trap, (wim == (1 << cwp)).
314         *  If we get here like that, then process a window overflow.
315         */
316
317        rd      %wim, %g4
318        srl     %g4, %l0, %g5            ! g5 = win >> cwp ; shift count and CWP
319                                         !   are LS 5 bits ; how convenient :)
320        cmp     %g5, 1                   ! Is this an invalid window?
321        bne     dont_do_the_window       ! No, then skip all this stuff
322        ! we are using the delay slot
323
324        /*
325         *  The following is same as a 1 position right rotate of WIM
326         */
327
328        srl     %g4, 1, %g5              ! g5 = WIM >> 1
329        sll     %g4, SPARC_NUMBER_OF_REGISTER_WINDOWS-1 , %g4
330                                         ! g4 = WIM << (Number Windows - 1)
331        or      %g4, %g5, %g4            ! g4 = (WIM >> 1) |
332                                         !      (WIM << (Number Windows - 1))
333
334        /*
335         *  At this point:
336         *
337         *    g4 = the new WIM
338         *    g5 is free
339         */
340
341        /*
342         *  Since we are tinkering with the register windows, we need to
343         *  make sure that all the required information is in global registers.
344         */
345
346        save                          ! Save into the window
347        wr      %g4, 0, %wim          ! WIM = new WIM
348        nop                           ! delay slots
349        nop
350        nop
351
352        /*
353         *  Now save the window just as if we overflowed to it.
354         */
355
356        std     %l0, [%sp + CPU_STACK_FRAME_L0_OFFSET]
357        std     %l2, [%sp + CPU_STACK_FRAME_L2_OFFSET]
358        std     %l4, [%sp + CPU_STACK_FRAME_L4_OFFSET]
359        std     %l6, [%sp + CPU_STACK_FRAME_L6_OFFSET]
360
361        std     %i0, [%sp + CPU_STACK_FRAME_I0_OFFSET]
362        std     %i2, [%sp + CPU_STACK_FRAME_I2_OFFSET]
363        std     %i4, [%sp + CPU_STACK_FRAME_I4_OFFSET]
364        std     %i6, [%sp + CPU_STACK_FRAME_I6_FP_OFFSET]
365
366        restore
367        nop
368
369dont_do_the_window:
370        /*
371         *  Global registers %g4 and %g5 are saved directly from %l4 and
372         *  %l5 directly into the ISF below.
373         */
374
375        /*
376         *  Save the state of the interrupted task -- especially the global
377         *  registers -- in the Interrupt Stack Frame.  Note that the ISF
378         *  includes a regular minimum stack frame which will be used if
379         *  needed by register window overflow and underflow handlers.
380         *
381         *  REGISTERS SAME AS AT _ISR_Handler
382         */
383
384        sub     %fp, CONTEXT_CONTROL_INTERRUPT_FRAME_SIZE, %sp
385                                               ! make space for ISF
386
387        std     %l0, [%sp + ISF_PSR_OFFSET]    ! save psr, PC
388        st      %l2, [%sp + ISF_NPC_OFFSET]    ! save nPC
389        st      %g1, [%sp + ISF_G1_OFFSET]     ! save g1
390        std     %g2, [%sp + ISF_G2_OFFSET]     ! save g2, g3
391        std     %l4, [%sp + ISF_G4_OFFSET]     ! save g4, g5 -- see above
392        st      %g7, [%sp + ISF_G7_OFFSET]     ! save g7
393
394        std     %i0, [%sp + ISF_I0_OFFSET]     ! save i0, i1
395        std     %i2, [%sp + ISF_I2_OFFSET]     ! save i2, i3
396        std     %i4, [%sp + ISF_I4_OFFSET]     ! save i4, i5
397        std     %i6, [%sp + ISF_I6_FP_OFFSET]  ! save i6/fp, i7
398
399        rd      %y, %g1
400        st      %g1, [%sp + ISF_Y_OFFSET]      ! save y
401        st      %l6, [%sp + ISF_TPC_OFFSET]    ! save real trapped pc
402
403        mov     %sp, %o1                       ! 2nd arg to ISR Handler
404
405        /*
406         *  Increment ISR nest level and Thread dispatch disable level.
407         *
408         *  Register usage for this section:
409         *
410         *    l6 = _Thread_Dispatch_disable_level value
411         *    l7 = _ISR_Nest_level value
412         *
413         *  NOTE: It is assumed that l6 - l7 will be preserved until the ISR
414         *        nest and thread dispatch disable levels are unnested.
415         */
416
417        ld       [%g6 + PER_CPU_ISR_NEST_LEVEL], %l7
418        ld       [%g6 + PER_CPU_THREAD_DISPATCH_DISABLE_LEVEL], %l6
419
420        add      %l7, 1, %l7
421        st       %l7, [%g6 + PER_CPU_ISR_NEST_LEVEL]
422
423        add      %l6, 1, %l6
424        st       %l6, [%g6 + PER_CPU_THREAD_DISPATCH_DISABLE_LEVEL]
425
426        /*
427         *  If ISR nest level was zero (now 1), then switch stack.
428         */
429
430        mov      %sp, %fp
431        subcc    %l7, 1, %l7             ! outermost interrupt handler?
432        bnz      dont_switch_stacks      ! No, then do not switch stacks
433
434#if defined( RTEMS_PROFILING )
435         sethi   %hi(SYM(_SPARC_Counter)), %o5
436        ld       [%o5 + %lo(SYM(_SPARC_Counter))], %l4
437        ld       [%l4], %o5
438#else
439         nop
440#endif
441
442        ld       [%g6 + PER_CPU_INTERRUPT_STACK_HIGH], %sp
443
444dont_switch_stacks:
445        /*
446         *  Make sure we have a place on the stack for the window overflow
447         *  trap handler to write into.  At this point it is safe to
448         *  enable traps again.
449         */
450
451        sub      %sp, CPU_MINIMUM_STACK_FRAME_SIZE, %sp
452
453        /*
454         *  Check if we have an external interrupt (trap 0x11 - 0x1f). If so,
455         *  set the PIL in the %psr to mask off interrupts with lower priority.
456         *  The original %psr in %l0 is not modified since it will be restored
457         *  when the interrupt handler returns.
458         */
459
460        mov      %l0, %g5
461        and      %l3, 0x0ff, %g4
462        subcc    %g4, 0x11, %g0
463        bl       dont_fix_pil
464        subcc    %g4, 0x1f, %g0
465        bg       dont_fix_pil
466        sll      %g4, 8, %g4
467        and      %g4, SPARC_PSR_PIL_MASK, %g4
468        andn     %l0, SPARC_PSR_PIL_MASK, %g5
469        ba       pil_fixed
470        or       %g4, %g5, %g5
471dont_fix_pil:
472        or       %g5, SPARC_PSR_PIL_MASK, %g5
473pil_fixed:
474        wr       %g5, SPARC_PSR_ET_MASK, %psr ! **** ENABLE TRAPS ****
475
476        /*
477         *  Vector to user's handler.
478         *
479         *  NOTE: TBR may no longer have vector number in it since
480         *        we just enabled traps.  It is definitely in l3.
481         */
482
483        sethi    %hi(SYM(_ISR_Vector_table)), %g4
484        or       %g4, %lo(SYM(_ISR_Vector_table)), %g4
485        and      %l3, 0xFF, %g5         ! remove synchronous trap indicator
486        sll      %g5, 2, %g5            ! g5 = offset into table
487        ld       [%g4 + %g5], %g4       ! g4 = _ISR_Vector_table[ vector ]
488
489
490                                        ! o1 = 2nd arg = address of the ISF
491                                        !   WAS LOADED WHEN ISF WAS SAVED!!!
492        mov      %l3, %o0               ! o0 = 1st arg = vector number
493        call     %g4, 0
494#if defined( RTEMS_PROFILING )
495         mov     %o5, %l3               ! save interrupt entry instant
496        cmp      %l7, 0
497        bne      profiling_not_outer_most_exit
498         nop
499        ta       SPARC_SWTRAP_IRQDIS    ! Call interrupt disable trap handler
500        ld       [%l4], %o2             ! o2 = 3rd arg = interrupt exit instant
501        mov      %l3, %o1               ! o1 = 2nd arg = interrupt entry instant
502        call     SYM(_Profiling_Outer_most_interrupt_entry_and_exit), 0
503         mov     %g6, %o0               ! o0 = 1st arg = per-CPU control
504profiling_not_outer_most_exit:
505#else
506         nop                            ! delay slot
507#endif
508
509        /*
510         *  Redisable traps so we can finish up the interrupt processing.
511         *  This is a VERY conservative place to do this.
512         *
513         *  NOTE: %l0 has the PSR which was in place when we took the trap.
514         */
515
516        mov      %l0, %psr             ! **** DISABLE TRAPS ****
517        nop; nop; nop
518
519        /*
520         *  Decrement ISR nest level and Thread dispatch disable level.
521         *
522         *  Register usage for this section:
523         *
524         *    l6 = _Thread_Dispatch_disable_level value
525         *    l7 = _ISR_Nest_level value
526         */
527
528        st       %l7, [%g6 + PER_CPU_ISR_NEST_LEVEL]
529
530        sub      %l6, 1, %l6
531        st       %l6, [%g6 + PER_CPU_THREAD_DISPATCH_DISABLE_LEVEL]
532
533        /*
534         *  If dispatching is disabled (includes nested interrupt case),
535         *  then do a "simple" exit.
536         */
537
538        orcc     %l6, %g0, %g0   ! Is dispatching disabled?
539        bnz      simple_return   ! Yes, then do a "simple" exit
540        nop
541
542        ! Are we dispatching from a previous ISR in the interrupted thread?
543        ld       [%g6 + SPARC_PER_CPU_ISR_DISPATCH_DISABLE], %l7
544        orcc     %l7, %g0, %g0   ! Is this thread already doing an ISR?
545        bnz      simple_return   ! Yes, then do a "simple" exit
546        nop
547
548
549        /*
550         *  If a context switch is necessary, then do fudge stack to
551         *  return to the interrupt dispatcher.
552         */
553
554        ldub     [%g6 + PER_CPU_DISPATCH_NEEDED], %l6
555
556        orcc     %l6, %g0, %g0   ! Is thread switch necessary?
557        bz       simple_return   ! no, then do a simple return
558        nop
559
560        /*
561         *  Invoke interrupt dispatcher.
562         */
563
564        ! Set ISR dispatch nesting prevention flag
565        mov      1,%l6
566        st       %l6, [%g6 + SPARC_PER_CPU_ISR_DISPATCH_DISABLE]
567
568        /*
569         *  The following subtract should get us back on the interrupted
570         *  tasks stack and add enough room to invoke the dispatcher.
571         *  When we enable traps, we are mostly back in the context
572         *  of the task and subsequent interrupts can operate normally.
573         */
574
575        sub      %fp, CPU_MINIMUM_STACK_FRAME_SIZE, %sp
576
577        or      %l0, SPARC_PSR_ET_MASK, %l7    ! l7 = PSR with ET=1
578        mov     %l7, %psr                      !  **** ENABLE TRAPS ****
579        nop
580        nop
581        nop
582isr_dispatch:
583        call    SYM(_Thread_Dispatch), 0
584         nop
585
586        /*
587         *  We invoked _Thread_Dispatch in a state similar to the interrupted
588         *  task.  In order to safely be able to tinker with the register
589         *  windows and get the task back to its pre-interrupt state,
590         *  we need to disable interrupts disabled so we can safely tinker
591         *  with the register windowing.  In particular, the CWP in the PSR
592         *  is fragile during this period. (See PR578.)
593         */
594        ta      SPARC_SWTRAP_IRQDIS  ! syscall (disable interrupts)
595
596        /*
597         *  While we had ISR dispatching disabled in this thread,
598         *  did we miss anything.  If so, then we need to do another
599         *  _Thread_Dispatch before leaving this ISR Dispatch context.
600         */
601        ldub    [%g6 + PER_CPU_DISPATCH_NEEDED], %l7
602
603        orcc    %l7, %g0, %g0        ! Is thread switch necesary?
604        bne,a   isr_dispatch         ! Yes, then invoke the dispatcher.
605                                     ! g1 = Old PSR PIL returned from IRQDis
606        ta      SPARC_SWTRAP_IRQEN   ! syscall (enable interrupts to same level)
607
608        ! No, then clear out and return
609
610        ! Zero out ISR stack nesting prevention flag
611        st       %g0, [%g6 + SPARC_PER_CPU_ISR_DISPATCH_DISABLE]
612
613        /*
614         *  The CWP in place at this point may be different from
615         *  that which was in effect at the beginning of the ISR if we
616         *  have been context switched between the beginning of this invocation
617         *  of _ISR_Handler and this point.  Thus the CWP and WIM should
618         *  not be changed back to their values at ISR entry time.  Any
619         *  changes to the PSR must preserve the CWP.
620         */
621
622simple_return:
623        ld      [%fp + ISF_Y_OFFSET], %l5      ! restore y
624        wr      %l5, 0, %y
625
626        ldd     [%fp + ISF_PSR_OFFSET], %l0    ! restore psr, PC
627        ld      [%fp + ISF_NPC_OFFSET], %l2    ! restore nPC
628        rd      %psr, %l3
629        and     %l3, SPARC_PSR_CWP_MASK, %l3   ! want "current" CWP
630        andn    %l0, SPARC_PSR_CWP_MASK, %l0   ! want rest from task
631        or      %l3, %l0, %l0                  ! install it later...
632        andn    %l0, SPARC_PSR_ET_MASK, %l0
633
634        /*
635         *  Restore tasks global and out registers
636         */
637
638        mov    %fp, %g1
639
640                                              ! g1 is restored later
641        ldd     [%fp + ISF_G2_OFFSET], %g2    ! restore g2, g3
642        ldd     [%fp + ISF_G4_OFFSET], %g4    ! restore g4, g5
643        ld      [%fp + ISF_G7_OFFSET], %g7    ! restore g7
644
645        ldd     [%fp + ISF_I0_OFFSET], %i0    ! restore i0, i1
646        ldd     [%fp + ISF_I2_OFFSET], %i2    ! restore i2, i3
647        ldd     [%fp + ISF_I4_OFFSET], %i4    ! restore i4, i5
648        ldd     [%fp + ISF_I6_FP_OFFSET], %i6 ! restore i6/fp, i7
649
650        /*
651         *  Registers:
652         *
653         *   ALL global registers EXCEPT G1 and the input registers have
654         *   already been restored and thuse off limits.
655         *
656         *   The following is the contents of the local registers:
657         *
658         *     l0 = original psr
659         *     l1 = return address (i.e. PC)
660         *     l2 = nPC
661         *     l3 = CWP
662         */
663
664        /*
665         *  if (CWP + 1) is an invalid window then we need to reload it.
666         *
667         *  WARNING: Traps should now be disabled
668         */
669
670        mov     %l0, %psr                  !  **** DISABLE TRAPS ****
671        nop
672        nop
673        nop
674        rd      %wim, %l4
675        add     %l0, 1, %l6                ! l6 = cwp + 1
676        and     %l6, SPARC_PSR_CWP_MASK, %l6 ! do the modulo on it
677        srl     %l4, %l6, %l5              ! l5 = win >> cwp + 1 ; shift count
678                                           !  and CWP are conveniently LS 5 bits
679        cmp     %l5, 1                     ! Is tasks window invalid?
680        bne     good_task_window
681
682        /*
683         *  The following code is the same as a 1 position left rotate of WIM.
684         */
685
686        sll     %l4, 1, %l5                ! l5 = WIM << 1
687        srl     %l4, SPARC_NUMBER_OF_REGISTER_WINDOWS-1 , %l4
688                                           ! l4 = WIM >> (Number Windows - 1)
689        or      %l4, %l5, %l4              ! l4 = (WIM << 1) |
690                                           !      (WIM >> (Number Windows - 1))
691
692        /*
693         *  Now restore the window just as if we underflowed to it.
694         */
695
696        wr      %l4, 0, %wim               ! WIM = new WIM
697        nop                                ! must delay after writing WIM
698        nop
699        nop
700        restore                            ! now into the tasks window
701
702        ldd     [%g1 + CPU_STACK_FRAME_L0_OFFSET], %l0
703        ldd     [%g1 + CPU_STACK_FRAME_L2_OFFSET], %l2
704        ldd     [%g1 + CPU_STACK_FRAME_L4_OFFSET], %l4
705        ldd     [%g1 + CPU_STACK_FRAME_L6_OFFSET], %l6
706        ldd     [%g1 + CPU_STACK_FRAME_I0_OFFSET], %i0
707        ldd     [%g1 + CPU_STACK_FRAME_I2_OFFSET], %i2
708        ldd     [%g1 + CPU_STACK_FRAME_I4_OFFSET], %i4
709        ldd     [%g1 + CPU_STACK_FRAME_I6_FP_OFFSET], %i6
710                                           ! reload of sp clobbers ISF
711        save                               ! Back to ISR dispatch window
712
713good_task_window:
714
715        mov     %l0, %psr                  !  **** DISABLE TRAPS ****
716        nop; nop; nop
717                                           !  and restore condition codes.
718        ld      [%g1 + ISF_G1_OFFSET], %g1 ! restore g1
719        jmp     %l1                        ! transfer control and
720        rett    %l2                        ! go back to tasks window
721
722/* end of file */
Note: See TracBrowser for help on using the repository browser.