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