[OpenSPARC-T2-SAM] / obp / obp / pkg / tokenizr / crosslis.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: crosslis.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: @(#)crosslis.fth 1.5 04/02/23
purpose: Tokenizer macros - one word expands to several FCodes
copyright: Copyright 1996-2004 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

\ Cross-compiler equivalents for tokenizer system
\ "All accounted for" means that, for this section, all non-primitives
\ are named (and either defined, or at least mentioned.)


\  In order to prevent multi-token macros from being accepted as
\      targets of ['] or ' (so-called "tick-targets"), we check
\      for seeming-tokens that are actually colon-definitions or
\      the like.  However, some single-token macros are valid
\     "tick-targets" anyway.
\  The operator  valid-tick-target  will qualify the last definition
\      as a valid tick-target. 


\ --- IEEE 1275 and ANS Forth name changes ------------------------------

\  As it happens, all the  v2-compat:  definitions are valid "tick-targets"
\      but this need not be necessarily so.  Therefore, I am not going to
\      include the  v2-compat:  defining-word in the list of word-types
\      that are valid "tick-targets", nor am I going to mark these words
\      individually with the  valid-tick-target  operator.
\  Instead, I will make  v2-compat:  do the checking and mark the new words
\      appropriately.  I will merely append a  v-t-t  comment... 

v2-compat: << lshift					  \  v-t-t
v2-compat: >> rshift					  \  v-t-t
v2-compat: attribute property				  \  v-t-t
v2-compat: delete-attribute delete-property		  \  v-t-t
v2-compat: get-inherited-attribute get-inherited-property \  v-t-t
v2-compat: get-my-attribute get-my-property		  \  v-t-t
v2-compat: get-package-attribute get-package-property	  \  v-t-t
v2-compat: /c*  chars					  \  v-t-t
v2-compat: ca1+ char+					  \  v-t-t
v2-compat: /n*  cells					  \  v-t-t
v2-compat: na1+ cell+					  \  v-t-t
v2-compat: decode-2int parse-2int			  \  v-t-t
v2-compat: eval evaluate				  \  v-t-t
v2-compat: flip wbflip					  \  v-t-t
v2-compat: lflips lwflips				  \  v-t-t
v2-compat: wflips wbflips				  \  v-t-t
v2-compat: is     to					  \  v-t-t
v2-compat: map-sbus map-low				  \  v-t-t
v2-compat: not  invert					  \  v-t-t
v2-compat: u*x  um*					  \  v-t-t
v2-compat: xu/mod um/mod				  \  v-t-t
v2-compat: x+ d+					  \  v-t-t
v2-compat: x- d-					  \  v-t-t
v2-compat: version fcode-revision			  \  v-t-t
v2-compat: xdr+ encode+					  \  v-t-t
v2-compat: xdrbytes encode-bytes			  \  v-t-t
v2-compat: xdrint encode-int				  \  v-t-t
v2-compat: xdrphys encode-phys				  \  v-t-t
v2-compat: xdrstring encode-string			  \  v-t-t
v2-compat: xdrtostring decode-string			  \  v-t-t
v2-compat: xdrtoint decode-int				  \  v-t-t
v2-compat: cmove move					  \  v-t-t
v2-compat: cmove> move					  \  v-t-t


\ --- Stack operators - All accounted for -------------------------------
\ : clear ( ??? -- ) depth 0 ?do drop loop  ;		not supported
\ : 4dup  ( a b c d -- a b c d  a b c d ) 2over 2over ; not supported
: 3dup  ( a b c   -- a b c    a b c   ) 2 pick  2 pick  2 pick ;
: 3drop ( a b c   -- ) drop 2drop ;


\ --- Memory operators - All accounted for ------------------------------
\   caps-comp						not supported
\   compare						not supported
\   creset						not supported
\   csearch						not supported
\   cset						not supported
\   ctoggle						not supported
\   du							not supported
\   dump						not supported
\   search						not supported
\   toggle						not supported
\   token!						not supported
\   token@						not supported
\   tsearch						not supported
\   wsearch						not supported
: blank ( addr count -- ) bl fill ;
: erase	( addr count -- ) 0 fill ;
: allot  ( #bytes -- ) 0 max 0 ?do 0 c, loop ;


\ --- Arithmetic - All accounted for ------------------------------------
\   4*							not supported
\   8*							not supported
\   cnot						not supported
\ : even  aligned ;					not supported
\ : lobyte  h# ff  and  ;				not supported
\ : ?negate  ( n1 n2 -- n1 | -n1 ) 0< if negate then ;	not supported
\   u*							not supported
\   umax						not supported
\   umin						not supported
: 1+    1 + ;
: 1-    1 - ;
: 2+    2 + ;
: 2-    2 - ;
: <<a   << ;  valid-tick-target
: */mod  >r * r> /mod ;
: */     >r * r> /    ;
: xu>l        ( ux -- ul ) drop   ;  valid-tick-target   \       64 -> 32
: lu>x        ( ul -- ux ) 0      ;  valid-tick-target   \ 32 -> 64


\ --- Stack operators - All accounted for -------------------------------
  : false  0 ;  valid-tick-target
  : true  -1 ;  valid-tick-target


\ --- TextInput - Only a subset is supported ----------------------------
\   (					included in main program
\   \					included in main program
\ : ok  ;						not supported
\   (s					included in main program
: accept ( addr len1 -- len2 )  span @ -rot expect  span @ swap span !  ;


\ --- Ascii - All accounted for -----------------------------------------
\   ascii  				included in main program
\   control 				included in main program
\   eof 						not needed
\ : printable?  ( char -- flag ) 			not supported
\    dup bl  h# 7f  within swap  h# 80  h# ff  between or ;
: carret    d# 13  emit-number ;
: linefeed  d# 10  emit-number ;
: newline   d# 10  emit-number ;


\ --- Numeric Input - All accounted for ---------------------------------
\   b#  				included in main program
\   convert  						not supported
\   d#  				included in main program
\   dpl   						not supported
\   h#  				included in main program
\   literal? 						not supported
\   long? 						not supported
\   number 						not supported
\   number? 						not supported
\   o#  				included in main program
\   td					included in main program
\   th					included in main program
: m-binary  ( -- )  2 base !  ;
: m-decimal ( -- )  d# 10 emit-number  base !  ;
: m-hex     ( -- )  d# 16 emit-number  base !  ;
: m-octal   ( -- )  8 emit-number  base !  ;


\ --- Numeric Output - All accounted for --------------------------------
: (.)  ( n -- addr len )  dup abs n->l <# u#s swap sign u#>  ;
: (.d) ( n -- addr len ) base @ swap m-decimal (.) rot base ! ;
: (.h) ( n -- addr len ) base @ swap m-hex     (.) rot base ! ;
: ?    ( addr -- )  @ .  ;
: .d   ( n -- )  base @ swap  m-decimal .  base !  ;
: .h   ( n -- )  base @ swap  m-hex     .  base !  ;
: s.   ( n -- )  (.) type  bl emit  ;
: (u.) ( n -- addr len )  n->l <# u#s u#>  ;
: .x   .h  ;  		\ Becoming obsolete


\ --- Pre IEEE-1275 use of #, #s, #> use single vs double stack value ---
Pre-1275:  #   #   u#
Pre-1275:  #s  #s  u#s
Pre-1275:  #>  #>  u#>

\ --- General Output - All accounted for --------------------------------
\ : backspaces  0 max 0 ?do  bs emit  loop  ; 		not supported
\ : beep  bell emit  ; 					not supported
\   crlf 						not supported
\   error-output 					not supported
\   exit? 						not supported
\   lf 							not supported
\   (lf 						not supported
\   prompt 						not supported
\   restore-output 					not supported
: space  bl emit  ; 
: spaces  0 max  0 ?do  space  loop  ;


\ --- Formatted output - All accounted for ------------------------------
\ : ??cr ( -- )  #out @  if cr then  ; 			not supported


\ --- Control - Most are in body of main program ------------------------
\ : perform  @ execute  ;				not supported


\ --- Strings - Only a subset is supported ------------------------------
\   "   				included in main program
\   .(  				included in main program
\   ."  				included in main program
\ : lower  ( addr len -- ) 				not supported
\    bounds ?do  i dup c@  lcc  swap c! loop ;

\ : upper  ( addr len -- ) 				not supported
\    bounds ?do  i dup c@  upc  swap c! loop ;

\ : sindex  ( addr1 len1 addr2 len2 -- n )  \ Find array1 within array2
\                                       		not supported
\    >r over r>  swap -    ( addr1 len1 addr2 len2-len1 )
\    dup 0<  if  2drop 2drop  -1  else
\       -1 swap  1+  0 do        ( addr1 len1 start2 found# )
\          2over 2over drop  swap comp  ( addr1 len1 start2 found# n )
\          0= if  drop i  leave  else  swap 1+ swap  then
\       loop                     ( addr1 len1 start2 found# )
\       >r 2drop drop r>
\    then ;

\ : -trailing  ( addr n1 -- addr n2 )
\    dup 0 do   2dup +  1- c@  bl <>  ?leave  1- loop ;
 

\ --- 32-Bit compatibility - All accounted for --------------------------
\   16\  included in main program  		not supported
\ : 32\  ;  					not supported
\ : 16-bit  abort" Not a 16-bit forth"  ;  	not supported
\ : 32-bit  ;  					not supported
\ : l!    !     ;				not supported
\ : l*    *     ; 				not supported
\ : l+    +     ; 				not supported
\ : l+!   +!    ; 				not supported
\ : l-    -     ; 				not supported
\ : l->n        ; 				not supported
\ : l->w  h# ffff and  ; 			not supported
\   l. 						not supported
\   (l.) 					not supported
\   l.r 					not supported
\ : l0=   0=    ; 				not supported
\ : l2/   2/    ; 				not supported
\ : l2dup 2dup  ; 				not supported
\ : l<    <     ; 				not supported
\ : l<<   <<    ; 				not supported
\ : l<<a  <<    ;				not supported
\ : l<=   <=    ; 				not supported
\ : l=    =     ; 				not supported
\ : l>    >     ; 				not supported
\ : l>=   >=    ; 				not supported
\ : l>>   >>    ; 				not supported
\ : l>>a  >>a   ; 				not supported
\   l>r  					not supported
\ : labs  abs   ; 				not supported
\ : land  and   ; 				not supported
\ : lbetween between ; 				not supported
\   lconstant 					not supported
\ : ldrop drop  ; 				not supported
\ : ldup  dup   ; 				not supported
\   lliteral 					not supported
\ : lmax  max   ; 				not supported
\ : lmin  min   ; 				not supported
\ : lnegate negate ; 				not supported
\ : ?lnegate ?negate ; 				not supported
\ : lnot  not   ; 				not supported
\ : lnover over ; 				not supported
\ : lnswap swap ; 				not supported
\ : lor   or    ; 				not supported
\   lr> 					not supported
\ : lswap  swap ; 				not supported
\   lvariable 					not supported
\ : lwithin within ; 				not supported
\ : m/mod  /mod ; 				not supported
\ : mu/mod u/mod ; 				not supported
\ : n->a        ; 				not supported
\ : n->l        ; 				not supported
\ : n->w  l->w  ; 				not supported
\ : nlover over ; 				not supported
\ : nlswap swap ; 				not supported
\ : s->l        ; 				not supported
\   ul*						not supported
\   ul.						not supported
\   (ul.)					not supported
\   ul.r					not supported
\   um*						not supported
\ : um/mod u/mod ;				not supported
\ : w->l        ;				not supported
\   wvariable					not supported
: wflip  lwsplit swap wljoin  ;

: version1? ( -- flag )   \ True if version 1.x 
   version h# 20000 emit-number <
;

: version2? ( -- flag )   \ True if version 2
   version h# 20000 emit-number >=
   version h# 30000 emit-number < and
   
;
: version2.0? ( -- flag )   \ True if version 2.0
   h# 20000 emit-number version =
;

: version2.1? ( -- flag )   \ True if version 2.1
   version h# 20001 emit-number =
;

: version2.2? ( -- flag )   \ True if version 2.2
   version h# 20002 emit-number =
;

: version2.3? ( -- flag )   \ True if version 2.3
   version h# 20003 emit-number =
;

: version3? ( -- flag )   \ True if version 3
   version h# 30000 emit-number =
;
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: crosslis.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: @(#)crosslis.fth 1.5 04/02/23
	43	purpose: Tokenizer macros - one word expands to several FCodes
	44	copyright: Copyright 1996-2004 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	\ Cross-compiler equivalents for tokenizer system
	48	\ "All accounted for" means that, for this section, all non-primitives
	49	\ are named (and either defined, or at least mentioned.)
	50
	51
	52	\ In order to prevent multi-token macros from being accepted as
	53	\ targets of ['] or ' (so-called "tick-targets"), we check
	54	\ for seeming-tokens that are actually colon-definitions or
	55	\ the like. However, some single-token macros are valid
	56	\ "tick-targets" anyway.
	57	\ The operator valid-tick-target will qualify the last definition
	58	\ as a valid tick-target.
	59
	60
	61	\ --- IEEE 1275 and ANS Forth name changes ------------------------------
	62
	63	\ As it happens, all the v2-compat: definitions are valid "tick-targets"
	64	\ but this need not be necessarily so. Therefore, I am not going to
65	\ include the v2-compat: defining-word in the list of word-types
66	\ that are valid "tick-targets", nor am I going to mark these words
67	\ individually with the valid-tick-target operator.
68	\ Instead, I will make v2-compat: do the checking and mark the new words
69	\ appropriately. I will merely append a v-t-t comment...
70
71	v2-compat: << lshift \ v-t-t
72	v2-compat: >> rshift \ v-t-t
73	v2-compat: attribute property \ v-t-t
74	v2-compat: delete-attribute delete-property \ v-t-t
75	v2-compat: get-inherited-attribute get-inherited-property \ v-t-t
76	v2-compat: get-my-attribute get-my-property \ v-t-t
77	v2-compat: get-package-attribute get-package-property \ v-t-t
78	v2-compat: /c* chars \ v-t-t
79	v2-compat: ca1+ char+ \ v-t-t
80	v2-compat: /n* cells \ v-t-t
81	v2-compat: na1+ cell+ \ v-t-t
82	v2-compat: decode-2int parse-2int \ v-t-t
83	v2-compat: eval evaluate \ v-t-t
84	v2-compat: flip wbflip \ v-t-t
85	v2-compat: lflips lwflips \ v-t-t
86	v2-compat: wflips wbflips \ v-t-t
87	v2-compat: is to \ v-t-t
88	v2-compat: map-sbus map-low \ v-t-t
89	v2-compat: not invert \ v-t-t
90	v2-compat: ux um \ v-t-t
91	v2-compat: xu/mod um/mod \ v-t-t
92	v2-compat: x+ d+ \ v-t-t
93	v2-compat: x- d- \ v-t-t
94	v2-compat: version fcode-revision \ v-t-t
95	v2-compat: xdr+ encode+ \ v-t-t
96	v2-compat: xdrbytes encode-bytes \ v-t-t
97	v2-compat: xdrint encode-int \ v-t-t
98	v2-compat: xdrphys encode-phys \ v-t-t
99	v2-compat: xdrstring encode-string \ v-t-t
100	v2-compat: xdrtostring decode-string \ v-t-t
101	v2-compat: xdrtoint decode-int \ v-t-t
102	v2-compat: cmove move \ v-t-t
103	v2-compat: cmove> move \ v-t-t
104
105
106	\ --- Stack operators - All accounted for -------------------------------
107	\ : clear ( ??? -- ) depth 0 ?do drop loop ; not supported
108	\ : 4dup ( a b c d -- a b c d a b c d ) 2over 2over ; not supported
109	: 3dup ( a b c -- a b c a b c ) 2 pick 2 pick 2 pick ;
110	: 3drop ( a b c -- ) drop 2drop ;
111
112
113	\ --- Memory operators - All accounted for ------------------------------
114	\ caps-comp not supported
115	\ compare not supported
116	\ creset not supported
117	\ csearch not supported
118	\ cset not supported
119	\ ctoggle not supported
120	\ du not supported
121	\ dump not supported
122	\ search not supported
123	\ toggle not supported
124	\ token! not supported
125	\ token@ not supported
126	\ tsearch not supported
127	\ wsearch not supported
128	: blank ( addr count -- ) bl fill ;
129	: erase ( addr count -- ) 0 fill ;
130	: allot ( #bytes -- ) 0 max 0 ?do 0 c, loop ;
131
132
133	\ --- Arithmetic - All accounted for ------------------------------------
134	\ 4* not supported
135	\ 8* not supported
136	\ cnot not supported
137	\ : even aligned ; not supported
138	\ : lobyte h# ff and ; not supported
139	\ : ?negate ( n1 n2 -- n1 \| -n1 ) 0< if negate then ; not supported
140	\ u* not supported
141	\ umax not supported
142	\ umin not supported
143	: 1+ 1 + ;
144	: 1- 1 - ;
145	: 2+ 2 + ;
146	: 2- 2 - ;
147	: <<a << ; valid-tick-target
148	: /mod >r r> /mod ;
149	: / >r r> / ;
150	: xu>l ( ux -- ul ) drop ; valid-tick-target \ 64 -> 32
151	: lu>x ( ul -- ux ) 0 ; valid-tick-target \ 32 -> 64
152
153
154	\ --- Stack operators - All accounted for -------------------------------
155	: false 0 ; valid-tick-target
156	: true -1 ; valid-tick-target
157
158
159	\ --- TextInput - Only a subset is supported ----------------------------
160	\ ( included in main program
161	\ \ included in main program
162	\ : ok ; not supported
163	\ (s included in main program
164	: accept ( addr len1 -- len2 ) span @ -rot expect span @ swap span ! ;
165
166
167	\ --- Ascii - All accounted for -----------------------------------------
168	\ ascii included in main program
169	\ control included in main program
170	\ eof not needed
171	\ : printable? ( char -- flag ) not supported
172	\ dup bl h# 7f within swap h# 80 h# ff between or ;
173	: carret d# 13 emit-number ;
174	: linefeed d# 10 emit-number ;
175	: newline d# 10 emit-number ;
176
177
178	\ --- Numeric Input - All accounted for ---------------------------------
179	\ b# included in main program
180	\ convert not supported
181	\ d# included in main program
182	\ dpl not supported
183	\ h# included in main program
184	\ literal? not supported
185	\ long? not supported
186	\ number not supported
187	\ number? not supported
188	\ o# included in main program
189	\ td included in main program
190	\ th included in main program
191	: m-binary ( -- ) 2 base ! ;
192	: m-decimal ( -- ) d# 10 emit-number base ! ;
193	: m-hex ( -- ) d# 16 emit-number base ! ;
194	: m-octal ( -- ) 8 emit-number base ! ;
195
196
197	\ --- Numeric Output - All accounted for --------------------------------
198	: (.) ( n -- addr len ) dup abs n->l <# u#s swap sign u#> ;
199	: (.d) ( n -- addr len ) base @ swap m-decimal (.) rot base ! ;
200	: (.h) ( n -- addr len ) base @ swap m-hex (.) rot base ! ;
201	: ? ( addr -- ) @ . ;
202	: .d ( n -- ) base @ swap m-decimal . base ! ;
203	: .h ( n -- ) base @ swap m-hex . base ! ;
204	: s. ( n -- ) (.) type bl emit ;
205	: (u.) ( n -- addr len ) n->l <# u#s u#> ;
206	: .x .h ; \ Becoming obsolete
207
208
209	\ --- Pre IEEE-1275 use of #, #s, #> use single vs double stack value ---
210	Pre-1275: # # u#
211	Pre-1275: #s #s u#s
212	Pre-1275: #> #> u#>
213
214	\ --- General Output - All accounted for --------------------------------
215	\ : backspaces 0 max 0 ?do bs emit loop ; not supported
216	\ : beep bell emit ; not supported
217	\ crlf not supported
218	\ error-output not supported
219	\ exit? not supported
220	\ lf not supported
221	\ (lf not supported
222	\ prompt not supported
223	\ restore-output not supported
224	: space bl emit ;
225	: spaces 0 max 0 ?do space loop ;
226
227
228	\ --- Formatted output - All accounted for ------------------------------
229	\ : ??cr ( -- ) #out @ if cr then ; not supported
230
231
232	\ --- Control - Most are in body of main program ------------------------
233	\ : perform @ execute ; not supported
234
235
236	\ --- Strings - Only a subset is supported ------------------------------
237	\ " included in main program
238	\ .( included in main program
239	\ ." included in main program
240	\ : lower ( addr len -- ) not supported
241	\ bounds ?do i dup c@ lcc swap c! loop ;
242
243	\ : upper ( addr len -- ) not supported
244	\ bounds ?do i dup c@ upc swap c! loop ;
245
246	\ : sindex ( addr1 len1 addr2 len2 -- n ) \ Find array1 within array2
247	\ not supported
248	\ >r over r> swap - ( addr1 len1 addr2 len2-len1 )
249	\ dup 0< if 2drop 2drop -1 else
250	\ -1 swap 1+ 0 do ( addr1 len1 start2 found# )
251	\ 2over 2over drop swap comp ( addr1 len1 start2 found# n )
252	\ 0= if drop i leave else swap 1+ swap then
253	\ loop ( addr1 len1 start2 found# )
254	\ >r 2drop drop r>
255	\ then ;
256
257	\ : -trailing ( addr n1 -- addr n2 )
258	\ dup 0 do 2dup + 1- c@ bl <> ?leave 1- loop ;
259
260
261	\ --- 32-Bit compatibility - All accounted for --------------------------
262	\ 16\ included in main program not supported
263	\ : 32\ ; not supported
264	\ : 16-bit abort" Not a 16-bit forth" ; not supported
265	\ : 32-bit ; not supported
266	\ : l! ! ; not supported
267	\ : l* * ; not supported
268	\ : l+ + ; not supported
269	\ : l+! +! ; not supported
270	\ : l- - ; not supported
271	\ : l->n ; not supported
272	\ : l->w h# ffff and ; not supported
273	\ l. not supported
274	\ (l.) not supported
275	\ l.r not supported
276	\ : l0= 0= ; not supported
277	\ : l2/ 2/ ; not supported
278	\ : l2dup 2dup ; not supported
279	\ : l< < ; not supported
280	\ : l<< << ; not supported
281	\ : l<<a << ; not supported
282	\ : l<= <= ; not supported
283	\ : l= = ; not supported
284	\ : l> > ; not supported
285	\ : l>= >= ; not supported
286	\ : l>> >> ; not supported
287	\ : l>>a >>a ; not supported
288	\ l>r not supported
289	\ : labs abs ; not supported
290	\ : land and ; not supported
291	\ : lbetween between ; not supported
292	\ lconstant not supported
293	\ : ldrop drop ; not supported
294	\ : ldup dup ; not supported
295	\ lliteral not supported
296	\ : lmax max ; not supported
297	\ : lmin min ; not supported
298	\ : lnegate negate ; not supported
299	\ : ?lnegate ?negate ; not supported
300	\ : lnot not ; not supported
301	\ : lnover over ; not supported
302	\ : lnswap swap ; not supported
303	\ : lor or ; not supported
304	\ lr> not supported
305	\ : lswap swap ; not supported
306	\ lvariable not supported
307	\ : lwithin within ; not supported
308	\ : m/mod /mod ; not supported
309	\ : mu/mod u/mod ; not supported
310	\ : n->a ; not supported
311	\ : n->l ; not supported
312	\ : n->w l->w ; not supported
313	\ : nlover over ; not supported
314	\ : nlswap swap ; not supported
315	\ : s->l ; not supported
316	\ ul* not supported
317	\ ul. not supported
318	\ (ul.) not supported
319	\ ul.r not supported
320	\ um* not supported
321	\ : um/mod u/mod ; not supported
322	\ : w->l ; not supported
323	\ wvariable not supported
324	: wflip lwsplit swap wljoin ;
325
326	: version1? ( -- flag ) \ True if version 1.x
327	version h# 20000 emit-number <
328	;
329
330	: version2? ( -- flag ) \ True if version 2
331	version h# 20000 emit-number >=
332	version h# 30000 emit-number < and
333
334	;
335	: version2.0? ( -- flag ) \ True if version 2.0
336	h# 20000 emit-number version =
337	;
338
339	: version2.1? ( -- flag ) \ True if version 2.1
340	version h# 20001 emit-number =
341	;
342
343	: version2.2? ( -- flag ) \ True if version 2.2
344	version h# 20002 emit-number =
345	;
346
347	: version2.3? ( -- flag ) \ True if version 2.3
348	version h# 20003 emit-number =
349	;
350
351	: version3? ( -- flag ) \ True if version 3
352	version h# 30000 emit-number =
353	;