From: Helmut Eller Date: Tue, 27 Dec 2016 08:42:45 +0000 (+0100) Subject: Implement SAVE-INPUT and RESTORE-INPUT X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/commitdiff_plain/0868989592470c064bae35eea78a6d23669d1995 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 --- 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 --- 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 --- 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 --- 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 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 --- 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 --- 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