\ ========== Copyright Header Begin ==========================================
\ Hypervisor Software File: checkpt.fth
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ - Do no alter or remove copyright notices
\ - Redistribution and use of this software in source and binary forms, with
\ or without modification, are permitted provided that the following
\ - Redistribution of source code must retain the above copyright notice,
\ this list of conditions and the following disclaimer.
\ - Redistribution in binary form must reproduce the above copyright notice,
\ this list of conditions and the following disclaimer in the
\ documentation and/or other materials provided with the distribution.
\ Neither the name of Sun Microsystems, Inc. or the names of contributors
\ may be used to endorse or promote products derived from this software
\ without specific prior written permission.
\ This software is provided "AS IS," without a warranty of any kind.
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ ========== Copyright Header End ============================================
id: @(#)checkpt.fth 1.4 05/04/08 22:16:13
copyright: Copyright 2005 Sun Microsystems, Inc. All Rights Reserved
copyright: Use is subject to license terms.
\ a checkpt is like a setjmp/longjmp in C. (man setjmp)
\ push-checkpt : Create an exception frame and push it onto the exception
\ pop-checkpt : Dispose the current exception frame.
\ The catch and throw are special cases of checkpts.
\ One of the difference between a push-checkpt and a 'catch' is that
\ the catch calls the thing it is trying to catch, a checkpoint does
\ not have this restriction. Looking at the tail end of 'catch' in
\ the normal execution case it pops the handler, which is the exact
\ equivalent of 'pop-checkpt'.
\ The primary difference is that you can mark a checkpoint at an arbitrary
\ point and 'recover' much like a 'catch' does except that you are no
\ longer on the same descending call frame (e.g., return stack).
\ : xxx cmn-error[ ..-1 throw ... ]cmn-end ;
\ The throw destroys the error frame by returning control to the 'catch'.
\ Now if cmn-error[ was implemented:
\ " [truncated]" (]cmn-end)
\ : ]cmn-end (]cmn-end) pop-checkpt ;
\ What we have done is ensure that an error inside an error message
\ frame is constrained in a recoverable manner and the original 'throw'
\ is propogated to the catch in yyy.
\ The magic is that 'cmn-error[' returned to its caller normally and the
\ caller xxx drove on, but on ERROR the code jumped back into the cmn-error[
\ routine which then had to throw. If it had not then the '-1 throw' would
\ execute again (assuming no other disasterous stack effects).
\ To be a good citizen you should only 'recover' from an error and
\ not propogate a throw if you know that the throw code is yours (as
\ In general it is bad practice to return from the routine that
\ established the check point (ie the routine that called 'push-checkpt'),
\ though a maximum unnest of /check-stack stack elements will permit this
\ IT IS BEST *NOT* TO RETURN FROM THE CHECKPOINT FRAME;
\ THOUGH IT WILL WORK IN MANY CASES
\ This is a similar restriction to setjmp/longjmp in C.
\ Frame Starts Frame Ends
\ push-checkpt pop-checkpt, throw
nuser checkpt \ most recent checkpoint
nuser checktrack \ tracker
nuser checkalloc \ counter
nuser checkmax \ max frames
also meta also definitions \ setup metacompiler magic
h# 18 constant /check-max \ max outstanding catch frames
h# 80 constant /check-max \ frames alloc'd after dynamic heap
h# 10 constant /check-crit \ frames alloc'd from critical heap
8 constant /check-stack \ How many elements to preserve
\ sized for known catch stack usage
/n field >check-prev \ previous frame
/n field >check-ip \ checkpt IP
/n field >check-sp \ checkpt DS pointer
/n field >check-rp \ checkpt RS pointer
/l field >check-myself \ my-self
/check-stack /n * field >check-ds \ a chunk of the DS
/check-stack /n * field >check-rs \ a chunk of the RS
previous previous definitions \ back to kernel
\ create the kernel side of these routines, using the structure
\ created in the host metacompiler to form the offsets.
: >check-prev [ 0 >check-prev ] literal + ;
: >check-myself [ 0 >check-myself ] literal + ;
: >check-age [ 0 >check-age ] literal + ;
\ initial 16 frames are allocated from the critical heap
/check-crit dup alloc-mem dup checktrack ! ( va )
/check-crit /check-frame * /n + ( sz )
alloc-mem /n 1- + /n 1- invert and checkbase ! ( )
\ dynamic heap is installed before we call into this so that the frame alloc
\ requirements can be satisfied by the expanded heap made available.
\ the alloc-mem calls will cause checkpt frames to be alloc/free'd due to
\ calls to 'catch', relying on a coherent state in the checkpt variables,
\ so the expanded allocations must not be swapped in until after they complete.
\ alloc max checktrack and copy critical heap checktrack
checktrack @ >r r@ ( oldt ) ( r: t )
/check-max dup alloc-mem ( oldt len newt )
dup rot erase swap ( newt oldt )
/check-crit bounds do i c@ over c! 1+ loop ( newt' )
\ alloc max checkpt frames and copy critical heap frames
checkbase @ >r r@ tuck ( oldb newt oldb ) ( r: t b )
/check-max /check-frame * /n + ( oldb newt oldb len )
alloc-mem /n 1- + /n 1- invert and ( oldb newt oldb newb )
swap /check-crit /check-frame * bounds ( oldb newt newb hi lo )
2dup /check-frame + 2>r ( oldb newt newb hi lo )
do i @ over ! na1+ /n +loop ( oldb newt newb' )
/check-crit /check-frame * - ( oldb newt newb )
\ having copied the old frames to the new now patch the >check-prev ptrs
\ start at second frame of old and new frames as first frame has null ptr
2 pick over /check-frame + 2r> do ( oldb newt newb oldb newb' )
over i @ swap - 3 pick + over ! ( oldb newt newb oldb newb'' )
/check-frame + /check-frame +loop ( oldb newt newb oldb newb'' )
\ now swap in expanded frame allocations after fully initialized
\ update checkpt to current frame in newly allocate frames
checkbase ! checktrack ! ( oldb )
checkpt @ ?dup if ( oldb cur )
swap - checkbase @ + checkpt ! ( )
/check-max checkmax ! ( ) ( r: t b )
r> /check-crit /check-frame * free-mem ( ) ( r: t )
r> /check-crit free-mem ( )
\ returns false the first time it is called (by push-checkpt)
\ returns the throw code when the saved state is restored by restore-checkpt
\ so that push-checkpt can distinguish between the initial save and a throw
\ the saved IP will be the symbol after save-checkpt in push-checkpt
\ the top /check-stack elements of both stacks are preserved
code save-checkpt ( frame -- 0 )
/check-stack /n* scr move
\ This works by restoring the return and data stack pointers and
\ /check-stack worth of data from the last checkpt frame,
\ restoring the IP and then setting tos to the throw code.
\ the effect is to restart the execution at the symbol following the
\ save-checkpt call in push-checkpt.
code restore-checkpt ( code frame -- code )
/check-stack /n* scr move
\ We free 16 frames - and hope this is enough to go interactive again
\ may be useful to increase for debugging
\ we only get here if we ran out of frames
: free-oldest-frames ( -- )
checkalloc @ 0 checkmax @ 0 ?do ( age n )
checkbase @ i /check-frame * + ( age n age ptr )
>check-age l@ ( age n age age-2 )
tuck > ( age n age-2 old? )
checktrack @ i + c@ 0<> ( age n age-2 old? used? )
nip nip i leave ( age' i )
checktrack @ + 0 swap c! drop ( )
\ We track individual allocs so that on an error (no more frames)
\ we can find the 'oldest' and try to reuse them. This will (hopefully)
\ give some insight into what the latest sequence of failures was.
-1 checktrack @ checkmax @ bounds ?do ( -1 )
i checktrack @ - leave ( n )
." FATAL: no exception frames available, "
checknested @ checknested on if
." NESTED ERRORs, going interactive" cr
." forcing misaligned trap" cr
/check-frame * checkbase @ + ( n )
checkalloc @ over >check-age l! ( n )
0 swap checkbase @ - /check-frame / checktrack @ + c!
: (free-checkpt) ( frame -- )
dup >check-prev @ checkpt ! ( frame )
\ free all allocated frames. used to wipe out frames when reentering
\ obp (l1-a, halt, exception, etc). the allocated frames are stale and
\ we prefer to begin with a complete set. otherwise, frames will
\ slowly leak as we exit/reenter forth (go, breakpoint, etc).
checktrack @ checkmax @ erase
\ Dispose the current exception frame.
: pop-checkpt ( -- ) checkpt @ ?dup if (free-checkpt) then ;
\ If a non-zero throw is done, then we unwind the current checkpoint
: throw ( n -- ) ?dup if checkpt @ ?dup if restore-checkpt then then ;
\ Create an exception frame and push it onto the exception stack
: push-checkpt ( ??? -- ??? code )
checkpt @ r@ >check-prev ! ( ??? )
my-self r@ >check-myself l! ( ??? )
r@ save-checkpt dup if ( ??? code )
dup >check-myself l@ is my-self ( ??? code frame )
(free-checkpt) ( ??? code )
: catch ( ??? acf -- code )
projects / OpenSPARC-T2-SAM / blob