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
 109 $FORTH_CODE_WORD +!
 110 ;; AberSoft
 111 ;; ( n a -- )
 112   pop   hl
 113   pop   de
 114   ld    a,(hl)
 115   add   a,e
 116   ld    (hl),a
 117   inc   hl
 118   ld    a,(hl)
 119   adc   a,d
 120   ld    (hl),a
 121   jp    i_next
 122 $FORTH_END_CODE_WORD +!
 123
 124 $FORTH_CODE_WORD -!
 125 ;; k8
 126 ;; ( n a -- )
 127   pop   hl
 128   pop   de
 129   ld    a,(hl)
 130   sub   a,e
 131   ld    (hl),a
 132   inc   hl
 133   ld    a,(hl)
 134   sbc   a,d
 135   ld    (hl),a
 136   jp    i_next
 137 $FORTH_END_CODE_WORD -!
 138
 139 $FORTH_CODE_WORD C+!
 140 ;; k8
 141 ;; ( n a -- )
 142   pop   hl
 143   pop   de
 144   ld    a,(hl)
 145   add   a,e
 146   ld    (hl),a
 147   jp    i_next
 148 $FORTH_END_CODE_WORD C+!
 149
 150 $FORTH_CODE_WORD C-!
 151 ;; k8
 152 ;; ( n a -- )
 153   pop   hl
 154   pop   de
 155   ld    a,(hl)
 156   sub   a,e
 157   ld    (hl),a
 158   jp    i_next
 159 $FORTH_END_CODE_WORD C-!
 160
 161 $FORTH_CODE_WORD TOGGLE
 162 ;; AberSoft
 163 ;; ( a n -- )
 164   pop   de
 165   pop   hl
 166   ld    a,(hl)
 167   xor   e
 168   ld    (hl),a
 169   jp    i_next
 170 $FORTH_END_CODE_WORD TOGGLE
 171
 172 $FORTH_CODE_WORD 2@
 173 ;; AberSoft
 174 ;; ( a -- d )
 175   pop   hl
 176   inc   hl
 177   inc   hl
 178   ld    e,(hl)
 179   inc   hl
 180   ld    d,(hl)
 181   push  de
 182   dec   hl
 183   dec   hl
 184   ld    d,(hl)
 185   dec   hl
 186   ld    e,(hl)
 187   push  de
 188   jp    i_next
 189 $FORTH_END_CODE_WORD 2@
 190
 191 $FORTH_CODE_WORD C@
 192 ;; AberSoft
 193 ;; ( a -- c )
 194   pop   hl
 195   ld    l,(hl)
 196   ld    h,0
 197   jp    i_pushhl
 198 $FORTH_END_CODE_WORD C@
 199
 200 $FORTH_CODE_WORD @
 201 ;; AberSoft
 202 ;; ( a -- n )
 203   pop   hl
 204   ld    e,(hl)
 205   inc   hl
 206   ld    d,(hl)
 207   push  de
 208   jp    i_next
 209 $FORTH_END_CODE_WORD @
 210
 211 $FORTH_CODE_WORD 2!
 212 ;; AberSoft
 213 ;; ( a -- d )
 214   pop   hl
 215   pop   de
 216   ld    (hl),e
 217   inc   hl
 218   ld    (hl),d
 219   inc   hl
 220   pop   de
 221   ld    (hl),e
 222   inc   hl
 223   ld    (hl),d
 224   jp    i_next
 225 $FORTH_END_CODE_WORD 2!
 226
 227 $FORTH_CODE_WORD C!
 228 ;; AberSoft
 229 ;; ( a -- c )
 230   pop   hl
 231   pop   de
 232   ld    (hl),e
 233   jp    i_next
 234 $FORTH_END_CODE_WORD C!
 235
 236 $FORTH_CODE_WORD !
 237 ;; AberSoft
 238 ;; ( n a -- )
 239   pop   hl
 240   pop   de
 241   ld    (hl),e
 242   inc   hl
 243   ld    (hl),d
 244   jp    i_next
 245 $FORTH_END_CODE_WORD !
 246
 247 $FORTH_CODE_WORD 0C!
 248 ;; AberSoft
 249 ;; ( a -- )
 250   pop   hl
 251   ld    (hl),0
 252   jp    i_next
 253 $FORTH_END_CODE_WORD 0C!
 254
 255 $FORTH_CODE_WORD 0!
 256 ;; AberSoft
 257 ;; ( a -- )
 258   pop   hl
 259   ld    (hl),0
 260   inc   hl
 261   ld    (hl),0
 262   jp    i_next
 263 $FORTH_END_CODE_WORD 0!
 264
 265 $FORTH_CODE_WORD 1C!
 266 ;; k8
 267 ;; ( a -- )
 268   pop   hl
 269   ld    (hl),1
 270   jp    i_next
 271 $FORTH_END_CODE_WORD 1C!
 272
 273 $FORTH_CODE_WORD 1!
 274 ;; k8
 275 ;; ( a -- )
 276   pop   hl
 277   ld    (hl),1
 278   inc   hl
 279   ld    (hl),0
 280   jp    i_next
 281 $FORTH_END_CODE_WORD 1!