\ ========== Copyright Header Begin ==========================================
\ Hypervisor Software File: register9.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: @(#)register9.fth 1.14 07/06/05 10:54:46
copyright: Copyright 2007 Sun Microsystems, Inc. All Rights Reserved
copyright: Use is subject to license terms.
\ This version uses multiple-code-field defining words for the self-fetching
\ Display and modify the saved state of the machine.
\ This code is highly machine-dependent.
\ Version for the Spitfire processor
\ >state ( offset -- addr )
\ Returns an address within the processor state array given the
\ The number of implemented register windows
\ window-registers ( -- offset )
\ The offset from CPU-STATE to the start of the area where the
\ window registers are stored
\ %g0 .. %g7 %o0 .. %o7 %l0 .. %l7 %i0 .. %i7
\ %pc %npc %y %psr %wim %tbr
needs action: objects.fth
only forth hidden also forth also definitions
\ This is used to examine state inside the cpu struct.
action: w@ >state cpu-reg-offset + @ ;
action: w@ >state cpu-reg-offset + ! ; \ to
action: w@ >state cpu-reg-offset + ; \ addr
action: drop /n ; \ size-of
: global-reg \ name ( offset -- offset+/l )
: global-regs \ name name ... ( offset #regs -- offset' )
( offset #regs ) 0 ?do global-reg loop ( offset' )
: offset-of \ name ( -- offset )
parse-word ['] forth $vfind if
." offset-of can't find " type cr
d# 2047 constant V9_SP_BIAS
: >outreg ( reg# -- adr flag )
previous-outs @ dup 1 and if
V9_SP_BIAS + swap na+ cpu-reg-offset + true
swap la+ cpu-reg-offset + false
: >window ( reg# -- adr flag )
view-window @ dup 1 and if
V9_SP_BIAS + swap na+ cpu-reg-offset + true
swap la+ cpu-reg-offset + false
action: w@ >window if x@ else l@ then ;
action: w@ >window if x! else l! then ; \ to
view-window @ dup 1 and if
action: drop view-window @ 1 and if /n else /l then ; \ size-of
: local-regs \ name name ... ( reg# #regs -- )
bounds ?do create i w, use-actions loop
action: w@ >outreg if x@ else l@ then ;
action: w@ >outreg if x! else x@ then ; \ to
view-window @ dup 1 and if
action: drop view-window @ 1 and if /n else /l then ; \ size-of
: out-regs \ name name ... ( #regs -- )
( #regs ) 0 do create i w, use-actions loop
2 global-regs %tpc-1 %tpc-2
2 global-regs %tnpc-1 %tnpc-2
2 global-regs %tt-1 %tt-2
2 global-regs %tstate-1 %tstate-2
2 global-regs %gl %mmu-info-ptr
5 global-regs %tpc-1 %tpc-2 %tpc-3 %tpc-4 %tpc-5
5 global-regs %tnpc-1 %tnpc-2 %tnpc-3 %tnpc-4 %tnpc-5
5 global-regs %tt-1 %tt-2 %tt-3 %tt-4 %tt-5
5 global-regs %tstate-1 %tstate-2 %tstate-3 %tstate-4 %tstate-5
8 global-regs %v0 %v1 %v2 %v3 %v4 %v5 %v6 %v7
8 global-regs %m0 %m1 %m2 %m3 %m4 %m5 %m6 %m7
5 global-regs %tpc-c %tnpc-c %tt-c %tl-c %tstate-c
5 global-regs %npc %cwp %pil %cansave %otherwin
5 global-regs %ccr %y %fprs %pstate %wstate
4 global-regs %cleanwin %tba %asi %canrestore
8 global-regs %g0 %g1 %g2 %g3 %g4 %g5 %g6 %g7
8 global-regs %a0 %a1 %a2 %a3 %a4 %a5 %a6 %a7
2 global-regs %pcontext %scontext
4 global-regs %state-valid %restartable? %saved-my-self last-trap#
3 global-regs error-reset-trap full-save? %nwins
\ Following words defined here to satisfy the
\ references to these "variables" anywhere else
: saved-my-self ( -- addr ) addr %saved-my-self ;
: state-valid ( -- addr ) addr %state-valid ;
: restartable? ( -- addr ) addr %restartable? ;
\ The set of out registers has to be defined as a single batch.
\ They can't be defined piecemeal like global registers.
\ The set of local registers must be "batched" too.
8 out-regs %o0 %o1 %o2 %o3 %o4 %o5 %o6 %o7
0 8 local-regs %l0 %l1 %l2 %l3 %l4 %l5 %l6 %l7
8 8 local-regs %i0 %i1 %i2 %i3 %i4 %i5 %i6 %i7
false value standalone? \ Can be used to turn off stuff in stand.exe
: aligned? ( adr -- flag ) 3 and 0= ;
defer accessible? ( adr -- flag )
: yes-accessible ( adr -- true ) drop true ;
' yes-accessible is accessible?
\ Invalid, unaligned, or inaccessible call point
: pointer-bad? ( adr -- flag ) \ True if the address is not a good pointer
dup aligned? ( adr flag )
swap accessible? ( flag flag )
[ifnexist] log2 \ Might be defined in code
: log2 ( n -- log2-of-n )
-1 swap begin ( initl-log n )
\ : %cwp ( -- psr.cwp ) %psr h# 1f and ;
V9_SP_BIAS - dup previous-outs !
#windows 1 - %cansave - ( #valid-windows )
addr %i0 dup previous-outs ! 8 na+ view-window !
%i6 pointer-bad? %i6 0= or if
: +w ( -- ) (+w) abort" No more valid windows" ;
: set-window ( n -- ) 0w ( n ) 0 ?do (+w) ?leave loop ;
dup set-window window# <> if
." Window number too large. The maximum number is " window# . cr
: .reg# ( n -- ) <# ascii : hold u#s u#> type space ;
8 0 do i .reg# dup i xa+ x@ .nx cr loop drop
dup 8 and if ." N" else ." n" then
dup 4 and if ." Z" else ." z" then
dup 2 and if ." V" else ." v" then
1 and if ." C" else ." c" then
: (.icc) ( ccr -- ) ." ICC:" (.cc) ;
: (.xcc) ( ccr -- ) ." XCC:" 4 rshift (.cc) ;
: (.ccr) ( ccr -- ) dup (.xcc) 3 spaces (.icc) ;
: .icc ( -- ) %ccr (.icc) ;
: .xcc ( -- ) %ccr (.xcc) ;
: .ccr ( -- ) %ccr (.ccr) ;
d# 8 to-column ." Normal"
d# 24 to-column ." Alternate"
d# 58 to-column ." Vector" cr
0 .reg# %g0 .nx %a0 .nx %m0 .nx %v0 .nx cr
1 .reg# %g1 .nx %a1 .nx %m1 .nx %v1 .nx cr
2 .reg# %g2 .nx %a2 .nx %m2 .nx %v2 .nx cr
3 .reg# %g3 .nx %a3 .nx %m3 .nx %v3 .nx cr
4 .reg# %g4 .nx %a4 .nx %m4 .nx %v4 .nx cr
5 .reg# %g5 .nx %a5 .nx %m5 .nx %v5 .nx cr
6 .reg# %g6 .nx %a6 .nx %m6 .nx %v6 .nx cr
7 .reg# %g7 .nx %a7 .nx %m7 .nx %v7 .nx cr
d# 24 to-column ." GL=1" cr
0 .reg# %g0 .nx %a0 .nx cr
1 .reg# %g1 .nx %a1 .nx cr
2 .reg# %g2 .nx %a2 .nx cr
3 .reg# %g3 .nx %a3 .nx cr
4 .reg# %g4 .nx %a4 .nx cr
5 .reg# %g5 .nx %a5 .nx cr
6 .reg# %g6 .nx %a6 .nx cr
7 .reg# %g7 .nx %a7 .nx cr
." %PC " %pc .x ." %nPC " %npc .x cr
." %TBA " %tba .x ." %CCR " %ccr .x .ccr cr
: .globals ( -- ) addr %g0 .glob-regs ;
: .alternate-globals ( -- ) addr %a0 .glob-regs ;
: .mmu-globals ( -- ) addr %m0 .glob-regs ;
: .vector-globals ( -- ) addr %v0 .glob-regs ;
d# 24 to-column ." LOCALs"
d# 40 to-column ." OUTs" cr
0 .reg# %i0 .nx %l0 .nx %o0 .nx cr
1 .reg# %i1 .nx %l1 .nx %o1 .nx cr
2 .reg# %i2 .nx %l2 .nx %o2 .nx cr
3 .reg# %i3 .nx %l3 .nx %o3 .nx cr
4 .reg# %i4 .nx %l4 .nx %o4 .nx cr
5 .reg# %i5 .nx %l5 .nx %o5 .nx cr
6 .reg# %i6 .nx %l6 .nx %o6 .nx cr
7 .reg# %i7 .nx %l7 .nx %o7 .nx cr
: (.pstate) ( pstate -- )
: (.tstate) ( tstate -- )
." %PSTATE:" d# 16 bits dup .x (.pstate) cr
." %CCR:" 8 bits dup .x ." " (.ccr)
: .pstate ( -- ) pstate@ (.pstate) ;
1- addr %tstate-1 swap xa+ x@ (.tstate)
: %tstate ( level -- n ) 1- addr %tstate-1 swap xa+ x@ ;
: %tpc ( level -- n ) 1- addr %tpc-1 swap xa+ x@ ;
: %tnpc ( level -- n ) 1- addr %tnpc-1 swap xa+ x@ ;
: %tt ( level -- n ) 1- addr %tt-1 swap xa+ x@ ;
: init-window ( -- ) 0w ;
: .window ( window# -- ) w .locals ;
#windows %cwp - + #windows mod 0 ?do
addr %i0 dup previous-outs !
only forth also definitions