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
13cell /x = constant 64bit?
14
1564bit? [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]
129