|
|
1.1 root 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:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.