Moved some input stream words to library.
[forth.jl.git] / src / lib_6_strings.4th
1 \ Strings
2
3 : CMOVE ( src dest length -- )
4
5         DUP 0<= IF
6                 DROP DROP DROP
7                 EXIT
8         THEN
9
10         -ROT OVER -         ( length src (dest-src) )
11         -ROT DUP ROT + SWAP ( (dest-src) (src+length) src )
12     
13         DO
14                 I @         ( (dest-src) i@ )
15                 OVER I +    ( (dest-src) i@ (dest-src+i) )
16                 !           ( (dest-src) )
17         LOOP
18
19         DROP
20 ;
21
22 : CMOVE> ( src dest length -- )
23         DUP 0<= IF
24                 DROP DROP DROP
25                 EXIT
26         THEN
27
28         -ROT OVER -         ( length src (dest-src) )
29         -ROT DUP ROT + 1-   ( (dest-src) src (src+length-1) )
30         
31         DO
32                 I @
33                 OVER I +
34                 !
35         -1 +LOOP
36
37         DROP
38 ;
39
40 ( Compile-mode word which compiles everything until the next
41   double quote as a litstring. )
42 : S" IMMEDIATE          ( -- addr len )
43         ['] LITSTRING ,   ( compile LITSTRING )
44         HERE          ( save the address of the length word on the stack )
45         0 ,             ( dummy length - we don't know what it is yet )
46
47         BEGIN
48                 >IN @ #IB @ >= IF      \ End of TIB?
49                         QUERY-INPUT    \ Get next line
50                 THEN
51
52                 IB >IN @ + @ 1 >IN +!  \ Get char from TIB
53
54                 DUP [CHAR] " <>
55         WHILE
56                 C,              ( copy character )
57         REPEAT
58         DROP            ( drop the double quote character at the end )
59         DUP             ( get the saved address of the length word )
60         HERE SWAP -   ( calculate the length )
61         1-              ( subtract 1 (because we measured from the start of the length word) )
62         SWAP !          ( and back-fill the length location )
63 ;
64
65 ( Compile-mode word which compiles everything until the
66   next double quote as a litstring and appends a TYPE. )
67 : ." IMMEDIATE
68         [COMPILE] S"
69         ['] TYPE ,
70 ;
71
72 ( Interpret-mode word which prints everything until the next
73   right-paren to the terminal. )
74 : .( 
75         BEGIN
76                 >IN @ #IB @ >= IF      \ End of TIB?
77                         QUERY-INPUT    \ Get next line
78                 THEN
79
80                 IB >IN @ + @ 1 >IN +!  \ Get char from TIB
81
82                 DUP [CHAR] ) = IF
83                         DROP    ( drop the double quote character )
84                         EXIT    ( return from this function )
85                 THEN
86                 EMIT
87         AGAIN
88 ;
89
90 ( Converts address of counted string into address of
91   start of string and length of string. )
92 : COUNT ( addr1 -- addr2 n )
93         DUP 1+ SWAP @ ;
94
95 ( Abort if flag is true. )
96 : ABORT" IMMEDIATE  ( flag -- )
97         [COMPILE] S"
98
99         ['] rot ,
100         [COMPILE] if
101                 s" Aborted: " ['] lit , , ['] lit , , ['] swap ,
102                 ['] type ,
103                 ['] type ,
104                 ['] cr ,
105                 ['] abort ,
106         [COMPILE] else
107                 ['] 2drop ,
108         [COMPILE] then
109 ;