Anonymous user
Binary strings: Difference between revisions
→{{header|Forth}}
(Updated D entry) |
|||
Line 809:
=={{header|Forth}}==
<lang forth>\ Rosetta Code Binary Strings Demo in Forth
\ Portions of this code are found at http://forth.sourceforge.net/mirror/toolbelt-ext/index.html
\ In Forth, as in Assembler, all strings are binary ie: they are simply bytes in memory
\ Using simple memory operations the programmer can quickly build a string word set
\ The code compiles to only 304 bytes on a 16 bit controller! (with labels stripped out)
\ Adding the 256 byte buffer it takes only 560 bytes, useable in embedded work
\ String words created:
\ 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) \ returns the address+1 and the length byte on the stack
dup strlen swap 1+ swap ;
: 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 1+ swap move 2r> c! ;
: STRING, ( addr len -- ) \ compile a string at the next available memory (called 'HERE')
here over 1+ 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
strpad ="" \ clear strpad
>r \ push the length
+ \ calc the new start addr
r> strpad append \ pop the length and append to strpad
strpad ; \ return the 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 = ;
</lang>
With these functions compiled into our system, we test to see if
we have satisfied the requirements interactively at the Forth console.
<lang forth>\ Rosetta Code Binary String tasks Console Tests
\ 1. String creation and destruction (when needed and if there's no garbage collection or similar mechanism)
\ RAW Forth can manually create a binary string with the C, operator
\ C, takes a byte off the stack and writes it into the next available memory address
\ 'binary_string' drops it's data address on the stack. Nothing more.
HEX ok
create binary_string 9 c, 1 c, 2 c, 3 c, 4 c, 5 c,
0A c, 0B c, 0C c, 0FF c, \ 1st byte is length
ok
\ test what we created using the DUMP utility
binary_string count dump
25EC:7365 01 02 03 04 05 0A 0B 0C FF 04 44 55 4D 50 00 20 ..........DUMP.
ok
\ create static string variables using our constructor ok
string: buffer1 ok
string: buffer2 ok
DECIMAL ok
\ 2. String assignment
\ create string constants with assignments(static, counted strings) ok
create string1 ," Now is the time for all good men to come to the aid"
create string2 ," Right now!" ok
\ assign text to string variables
buffer1 =" This text will go into the memory allocated for buffer1" ok
buffer2 ="" ok
\ Test the assignments
string2 writestr Right now!
ok
string1 writestr Now is the time for all good men to come to the aid
ok
buffer1 writestr This text will go into the memory allocated for buffer1
ok
buffer2 writestr
\ destroy string contents. Fill string with zero
buffer1 clearstr ok
buffer1 40 dump
25EC:7370 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
25EC:7380 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
25EC:7390 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
ok
\ 3. String comparison
buffer1 buffer2 STR= . ( should be 0 FALSE flag) -1 ok
buffer1 =" ABCDEFG" ok
buffer2 =" ABCDEFG" ok
buffer1 buffer2 STR= . ( should be -1 TRUE flag) -1 ok
string1 buffer1 str> . ( should be -1 ) 0 ok
string1 buffer1 str< . ( should be 0 ) -1 ok
\ 4. String cloning and copying
string1 buffer1 COPYSTR ok
string1 writestr Now is the time for all good men to come to the aid ok
buffer1 writestr Now is the time for all good men to come to the aid ok
\ 5. Check if a string is empty
buffer1 len . \ not empty 55 ok
buffer1 ="" \ assign null string ok
buffer1 len . \ 0 count means empty 0 ok
\ 6. Append a byte to a string
string2 writestr Right now!
ok
char # string2 APPEND-CHAR ok
string2 writestr Right now!#
ok
hex
0A string1 APPEND-CHAR \ append a raw carriage return
0D string1 APPEND-CHAR \ append a raw line-feed
string1 writestr
decimal
\ 7. Extract a substring from a string
string1 writestr Now is the time for all good men to come to the aid ok
string1 5 11 substr writestr is the time ok
\ 8. Replace every occurrence of a byte (or a string) in a string with another string
buffer1 =" This*string*is*full*of*stars*" ok
ok
BL char * buffer1 REPLACE-CHAR ok
buffer1 writestr This string is full of stars
ok
\ 9. Join strings
buffer1 =" James " ok
buffer2 =" Alexander" ok
buffer2 buffer1 CONCAT ok
ok
buffer1 writestr James Alexander
ok
</lang>
| |||