/hmsl/tools/file_port.fth

https://github.com/philburk/hmsl · Forth · 78 lines · 66 code · 12 blank · 0 comment · 0 complexity · 365ab0207b6299a08208fda14d0b9d08 MD5 · raw file

  1. \ Add HMSL File access words to pForth.
  2. \ Define them in terms of the ANSI file words.
  3. \
  4. \ Licensed under Apache Open Source License V2
  5. ANEW TASK-FILE_PORT
  6. variable FILE-IF-NEW
  7. : NEW ( -- , create next file )
  8. true file-if-new !
  9. ;
  10. : $FOPEN ( $filename -- refnum | 0 , open a file )
  11. .S cr
  12. dup ." open file " count type cr
  13. count
  14. file-if-new @ IF
  15. r/w create-file
  16. false file-if-new !
  17. ELSE
  18. r/w open-file
  19. THEN
  20. IF \ error?
  21. drop 0
  22. THEN
  23. .s cr
  24. ;
  25. : FILEWORD ( <filename> -- addr , parse name with quote delimiters )
  26. bl lword
  27. dup 1+ c@ ascii " = ( is first char a " )
  28. IF ( -- addr , reset >in and reparse )
  29. c@ negate >in +!
  30. ascii " lword
  31. THEN
  32. ;
  33. : FOPEN ( <filename> -- refnum | 0 , open a file )
  34. fileword $fopen
  35. ;
  36. : FCLOSE ( refnum -- , close the file )
  37. close-file
  38. IF ." ERROR closing the file." cr
  39. THEN
  40. ;
  41. : FREAD ( refnum addr num_bytes -- bytes_read )
  42. rot read-file drop
  43. ;
  44. : FWRITE ( refnum addr num_bytes -- bytes_written )
  45. dup >r
  46. rot write-file
  47. r> swap IF
  48. drop 0 \ error so return 0 bytes written
  49. THEN
  50. ;
  51. : FEMIT ( refnum char -- , write single char to the file, abort on error )
  52. 0 >r rp@ c! \ store char on return stack
  53. rp@ 1 rot ( -- addr 1 refnum )
  54. write-file abort" failed in FEMIT"
  55. rdrop
  56. ;
  57. -1 constant EOF \ 00002
  58. VARIABLE FIO-CHAR-BUFFER
  59. : FKEY ( fid -- char | -1)
  60. fio-char-buffer 1 fread
  61. 1 =
  62. IF fio-char-buffer c@
  63. ELSE EOF \ 00002
  64. THEN
  65. ;
  66. ." TODO define remaining FILE words: FSEEK " cr