[OpenSPARC-T2-SAM] / obp / obp / fm / lib / headtool.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: headtool.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: @(#)headtool.fth 1.9 03/12/11 09:22:54
purpose: 
copyright: Copyright 1990-2001 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.
\ Copyright 1985-1990 Bradley Forthware

\ Tools to make headerless definitions easier to live with.
\ To reheader the headerless words, download the headers file
\ via  DL  or something like it. 

headers

\  The format of each line of the "headers" file produced by the OBP
\  make  process is:
\      h#  <Offset>  <headerless:|header:>  <name>
\
\  After reading the "headers" file through these definitions, it should
\  be possible to find a name for most definitions.

\  Re-create headers by making them an alias for the actual name.  Keep them
\  within the special re-created headers' vocabulary.  If they are leftover
\  transient words, i.e., outside the dictionary, ignore them...
: headerless:  \ name  ( offset -- )   compile-time
               \       ( ??? -- ??? )  run-time
   origin+ dup in-dictionary? parse-word rot if
	  [ also hidden ]
	  ['] re-heads
	  [ previous ] $create-word flagalias  acf-align token,
   else
	  3drop
   then
;

: header:      \ name  ( offset -- )   compile-time
               \       ( ??? -- ??? )  run-time
   drop [compile] \
;


\  Before faking-out a headerless name, scan the vocabulary of the
\  re-created headers.  Fake-out the name only if it isn't found.
: find-head  ( cfa -- nfa )
   [ also hidden ]
   ['] re-heads
   [ previous ] follow begin	( cfa )
      another?			( cfa nfa flag )
   while			( cfa nfa )
      2dup name> token@		( cfa nfa cfa cfa2 )
      = if			( cfa nfa )
	 nip exit		( nfa )
      else
	 drop			( cfa )
      then			( cfa )
   repeat			( cfa )
   fake-name			( nfa )
;


\  Plug the routine to scan the re-created headers' vocabulary in to
\  the word that looks up names.  It does no harm to have it plugged
\  in place even if the headers file has not been read, because the
\  initial link-pointer in the re-created headers' vocabulary is null.

patch find-head fake-name >name
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: headtool.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: @(#)headtool.fth 1.9 03/12/11 09:22:54
	43	purpose:
	44	copyright: Copyright 1990-2001 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46	\ Copyright 1985-1990 Bradley Forthware
	47
	48	\ Tools to make headerless definitions easier to live with.
	49	\ To reheader the headerless words, download the headers file
	50	\ via DL or something like it.
	51
	52	headers
	53
	54	\ The format of each line of the "headers" file produced by the OBP
	55	\ make process is:
	56	\ h# <Offset> <headerless:\|header:> <name>
	57	\
	58	\ After reading the "headers" file through these definitions, it should
	59	\ be possible to find a name for most definitions.
	60
	61	\ Re-create headers by making them an alias for the actual name. Keep them
	62	\ within the special re-created headers' vocabulary. If they are leftover
	63	\ transient words, i.e., outside the dictionary, ignore them...
	64	: headerless: \ name ( offset -- ) compile-time
65	\ ( ??? -- ??? ) run-time
66	origin+ dup in-dictionary? parse-word rot if
67	[ also hidden ]
68	['] re-heads
69	[ previous ] $create-word flagalias acf-align token,
70	else
71	3drop
72	then
73	;
74
75	: header: \ name ( offset -- ) compile-time
76	\ ( ??? -- ??? ) run-time
77	drop [compile] \
78	;
79
80
81	\ Before faking-out a headerless name, scan the vocabulary of the
82	\ re-created headers. Fake-out the name only if it isn't found.
83	: find-head ( cfa -- nfa )
84	[ also hidden ]
85	['] re-heads
86	[ previous ] follow begin ( cfa )
87	another? ( cfa nfa flag )
88	while ( cfa nfa )
89	2dup name> token@ ( cfa nfa cfa cfa2 )
90	= if ( cfa nfa )
91	nip exit ( nfa )
92	else
93	drop ( cfa )
94	then ( cfa )
95	repeat ( cfa )
96	fake-name ( nfa )
97	;
98
99
100	\ Plug the routine to scan the re-created headers' vocabulary in to
101	\ the word that looks up names. It does no harm to have it plugged
102	\ in place even if the headers file has not been read, because the
103	\ initial link-pointer in the re-created headers' vocabulary is null.
104
105	patch find-head fake-name >name
106
107