Note this word cannot be used with local variables, it assumes LP still points to the interrupt: stack frame

 
	: @int_stack_frame ( offset -- value)
		@lp + @ 
	;
	 

On fault you often want to alter the return address ( not much use re-executing the fault instruction). This word is the word to use. No lP must still point to the interrupt stack frame.

 
	: int_return! ( xt --) 
		_#int_A7 @int_stack_frame _#int_user_return + !
	; 
	 
 

	_#int_format 2+ _#int_status ??=

    : panic_stack_frame ( --)
		panic_cr
		panic" Registers"
		panic_cr
		panic" D0 " _#int_D0 @int_stack_frame .panic BL panic_emit
		panic" D1 " _#int_D1 @int_stack_frame .panic BL panic_emit	
		panic" D2 " _#int_D2 @int_stack_frame .panic BL panic_emit	
		panic" D3 " _#int_D3 @int_stack_frame .panic BL panic_emit	
		panic_cr
		panic" D4 " _#int_D4 @int_stack_frame .panic BL panic_emit		
		panic" D5 " _#int_D5 @int_stack_frame .panic BL panic_emit	
		panic" D6 " _#int_D6 @int_stack_frame .panic BL panic_emit	
		panic" D7 " _#int_D7 @int_stack_frame .panic	
		panic_cr
		panic" A0 " _#int_D7 @int_stack_frame .panic BL panic_emit	
		panic" A1 " _#int_A1 @int_stack_frame .panic BL panic_emit	
		panic" A2 " _#int_A2 @int_stack_frame .panic BL panic_emit	
		panic" A3 " _#int_A3 @int_stack_frame .panic 	
		panic_cr
		panic" A4 " _#int_A4 @int_stack_frame .panic BL panic_emit	
		panic" A5 " _#int_A5 @int_stack_frame .panic BL panic_emit	
		panic" A6 " _#int_A6 @int_stack_frame .panic BL panic_emit	
		panic" A7 " _#int_A7 @int_stack_frame .panic 	
		panic_cr
		panic" SR " _#int_format @int_stack_frame .panic BL panic_emit	
		panic" PC " _#int_PC @int_stack_frame .panic 
	;	

	 

On a fault the interrupt stack is saved, along with the current value of lp. This can be used latter to work out what was going on.

 
	: save_fault_stack ( --)
		@lp _%fault_lp !
		@u  _%fault_u !
		_%system_stack _%fault_stack _#system_stack_length  MOVE
	;

	_%fault_stack _%system_stack - CONSTANT _#stack_data_offset
	 

