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