\ ========== Copyright Header Begin ==========================================
\ Hypervisor Software File: target.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 ============================================
copyright: Copyright 1990-2003 Sun Microsystems, Inc. All Rights Reserved
copyright: Use is subject to license terms.
\ Copyright 1985-1990 Bradley Forthware
\ Target configuration - SPARC
only forth also meta assembler definitions
: normal ( -- ) \ Perform target-dependent assembler initialization
only forth also meta definitions
: init-relocation-t ; immediate
\t16-t tshift-t constant tshift-t
\t16-t /w-t constant /a-t
\t32-t /l-t constant /a-t
\t16-t /w-t constant /token-t
\t32-t /l-t constant /token-t
\t16-t /w-t constant /link-t
\t32-t /l-t constant /link-t
/token-t constant /defer-t
/n-t th 800 * constant user-size-t
/n-t th 200 1- * constant ps-size-t
/n-t th 200 1- * constant rs-size-t
\t16-t /w-t constant /user#-t
\t32-t /l-t constant /user#-t
\ 32 bit host Forth compiling 32-bit target Forth
: c!-t ( n add -- ) >hostaddr c! ;
: c@-t ( target-address -- n ) >hostaddr c@ ;
over hibyte over c!-t ca1+ swap lobyte swap c!-t
: l!-t ( l add -- ) >r lwsplit r@ w!-t r> /w-t + w!-t ;
: !-t ( n add -- ) l!-t ;
: w@-t ( target-address -- n )
dup c@-t 8 << swap 1+ c@-t or
: l@-t ( target-address -- n )
dup >r /w-t + w@-t r> w@-t wljoin
32\ : @-t ( target-address -- n ) l@-t ;
64\ : @-t ( target-address -- n ) /l + l@-t ;
\ Store target data types into the host address space.
: c-t! ( c host-address -- ) c! ;
: w-t! ( w host-address -- )
over hibyte over c-t! ca1+ swap lobyte swap c-t!
: l-t! ( l host-address -- ) >r lwsplit r@ w-t! r> /w-t + w-t! ;
32\ : n-t! ( n host-address -- ) l-t! ;
64\ : n-t! ( n host-address -- ) /l + l-t! ;
\ Next 3 are machine-independent
: c,-t ( byte -- ) dp-t @ c!-t 1 dp-t +! ;
: w,-t ( word -- ) dp-t @ w!-t /w-t dp-t +! ;
: l,-t ( long -- ) dp-t @ l!-t /l-t dp-t +! ;
32\ : ,-t ( n -- ) l,-t ; \ for 32 bit stacks
64\ dup h# 8000.0000 and if
64\ dup h# ffff.ff00 u> if -1 else 0 then
64\ else 0 then l,-t l,-t
: a@-t ( target-address -- target-address )
\t16-t w@-t tshift-t << origin-t +
: a!-t ( token target-address -- )
\t16-t swap origin-t - tshift-t >> swap w!-t
: token@-t ( target-address -- target-acf ) a@-t ;
: token!-t ( acf target-address -- ) a!-t ;
: rlink@-t ( occurrence -- next-occurrence )
\t16-t w@-t 1 << origin-t +
: rlink!-t ( next-occurrence occurrence -- )
\t16-t swap origin-t - 1 >> swap w!-t
: a,-t ( adr -- ) here-t /a-t allot-t a!-t ;
: token,-t ( token -- ) here-t /token-t allot-t token!-t ;
\ These versions of linkx-t are for absolute links
: link@-t ( target-address -- target-address' ) a@-t ;
: link!-t ( target-address target-address -- ) a!-t ;
: link,-t ( target-address -- ) a,-t ;
: a-t@ ( host-address -- target-address )
\t16-t w@ tshift-t << origin-t +
: a-t! ( target-address host-address -- )
\t16-t swap origin-t - tshift-t >> swap w!
: rlink-t@ ( host-adr -- target-adr )
\t16-t w@ 1 << origin-t +
: rlink-t! ( target-adr host-adr -- )
\t16-t swap origin-t - 1 >> swap w!
: token-t@ ( host-address -- target-acf ) a-t@ ;
: token-t! ( target-acf host-address -- ) a-t! ;
: link-t@ ( host-address -- target-address ) a-t@ ;
: link-t! ( target-address host-address -- ) a-t! ;
: a-t, ( target-address -- ) here /a-t allot a-t! ;
: token-t, ( target-address -- ) here /token-t allot token-t! ;
: >body-t ( cfa-t -- pfa-t )
\t32-t 8 + \ Call instruction plus delay instruction
\t16-t 2 + \ Indirect token
create threads-t #threads-t /link-t * allot
: $hash-t ( str voc-ptr -- thread )
nip swap c@ #threads-t 1- and /thread-t * +
\ Should allocate these dynamically.
\ The dictionary space should be dynamically allocated too.
\ The user area image lives in the host address space.
\ We wish to store into the user area with -t commands so as not
\ to need separate words to store target items into host addresses.
\ That is why user+ returns a target address.
user-size-t alloc-mem is userarea-t
userarea-t user-size-t erase
: >user-t ( cfa-t -- user-address-t )
: n>link-t ( anf-t -- alf-t ) dup begin 1+ dup c@ h# 80 and until c@ + 1+ ;
: l>name-t ( alf-t -- anf-t ) 1- dup c@ h# 1f and - ;
: >link-t ( acf-t -- alf-t ) /link-t - ;
/l constant #align-t \ XXX Is this right ?
\t16-t /w constant #talign-t
\t32-t /l constant #talign-t
\t16-t 1 tshift-t << constant #linkalign-t
\t16-t 1 tshift-t << constant #acf-align-t
\t32-t /l constant #linkalign-t
\t32-t /l constant #acf-align-t
: aligned-t ( n1 -- n2 ) #align-t 1- + #align-t negate and ;
: acf-aligned-t ( n1 -- n2 ) #acf-align-t 1- + #acf-align-t negate and ;
begin here-t #align-t 1- and while 0 c,-t repeat
begin here-t #talign-t 1- and while 0 c,-t repeat
begin here-t #linkalign-t 1- and while 0 c,-t repeat
begin here-t #acf-align-t 1- and while 0 c,-t repeat
only forth also labels also meta also srassembler
[ assembler ] normal [ meta ]
\ Next 5 are Machine Independent
: cmove-t ( from to-t n -- )
0 do over c@ over c!-t 1+ swap 1+ swap loop 2drop
: place-cstr-t ( adr len cstr-adr-t -- cstr-adr-t )
>r tuck r@ swap cmove-t ( len ) r@ + 0 swap c!-t r>
: "copy-t ( from to-t -- )
: toggle-t ( addr-t n -- ) swap >r r@ c@-t xor r> c!-t ;
: clear-threads-t ( hostaddr -- )
#threads-t /link-t * bounds do
threads-t clear-threads-t threads-t current-t !
\ For compiling branch offsets used by control constructs.
\ These compile relative branches.
\t16-t /w-t constant /branch
\t32-t /l-t constant /branch
: branch! ( from target -- )
over - ( from offset ) swap
: thread-t! ( thread adr -- ) link-t! ;
only forth also meta also definitions
: install-target-assembler ( -- )
: install-host-assembler ( -- )
[ assembler ] resident-assembler [ meta ]
projects / OpenSPARC-T2-SAM / blob