97 lines
4.1 KiB
Forth
97 lines
4.1 KiB
Forth
\ Rosetta Code Binary Strings Demo in Forth
|
|
\ Portions of this code are found at http://forth.sourceforge.net/mirror/toolbelt-ext/index.html
|
|
|
|
\ String words created in this code:
|
|
\ STR< STR> STR= COMPARESTR SUBSTR STRPAD CLEARSTR
|
|
\ ="" =" STRING: MAXLEN REPLACE-CHAR COPYSTR WRITESTR
|
|
\ ," APPEND-CHAR STRING, PLACE CONCAT APPEND C+! ENDSTR
|
|
\ COUNT STRLEN
|
|
|
|
: STRLEN ( addr -- length) c@ ; \ alias the "character fetch" operator
|
|
|
|
: COUNT ( addr -- addr+1 length) \ Standard word. Shown for explanation
|
|
dup strlen swap 1+ swap ; \ returns the address+1 and the length byte on the stack
|
|
|
|
: ENDSTR ( str -- addr) \ calculate the address at the end of a string
|
|
COUNT + ;
|
|
|
|
: C+! ( n addr -- ) \ primitive: increment a byte at addr by n
|
|
DUP C@ ROT + SWAP C! ;
|
|
|
|
: APPEND ( addr1 length addr2 -- ) \ Append addr1 length to addr2
|
|
2dup 2>r endstr swap move 2r> c+! ;
|
|
|
|
: CONCAT ( string1 string2 -- ) \ concatenate counted string1 to counted string2
|
|
>r COUNT R> APPEND ;
|
|
|
|
: PLACE ( addr1 len addr2 -- ) \ addr1 and length, placed at addr2 as counted string
|
|
2dup 2>r char+ swap move 2r> c! ;
|
|
|
|
: STRING, ( addr len -- ) \ compile a string at the next available memory (called 'HERE')
|
|
here over char+ allot place ;
|
|
|
|
: APPEND-CHAR ( char string -- ) \ append char to string
|
|
dup >r count dup 1+ r> c! + c! ;
|
|
|
|
: ," [CHAR] " PARSE STRING, ; \ Parse input stream until '"' and compile into memory
|
|
|
|
|
|
: WRITESTR ( string -- ) \ output a counted string with a carriage return
|
|
count type CR ;
|
|
|
|
: COPYSTR ( string1 string3 -- ) \ String cloning and copying COPYSTR
|
|
>r count r> PLACE ;
|
|
|
|
: REPLACE-CHAR ( char1 char2 string -- ) \ replace all char2 with char1 in string
|
|
count \ get string's address and length
|
|
BOUNDS \ calc start and end addr of string for do-loop
|
|
DO \ do a loop from start address to end address
|
|
I C@ OVER = \ fetch the char at loop index compare to CHAR2
|
|
IF
|
|
OVER I C! \ if its equal, store CHAR1 into the index address
|
|
THEN
|
|
LOOP
|
|
2drop ; \ drop the chars off the stack
|
|
|
|
|
|
256 constant maxlen \ max size of byte counted string in this example
|
|
|
|
: string: CREATE maxlen ALLOT ; \ simple string variable constructor
|
|
|
|
|
|
: =" ( string -- ) \ String variable assignment operator (compile time only)
|
|
[char] " PARSE ROT PLACE ;
|
|
|
|
: ="" ( string -- ) 0 swap c! ; \ empty a string, set count to zero
|
|
|
|
|
|
: clearstr ( string -- ) \ erase a string variables contents, fill with 0
|
|
maxlen erase ;
|
|
|
|
|
|
string: strpad \ general purpose storage buffer
|
|
|
|
: substr ( string1 start length -- strpad) \ Extract a substring of string and return an output string
|
|
>r >r \ push start,length
|
|
count \ compute addr,len
|
|
r> 1- /string \ pop start, subtract 1, cut string
|
|
drop r> \ drop existing length, pop new length
|
|
strpad place \ place new stack string in strpad
|
|
strpad ; \ return address of strpad
|
|
|
|
\ COMPARE takes the 4 inputs from the stack (addr1 len1 addr2 len2 )
|
|
\ and returns a flag for equal (0) , less-than (1) or greater-than (-1) on the stack
|
|
|
|
: comparestr ( string1 string2 -- flag) \ adapt for use with counted strings
|
|
count rot count compare ;
|
|
|
|
\ now it's simple to make new operators
|
|
: STR= ( string1 string2 -- flag)
|
|
comparestr 0= ;
|
|
|
|
: STR> ( string1 string2 -- flag)
|
|
comparestr -1 = ;
|
|
|
|
: STR< ( string1 string2 -- flag)
|
|
comparestr 1 = ;
|