[OpenSPARC-T2-SAM] / obp / obp / os / sun / elfsym.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: elfsym.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 
\    conditions are met: 
\ 
\  - 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
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
id: @(#)elfsym.fth 1.6 95/05/31
purpose: 
copyright: Copyright 1992-1994 Sun Microsystems, Inc.  All Rights Reserved

\ symtab.fth 2.3 90/09/03
\ Copyright 1985-1990 Bradley Forthware

\ Creates an ELF-format symbol table.
\
\    add-symbol  ( value name type -- )   \ Adds a symbol to the symbol table
\    symbol-table  ( -- adr )             \ Base address of symbol table
\    /symbol-table  ( -- n )              \ Current size of symbol table
\    string-table  ( -- adr )             \ Base address of string table
\    /string-table  ( -- n )              \ Current size of string table
\    clear-symbol-table  ( -- )           \ Deallocates space used by tables
\    set-symbol-usage  ( adr -- )         \ Last symbol referenced at adr
\    find-symbol-usage  ( name -- adr )   \ Location where name is referenced

decimal

headerless
100 value #symbols-max
 15 constant avg-bytes/string

alias /sym /elf32-symbol

variable symbol#
0 value symbol-table
: /sym*  ( index -- offset )  /sym  *  ;	\ String offset, flags, value
: /symbol-table  ( -- n )  symbol# @  /sym*  ;
#symbols-max /sym*  constant /symbol-table-max

0 value symbol-used		\ Array of pointer to symbol references
#symbols-max /l*              constant /symbol-used

0 value string-table
#symbols-max avg-bytes/string *  /l +        constant /string-table-max

0 value /string-table

defer $add-symbol
: ?initialize-symbol-table  ( -- )    \ Allocate memory for tables if needed
   symbol-table 0=  if
      symbol# off
      /symbol-table-max   alloc-mem  is symbol-table
      /symbol-used        alloc-mem  is symbol-used
      /string-table-max   alloc-mem  is string-table
\      0 string-table c!  1 to /string-table	\ Skip the beginning null byte
      0  " "  0 $add-symbol                     \ Required null symbol entry
      0  " "  h# 0003.0003 $add-symbol  \ Data section
      0  " "  h# 0002.0003 $add-symbol  \ Text section
   then
;
: clear-symbol-table  ( -- )    \ Deallocate memory used by tables
   symbol-table 0<>  if
      string-table /string-table-max   free-mem
      symbol-used  /symbol-used        free-mem
      symbol-table /symbol-table-max   free-mem
      0 is symbol-table
   then
;
: omit-_  ( adr,len -- adr',len' )
   dup 1 >=  if
      over c@  ascii _  =  if
         1 /string
      then
   then
;
: >sym-offset  ( index -- offset )
   /sym*  symbol-table  +  st32_name  l@  ( string-table-offset )
;
: symname  ( index -- adr len )
   >sym-offset  string-table +  cscount
;
: $find-symbol  ( adr,len -- symbol# )  \ Symbol# is -1 if not found
   omit-_                    ( adr len sym# )
   -1  -rot                  ( sym# adr len )
   symbol# @  0  ?do         ( sym# adr len )
      2dup  i symname  $=  if  rot drop i -rot  leave  then   ( sym# adr len )
   loop    ( sym# adr len )
   2drop     ( sym# )
;
: $place-string  ( adr,len -- location )	\ Internal factor
   2dup $find-symbol dup -1 <>  if  ( adr,len )
      nip nip  >sym-offset  exit
   then                        ( adr,len -1 )
   drop                        ( adr,len )
   omit-_
   dup 1+  /string-table  +      ( adr len end-index )
   dup  /string-table-max  >=
   abort" String table overflow; increase /string-table-max"
   >r                            ( adr len )
   /string-table string-table +  swap cmove   ( )
   0  r@ 1- string-table +  c!
   /string-table
   r> is /string-table
;
\ Interesting values for $add-symbol's "type" argument

h# 0000.0010 constant undefined-external        \ Undef, global, STT_NOTYPE
h# 0002.0012 constant external-procedure        \ Text,  global, STT_FUNC
h# 0003.0011 constant external-variable         \ Data,  global, STT_OBJECT
h# fff2.0014 constant external-common           \ Common,global, STT_OBJECT

: $add-sized-symbol  ( value name,len type size -- )
   ?initialize-symbol-table
   symbol# @  #symbols-max >=
   abort" Symbol table overflow; increase #symbols-max"

   symbol-table  /symbol-table +     ( value name,len type size adr )
   >r                                ( value name type size )
   0 r@ st32_other c!                \ Clear boring field
   r@ st32_size l!                   ( value name,len type )
   dup r@ st32_info c!               ( value name,len type )
   d# 16 >> r@ st32_shndx w!         ( value name,len )
   rot  r@ st32_value l!             ( name,len )
   $place-string  r> st32_name l!    ( )
   1 symbol# +!
;
: ($add-symbol)  ( value name,len type -- )
   0 $add-sized-symbol
;
' ($add-symbol) is $add-symbol
: set-symbol-usage  ( adr -- )  symbol-used  symbol# @ 1-  la+  !  ;

: $find-symbol-usage  ( adr,len -- adr )
   $find-symbol  ( sym# )
   dup 0<  if  drop 0  else  symbol-used swap la+  l@  then
;

: ?$add-symbol  ( name$ -- sym# )
   2dup  $find-symbol                       ( name,len sym# )
   dup 0<  if                               ( name,len sym# )
      drop                                  ( name,len )
      0 -rot undefined-external $add-symbol ( )
      symbol# @ 1-                          ( sym# )
   else                                     ( name,len sym# )
      nip nip                               ( sym# )
   then                                     ( sym# )
;
: terminate-string-table  ( -- )  " " $place-string  drop  ;

0 is symbol-table
headers
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: elfsym.fth
	4	\
	5	\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
	6	\
	7	\ - Do no alter or remove copyright notices
	8	\
	9	\ - Redistribution and use of this software in source and binary forms, with
	10	\ or without modification, are permitted provided that the following
	11	\ conditions are met:
	12	\
	13	\ - Redistribution of source code must retain the above copyright notice,
	14	\ this list of conditions and the following disclaimer.
	15	\
	16	\ - Redistribution in binary form must reproduce the above copyright notice,
	17	\ this list of conditions and the following disclaimer in the
	18	\ documentation and/or other materials provided with the distribution.
	19	\
	20	\ Neither the name of Sun Microsystems, Inc. or the names of contributors
	21	\ may be used to endorse or promote products derived from this software
	22	\ without specific prior written permission.
	23	\
	24	\ This software is provided "AS IS," without a warranty of any kind.
	25	\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
	26	\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
	27	\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
	28	\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
	29	\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
	30	\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
	31	\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
	32	\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
	33	\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
	34	\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
	35	\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
	36	\
	37	\ You acknowledge that this software is not designed, licensed or
	38	\ intended for use in the design, construction, operation or maintenance of
	39	\ any nuclear facility.
	40	\
	41	\ ========== Copyright Header End ============================================
	42	id: @(#)elfsym.fth 1.6 95/05/31
	43	purpose:
	44	copyright: Copyright 1992-1994 Sun Microsystems, Inc. All Rights Reserved
	45
	46	\ symtab.fth 2.3 90/09/03
	47	\ Copyright 1985-1990 Bradley Forthware
	48
	49	\ Creates an ELF-format symbol table.
	50	\
	51	\ add-symbol ( value name type -- ) \ Adds a symbol to the symbol table
	52	\ symbol-table ( -- adr ) \ Base address of symbol table
	53	\ /symbol-table ( -- n ) \ Current size of symbol table
	54	\ string-table ( -- adr ) \ Base address of string table
	55	\ /string-table ( -- n ) \ Current size of string table
	56	\ clear-symbol-table ( -- ) \ Deallocates space used by tables
	57	\ set-symbol-usage ( adr -- ) \ Last symbol referenced at adr
	58	\ find-symbol-usage ( name -- adr ) \ Location where name is referenced
	59
	60	decimal
	61
	62	headerless
	63	100 value #symbols-max
	64	15 constant avg-bytes/string
65
66	alias /sym /elf32-symbol
67
68	variable symbol#
69	0 value symbol-table
70	: /sym* ( index -- offset ) /sym * ; \ String offset, flags, value
71	: /symbol-table ( -- n ) symbol# @ /sym* ;
72	#symbols-max /sym* constant /symbol-table-max
73
74	0 value symbol-used \ Array of pointer to symbol references
75	#symbols-max /l* constant /symbol-used
76
77	0 value string-table
78	#symbols-max avg-bytes/string * /l + constant /string-table-max
79
80	0 value /string-table
81
82	defer $add-symbol
83	: ?initialize-symbol-table ( -- ) \ Allocate memory for tables if needed
84	symbol-table 0= if
85	symbol# off
86	/symbol-table-max alloc-mem is symbol-table
87	/symbol-used alloc-mem is symbol-used
88	/string-table-max alloc-mem is string-table
89	\ 0 string-table c! 1 to /string-table \ Skip the beginning null byte
90	0 " " 0 $add-symbol \ Required null symbol entry
91	0 " " h# 0003.0003 $add-symbol \ Data section
92	0 " " h# 0002.0003 $add-symbol \ Text section
93	then
94	;
95	: clear-symbol-table ( -- ) \ Deallocate memory used by tables
96	symbol-table 0<> if
97	string-table /string-table-max free-mem
98	symbol-used /symbol-used free-mem
99	symbol-table /symbol-table-max free-mem
100	0 is symbol-table
101	then
102	;
103	: omit-_ ( adr,len -- adr',len' )
104	dup 1 >= if
105	over c@ ascii _ = if
106	1 /string
107	then
108	then
109	;
110	: >sym-offset ( index -- offset )
111	/sym* symbol-table + st32_name l@ ( string-table-offset )
112	;
113	: symname ( index -- adr len )
114	>sym-offset string-table + cscount
115	;
116	: $find-symbol ( adr,len -- symbol# ) \ Symbol# is -1 if not found
117	omit-_ ( adr len sym# )
118	-1 -rot ( sym# adr len )
119	symbol# @ 0 ?do ( sym# adr len )
120	2dup i symname $= if rot drop i -rot leave then ( sym# adr len )
121	loop ( sym# adr len )
122	2drop ( sym# )
123	;
124	: $place-string ( adr,len -- location ) \ Internal factor
125	2dup $find-symbol dup -1 <> if ( adr,len )
126	nip nip >sym-offset exit
127	then ( adr,len -1 )
128	drop ( adr,len )
129	omit-_
130	dup 1+ /string-table + ( adr len end-index )
131	dup /string-table-max >=
132	abort" String table overflow; increase /string-table-max"
133	>r ( adr len )
134	/string-table string-table + swap cmove ( )
135	0 r@ 1- string-table + c!
136	/string-table
137	r> is /string-table
138	;
139	\ Interesting values for $add-symbol's "type" argument
140
141	h# 0000.0010 constant undefined-external \ Undef, global, STT_NOTYPE
142	h# 0002.0012 constant external-procedure \ Text, global, STT_FUNC
143	h# 0003.0011 constant external-variable \ Data, global, STT_OBJECT
144	h# fff2.0014 constant external-common \ Common,global, STT_OBJECT
145
146	: $add-sized-symbol ( value name,len type size -- )
147	?initialize-symbol-table
148	symbol# @ #symbols-max >=
149	abort" Symbol table overflow; increase #symbols-max"
150
151	symbol-table /symbol-table + ( value name,len type size adr )
152	>r ( value name type size )
153	0 r@ st32_other c! \ Clear boring field
154	r@ st32_size l! ( value name,len type )
155	dup r@ st32_info c! ( value name,len type )
156	d# 16 >> r@ st32_shndx w! ( value name,len )
157	rot r@ st32_value l! ( name,len )
158	$place-string r> st32_name l! ( )
159	1 symbol# +!
160	;
161	: ($add-symbol) ( value name,len type -- )
162	0 $add-sized-symbol
163	;
164	' ($add-symbol) is $add-symbol
165	: set-symbol-usage ( adr -- ) symbol-used symbol# @ 1- la+ ! ;
166
167	: $find-symbol-usage ( adr,len -- adr )
168	$find-symbol ( sym# )
169	dup 0< if drop 0 else symbol-used swap la+ l@ then
170	;
171
172	: ?$add-symbol ( name$ -- sym# )
173	2dup $find-symbol ( name,len sym# )
174	dup 0< if ( name,len sym# )
175	drop ( name,len )
176	0 -rot undefined-external $add-symbol ( )
177	symbol# @ 1- ( sym# )
178	else ( name,len sym# )
179	nip nip ( sym# )
180	then ( sym# )
181	;
182	: terminate-string-table ( -- ) " " $place-string drop ;
183
184	0 is symbol-table
185	headers