qemu/roms/SLOF/slof/fs/rmove.fs

   1 \ *****************************************************************************
   2 \ * Copyright (c) 2004, 2008 IBM Corporation
   3 \ * All rights reserved.
   4 \ * This program and the accompanying materials
   5 \ * are made available under the terms of the BSD License
   6 \ * which accompanies this distribution, and is available at
   7 \ * http://www.opensource.org/licenses/bsd-license.php
   8 \ *
   9 \ * Contributors:
  10 \ *     IBM Corporation - initial implementation
  11 \ ****************************************************************************/
  12
  13 defer '(r@)
  14 defer '(r!)
  15 1 VALUE /(r)
  16
  17
  18 \ The rest of the code already implemented in prim.in
  19 \ In the end all of this should be moved over there and this file terminated
  20
  21 : (rfill) ( addr size pattern 'r! /r -- )
  22         to /(r) to '(r!) ff and
  23         dup 8 lshift or dup 10 lshift or dup 20 lshift or
  24         -rot bounds ?do dup i '(r!) /(r) +loop drop
  25 ;
  26
  27 : (fwrmove) ( src dest size -- )
  28         >r 0 -rot r> bounds ?do + dup '(r@) i '(r!) /(r) dup +loop 2drop
  29 ;
  30
  31 \ Move from main to device memory
  32 : mrmove ( src dest size -- )
  33         3dup or or 7 AND CASE
  34                 0 OF ['] x@ ['] rx! /x ENDOF
  35                 4 OF ['] l@ ['] rl! /l ENDOF
  36                 2 OF ['] w@ ['] rw! /w ENDOF
  37                 dup OF ['] c@ ['] rb! /c ENDOF
  38         ENDCASE
  39         ( We already know that source and destination do not overlap )
  40         to /(r) to '(r!) to '(r@) (fwrmove)
  41 ;
  42
  43 : rfill ( addr size pattern -- )
  44         3dup drop or 7 AND CASE
  45                 0 OF ['] rx! /x ENDOF
  46                 4 OF ['] rl! /l ENDOF
  47                 2 OF ['] rw! /w ENDOF
  48                 dup OF ['] rb! /c ENDOF
  49         ENDCASE (rfill)
  50 ;
  51
  52
  53