dsforth/dos_mid_trdos.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; TR-DOS interface
   3 ;; coded by Ketmar
   4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   5
   6
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8 ;; sector buffer
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 $FORTH_CONST (FCB-DISK-BUFFER)      fcb_disk_buffer
  12 $FORTH_CONST (FCB-DISK-BUFFER-DATA) fcb_disk_buffer+2
  13 fcb_disk_buffer:
  14   defw 0
  15   defs 256,0
  16
  17
  18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19 ;; sector buffer management
  20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21
  22 ;; ensure that FCB sector is read
  23 $FORTH_WORD (FENSURE-SECTOR)
  24 ;; k8
  25 ;; ( -- )
  26   (FCB-SECTOR) @ DUP 0BRANCH fensure_sector_nofile
  27   ;; ( sector )
  28   (FCB-DISK-BUFFER) @ OVER = TBRANCH fensure_sector_done
  29     $IF 0
  30     (.")  ~( reading disk sector ~  ;;"
  31     DUP U. (.")  ~)\x02~  ;;"
  32     ;;1 LIT 254 OUTP
  33     $ENDIF
  34   DUP (FCB-DISK-BUFFER) !
  35   1 (FCB-DISK-BUFFER-DATA) TR-SREAD
  36   (FCB-SHOW-PROGRESS)
  37     ;;LIT 7 LIT 254 OUTP
  38   ;S
  39 fensure_sector_done:
  40   DROP  ;; drop sector
  41   ;S
  42 fensure_sector_nofile:
  43   (.")  ~\x02DISK FILE NOT OPENED!\x02~  ;;"
  44   (ERROR-STOP)
  45 $FORTH_END_WORD (FENSURE-SECTOR)
  46
  47
  48 ;; ensure that FCB sector is read, and BLKIN is valid
  49 $FORTH_WORD (FENSURE-BLKIN)
  50 ;; k8
  51 ;; ( -- )
  52   ;; check EOF
  53   (FCB-BLEFT) @ 0BRANCH fensure_blkin_eof
  54   (FCB-BLKIN) @ LIT 256 < TBRANCH fensure_blkin_sector
  55   ;; read next block
  56   1 (FCB-SECTOR) +!
  57   (FCB-BLKIN) 0!
  58 fensure_blkin_sector:
  59   (FENSURE-SECTOR)
  60   ;S
  61 fensure_blkin_eof:
  62   (FCB-SECTOR) @ 0BRANCH fensure_sector_nofile
  63   ;S
  64 $FORTH_END_WORD (FENSURE-BLKIN)
  65
  66
  67 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  68 ;; dos_close_current_fcb:
  69 ;;   close current fcb (at `(fcb_curr_addr)`)
  70 ;;   there is no need to clear fcb, the caller will do it
  71 ;;   BC must be preserved
  72 dos_close_current_fcb:
  73   ret
  74
  75
  76 $FORTH_WORD (DOS-ERRMSG)
  77 ;; k8
  78 ;; ( errcode -- addr count )
  79   DUP -1 = 0BRANCH .not_err1
  80     DROP (") ~File not found~  ;;"
  81     ;S
  82 .not_err1:
  83   DROP (") ~DOS error~  ;;"
  84     ;S
  85 $FORTH_END_WORD (DOS-ERRMSG)
  86
  87
  88 $FORTH_WORD (DOS-FOPEN)
  89 ;; k8
  90 ;; ( addr len -- 0/errcode )
  91   (TR-FFIND) DUP 0< 0BRANCH .found
  92   DROP -1
  93   ;S
  94 .found:
  95   (FDOS-FPUSH)
  96   ;; do not read file right now
  97   (TR-FILEBUF) 1- (FCB-SECTOR) !
  98   LIT 256 (FCB-BLKIN) !
  99   (TR-GET-LAST-FSIZE) DUP (FCB-BLEFT) ! (FCB-FSIZE) !
 100   0 ;S
 101 $FORTH_END_WORD (DOS-FOPEN)
 102
 103
 104 ;; caller must ensure that FCB is valid and the file is open
 105 $FORTH_WORD (DOS-FGETCH)
 106 ;; k8
 107 ;; ( -- ch | -1 )
 108   (FENSURE-BLKIN)
 109   $IF 0
 110     (.") ~\x02BLKIN:~  ;;"
 111     (FCB-BLKIN) @ U. CR
 112     (.") ~\x02BLEFT:~  ;;"
 113     (FCB-BLEFT) @ U. CR
 114     (.") ~\x02SECTOR:~  ;;"
 115     (FCB-SECTOR) @ U. CR
 116     (.") ~\x02FSIZE:~  ;;"
 117     (FCB-FSIZE) @ U. CR
 118   $ENDIF
 119   ;; check EOF
 120   (FCB-BLEFT) @ TBRANCH freadch_not_eof
 121     $IF 0
 122     (.") ~\x02(reading char: EOF)\x02~  ;;"
 123     $ENDIF
 124     -1 ;S  ;;EOF
 125 freadch_not_eof:
 126     $IF 0
 127     (.") ~\x02(reading char...)\x02~  ;;"
 128     $ENDIF
 129   (FCB-BLKIN) @
 130   DUP LIT 256 < TBRANCH freadch_ok
 131     ;; read next block
 132     DROP
 133     1 (FCB-SECTOR) +!
 134     (FENSURE-SECTOR)
 135     0  ;; new offset
 136 freadch_ok:
 137   ;; save new offset
 138   DUP 1+ (FCB-BLKIN) !
 139   ;; decrement bytes left
 140   -1 (FCB-BLEFT) +!
 141   ;; get char
 142   (FCB-DISK-BUFFER-DATA) + C@
 143     $IF 0
 144     (.") ~\x02char:~  ;;"
 145     DUP XEMIT SPACE DUP U. CR
 146     $ENDIF
 147   ;S
 148 $FORTH_END_WORD (DOS-FGETCH)
 149
 150
 151 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 152 ;; convert file name to TR-DOS file name
 153 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 154
 155 $FORTH_CONST (TLOAD-NAME-BUF) tload_name_buf
 156 ;; 9 bytes: name and ext
 157 tload_name_buf: defb 0,0,0,0,0,0,0,0,0
 158
 159 $FORTH_WORD (DOS-PARSE-NAME)
 160 ;; k8
 161 ;; ( addr len defext -- newaddr len )
 162   (TLOAD-NAME-BUF) LIT 9 BLANKS
 163   >R  ;; save defext
 164   LIT 8 MIN (TLOAD-NAME-BUF) SWAP CMOVE
 165   R> ?DUP 0BRANCH trd_parse_name_done
 166     (TLOAD-NAME-BUF) LIT 8 + C!
 167 trd_parse_name_done:
 168   (TLOAD-NAME-BUF) LIT 9
 169   ;S
 170 $FORTH_END_WORD (DOS-PARSE-NAME)
 171
 172 $FORTH_WORD (DOS-TYPE-NAME)
 173 ;; k8
 174 ;; ( addr count -- )
 175   ?DUP 0BRANCH fword_trd_type_name_skip
 176   2DUP 1- -TRAILING XTYPE
 177   + 1- C@ DUP 0BRANCH fword_trd_type_name_skip
 178   [CHAR] . XEMIT XEMIT
 179   ;S
 180 fword_trd_type_name_skip:
 181   DROP
 182   ;S
 183 $FORTH_END_WORD (DOS-TYPE-NAME)