|
|
1.1 root 1: \
2: \ Copyright (C) 2009 Stefan Reinauer
3: \
4: \ See the file "COPYING" for further information about
5: \ the copyright and warranty status of this work.
6: \
7:
8: \ Implementation of IEEE Draft Std P1275.6/D5
9: \ Standard for Boot (Initialization Configuration) Firmware
10: \ 64 Bit Extensions
11:
12:
13: cell /x = constant 64bit?
14:
15: 64bit? [IF]
16:
17: : 32>64 ( 32bitsigned -- 64bitsigned )
18: dup 80000000 and if \ is it negative?
19: ffffffff00000000 or \ then set all high bits
20: then
21: ;
22:
23: : 64>32 ( 64bitsigned -- 32bitsigned )
24: h# ffffffff and
25: ;
26:
27: : lxjoin ( quad.lo quad.hi -- o )
28: d# 32 lshift or
29: ;
30:
31: : wxjoin ( w.lo w.2 w.3 w.hi -- o )
32: wljoin >r wljoin r> lxjoin
33: ;
34:
35: : bxjoin ( b.lo b.2 b.3 b.4 b.5 b.6 b.7 b.hi -- o )
36: bljoin >r bljoin r> lxjoin
37: ;
38:
39: : <l@ ( qaddr -- n )
40: l@ 32>64
41: ;
42:
43: : unaligned-x@ ( addr - o )
44: dup la1+ unaligned-l@ 64>32 swap unaligned-l@ 64>32 lxjoin
45: ;
46:
47: : unaligned-x! ( o oaddr -- )
48: >r dup d# 32 rshift r@ unaligned-l!
49: h# ffffffff and r> la1+ unaligned-l!
50: ;
51:
52: : x@ ( oaddr -- o )
53: unaligned-x@ \ for now
54: ;
55:
56: : x! ( o oaddr -- )
57: unaligned-x! \ for now
58: ;
59:
60: : (rx@) ( oaddr - o )
61: x@
62: ;
63:
64: : (rx!) ( o oaddr -- )
65: x!
66: ;
67:
68: : x, ( o -- )
69: here /x allot x!
70: ;
71:
72: : /x* ( nu1 -- nu2 )
73: /x *
74: ;
75:
76: : xa+ ( addr1 index -- addr2 )
77: /x* +
78: ;
79:
80: : xa1+ ( addr1 -- addr2 )
81: /x +
82: ;
83:
84: : xlsplit ( o -- quad.lo quad.hi )
85: dup h# ffffffff and swap d# 32 rshift
86: ;
87:
88: : xwsplit ( o -- w.lo w.2 w.3 w.hi )
89: xlsplit >r lwsplit r> lwsplit
90: ;
91:
92: : xbsplit ( o -- b.lo b.2 b.3 b.4 b.5 b.6 b.7 b.hi )
93: xlsplit >r lbsplit r> lbsplit
94: ;
95:
96: : xlflip ( oct1 -- oct2 )
97: xlsplit swap lxjoin
98: ;
99:
100: : xlflips ( oaddr len -- )
101: bounds ?do
102: i unaligned-x@ xlflip i unaligned-x!
103: /x +loop
104: ;
105:
106: : xwflip ( oct1 -- oct2 )
107: xlsplit lwflip swap lwflip lxjoin
108: ;
109:
110: : xwflips ( oaddr len -- )
111: bounds ?do
112: i unaligned-x@ xwflip i unaligned-x! /x
113: +loop
114: ;
115:
116: : xbflip ( oct1 -- oct2 )
117: xlsplit lbflip swap lbflip lxjoin
118: ;
119:
120: : xbflips ( oaddr len -- )
121: bounds ?do
122: i unaligned-x@ xbflip i unaligned-x!
123: /x +loop
124: ;
125:
126: \ : b(lit) b(lit) 32>64 ;
127:
128: [THEN]
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.