dsforth/trdos.zas

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