/fth/save-input.fth

https://github.com/philburk/pforth · Forth · 85 lines · 73 code · 12 blank · 0 comment · 2 complexity · e00aec81e5ce3d390dc646c81c318a4d MD5 · raw file

  1. \ SAVE-INPUT and RESTORE-INPUT
  2. \
  3. \ This code is part of pForth.
  4. \
  5. \ Permission to use, copy, modify, and/or distribute this
  6. \ software for any purpose with or without fee is hereby granted.
  7. \
  8. \ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
  9. \ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
  10. \ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
  11. \ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
  12. \ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
  13. \ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
  14. \ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  15. \ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  16. anew task-save-input.fth
  17. private{
  18. : SAVE-BUFFER ( -- column source-id 2 ) >in @ source-id 2 ;
  19. \ Restore >IN from COLUMN unless COLUMN is too large. Valid values
  20. \ for COLUMN are from 0 to (including) the length of SOURCE plus one.
  21. : RESTORE-COLUMN ( column -- flag )
  22. source nip 1+ over u<
  23. IF drop true
  24. ELSE >in ! false
  25. THEN
  26. ;
  27. \ Return the file-position of the beginning of the current line in
  28. \ file SOURCE-ID. Assume that the current line is stored in SOURCE
  29. \ and that the current file-position is at an end-of-line (or
  30. \ end-of-file).
  31. : LINE-START-POSITION ( -- ud )
  32. source-id file-position throw
  33. \ unless at end-of-file, subtract newline
  34. source-id file-size throw 2over d= 0= IF 1 s>d d- THEN
  35. \ subtract line length
  36. source nip s>d d-
  37. ;
  38. : SAVE-FILE ( column line filepos:ud source-id 5 -- )
  39. >in @
  40. source-line-number@
  41. line-start-position
  42. source-id
  43. 5
  44. ;
  45. : RESTORE-FILE ( column line filepos:ud -- flag )
  46. source-id reposition-file IF 2drop true EXIT THEN
  47. refill 0= IF 2drop true EXIT THEN
  48. source-line-number!
  49. restore-column
  50. ;
  51. : NDROP ( n*x n -- ) 0 ?DO drop LOOP ;
  52. }private
  53. \ Source Stack
  54. \ EVALUATE >IN SourceID=(-1) 2
  55. \ keyboard >IN SourceID=(0) 2
  56. \ file >IN lineNumber filePos SourceID=(fileID) 5
  57. : SAVE-INPUT ( -- column {line filepos}? source-id n )
  58. source-id CASE
  59. -1 OF save-buffer ENDOF
  60. 0 OF save-buffer ENDOF
  61. drop save-file EXIT
  62. ENDCASE
  63. ;
  64. : RESTORE-INPUT ( column {line filepos}? source-id n -- flag )
  65. over source-id <> IF ndrop true EXIT THEN
  66. drop
  67. CASE
  68. -1 OF restore-column ENDOF
  69. 0 OF restore-column ENDOF
  70. drop restore-file EXIT
  71. ENDCASE
  72. ;
  73. privatize