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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
\ *****************************************************************************
\ * Copyright (c) 2004, 2007 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
\ ****************************************************************************/
\ Client interface.
\ First, the machinery.
VOCABULARY client-voc \ We store all client-interface callable words here.
6789 CONSTANT sc-exit
4711 CONSTANT sc-yield
VARIABLE client-callback \ Address of client's callback function
: client-data ciregs >r3 @ ;
: nargs client-data la1+ l@ ;
: nrets client-data la1+ la1+ l@ ;
: client-data-to-stack
client-data 3 la+ nargs 0 ?DO dup l@ swap la1+ LOOP drop ;
: stack-to-client-data
client-data nargs nrets + 2 + la+ nrets 0 ?DO tuck l! /l - LOOP drop ;
: call-client ( args len client-entry -- )
\ (args, len) describe the argument string, client-entry is the address of
\ the client's .entry symbol, i.e. where we eventually branch to.
\ ciregs is a variable that describes the register set of the host processor,
\ see slof/fs/exception.fs for details
\ client-entry-point maps to client_entry_point in slof/entry.S which is
\ the SLOF entry point when calling a SLOF client interface word from the
\ client.
\ We pass the arguments for the client in R6 and R7, the client interface
\ entry point address is passed in R5.
>r ciregs >r7 ! ciregs >r6 ! client-entry-point @ ciregs >r5 !
\ jump-client maps to call_client in slof/entry.S
\ When jump-client returns, R3 holds the address of a NUL-terminated string
\ that holds the client interface word the client wants to call, R4 holds
\ the return address.
r> jump-client drop
BEGIN
client-data-to-stack
\ Now create a Forth-style string, look it up in the client dictionary and
\ execute it, guarded by CATCH. Result of xt == 0 is stored on the return
\ stack
client-data l@ zcount
\ XXX: Should only look in client-voc...
ALSO client-voc $find PREVIOUS
dup 0= >r IF
CATCH
\ If a client interface word needs some special treatment, like exit and
\ yield, then the implementation needs to use THROW to indicate its needs
?dup IF
dup CASE
sc-exit OF drop r> drop EXIT ENDOF
sc-yield OF drop r> drop EXIT ENDOF
ENDCASE
\ Some special call was made but we don't know that to do with it...
THROW
THEN
stack-to-client-data
ELSE
cr type ." NOT FOUND"
THEN
\ Return to the client
r> ciregs >r3 ! ciregs >r4 @ jump-client
UNTIL ;
: flip-stack ( a1 ... an n -- an ... a1 ) ?dup IF 1 ?DO i roll LOOP THEN ;
: (callback) ( "service-name<>" "arguments<cr>" -- )
client-callback @ \ client-callback points to the function prolog
dup 8 + @ ciregs >r2 ! \ Set up the TOC pointer (???)
@ call-client ; \ Resolve the function's address from the prolog
' (callback) to callback
: (continue-client)
s" " \ make call-client happy, client won't use the string anyways.
ciregs >r4 @ call-client ;
' (continue-client) to continue-client
\ Utility.
: string-to-buffer ( str len buf len -- len' )
2dup erase rot min dup >r move r> ;
\ Now come the actual client interface words.
ALSO client-voc DEFINITIONS
: exit sc-exit THROW ;
: yield sc-yield THROW ;
: test ( zstr -- missing? )
\ XXX: Should only look in client-voc...
zcount
ALSO client-voc $find PREVIOUS IF nip FALSE ELSE nip nip TRUE THEN
;
: finddevice ( zstr -- phandle )
zcount find-node dup 0= IF drop -1 THEN ;
: getprop ( phandle zstr buf len -- len' )
>r >r zcount rot get-property
0= IF r> swap dup r> min swap >r move r>
ELSE r> r> 2drop -1 THEN ;
: getproplen ( phandle zstr -- len )
zcount rot get-property 0= IF nip ELSE -1 THEN ;
: setprop ( phandle zstr buf len -- size|-1 )
dup >r \ save len
encode-bytes ( phandle zstr prop-addr prop-len )
2swap zcount rot ( prop-addr prop-len name-addr name-len phandle )
current-node @ >r \ save current node
set-node \ change to specified node
property \ set property
r> set-node \ restore original node
r> \ always return size, because we can not fail.
;
\ VERY HACKISH
: canon ( zstr buf len -- len' )
over >r move r> zcount nip ;
: nextprop ( phandle zstr buf -- flag ) \ -1 invalid, 0 end, 1 ok
>r zcount rot next-property IF r> zplace 1 ELSE r> drop 0 THEN ;
: open ( zstr -- ihandle ) zcount open-dev ;
: close ( ihandle -- ) close-dev ;
\ Now implemented: should return -1 if no such method exists in that node
: write ( ihandle str len -- len' ) rot s" write" rot
['] $call-method CATCH IF 2drop 3drop -1 THEN ;
: read ( ihandle str len -- len' ) rot s" read" rot
['] $call-method CATCH IF 2drop 3drop -1 THEN ;
: seek ( ihandle hi lo -- status ) swap rot s" seek" rot
['] $call-method CATCH IF 2drop 3drop -1 THEN ;
\ A real claim implementation: 3.2% memory fat :-)
: claim ( addr len align -- base )
dup IF rot drop
['] claim CATCH IF 2drop -1 THEN
ELSE
['] claim CATCH IF 3drop -1 THEN
THEN
;
: release ( addr len -- ) release ;
: instance-to-package ( ihandle -- phandle )
ihandle>phandle ;
: package-to-path ( phandle buf len -- len' )
2>r node>path 2r> string-to-buffer ;
: instance-to-path ( ihandle buf len -- len' )
2>r instance>path 2r> string-to-buffer ;
: instance-to-interposed-path ( ihandle buf len -- len' )
2>r instance>qpath 2r> string-to-buffer ;
: call-method ( str ihandle arg ... arg -- result return ... return )
nargs flip-stack zcount rot ['] $call-method CATCH
nrets 0= IF drop ELSE \ if called with 0 return args do not return the catch result
dup IF nrets 1 ?DO -444 LOOP THEN
nrets flip-stack
THEN ;
\ From the PAPR.
: test-method ( phandle str -- missing? )
zcount rot find-method dup IF nip THEN 0= ;
: milliseconds milliseconds ;
: start-cpu ( phandle addr r3 -- )
>r >r
s" reg" rot get-property 0= IF drop l@
ELSE true ABORT" start-cpu called with invalid phandle" THEN
r> r> of-start-cpu drop
;
\ Quiesce firmware and assert that all hardware is in a sane state
\ (e.g. assert that no background DMA is running anymore)
: quiesce ( -- )
\ The main quiesce call is defined in quiesce.fs
quiesce
;
\
\ User Interface, defined in 6.3.2.6
\
: interpret ( ... zstr -- result ... )
zcount ['] evaluate CATCH ;
\ Allow the client to register a callback
: set-callback ( newfunc -- oldfunc )
client-callback @ swap client-callback ! ;
PREVIOUS DEFINITIONS
|
