1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
\ filesw.4th
\
\ This code provides kForth with a subset of the optional
\ file access word set, following the guidelines of the ANS
\ specifications.
\
\ Note that kForth (as of Rls. 3-2-1999) has the built-in
\ low level file access words OPEN, LSEEK, CLOSE, READ, WRITE.
\ The definitions herein provide some of the ANS compatible
\ word set and useful constants.
\
\ Copyright (c) 1999 Krishna Myneni
\ Creative Consulting for Research and Education
\
\ This software is provided under the terms of the GNU General
\ Public License.
\
\ Revisions:
\
\ 3-2-1999 created
\ 3-6-1999
\ 4-25-1999 added read-line KM
\ 10-15-1999 added file-exists KM
\ 12-20-1999 fixed create-file and open-file; now
\ requires strings.4th KM
\ 11-24-2000 modified O_CREAT and O_APPEND for
\ Cygwin compatibility KM
\
hex
0 constant R/O
1 constant W/O
2 constant R/W
A constant EOL
200 constant O_CREAT
8 constant O_APPEND
0 constant SEEK_SET
decimal
create EOL_BUF 4 allot
EOL EOL_BUF c!
0 EOL_BUF 1+ c!
variable read_count
: create-file ( c-addr count fam -- fileid ior )
>r strpck r> O_CREAT or open
dup 0> invert ;
: open-file ( c-addr count fam -- fileid ior )
>r strpck r> open
dup 0> invert ;
: close-file ( fileid -- ior )
close ;
: read-file ( c-addr u1 fileid -- u2 ior )
-rot read dup -1 = ;
: write-file ( c-addr u fileid -- ior )
-rot write ;
: reposition-file ( ud fileid -- ior )
swap SEEK_SET lseek ;
: file-exists ( ^filename -- flag | return true if file exists )
count R/O open-file
if drop false else close-file drop true then ;
: read-line ( c-addr u1 fileid -- u2 flag ior )
-rot 0 read_count !
0 do
2dup 1 read
1 < if
2drop read_count @ false -1 unloop exit
then
dup c@ EOL =
if
2drop read_count @ true 0 unloop exit
then
1+
1 read_count +!
loop
2drop read_count @ true 0 ;
: write-line ( c-addr u fileid -- ior )
dup >r write-file
EOL_BUF 1 r> write-file
or ;
|
