← Back to branch summary

~pmdj/ubuntu/trusty/qemu/2.9+applesmc+fadtv3

« back to all changes in this revision

Viewing changes to roms/openbios/forth/lib/64bit.fs

  • Committer: Phil Dennis-Jordan
  • Date: 2017-07-21 08:03:43 UTC
  • mfrom: (1.1.1)
  • Revision ID: phil@philjordan.eu-20170721080343-2yr2vdj7713czahv
New upstream release 2.9.0.

Show diffs side-by-side

added added

removed removed

Lines of Context:
roms/openbios/forth/lib/64bit.fs
 
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]