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