home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
forth
/
compiler
/
fpc
/
tutor
/
l6p120
< prev
next >
Wrap
Text File
|
1990-07-15
|
3KB
|
100 lines
╔════════════════════════════════════════════════════╗
║ Lesson 6 Part 120 F-PC 3.5 Tutorial by Jack Brown ║
╚════════════════════════════════════════════════════╝
┌─────────────────────────────────────┐
│ A Simple Sting Package Case Study. │
└─────────────────────────────────────┘
\ This string package originally appeared in
\ Dr. Dobbs Number 50 and was written by
\ Mr. Ralph Dean
\ Search for end of string addr and leave string length on top.
: SEARCH ( addr -- len )
DUP BEGIN \ addr addr
DUP C@ \ addr addr char
SWAP 1+ SWAP \ addr addr+1 char
0= UNTIL \ addr addr+1+len
SWAP - 1- ; \ len
\ Defining word to create new strings.
: STRING ( len -- ) \ when compiling
( -- addr len ) \ when executing
CREATE ABS 255 MIN 1 MAX \ len has been range checked.
DUP C,
0 DO 0 C, LOOP 0 C, \ -- initialize as nulls.
DOES> 1+ DUP SEARCH ;
\ Store string. Usage: string1 string2 S!
\ Target string is replaced by new string.
: S! ( addr1 len1 addr2 len2 -- )
DROP DUP 1- C@ \ addr1 len1 addr2 mlen
ROT MIN 1 MAX \ addr1 addr2 len <- length to store
2DUP + 0 SWAP C! \ addr1 addr2 len mark end with a null
MOVE ;
\ Store sub string. Usage: string1 string2 SUB!
\ Only sub string of target is replaced.
: SUB! ( addr1 len1 addr2 len2 -- )
ROT MIN 1 MAX \ addr1 addr2 len <- sub string length.
MOVE ;
\ Temporary storage for string operations.
CREATE TEMP 256 ALLOT
\ Usage: 5 10 string MID$
: MID$ ( posn len1 addr2 len2 -- addr len )
SWAP >R ROT MIN 1 MAX \ len1 len2 posn
SWAP OVER MAX OVER - 1+
SWAP R> + 1- SWAP
OVER SEARCH MIN ;
\ Usage: 6 string LEFT$
: LEFT$ ( posn addr1 len1 -- addr len )
>R >R 1 SWAP R> R> MID$ ;
\ Usage: 6 string RIGHT$
: RIGHT$ ( posn addr1 len1 -- addr len )
256 -ROT MID$ ;
\ Concatenate two strings.
\ Usage: string1 string2 S+ string3 S!
: S+ ( addr1 len1 addr2 len2 -- addr len )
ROT >R ROT R> TUCK
TEMP SWAP MOVE
TUCK + 255 MIN DUP >R
OVER - SWAP TEMP + SWAP MOVE
R> 0 OVER TEMP + C!
TEMP SWAP ;
\ Return current string length. Usage: string LEN
: LEN ( addr len -- len )
NIP ;
\ Return max string length. Usage: string MLEN
: MLEN ( addr len -- mlen )
DROP 1- C@ ;
\ Convert single number to a string.
: STR$ ( n -- addr len )
S>D TUCK DABS
<# 0 HOLD #S ROT SIGN #> 1- ;
\ Convert string to a number.
: VAL ( addr len -- dn )
PAD 2DUP C! 1+ SWAP CMOVE \ Move string to PAD
BL PAD COUNT + C! \ Add a blank at the end
PAD NUMBER DROP ;
: " \ " {text}" ( -- addr len )
STATE @ IF [COMPILE] "
ELSE ASCII " WORD
PAD 257 ERASE DUP COUNT
PAD SWAP MOVE PAD SWAP C@
THEN ; IMMEDIATE
┌─────────────────────────────────────┐
│ Please Move to Lesson 6 Part 130 │
└─────────────────────────────────────┘