dsforth/ext_textfile.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; text file loader
   3 ;; coded by Ketmar
   4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   5
   6 $FORTH_CONST (FCB-DISK-BUFFER)      fcb_disk_buffer
   7 $FORTH_CONST (FCB-DISK-BUFFER-DATA) fcb_disk_buffer+2
   8 fcb_disk_buffer:
   9   defw 0
  10   defs 256,0
  11
  12 fcb_line_buffer_size equ 80
  13 $FORTH_CONST (FILE-LINE-BUF)       fcb_line_buffer
  14 $FORTH_CONST (FILE-LINE-BUF-SIZE)  fcb_line_buffer_size
  15
  16   defw 0  ;; working area
  17 fcb_line_buffer:
  18   defs fcb_line_buffer_size,0
  19   defw 0
  20
  21 ;; current file block
  22 $FORTH_CONST (FCB)       fcb_data
  23 $FORTH_CONST (FCB-SIZE)  fcb_size
  24
  25 fcb_data:
  26   dw  0  ;; offset in the current sector
  27   dw  0  ;; bytes left in file
  28   dw  0  ;; current file sector
  29 fcb_size equ $-fcb_data
  30
  31 $FORTH_CONST (FCB-BLKIN)   fcb_data
  32 $FORTH_CONST (FCB-BLEFT)   fcb_data+2
  33 $FORTH_CONST (FCB-SECTOR)  fcb_data+4
  34
  35
  36 $FORTH_WORD (FCB-DUMP)
  37 ;; k8
  38 ;; ( -- )
  39   (.") ~FCB: ofs=~  ;;"
  40   (FCB-BLKIN) @ U.
  41   (.") ~left=~  ;;"
  42   (FCB-BLEFT) @ U.
  43   (.") ~sec=~  ;;"
  44   (FCB-SECTOR) @ U.
  45   CR
  46   ;S
  47 $FORTH_END_WORD (FCB-DUMP)
  48
  49
  50 ;; ensure that FCB sector is read
  51 $FORTH_WORD (FENSURE-SECTOR)
  52 ;; k8
  53 ;; ( -- )
  54   (FCB-SECTOR) @ DUP 0BRANCH fensure_sector_nofile
  55   (FCB-DISK-BUFFER) @ OVER = TBRANCH fensure_sector_done
  56     ;;(.")  ~( reading disk sector ~  ;;"
  57     ;;DUP U. (.")  ~)\n~  ;;"
  58     ;;1 LIT 254 OUTP
  59   DUP (FCB-DISK-BUFFER) !
  60   DUP 1 (FCB-DISK-BUFFER-DATA) TR-SREAD
  61     ;;LIT 7 LIT 254 OUTP
  62 fensure_sector_done:
  63   DROP ;S
  64 fensure_sector_nofile:
  65   (.")  ~DISK FILE NOT OPENED!\n~  ;;"
  66   (ERROR-STOP)
  67 $FORTH_END_WORD (FENSURE-SECTOR)
  68
  69
  70 ;; ensure that FCB sector is read, and BLKIN is valid
  71 $FORTH_WORD (FENSURE-BLKIN)
  72 ;; k8
  73 ;; ( -- )
  74   ;; check EOF
  75   (FCB-BLEFT) @ 0BRANCH fensure_blkin_eof
  76   (FCB-BLKIN) @ LIT 256 < TBRANCH fensure_blkin_sector
  77   ;; read next block
  78   1 (FCB-SECTOR) +!
  79   (FCB-BLKIN) 0!
  80 fensure_blkin_sector:
  81   (FENSURE-SECTOR)
  82   ;S
  83 fensure_blkin_eof:
  84   (FCB-SECTOR) @ 0BRANCH fensure_sector_nofile
  85   ;S
  86 $FORTH_END_WORD (FENSURE-BLKIN)
  87
  88
  89 $FORTH_WORD FOPENED?
  90 ;; k8
  91 ;; ( -- flag )
  92   (FCB-SECTOR) @ NOTNOT
  93   ;S
  94 $FORTH_END_WORD FOPENED?
  95
  96 $FORTH_WORD FEOF?
  97 ;; k8
  98 ;; ( -- flag )
  99   (FCB-SECTOR) @ 0BRANCH fword_feof_tan
 100   (FCB-BLEFT) @ 0BRANCH fword_feof_tan
 101   0 ;S
 102 fword_feof_tan:
 103   1 ;S
 104 $FORTH_END_WORD FEOF?
 105
 106
 107 ;; "close" current file -- clear vars
 108 $FORTH_WORD FCLOSE
 109 ;; k8
 110 ;; ( -- )
 111   (FCB) (FCB-SIZE) ERASE
 112   ;S
 113 $FORTH_END_WORD FCLOSE
 114
 115
 116 ;; prepare variables for reading file
 117 $FORTH_WORD FOPEN
 118 ;; k8
 119 ;; ( addr len -- )
 120   FOPENED? 0BRANCH fword_fopen_allowed
 121   (.")  ~DISK FILE ALREADY OPENED!\n~  ;;"
 122   (ERROR-STOP)
 123 fword_fopen_allowed:
 124   (TR-FFIND) DUP 0< 0BRANCH fopen_found
 125   ;; no file
 126   (.")  ~DISK FILE NOT FOUND!\n~  ;;"
 127   (ERROR-STOP)
 128 fopen_found:
 129   ;; do not read file right now
 130   (TR-FILEBUF) 1- (FCB-SECTOR) !
 131   LIT 256 (FCB-BLKIN) !
 132   (TR-GET-LAST-FSIZE) (FCB-BLEFT) !
 133     ;;(.") ~OPENED DISK FILE; LSEC:~  ;;"
 134     ;;(FCB-SECTOR) @ 1+ U.
 135     ;;(.") ~SIZE:~  ;;"
 136     ;;(FCB-BLEFT) @ U.
 137     ;;CR
 138   ;S
 139 $FORTH_END_WORD FOPEN
 140
 141
 142 ;; caller must ensure that FCB is valid
 143 $FORTH_WORD FPEEKCH
 144 ;; k8
 145 ;; ( -- ch | -1 )
 146   ;; check EOF
 147   (FCB-BLEFT) @ TBRANCH fpeekch_not_eof
 148     -1 ;S  ;;EOF
 149 fpeekch_not_eof:
 150   (FENSURE-BLKIN)
 151   ;; get char
 152   (FCB-BLKIN) @ (FCB-DISK-BUFFER-DATA) + C@
 153   ;S
 154 $FORTH_END_WORD FPEEKCH
 155
 156
 157 ;; caller must ensure that FCB is valid and the sector is loaded
 158 $FORTH_WORD (FREADCH)
 159 ;; k8
 160 ;; ( -- ch | -1 )
 161   ;; check EOF
 162   (FCB-BLEFT) @ TBRANCH freadch_not_eof
 163     -1 ;S  ;;EOF
 164 freadch_not_eof:
 165   ;; (.") ~(reading char...)\n~  ;;"
 166   (FCB-BLKIN) @
 167   DUP LIT 256 < TBRANCH freadch_ok
 168     ;; read next block
 169     DROP
 170     1 (FCB-SECTOR) +!
 171     (FENSURE-SECTOR)
 172     0  ;; new offset
 173 freadch_ok:
 174   ;; save new offset
 175   DUP 1+ (FCB-BLKIN) !
 176   ;; decrement bytes left
 177   -1 (FCB-BLEFT) +!
 178   ;; get char
 179   (FCB-DISK-BUFFER-DATA) + C@
 180   ;S
 181 $FORTH_END_WORD (FREADCH)
 182
 183
 184 ;; read text file line by line
 185 ;; all variables must be set!
 186 $FORTH_WORD FREADLN
 187 ;; k8
 188 ;; ( -- addr len TRUE | FALSE )
 189   (FENSURE-BLKIN)
 190   0  ;; ( counter/result )
 191   FEOF? 0BRANCH fword_freadln_noteof
 192     ;; EOF
 193     ;S
 194 fword_freadln_noteof:
 195   ;; scan for CHCR or CHLF
 196   ;;(.") ~(reading line...)\n~  ;;"
 197 fword_freadln_loop:
 198   (FREADCH) DUP 0< TBRANCH freadln_done
 199   ;; ( len ch )
 200   DUP CHCR = 0BRANCH fword_freadln_notcr
 201     ;; cr, check for possible lf
 202     FPEEKCH CHLF = 0BRANCH freadln_done
 203     (FREADCH) DROP BRANCH freadln_done
 204 fword_freadln_notcr:
 205   DUP CHLF = TBRANCH freadln_done
 206   ;; ( len ch )
 207   ;; store char
 208     ;;DUP XEMIT
 209   OVER (FILE-LINE-BUF) + C!
 210   1+  ;; increment length
 211   ;; check if our line is too big
 212   DUP (FILE-LINE-BUF-SIZE) <
 213   TBRANCH fword_freadln_loop
 214   ;; no need to drop anything
 215   (.")  ~DISK FILE LINE TOO LONG!\n~  ;;"
 216   (ERROR-STOP)
 217 freadln_done:
 218   DROP  ;; drop char
 219     ;;CR
 220   ;; ( len )
 221   (FILE-LINE-BUF) OVER + BL SWAP !
 222   (FILE-LINE-BUF) SWAP 1
 223     ;;(.")  ~---\n~  ;;"
 224     ;;>R 2DUP SWAP U. U. CR R>
 225     ;;>R 2DUP XTYPE CR R>
 226     ;;(.")  ~---\n~  ;;"
 227   ;S
 228 $FORTH_END_WORD FREADLN
 229
 230
 231
 232 ;; interpret text file
 233 $FORTH_WORD (TLOAD)
 234 ;; k8
 235 ;; ( addr len -- )
 236   FOPEN
 237   FREADLN 0BRANCH tload_eof
 238   ;;TLOAD-Y 1!
 239   DROP TIB ! IN 0!  INTERPRET
 240     ;;(.") ~(TLOAD DONE)\n~  ;;"
 241   ;S
 242 tload_eof:
 243   FCLOSE
 244   ;S
 245 $FORTH_END_WORD (TLOAD)
 246
 247
 248 $FORTH_CONST (TLOAD-NAME-BUF) tload_name_buf
 249 ;; 9 bytes: name and ext
 250 tload_name_buf: defb 0,0,0,0,0,0,0,0,0
 251
 252 $FORTH_WORD (TRD-PARSE-NAME)
 253 ;; k8
 254 ;; ( addr len defext -- newaddr len )
 255   (TLOAD-NAME-BUF) LIT 9 BLANKS
 256   >R  ;; save defext
 257   LIT 8 MIN (TLOAD-NAME-BUF) SWAP CMOVE
 258   R> -DUP 0BRANCH trd_parse_name_done
 259     (TLOAD-NAME-BUF) LIT 8 + C!
 260 trd_parse_name_done:
 261   (TLOAD-NAME-BUF) LIT 9
 262   ;S
 263 $FORTH_END_WORD (TRD-PARSE-NAME)
 264
 265 ;; interpret text file
 266 $FORTH_WORD TLOAD
 267 ;; k8
 268 ;; ( addr len -- )
 269   LIT 70 (TRD-PARSE-NAME)
 270   (.") "loading: " 2DUP XTYPE CR  ;;"
 271   (TLOAD)
 272   ;S
 273 $FORTH_END_WORD TLOAD
 274
 275
 276 $FORTH_WORD LDC
 277   (") ~DECO~  ;;"
 278   TLOAD ;S
 279 $FORTH_END_WORD LDC
 280
 281 $FORTH_WORD LDT
 282   (") ~ZTEST~  ;;"
 283   TLOAD ;S
 284 $FORTH_END_WORD LDT