Implement SAVE-INPUT and RESTORE-INPUT

There used to be primitive tokens ID_SAVE_INPUT and ID_RESTORE_INPUT
but those weren't used.  Saving/restoring positions in files is
somewhat involved so I decided to it in Forth.  To support this, I
re-purposed the codes of ID_SAVE_INPUT and ID_RESTORE_INPUT to
save/store the current line number (ID_SOURCE_LINE_NUMBER_FETCH, and
ID_SOURCE_LINE_NUMBER_STORE).  Those can also be used for something
like C's __LINE__ macro.

* fth/save-input.fth: New file.
* fth/loadp4th.fth: Load it.
* fth/system.fth (D=): New. Needed to compare file positions.
* fth/t_corex.fth: Add simple tests.

* csrc/pf_guts.h (ID_SOURCE_LINE_NUMBER_FETCH,
ID_SOURCE_LINE_NUMBER_STORE): Renamed from ID_SAVE_INPUT and
ID_RESTORE_INPUT.

* csrc/pf_inner.c (ID_SOURCE_LINE_NUMBER_FETCH,
ID_SOURCE_LINE_NUMBER_STORE): Implement.
(ID_SAVE_INPUT): Deleted. It's now in Forth.

* csrc/pfcompil.c (pfBuildDictionary): Define SOURCE-LINE-NUMBER@ and
 SOURCE-LINE-NUMBER!.

diff --git a/csrc/pf_guts.h b/csrc/pf_guts.h
index 3667824..8f5e11f 100644 (file)
--- a/csrc/pf_guts.h
+++ b/csrc/pf_guts.h
@@ -216,7 +216,7 @@ enum cforth_primitive_ids
     ID_QUIT_P,
     ID_REFILL,
     ID_RESIZE,
-    ID_RESTORE_INPUT,
+    ID_SOURCE_LINE_NUMBER_FETCH, /* used to be ID_RESTORE_INPUT */
     ID_ROLL,
     ID_ROT,
     ID_RP_FETCH,
@@ -226,7 +226,7 @@ enum cforth_primitive_ids
     ID_R_FETCH,
     ID_R_FROM,
     ID_SAVE_FORTH_P,
-    ID_SAVE_INPUT,
+    ID_SOURCE_LINE_NUMBER_STORE, /* used to be ID_SAVE_INPUT */
     ID_SCAN,
     ID_SEMICOLON,
     ID_SKIP,

diff --git a/csrc/pf_inner.c b/csrc/pf_inner.c
index 7cdaeb1..dcf12c6 100644 (file)
--- a/csrc/pf_inner.c
+++ b/csrc/pf_inner.c
@@ -1559,16 +1559,6 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
             endcase;
 #endif
 
-/* Source     Stack
-** EVALUATE    >IN  SourceID=(-1)  1111
-** keyboard    >IN  SourceID=(0)   2222
-** file        >IN  lineNumber filePos  SourceID=(fileID)
-*/
-        case ID_SAVE_INPUT:  /* FIXME - finish */
-            {
-            }
-            endcase;
-
         case ID_SP_FETCH:    /* ( -- sp , address of top of stack, sorta ) */
             PUSH_TOS;
             TOS = (cell_t)STKPTR;
@@ -1650,6 +1640,16 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
             else M_DROP;
             endcase;
 
+       case ID_SOURCE_LINE_NUMBER_FETCH: /* ( -- linenr ) */
+           PUSH_TOS;
+           TOS = gCurrentTask->td_LineNumber;
+           endcase;
+
+       case ID_SOURCE_LINE_NUMBER_STORE: /* ( linenr -- ) */
+           gCurrentTask->td_LineNumber = TOS;
+           TOS = M_POP;
+           endcase;
+
         case ID_SWAP:
             Scratch = TOS;
             TOS = *STKPTR;

diff --git a/csrc/pfcompil.c b/csrc/pfcompil.c
index 2f0c04e..467d1e8 100644 (file)
--- a/csrc/pfcompil.c
+++ b/csrc/pfcompil.c
@@ -343,6 +343,8 @@ PForthDictionary pfBuildDictionary( cell_t HeaderSize, cell_t CodeSize )
     CreateDicEntryC( ID_SOURCE_ID, "SOURCE-ID",  0 );
     CreateDicEntryC( ID_SOURCE_ID_PUSH, "PUSH-SOURCE-ID",  0 );
     CreateDicEntryC( ID_SOURCE_ID_POP, "POP-SOURCE-ID",  0 );
+    CreateDicEntryC( ID_SOURCE_LINE_NUMBER_FETCH, "SOURCE-LINE-NUMBER@",  0 );
+    CreateDicEntryC( ID_SOURCE_LINE_NUMBER_STORE, "SOURCE-LINE-NUMBER!",  0 );
     CreateDicEntryC( ID_SWAP, "SWAP",  0 );
     CreateDicEntryC( ID_TEST1, "TEST1",  0 );
     CreateDicEntryC( ID_TEST2, "TEST2",  0 );