Once we have determined that we are dealing with an interrupt: stack frame, we use this word to print out the register details.

 
	: _.interrupt_stack_frame ( lp --)
		CR
		." Registers" 
		CR
		." D0 " DUP _#int_D0 + @ .h BL EMIT
		." D1 " DUP _#int_D1 + @ .h BL EMIT
		." D2 " DUP _#int_D2 + @ .h BL EMIT
		." D3 " DUP _#int_D3 + @ .h 
		CR
		." D4 " DUP _#int_D4 + @ .h BL EMIT
		." D5 " DUP _#int_D5 + @ .h BL EMIT
		." D6 " DUP _#int_D6 + @ .h BL EMIT
		." D7 " DUP _#int_D7 + @ .h 
		CR
		." A0 " DUP _#int_A0 + @ .h BL EMIT
		." A1 " DUP _#int_A1 + @ .h BL EMIT
		." A2 " DUP _#int_A2 + @ .h BL EMIT
		." A3 " DUP _#int_A3 + @ .h 
		CR
		." A4 " DUP _#int_A4 + @ .h BL EMIT
		." A5 " DUP _#int_A5 + @ .h BL EMIT
		." A6 " DUP _#int_A6 + @ .h BL EMIT
		." A7 " DUP _#int_A7 + @ .h 
		CR 
		." SR " DUP _#int_format + @ .h BL EMIT
		." PC " DUP _#int_PC + @ .h 
		send
		DROP
		;

	: _within_system_stack?  ( addr -- falg)
		_%system_stack [ _%system_stack _#system_stack_length + ]T LITERAL  WITHIN 
	;

	: _magic_number? ( addr -- flag)
		\ make sure it is on a long word boundry
		0FFFFFFFC AND  _#stack_data_offset +
		[ interrupt_magic_number user_base - ]T LITERAL + @ _#interrupt_magic = 
	;
	 

The format code contains the vector of the exception. Using this we can give the excetion frame a name.

 
	CREATE _exception_name_table
		$02 tw, ," Access error"
		$03 tw, ," Address error"
		$04 tw, ," Illegial instruction"
		$08 tw, ," Privilege violation"
		$09 tw, ," Trace"
		$0A tw, ," Line 1010"
		$0B tw, ," Line 1111"
		$0C tw, ," Hardware breakpoint"
		$0E tw, ," Format error"
		$0F tw, ," Unitialised Interrupt"
		$1E tw, ," Real time clock"
		$22 tw, ," Task switch"
		$25 tw, ," Reset"
		$26 tw, ," Supervisor execute"
		$27 tw, ," Task switch"
		$28 tw, ," Enable all interrupts"
		$29 tw, ," Level 1 interrupts"
		$2A tw, ," Level 2 interrupts"
		$2B tw, ," Level 3 interrupts"
		$2C tw, ," Level 4 interrupts"
		$2D tw, ," Level 5 interrupts"
		$2E tw, ," Level 6 interrupts"
		$2F tw, ," Level 7 interrupts"
		_#m68a_vector tw, ," Serial channel a"
		_#m68b_vector tw, ," Serial channel b"
		$80 tw, ," RTI1000 slot F"
		$81 tw, ," RTI1000 slot E"
		$82 tw, ," RTI1000 slot D"
		$83 tw, ," RTI1000 slot C"
		$84 tw, ," RTI1000 slot B"
		$85 tw, ," RTI1000 slot A"
		$86 tw, ," RTI1000 slot 9"
		$87 tw, ," RTI1000 slot 8"
		$88 tw, ," RTI1000 slot 7"
		$89 tw, ," RTI1000 slot 6"
		$8A tw, ," RTI1000 slot 5"
		$8B tw, ," RTI1000 slot 4"
		$8C tw, ," RTI1000 slot 3"
		$8D tw, ," RTI1000 slot 2"
		$8E tw, ," RTI1000 slot 1"
		$8F tw, ," RTI1000 slot 0"
		\ end of list
		$FFFF tw,
	
	CREATE _$unnamed ," Unnamed vector"

	: $exception_name ( code -- $)
		_exception_name_table \ code addr<-
		BEGIN
			2DUP W@ = IF \ found the code
				NIP 2+
				EXIT
			THEN
			DUP W@ $FFFF = IF
				2DROP
				_$unnamed
				EXIT
			THEN
			\ move to next string
			2+ COUNT + ALIGNED
		AGAIN
	;
	 

Because we now set up a forth process to service interrupt, and because such a process can abort, it is possible to get interrupt exceptions and for there to be a valid description of what happen.

If the interrupt has been reset, and things aren't in a complete mess the system will even recover.

To print out layered interrupt stack frames we have to trace down the lp link. So poor old .FAULT gets a little more complex.

 
	: .fault ( --)
		_%fault_u @
		_%fault_lp @
		BEGIN  \ u lp (--
			\ lp has to be within the system stack
			DUP _within_system_stack? not IF
				2DROP EXIT
			THEN
			\ u has to be within system stack for magic_number test
			OVER _within_system_stack? IF  \ u lp (--
				OVER _magic_number? IF \ u lp (-- valid interrupt: stack frame
					CR 
					DUP _#stack_data_offset + _#int_format + W@ 
					2 RSHIFT $FF AND $exception_name $type
					DUP _#stack_data_offset + _.interrupt_stack_frame
					DUP _#stack_data_offset +  _#int_PC + @ $40 show
				THEN
			THEN \ u lp(--
			NIP DUP _#int_A3 + _within_system_stack? not IF
				DROP EXIT
			THEN
			\ lp(--
			DUP  _#stack_data_offset + _#int_A3 + @
			SWAP _#stack_data_offset + _#int_old_lp + @ 
		AGAIN
	;


	: .fault_reset ( --)
		.fault
[ #BCM550h #BCM550j + [IF] ]T
		_breg_SS1 C@
		_#SS1_processor_fault -1 XOR AND 
		_breg_SS1 C!
[ [THEN] ]T
	;