dsforth/dos_low_trdos.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; low-level TR-DOS words
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4
   5 $FORTH_CONST (TR-FINFO) #5CDD
   6 $FORTH_VAR (TRDOS-R/O)  0
   7
   8 $FORTH_CODE_WORD (TR-CMD)
   9 ;; k8
  10 ;; ( AF DE HL BC -- )
  11 ;; c_code: C
  12   di
  13   ld    a,#3F
  14   ld    i,a
  15   im    1
  16   ei
  17
  18   pop   de  ;; bc
  19   pop   hl  ;; hl
  20   pop   af  ;; de
  21
  22 ;; BC<->HL
  23   push  bc
  24   push  hl
  25   pop   bc       ;; hl
  26   pop   hl
  27   ex    (sp),hl  ;; af
  28
  29   push  hl  ;; af
  30   push  de  ;; bc
  31   push  af  ;; de
  32   push  bc  ;; hl
  33   pop   hl
  34   pop   de
  35   pop   bc
  36   pop   af
  37   or    a
  38   push  ix
  39
  40 trcall:
  41   call  #3D13
  42   pop   ix
  43
  44   ld    a,(f_useIM2)
  45   or    a
  46   jr    z,.trdone
  47
  48   di
  49   ld    a,(f_im2Ireg)
  50   ld    i,a
  51   im    2
  52   ei
  53
  54 .trdone:
  55   pop   bc
  56   jp    i_next
  57 $FORTH_END_CODE_WORD (TR-CMD)
  58
  59 $FORTH_WORD (TR-INIT)
  60 ;; k8
  61 ;; ( -- )
  62   0 0 0 0 (TR-CMD) ;S
  63 $FORTH_END_WORD (TR-INIT)
  64
  65 ;; seek to track
  66 $FORTH_WORD (TR-SEEK)
  67 ;; k8
  68 ;; ( track -- )
  69   256U* 0 0 2 (TR-CMD) ;S
  70 $FORTH_END_WORD (TR-SEEK)
  71
  72 ;; seek to sector
  73 $FORTH_WORD (TR-SETSECTOR)
  74 ;; k8
  75 ;; ( sector -- )
  76   256U* 0 0 2 (TR-CMD) ;S
  77 $FORTH_END_WORD (TR-SETSECTOR)
  78
  79 ;; read sectors
  80 $FORTH_WORD (TR-READ)
  81 ;; k8
  82 ;; ( t s addr -- )
  83 ;;
  84 ;; (TR-CMD): ( 0 t_s buf cnt_5 -- )
  85   >R  LIT #FF AND SWAP LIT #FF AND 256U* +
  86   0 SWAP  R> LIT #0105  (TR-CMD)
  87   ;S
  88 $FORTH_END_WORD (TR-READ)
  89
  90 $FORTH_WORD TR-SREAD
  91 ;; k8
  92 ;; ( num cnt addr -- )
  93 ;;
  94 ;; (TR-CMD): ( 0 t_s buf cnt_5 -- )
  95   >R >R
  96   0 LIT 16 UM/MOD 256U* +
  97   0 SWAP  R> R> SWAP  0 MAX LIT 255 MIN 256U* LIT 5 +  (TR-CMD)
  98   ;S
  99 $FORTH_END_WORD TR-SREAD
 100
 101 $FORTH_WORD TR-SWRITE
 102 ;; k8
 103 ;; ( num cnt addr -- )
 104 ;;
 105 ;; (TR-CMD): ( 0 t_s buf cnt_5 -- )
 106   (TRDOS-R/O) @ TBRANCH tr_swrite_skip
 107   >R >R
 108   0 LIT 16 UM/MOD 256U* +
 109   0 SWAP  R> R> SWAP  0 MAX LIT 255 MIN 256U* LIT 6 +  (TR-CMD)
 110   ;S
 111 tr_swrite_skip:
 112   DROP 2DROP ;S
 113 $FORTH_END_WORD TR-SWRITE
 114
 115 $FORTH_WORD (TR-HEADLOAD)
 116 ;; k8
 117 ;; ( num -- )
 118   (TR-FINFO) LIT 16 ERASE
 119   DUP -1 > OVER LIT 128 < AND 0BRANCH trheaderload0
 120   256U* 0 0 LIT 8 (TR-CMD) BRANCH trheaderload1
 121 trheaderload0:
 122   DROP
 123 trheaderload1:
 124   ;S
 125 $FORTH_END_WORD (TR-HEADLOAD)
 126
 127 $FORTH_WORD (TR-GET-LAST-FILEBUF)
 128 ;; k8
 129 ;; ( -- first_buf_num )
 130 ;; first_buf_num == starting logical sector (for TR-SREAD)
 131   LIT #5CEC C@ LIT 16 *  LIT #5CEB C@ +
 132   ;S
 133 $FORTH_END_WORD (TR-GET-LAST-FILEBUF)
 134
 135 ;; used after (TR-HEADLOAD)
 136 $FORTH_WORD (TR-GET-LAST-FSIZE)
 137 ;; k8
 138 ;; ( -- last size )
 139   LIT #5CE8 @
 140   ;S
 141 $FORTH_END_WORD (TR-GET-LAST-FSIZE)
 142
 143 $FORTH_WORD (TR-FILEBUF)
 144 ;; k8
 145 ;; ( num -- first_buf_num )
 146 ;; first_buf_num == starting logical sector (for TR-SREAD)
 147   (TR-HEADLOAD)
 148   (TR-GET-LAST-FILEBUF)
 149   ;S
 150 $FORTH_END_WORD (TR-FILEBUF)
 151
 152 $FORTH_WORD (TR-FFIND)
 153 ;; k8
 154 ;; ( addr len -- num | -1 )
 155   0 MAX LIT 9 MIN >R  (TR-FINFO) R@  CMOVE
 156   R> LIT #5D06 C!  LIT #FF LIT 23838 C!
 157   0 0 0 LIT 10 (TR-CMD)  LIT 9 LIT #5D06 C!
 158   LIT 23838 C@ DUP LIT 127 > 0BRANCH trffind0
 159   DROP -1
 160 trffind0:
 161   ;S
 162 $FORTH_END_WORD (TR-FFIND)
 163
 164 ;; print TR-DOS directory
 165 $FORTH_WORD TR-CAT
 166 ;; k8
 167 ;; ( -- )
 168   0 ;; wcount
 169   0 ;; didx
 170   ENDCR
 171 tr_cat_loop:
 172   DUP LIT 128 = TBRANCH tr_cat_exit
 173   ;; load header
 174   DUP (TR-HEADLOAD)
 175   ;; check for end of directory
 176   (TR-FINFO) C@ 0= TBRANCH tr_cat_exit
 177   ;; type name
 178   (TR-FINFO) LIT 8 XTYPE
 179   ;; type extension
 180   LIT 46 XEMIT (TR-FINFO) LIT 8 + C@ XEMIT
 181   ;; wrapping
 182   SWAP 1+ DUP 3 EMIT8? - = 0BRANCH tr_cat_spaces
 183   DROP 0 ENDCR BRANCH tr_cat_wrap_done
 184 tr_cat_spaces:
 185   SPACE SPACE
 186 tr_cat_wrap_done:
 187   SWAP
 188   1+
 189   BRANCH tr_cat_loop
 190 tr_cat_exit:
 191   DROP
 192   0BRANCH tr_cat_no_final_cr
 193   ENDCR
 194 tr_cat_no_final_cr:
 195   ;S
 196 $FORTH_END_WORD TR-CAT