diff --git a/fth/loadp4th.fth b/fth/loadp4th.fth
index 2e9c2ad..0ce27dc 100644 (file)
--- a/fth/loadp4th.fth
+++ b/fth/loadp4th.fth
@@ -24,6 +24,7 @@ include? {       locals.fth
 include? fm/mod  math.fth
 include? task-misc2.fth misc2.fth
 include? [if]    condcomp.fth
+include? save-input save-input.fth
 
 \ load floating point support if basic support is in kernel
 exists? F*

diff --git a/fth/save-input.fth b/fth/save-input.fth
new file mode 100644 (file)
index 0000000..e966969
--- /dev/null
+++ b/fth/save-input.fth
@@ -0,0 +1,67 @@
+\ SAVE-INPUT and RESTORE-INPUT
+
+anew task-save-input.fth
+
+private{
+
+: save-buffer ( -- column source-id 2 ) >in @ source-id 2 ;
+
+: restore-column ( column -- flag )
+  source nip over < if drop true exit then
+  >in ! false
+;
+
+\ Return the file-position of the beginning of the current line in
+\ file SOURCE-ID.  Assume that the current line is stored in SOURCE
+\ and that the current file-position is at an end-of-line (or
+\ end-of-file).
+: line-start-position ( -- ud )
+  source-id file-position throw
+  \ unless at end-of-file, subtract newline
+  source-id file-size throw 2over d= 0= if 1 s>d d- then
+  \ subtract line length
+  source nip s>d d-
+;
+
+: save-file ( column line filepos:ud source-id 5 -- )
+  >in @
+  source-line-number@
+  line-start-position
+  source-id
+  5
+;
+
+: restore-file ( column line filepos:ud -- flag )
+  source-id reposition-file if 2drop true exit then
+  source-line-number!
+  refill 0= if drop true exit then
+  restore-column
+;
+
+: ndrop ( n*x n -- ) 0 ?do drop loop ;
+
+}private
+
+\ Source      Stack
+\ EVALUATE    >IN  SourceID=(-1)  2
+\ keyboard    >IN  SourceID=(0)   2
+\ file        >IN  lineNumber filePos  SourceID=(fileID) 5
+: SAVE-INPUT ( -- column {line filepos}? source-id n )
+  source-id case
+    -1 of save-buffer endof
+    0  of save-buffer endof
+    drop save-file exit
+  endcase
+;
+
+: RESTORE-INPUT ( column {line filepos}? source-id n -- flag )
+  over source-id <> if ndrop true exit then
+  drop
+  case
+    -1 of restore-column endof
+    0  of restore-column endof
+    drop restore-file exit
+  endcase
+;
+
+privatize

diff --git a/fth/system.fth b/fth/system.fth
index c33f40b..5e7aff0 100644 (file)
--- a/fth/system.fth
+++ b/fth/system.fth
@@ -360,6 +360,10 @@
         2* swap
 ;
 
+: D= ( xd1 xd2 -- flag )
+       rot = -rot = and
+;
+
 \ define some useful constants ------------------------------
 1 0= constant FALSE
 0 0= constant TRUE

diff --git a/fth/t_corex.fth b/fth/t_corex.fth
index 3784cee..f2b3f19 100644 (file)
--- a/fth/t_corex.fth
+++ b/fth/t_corex.fth
@@ -9,10 +9,6 @@ ANEW TASK-T_COREX.FTH
 
 DECIMAL
 
-\ STUB because missing definition in pForth - FIXME
-: SAVE-INPUT ;
-: RESTORE-INPUT -1 ;
-
 TEST{
 
 \ ==========================================================
@@ -155,7 +151,20 @@ T{ ' QUERY 0<> }T{ TRUE }T
 T{ ' REFILL 0<> }T{ TRUE }T
 
 \  ----------------------------------------------------- RESTORE-INPUT
-T{ : T.SAVE-INPUT SAVE-INPUT RESTORE-INPUT ; T.SAVE-INPUT }T{ 0 }T  \ EXPECTED FAILURE
+T{ : T.SAVE-INPUT SAVE-INPUT RESTORE-INPUT ; T.SAVE-INPUT }T{ 0 }T
+
+\ TESTING SAVE-INPUT and RESTORE-INPUT with a string source
+
+VARIABLE SI_INC 0 SI_INC !
+
+: SI1
+   SI_INC @ >IN +!
+   15 SI_INC !
+;
+
+: S$ S" SAVE-INPUT SI1 RESTORE-INPUT 12345" ;
+
+T{ S$ EVALUATE SI_INC @ }T{ 0 2345 15 }T
 
 \  ----------------------------------------------------- ROLL
 T{ 15 14 13 12 11 10 0 ROLL  }T{  15 14 13 12 11 10 }T