dsforth/main_blocks.zas

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