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