Transfer the token as a counted string. A space is placed at the end, but the space is not included in the count.

_html_token will remove a token of the form < name>

This is designed to support the use of XML files, this is not ANSI standard.

 
	: _html_token { ( input_addr  -- addr n ) }{
		variable _%output_base
		}
		DUP _%output_base !
		BEGIN
			>IN @ #TIB @ < 
		WHILE
			DUP char@ [ BL 1 + ]T LITERAL < IF \ found terminator
				_%output_base @ -
				_%output_base @
				SWAP
				\ skip the terminator
				1 CHARS >IN +! 
				EXIT
			THEN
			DUP char@ [CHAR] > = IF
				\ ##### for the moment
				\ > is included in the token
				1 CHARS +
				_%output_base @ -
				_%output_base @
				SWAP
				\ skip the terminator
				1 CHARS >IN +!
				EXIT
			THEN
			1 CHARS +
			1 CHARS >IN +!
		REPEAT
		\ If we get to here we have data but have run out of line.
		\ This is a valid termination condition.
		_%output_base @ -
		_%output_base @
		SWAP
	;


	??HEX
	: (word) { variable _%test_character -- ( addr n ) }{
	           variable _%output_base
			}
		TIB >IN @ + DUP _%output_base !
		\ in_addr (--
		_%test_character @  BL = IF
			\ Scan as a XML file
			BEGIN
				\ while there are characters
				>IN @ #TIB @ < 
			WHILE
				DUP char@ BL >  IF
					DUP char@ [CHAR] < = IF
						\ input_addr(--
						_html_token
						EXIT
					THEN
					BEGIN
						>IN @ #TIB @ < 
					WHILE
						DUP char@ [ BL 1 + ]T LITERAL < IF \ found terminator
							_%output_base @ -
							_%output_base @
							SWAP 
							1 CHARS >IN +! 
							EXIT
						THEN
						\ else character to be added to current token
						1 CHARS +
						1 CHARS >IN +!
					REPEAT
					\ If we get to here we have data but have run out of line.
					\ This is a valid termination condition.
					_%output_base @ -
					_%output_base @
					SWAP 
					EXIT
				THEN
				\ we have a leading space, skip it
				1 CHARS _%output_base +!
				1 CHARS +          \ in_addr(--
				1 CHARS >IN +!
			REPEAT
			\ there is no token
			zero
			EXIT
		ELSE
			BEGIN
				\ while there are characters
				>IN @ #TIB @ < 
			WHILE
				DUP char@ _%test_character @  <> IF
					BEGIN
						>IN @ #TIB @ < 
					WHILE
						DUP char@ _%test_character @ = IF \ found terminator
							_%output_base @ -
							_%output_base @
							SWAP 
							1 CHARS >IN +! 
							EXIT
						THEN
						1 CHARS +
						1 CHARS >IN +!
					REPEAT
					\ If we get to here we have data but have run out of line.
					\ This is a valid termination condition
					_%output_base @ -
					_%output_base @
					SWAP 
					EXIT
				THEN
				\ leading terminator
				1 CHARS _%output_base +!
				1 CHARS +          \ in_addr(--
				1 CHARS >IN +!
			REPEAT
			zero
		THEN
	;

	 

6.1.2450 WORD

CORE

( char "{chars}ccc{char}" -- c-addr )

Skip leading delimiters. Parse characters ccc delimited by char. An ambiguous condition exists if the length of the parsed string is greater than the implementation-defined length of a counted string.

c-addr is the address of a transient region containing the parsed word as a counted string. If the parse area was empty or contained no characters other than the delimiter, the resulting string has a zero length. A space, not included in the length, follows the string. A program may replace characters within the string.

Note: The requirement to follow the string with a space is obsolescent and is included as a concession to existing programs that use CONVERT. A program shall not depend on the existence of the space.

COLDFORTH

The COLDFORTH CONVERT requires a counted string and does not need the terminating space. COLDFORTH does not make the concession.

 
	: WORD ( c - a)
		 (word) _token $make _token
	;

	
	: _defined   ( -- FALSE | xt -1 | xt 1 )
		BL (word)         \ add n (--
		sfind 
	;
	 

6.2.2008 PARSE

CORE EXT

( char "ccc" -- c-addr u )

Parse ccc delimited by the delimiter char.

c-addr is the address (within the input buffer) and u is the length of the parsed string. If the parse area was empty, the resulting string has a zero length.

 
	: Sparse { 	variable %addr 
				variable %n 
				variable _%test_character -- ( addr count) }{
				variable %end 
			}
			%addr @ %n @ + %end !
		    %addr @ \ in_addr (--
			BEGIN
				DUP %end @ < 
			WHILE
				DUP char@ _%test_character @ = IF \ found terminator
					%addr @ TUCK -  \ addr count (--
					EXIT
				THEN
				\ else character to be added to current token
				1 CHARS +
			REPEAT
			\ If we get to here we have data but have run out of line.
			\ This is a valid termination condition
			%addr @ TUCK -  \ addr count (--
	;

	: $parse ( $ char -- addr count )
		SWAP COUNT ROT Sparse
	;
	
	: PARSE ( test_character -- addr count)
		TIB >IN @ +                               \ char addr(--
		#TIB @ >IN @ - ROT Sparse
		\ added complication: the count doesn't include terminator
		\ addr n(--addr is the start n is the number of characters before terminator
		DUP 1+ >IN +!
	;