Fix SAVE-INPUT
[pforth] / fth / save-input.fth
... / ...
CommitLineData
1\ SAVE-INPUT and RESTORE-INPUT
2\
3\ This code is part of pForth.
4\
5\ The pForth software code is dedicated to the public domain,
6\ and any third party may reproduce, distribute and modify
7\ the pForth software code or any derivative works thereof
8\ without any compensation or license. The pForth software
9\ code is provided on an "as is" basis without any warranty
10\ of any kind, including, without limitation, the implied
11\ warranties of merchantability and fitness for a particular
12\ purpose and their equivalents under the laws of any jurisdiction.
13
14anew task-save-input.fth
15
16private{
17
18: SAVE-BUFFER ( -- column source-id 2 ) >in @ source-id 2 ;
19
20\ Restore >IN from COLUMN unless COLUMN is too large. Valid values
21\ for COLUMN are from 0 to (including) the length of SOURCE plus one.
22: RESTORE-COLUMN ( column -- flag )
23 source nip 1+ over u<
24 IF drop true
25 ELSE >in ! false
26 THEN
27;
28
29\ Return the file-position of the beginning of the current line in
30\ file SOURCE-ID. Assume that the current line is stored in SOURCE
31\ and that the current file-position is at an end-of-line (or
32\ end-of-file).
33: LINE-START-POSITION ( -- ud )
34 source-id file-position throw
35 \ unless at end-of-file, subtract newline
36 source-id file-size throw 2over d= 0= IF 1 s>d d- THEN
37 \ subtract line length
38 source nip s>d d-
39;
40
41: SAVE-FILE ( column line filepos:ud source-id 5 -- )
42 >in @
43 source-line-number@
44 line-start-position
45 source-id
46 5
47;
48
49: RESTORE-FILE ( column line filepos:ud -- flag )
50 source-id reposition-file IF 2drop true EXIT THEN
51 refill 0= IF 2drop true EXIT THEN
52 source-line-number!
53 restore-column
54;
55
56: NDROP ( n*x n -- ) 0 ?DO drop LOOP ;
57
58}private
59
60\ Source Stack
61\ EVALUATE >IN SourceID=(-1) 2
62\ keyboard >IN SourceID=(0) 2
63\ file >IN lineNumber filePos SourceID=(fileID) 5
64: SAVE-INPUT ( -- column {line filepos}? source-id n )
65 source-id CASE
66 -1 OF save-buffer ENDOF
67 0 OF save-buffer ENDOF
68 drop save-file EXIT
69 ENDCASE
70;
71
72: RESTORE-INPUT ( column {line filepos}? source-id n -- flag )
73 over source-id <> IF ndrop true EXIT THEN
74 drop
75 CASE
76 -1 OF restore-column ENDOF
77 0 OF restore-column ENDOF
78 drop restore-file EXIT
79 ENDCASE
80;
81
82privatize