( String words. Parallel those available in Basic. ( Taken from Forth Dimensions example. Comments added. ( Transcription error in S+ corrected ( Should work on HC11 type arch, but not yet suitable for ( Harvard type arch. of 'Pod's yet ( Now updated for 'Pod use. ( IMPORTANT NOTE! ( The words with < and > in them had to be separated with spaces ( because this media of web page took them as formating commands ( The spaces must be removed to make the code downloadable SCRUB ( SRCH a word for counting a string to the null char. This way uses null ( for length, rather than fixed length of string as when defined. ( Use: A$ DROP SRCH : SRCH ( straddr --- strlength DUP ( Begining address dup BEGIN DUP @ ( Get char at index address 0= NOT ( See if fetched character is null char WHILE 1+ ( Swap up index, add 1, swap back REPEAT SWAP ( Swap for correct order of subtraction - ( Take different of beginning and ending ; EEWORD ( STRING a defining word to create a new string variable ( Use defining: 10 STRING A$ ( defining string ( Use runtime : A$ ( string leaves straddr strlength : STRING ( --- ( Run time action P@ 1+ ( At address of count, 1+ DUP SRCH ( Dup and search ( leaves --- straddr strlength ; EEWORD ( IB a temprary internal buffer ( Use: IB A$ S! VARIABLE IB 255 ALLOT ( 255+1 long EEWORD \ append counted string from Data space to Program space (at PDP) : PARSE>P ( adr -- ) WORD DUP COUNT + SWAP DO I @ P, LOOP ; EEWORD : EEALLOT ( n -- ) EDP +! ; EEWORD : EE, ( n -- ) EDP @ EE! 1 EEALLOT ; EEWORD ( " Word to compile an inline constant string ( Use: : ... " This is a constant string" A$ S! ... ; or : " 34 ( Put ascii for " on stack STATE @ ( See if compiling or interpreting IF ( If compiling EDP @ [COMPILE] LITERAL ( compile Data Flash address as literal COMPILE COUNT ( compile code to return adr+length WORD ( parse string delimited by " EDP @ OVER C@ 1+ ( -- ramadr flashadr len, including count DUP EEALLOT EEMOVE ( allot space and copy string 0 EE, ( append a null terminator just in case ELSE ( If interpreting WORD ( Parse out the string until " is found ( HERE COUNT ( Use the count left by word IB ( Internal Buffer SWAP ( Here Count IB --- Here IB Count ROT ( Here IB Count --- IB Count Here OVER ( IB Count Here --- IB Count Here Count IB ( IB Count Here Count IB SWAP 1+ ( IB Count Here IB Count+1 CMOVE ( Move string from Here to IB for Count+1 2DUP ( IB Count IB Count + ( IB Count IB+Count 0 ( IB Count IB+Count 0 SWAP ( IB Count 0 IB+Count ! ( Store null at end of string, leave IB COUNT THEN ; IMMEDIATE EEWORD ( VAL Word to convert a str to a number ( Use: A$ VAL : VAL ( straddr strlength --- n OVER ( straddr strlength straddr + ( straddr strlength+straddr, or ending addr BL SWAP ! ( put a blank at the end of the string 1- NUMBER ( move back one address for number, and convert ; EEWORD ( STR$ Word makes a string out of a number ( Use: D1 2@ STR$ A$ S! : STR$ ( d --- ; where d is n1 n2 SWAP ( n1 n2 --- n2 n1 OVER ( n2 n1 --- n2 n1 n2 DABS ( prep double number with sign word for format <# #S SIGN #> ( format in current base to just prior PAD ; EEWORD ( MLEN A word to return maximum length of a string ( Use: A$ MLEN : MLEN ( straddr strlength1 --- strlength2 DROP 1- @ ( Drop this length, move back, take old counted length ; EEWORD ( S! A word to store a string at an address ( Use: " TEST" A$ S! : S! ( straddr1 strlength1 straddr2 strlength2 --- DROP ( straddr1 strlength1 straddr2 DUP 1- @ ( straddr1 strlength1 straddr2 strcount2 ROT ( straddr1 straddr2 strcount2 strlength1 MIN 1 MAX ( straddr1 straddr2 strlength2 2DUP + ( straddr1 straddr2 strlength2 straddr2end 0 SWAP ! ( Make sure null terminated CMOVE ( Source straddr1 Dest straddr2 Count strcount2 ; EEWORD ( LEN A word that gives the length of a string ( Use: A$ LEN 5 < IF ... : LEN ( straddr strlength --- strlength SWAP DROP ( Swap up address and drop leaving only length ; EEWORD ( MID$ A word that picks out a counted section of a string ( from a specified starting point ( n1 is starting point ( n2 is desired length ( Use: 8 6 A$ MID$ B$ S! : MID$ ( n1 n2 straddr1 strlength1 --- SWAP >R ( n1 n2 strlength1 R: straddr1 ROT ( n2 strlength1 n1 R: straddr1 MIN 1 MAX ( n2 n1mm R: straddr1 ( SWAP ( n1mm n2 R: straddr1 ( OVER ( n1mm n2 n1mm R: straddr1 ( MAX ( n1mm n2m R: straddr1 ( OVER - ( n1mm n3 R: straddr1 ( 1+ ( n1mm n3+1 R: straddr1 ( SWAP ( n3+1 n1mm R: straddr1 R> ( n3+1 n1mm straddr1 + 1- ( n3+1 newaddr SWAP OVER ( newaddr n3+1 newaddr SRCH MIN ( newaddr newlength ; EEWORD ( LEFT$ A word that picks out a counted section of a string from the left ( Use: 7 A$ LEFT$ : LEFT$ ( n1 straddr1 strlength1 --- >R >R ( n1 R: strlength1 straddr1 1 SWAP ( 1 n1 R: strlength1 straddr1 R> R> ( 1 n1 straddr1 strlength1 MID$ ( Extract the string from 1 upto n1 ; EEWORD ( RIGHT$ A word that picks out section of a string from a point until the right ( Use: 8 A$ RIGHT$ : RIGHT$ ( n1 straddr1 strlength1 --- >R >R ( n1 R: strlength1 straddr1 256 ( n1 256 R: strlength1 straddr1 R> R> ( n1 256 straddr1 strlength1 MID$ ( Extract the string from n1 upto 256 ; EEWORD : S+ ( straddr1 strlength1 straddr2 strlength2 --- 2SWAP ( straddr2 strlength2 straddr1 strlength1 DUP >R ( straddr2 strlength2 straddr1 strlength1 R: strlength1 IB SWAP ( straddr2 strlength2 straddr1 IB strlength1 R: strlength1 CMOVE ( straddr2 strlength2 R: strlength1 R@ ( straddr2 strlength2 strlength1 R: strlength1 IB + SWAP ( straddr2 strlength1+IB strlength2 R: strlength1 255 R@ - MIN ( straddr2 strlength1+IB strlength2 R: strlength1 DUP >R ( straddr2 strlength1+IB strlength2 R: strlength1 strlength2 CMOVE ( R: strlength1 strlength2 IB ( IB R: strlength1 strlength2 R> R> ( IB strlength2 strlength1 + ( IB strlength3 2DUP + ( IB strlength3 IB+strlength3 0 SWAP ( IB strlength3 0 IB+strlength3 C! ( IB strlength3 ; EEWORD ( SUB A word that substitutes one string from another ( Use: A$ B$ SUB ( Puts A$ into B$ variable : SUB ( straddr1 strlength1 straddr2 strlength2 --- ROT ( straddr1 straddr2 strlength2 strlength1 MIN 1 MAX ( straddr1 straddr2 strlength CMOVE ( Source: straddr1 Dest: straddr2 Count: strlength ; EEWORD ( S= A word that compares one string to another ( Use: A$ B$ S= IF ... : S= ( straddr1 strlength1 straddr2 strlength2 --- ROT OVER = ( straddr1 straddr2 strlength2 b1 IF 1 SWAP 0 ( straddr1 straddr2 b1 strlength2 0 DO ( straddr1 straddr2 b1 DROP ( straddr1 straddr2 OVER C@ ( straddr1 straddr2 char1 OVER C@ ( straddr1 straddr2 char1 char2 = ( straddr1 straddr2 b2 IF 1+ SWAP ( Inc addr2 1+ SWAP ( Inc addr1 1 ( straddr1++ straddr2++ b1 ELSE 0 ( straddr1++ straddr2++ b0 LEAVE ( Terminate loop THEN LOOP ELSE DROP 0 ( straddr1 straddr2 b0 THEN SWAP DROP ( straddr1 b0/1 SWAP DROP ( b0/1 ; EEWORD 20 STRING H$ " HI " H$ S! H$ TYPE 20 STRING T$ " THERE " T$ S! H$ TYPE H$ T$ S+ TYPE 0 1 A$ MID$ TYPE 0 2 A$ MID$ TYPE 0 3 A$ MID$ TYPE 0 4 A$ MID$ TYPE 0 5 A$ MID$ TYPE 1 1 A$ MID$ TYPE 1 2 A$ MID$ TYPE 1 3 A$ MID$ TYPE 1 4 A$ MID$ TYPE 1 5 A$ MID$ TYPE 2 1 A$ MID$ TYPE 2 2 A$ MID$ TYPE 2 3 A$ MID$ TYPE 2 4 A$ MID$ TYPE 2 5 A$ MID$ TYPE 3 1 A$ MID$ TYPE 3 2 A$ MID$ TYPE 3 3 A$ MID$ TYPE 3 4 A$ MID$ TYPE 3 5 A$ MID$ TYPE 1 0 A$ MID$ TYPE 2 0 A$ MID$ TYPE 3 0 A$ MID$ TYPE 4 0 A$ MID$ TYPE 5 0 A$ MID$ TYPE 1 15 A$ MID$ TYPE 2 15 A$ MID$ TYPE 3 15 A$ MID$ TYPE 4 15 A$ MID$ TYPE 5 15 A$ MID$ TYPE 15 1 A$ MID$ TYPE 15 2 A$ MID$ TYPE 15 3 A$ MID$ TYPE 15 4 A$ MID$ TYPE 15 5 A$ MID$ TYPE