dsforth/main_memops.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; memory loading and storing
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4
   5 $FORTH_CODE_WORD PAGE-CMOVE
   6 ;; k8
   7 ;; CMOVE with page swapping
   8 ;; disables interrupts, so it is safe
   9 ;; ( from to len destpage -- )
  10 ;; `to` must be >= #C000
  11   pop   de         ; destpage
  12   ld    a,e
  13   ;;AND  #07      ; we can have alot of pages
  14   ; get other args and save BC
  15   ld    l,c
  16   ld    h,b
  17   pop   bc         ; length
  18   pop   de         ; dest
  19   ex    (sp),hl    ; save BC and get src
  20   ld    a,b
  21   or    c
  22   jr    z,cmove0
  23   ; move
  24   exx
  25   ld    bc,#7FFD
  26   di
  27   out   (c),a
  28   exx
  29   ldir
  30   exx
  31   ld    a,(f_cur7FFD)
  32   out   (c),a
  33   ei
  34   jr    cmove0
  35 $FORTH_END_CODE_WORD PAGE-CMOVE
  36
  37 $FORTH_CODE_WORD CMOVE
  38 ;; AberSoft
  39 ;; ( from to len -- )
  40   ld    l,c
  41   ld    h,b
  42   pop   bc
  43   pop   de
  44   ex    (sp),hl
  45   ld    a,b
  46   or    c
  47   jr    z,cmove0
  48   ldir
  49 cmove0:
  50   pop   bc
  51   jp    i_next
  52 $FORTH_END_CODE_WORD CMOVE
  53
  54 $FORTH_CODE_WORD FILL
  55 ;; k8
  56 ;; ( addr len byte -- )
  57   ;;jr    fword_fill_old
  58   pop   hl  ;; A is byte
  59   ld    a,l
  60   pop   de  ;; DE is len
  61   pop   hl  ;; HL is addr
  62   ex    af,af'
  63   ld    a,d
  64   or    a
  65   jr    nz,fword_fill_valid
  66   ;; less than 256 bytes, check for one byte
  67   ld    a,e
  68   cp    1
  69   jp    c,i_next  ;; zero bytes, do nothing
  70   jr    nz,fword_fill_valid
  71   ;; one byte
  72   ex    af,af'
  73   ld    (hl),a
  74   jp    i_next
  75 fword_fill_valid:
  76   push  bc
  77   ld    bc,de
  78   ld    de,hl
  79   inc   de
  80   ex    af,af'
  81   ld    (hl),a
  82   dec   bc
  83   ldir
  84   pop   bc
  85   jp    i_next
  86 ;; ;; AberSoft
  87 ;; ;; ( addr len byte -- )
  88 ;; fword_fill_old:
  89 ;;   ld    hl,bc
  90 ;;   pop   de
  91 ;;   pop   bc
  92 ;;   ex    (sp),hl
  93 ;;   ex    de,hl
  94 ;; fill0:
  95 ;;   ld    a,b
  96 ;;   or    c
  97 ;;   jr    z,fill1
  98 ;;   ld    a,l
  99 ;;   ld    (de),a
 100 ;;   inc   de
 101 ;;   dec   bc
 102 ;;   jr    fill0
 103 ;; fill1:
 104 ;;   pop   bc
 105 ;;   jp    i_next
 106 $FORTH_END_CODE_WORD FILL
 107
 108 $FORTH_WORD ERASE
 109 ;; AberSoft
 110 ;; ( addr len -- )
 111   0 FILL ;S
 112 $FORTH_END_WORD ERASE
 113
 114 $FORTH_WORD BLANKS
 115 ;; AberSoft
 116 ;; ( addr len -- )
 117   BL FILL ;S
 118 $FORTH_END_WORD BLANKS
 119
 120
 121 $FORTH_CODE_WORD +!
 122 ;; AberSoft
 123 ;; ( n a -- )
 124   pop   hl
 125   pop   de
 126   ld    a,(hl)
 127   add   a,e
 128   ld    (hl),a
 129   inc   hl
 130   ld    a,(hl)
 131   adc   a,d
 132   ld    (hl),a
 133   jp    i_next
 134 $FORTH_END_CODE_WORD +!
 135
 136 $FORTH_CODE_WORD -!
 137 ;; k8
 138 ;; ( n a -- )
 139   pop   hl
 140   pop   de
 141   ld    a,(hl)
 142   sub   a,e
 143   ld    (hl),a
 144   inc   hl
 145   ld    a,(hl)
 146   sbc   a,d
 147   ld    (hl),a
 148   jp    i_next
 149 $FORTH_END_CODE_WORD -!
 150
 151 $FORTH_CODE_WORD C+!
 152 ;; k8
 153 ;; ( n a -- )
 154   pop   hl
 155   pop   de
 156   ld    a,(hl)
 157   add   a,e
 158   ld    (hl),a
 159   jp    i_next
 160 $FORTH_END_CODE_WORD C+!
 161
 162 $FORTH_CODE_WORD C-!
 163 ;; k8
 164 ;; ( n a -- )
 165   pop   hl
 166   pop   de
 167   ld    a,(hl)
 168   sub   a,e
 169   ld    (hl),a
 170   jp    i_next
 171 $FORTH_END_CODE_WORD C-!
 172
 173 $FORTH_CODE_WORD TOGGLE
 174 ;; AberSoft
 175 ;; ( a n -- )
 176   pop   de
 177   pop   hl
 178   ld    a,(hl)
 179   xor   e
 180   ld    (hl),a
 181   jp    i_next
 182 $FORTH_END_CODE_WORD TOGGLE
 183
 184 $FORTH_CODE_WORD 2@
 185 ;; AberSoft
 186 ;; ( a -- d )
 187   pop   hl
 188   inc   hl
 189   inc   hl
 190   ld    e,(hl)
 191   inc   hl
 192   ld    d,(hl)
 193   push  de
 194   dec   hl
 195   dec   hl
 196   ld    d,(hl)
 197   dec   hl
 198   ld    e,(hl)
 199   push  de
 200   jp    i_next
 201 $FORTH_END_CODE_WORD 2@
 202
 203 $FORTH_CODE_WORD C@
 204 ;; AberSoft
 205 ;; ( a -- c )
 206   pop   hl
 207   ld    l,(hl)
 208   ld    h,0
 209   jp    i_pushhl
 210 $FORTH_END_CODE_WORD C@
 211
 212 $FORTH_CODE_WORD @
 213 ;; AberSoft
 214 ;; ( a -- n )
 215   pop   hl
 216   ld    e,(hl)
 217   inc   hl
 218   ld    d,(hl)
 219   push  de
 220   jp    i_next
 221 $FORTH_END_CODE_WORD @
 222
 223 $FORTH_CODE_WORD 2!
 224 ;; AberSoft
 225 ;; ( a -- d )
 226   pop   hl
 227   pop   de
 228   ld    (hl),e
 229   inc   hl
 230   ld    (hl),d
 231   inc   hl
 232   pop   de
 233   ld    (hl),e
 234   inc   hl
 235   ld    (hl),d
 236   jp    i_next
 237 $FORTH_END_CODE_WORD 2!
 238
 239 $FORTH_CODE_WORD C!
 240 ;; AberSoft
 241 ;; ( a -- c )
 242   pop   hl
 243   pop   de
 244   ld    (hl),e
 245   jp    i_next
 246 $FORTH_END_CODE_WORD C!
 247
 248 $FORTH_CODE_WORD !
 249 ;; AberSoft
 250 ;; ( n a -- )
 251   pop   hl
 252   pop   de
 253   ld    (hl),e
 254   inc   hl
 255   ld    (hl),d
 256   jp    i_next
 257 $FORTH_END_CODE_WORD !
 258
 259 $FORTH_CODE_WORD 0C!
 260 ;; AberSoft
 261 ;; ( a -- )
 262   pop   hl
 263   ld    (hl),0
 264   jp    i_next
 265 $FORTH_END_CODE_WORD 0C!
 266
 267 $FORTH_CODE_WORD 0!
 268 ;; AberSoft
 269 ;; ( a -- )
 270   pop   hl
 271   ld    (hl),0
 272   inc   hl
 273   ld    (hl),0
 274   jp    i_next
 275 $FORTH_END_CODE_WORD 0!
 276
 277 $FORTH_CODE_WORD 1C!
 278 ;; k8
 279 ;; ( a -- )
 280   pop   hl
 281   ld    (hl),1
 282   jp    i_next
 283 $FORTH_END_CODE_WORD 1C!
 284
 285 $FORTH_CODE_WORD 1!
 286 ;; k8
 287 ;; ( a -- )
 288   pop   hl
 289   ld    (hl),1
 290   inc   hl
 291   ld    (hl),0
 292   jp    i_next
 293 $FORTH_END_CODE_WORD 1!