dsforth/textfile.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; text file loader
   3 ;; coded by Ketmar
   4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   5
   6
   7 ;; current file block
   8 $FORTH_VAR (FREADCH-BLOCK) 0
   9 ;; offset in the current block
  10 $FORTH_VAR (FREADCH-OFS) 0
  11 ;; bytes left in file
  12 $FORTH_VAR (FREADCH-LEFT) 0
  13
  14 ;; read char from file
  15 ;; all variables must be set!
  16 ;; block must be loaded!
  17 $FORTH_WORD FREADCH
  18 ;; k8
  19 ;; ( -- ch | -1 )
  20   (FREADCH-LEFT) @ 0BRANCH freadch_eof
  21
  22   (FREADCH-OFS) @ LIT 256 < 0= 0BRANCH freadch_0
  23 ;; read next block
  24   (FREADCH-OFS) 0!  (FREADCH-BLOCK) @ 1+  DUP (FREADCH-BLOCK) !
  25   1 LIMIT 1+ TR-SREAD
  26 freadch_0:
  27   1 (FREADCH-OFS) +!  LIT -1 (FREADCH-LEFT) +!
  28   (FREADCH-OFS) @ LIMIT + C@
  29   ;S
  30 freadch_eof:
  31   LIT -1 ;S
  32 $FORTH_END_WORD FREADCH
  33
  34 $FORTH_WORD FUNREADCH
  35 ;; k8
  36 ;; ( ch -- )
  37   (FREADCH-OFS) @ LIMIT + C!
  38   LIT -1 (FREADCH-OFS) +!  LIT -1 (FREADCH-LEFT) +!  ;S
  39 $FORTH_END_WORD FUNREADCH
  40
  41
  42 ;; read text file line by line
  43 ;; all variables must be set!
  44 $FORTH_WORD FREADLN
  45 ;; k8
  46 ;; ( -- addr len TRUE | FALSE )
  47   LIMIT LIT 257 +  0
  48 freadln_loop:
  49   FREADCH  DUP 0< 0BRANCH freadln_0
  50 ;; EOF
  51   DROP -DUP 0= 0BRANCH freadln_qt
  52 ;; nothing except EOF was read
  53   DROP 0 BRANCH freadln_q
  54
  55 freadln_0:
  56   DUP LIT 10 - 0BRANCH freadln_qt1
  57 freadln_2:
  58   DUP LIT 13 = 0BRANCH freadln_3
  59 ;; end of line...
  60   DROP FREADCH DUP LIT 10 - 0BRANCH freadln_qt1
  61 ;; unread char %-)
  62 freadln_unget:
  63   FUNREADCH BRANCH freadln_qt
  64
  65 freadln_3:
  66 ;; just add char (if there is enough room for it %-)
  67   OVER LIT 256 < 0BRANCH freadln_unget
  68   >R 2DUP + R> SWAP C!  ;; store char
  69   1+                    ;; increase length
  70   BRANCH freadln_loop
  71 freadln_qt1:
  72   DROP
  73 freadln_qt:
  74 ;; write terminating 0x00 & success flag
  75   2DUP + 0 SWAP C!  1
  76 freadln_q:
  77   ;S
  78 $FORTH_END_WORD FREADLN
  79
  80 ;; "close" current file -- clear vars
  81 $FORTH_WORD FCLOSE
  82 ;; k8
  83 ;; ( -- )
  84   (FREADCH-OFS) 0!  (FREADCH-LEFT) 0!  ;S
  85 $FORTH_END_WORD FCLOSE
  86
  87 ;; prepare variables for reading file
  88 $FORTH_WORD FOPEN
  89 ;; k8
  90 ;; ( addr len -- success_flag)
  91   (TR-FFIND) DUP 0< 0BRANCH fopen0
  92 ;; no file
  93   DROP 0 BRANCH fopenq
  94 fopen0:
  95   (TR-FILEBUF) 1- (FREADCH-BLOCK) !  LIT #5CE8 @ (FREADCH-LEFT) !
  96   LIT 256 (FREADCH-OFS) !  1
  97 fopenq:
  98   ;S
  99 $FORTH_END_WORD FOPEN
 100
 101 ;; interpret text file
 102 $FORTH_WORD TLOAD
 103 ;; k8
 104 ;; ( addr len -- )
 105   FOPEN 0BRANCH tload_err
 106 tload_0:
 107   FREADLN 0BRANCH tload_q
 108   TLOAD-Y 1! DROP TIB ! IN 0!  INTERPRET
 109   BRANCH tload_q
 110 tload_err:
 111   (.") ~TLOAD: can't open input file %-(\n~ ;;"
 112 tload_q:
 113   ;S
 114 $FORTH_END_WORD TLOAD
 115
 116 ;; $FORTH_WORD L
 117 ;;   (") ~TEST    F~ TLOAD  ;S ;;"
 118 ;; $FORTH_END_WORD L
 119
 120 $FORTH_WORD LDC
 121   (") ~DECO    F~ TLOAD  ;S ;;"
 122 $FORTH_END_WORD LDC