dsforth/blocks.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; buffers, blocks, etc...
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4
   5 $FORTH_CONST FIRST #D800
   6 $FORTH_CONST LIMIT #E01F
   7 $FORTH_CONST BUF-NUM 8
   8 $FORTH_CONST B/BUF 256
   9 $FORTH_CONST B/SCR 4
  10 $FORTH_CONST (B/BUF) 260
  11
  12 $FORTH_VAR BUF-USE #D800
  13 $FORTH_VAR BUF-PREV #D800
  14
  15 ;; get next buffer to use
  16 $FORTH_WORD +BUF
  17 ;; AberSoft, k8
  18 ;; ( a -- na isprevflg )
  19 ;; isprevflg: TRUE when new buffer is BUF-PREV (so the cycle is closed %-)
  20   (B/BUF) +       ;; next buffer address
  21   DUP LIMIT U>    ;; is limit reached?
  22   0BRANCH pbuf0
  23   DROP FIRST      ;; yes: start from the first buffer
  24 pbuf0:
  25   DUP BUF-PREV @ -
  26   ;S
  27 $FORTH_END_WORD +BUF
  28
  29 ;; set "dirty" flag
  30 $FORTH_WORD UPDATE
  31 ;; AberSoft
  32   BUF-PREV @ @  LIT #8000 OR  BUF-PREV @ ! ;S
  33 $FORTH_END_WORD UPDATE
  34
  35 ;; reset "dirty" flag
  36 $FORTH_WORD UNUPDATE
  37 ;; k8
  38   BUF-PREV @ @  LIT #7FFF AND  BUF-PREV @ ! ;S
  39 $FORTH_END_WORD UNUPDATE
  40
  41 $FORTH_WORD EMPTY-BUFFERS
  42 ;; k8
  43   FIRST LIMIT OVER - 1+ ERASE
  44   FIRST BUF-NUM 0 (DO)
  45 emptybuffers0:
  46   LIT #7FFE OVER !  (B/BUF) +
  47   (LOOP) emptybuffers0
  48   DROP ;S
  49 $FORTH_END_WORD EMPTY-BUFFERS
  50
  51 ;; clear OFFSET
  52 $FORTH_WORD DR0
  53 ;; AberSoft
  54   OFFSET 0! ;S
  55 $FORTH_END_WORD DR0
  56
  57 ;; load or save buffer
  58 $FORTH_WORD R/W
  59 ;; k8
  60 ;; ( addr bufnum readflag -- )
  61 ;; read buffer if readflag <> 0
  62   >R  ;; save readflag
  63   DUP LIT 32767 - 0= 0BRANCH rwdo0
  64   DROP 0
  65 rwdo0:
  66   DUP 0< OVER LIT 2559 > OR LIT 6 ?ERROR  ;; check for valid buffer number
  67 ;; ( addr bufnum | readflag )
  68   R> 0BRANCH rwdo_write
  69 ;; read buffer
  70   1 ROT TR-SREAD
  71   ;S
  72 rwdo_write:
  73 ;; write buffer
  74   READ-ONLY @ 0BRANCH rwdo_write1
  75   2DROP
  76   ;S
  77 rwdo_write1:
  78   1 ROT TR-SWRITE
  79   ;S
  80 $FORTH_END_WORD R/W
  81
  82 ;; get new buffer to use (save dirty buffer if necessary)
  83 $FORTH_WORD BUFFER
  84 ;; AberSoft
  85 ;; ( -- a )
  86   BUF-USE @ DUP >R
  87 buffer0:
  88   +BUF 0BRANCH buffer0
  89 ;; ( buffaddr | prefbuffuse )
  90   BUF-USE !  R@ @ 0<  ;; ( dirty? | prefbuffuse )
  91   0BRANCH buffer1
  92 ;; save dirty buffer
  93   R@ 2+  R@ @ LIT #7FFF AND  0  R/W   ;; save dirty buffer
  94 buffer1:
  95   R@ !  R@ BUF-PREV !  R> 2+
  96   ;S
  97 $FORTH_END_WORD BUFFER
  98
  99 ;; load block
 100 $FORTH_WORD BLOCK
 101 ;; AberSoft, k8
 102 ;; ( n -- a )  ??? unclear
 103   OFFSET @ + >R  ;; store real block number
 104   BUF-PREV @     ;; buffer addr
 105   DUP @          ;; buffer number;  ( bpa bpn | bn )
 106   R@ -  DUP +    ;; ( bpa bpn-bn bpn-bn*2 | bn )
 107   0BRANCH block2 ;; zero? i.e. does the user wants the last loaded block?
 108 block0:
 109   +BUF 0= 0BRANCH block1  ;; last buffer reached?
 110 ;; have to load new block
 111   DROP  R@ BUFFER DUP  R@  1  R/W  2-
 112 block1:
 113 ;; ( buffa | bn )
 114 ;; check if the buffer is ours
 115   DUP @ R@ -     ;; get block number delta
 116   DUP + 0= 0BRANCH block0
 117   DUP BUF-PREV !
 118 block2:
 119 ;; drop real block number, return address
 120   RDROP 2+
 121   ;S
 122 $FORTH_END_WORD BLOCK
 123
 124 ;; save all dirty buffers
 125 $FORTH_WORD FLUSH
 126 ;; AberSoft
 127 ;; ( -- )
 128   BUF-NUM 1+ 0 (DO)
 129 flush0:
 130   0 BUFFER DROP
 131   (LOOP) flush0
 132   ;S
 133 $FORTH_END_WORD FLUSH
 134
 135 ;; load block line
 136 $FORTH_WORD (LINE)
 137 ;; AberSoft
 138 ;; ( line block -- addr )
 139 ;; expects two args
 140 ;; returns address
 141   >R  LIT 64 B/BUF */MOD  R>
 142   B/SCR * + BLOCK + LIT 64
 143   ;S
 144 $FORTH_END_WORD (LINE)
 145
 146 $FORTH_WORD .LINE
 147 ;; AberSoft
 148 ;; expects two args
 149 ;; returns nothing
 150   (LINE) -TRAILING TYPE ;S
 151 $FORTH_END_WORD .LINE
 152
 153 ;; interpret block
 154 $FORTH_WORD LOAD
 155 ;; AberSoft
 156 ;; ( n )
 157   DUP 0 = LIT 9 ?ERROR
 158   BLK @ >R  IN @ >R  IN 0!  B/SCR * BLK !
 159   INTERPRET
 160   R> IN !  R> BLK !
 161   ;S
 162 $FORTH_END_WORD LOAD
 163
 164 ;; interpret next block
 165 $FORTH_WORD --> IMM
 166 ;; AberSoft
 167   ?LOADING  IN 0!  B/SCR BLK @ OVER MOD - BLK +!
 168   ;S
 169 $FORTH_END_WORD -->
 170
 171 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 172 ;; end of buffers, blocks, etc...
 173 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;