![[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? )
1.1.1.2 ! root 105: \ XXX: Should only look in client-voc...
! 106: zcount
! 107: ALSO client-voc $find PREVIOUS IF
! 108: drop FALSE
! 109: ELSE
! 110: 2drop TRUE
! 111: THEN
! 112: ;
1.1 root 113:
114: : finddevice ( zstr -- phandle )
115: zcount find-node dup 0= IF drop -1 THEN ;
116:
117: : getprop ( phandle zstr buf len -- len' )
118: >r >r zcount rot get-property
119: 0= IF r> swap dup r> min swap >r move r>
120: ELSE r> r> 2drop -1 THEN ;
121:
122: : getproplen ( phandle zstr -- len )
123: zcount rot get-property 0= IF nip ELSE -1 THEN ;
124:
125: : setprop ( phandle zstr buf len -- size|-1 )
126: dup >r \ save len
127: encode-bytes ( phandle zstr prop-addr prop-len )
128: 2swap zcount rot ( prop-addr prop-len name-addr name-len phandle )
129: current-node @ >r \ save current node
130: set-node \ change to specified node
131: property \ set property
132: r> set-node \ restore original node
133: r> \ always return size, because we can not fail.
134: ;
135:
136: \ VERY HACKISH
137: : canon ( zstr buf len -- len' )
138: over >r move r> zcount nip ;
139:
140: : nextprop ( phandle zstr buf -- flag ) \ -1 invalid, 0 end, 1 ok
141: >r zcount rot next-property IF r> zplace 1 ELSE r> drop 0 THEN ;
142:
143: : open ( zstr -- ihandle ) zcount open-dev ;
144: : close ( ihandle -- ) close-dev ;
145:
146: \ Now implemented: should return -1 if no such method exists in that node
147: : write ( ihandle str len -- len' ) rot s" write" rot
148: ['] $call-method CATCH IF 2drop 3drop -1 THEN ;
149: : read ( ihandle str len -- len' ) rot s" read" rot
150: ['] $call-method CATCH IF 2drop 3drop -1 THEN ;
151: : seek ( ihandle hi lo -- status ) swap rot s" seek" rot
152: ['] $call-method CATCH IF 2drop 3drop -1 THEN ;
153:
154: \ A real claim implementation: 3.2% memory fat :-)
155: : claim ( addr len align -- base )
156: dup IF rot drop
157: ['] claim CATCH IF 2drop -1 THEN
158: ELSE
159: ['] claim CATCH IF 3drop -1 THEN
160: THEN
161: ;
162:
163: : release ( addr len -- ) release ;
164:
165: : instance-to-package ( ihandle -- phandle )
166: ihandle>phandle ;
167:
168: : package-to-path ( phandle buf len -- len' )
169: 2>r node>path 2r> string-to-buffer ;
170: : instance-to-path ( ihandle buf len -- len' )
171: 2>r instance>path 2r> string-to-buffer ;
172: : instance-to-interposed-path ( ihandle buf len -- len' )
173: 2>r instance>qpath 2r> string-to-buffer ;
174:
175: : call-method ( str ihandle arg ... arg -- result return ... return )
176: nargs flip-stack zcount rot ['] $call-method CATCH
177: nrets 0= IF drop ELSE \ if called with 0 return args do not return the catch result
178: dup IF nrets 1 ?DO -444 LOOP THEN
179: nrets flip-stack
180: THEN ;
181:
182: \ From the PAPR.
183: : test-method ( phandle str -- missing? )
184: zcount rot find-method dup IF nip THEN 0= ;
185:
186: : milliseconds milliseconds ;
187:
188: : start-cpu ( phandle addr r3 -- )
189: >r >r
190: s" reg" rot get-property 0= IF drop l@
191: ELSE true ABORT" start-cpu called with invalid phandle" THEN
192: r> r> of-start-cpu drop
193: ;
194:
195: \ Quiesce firmware and assert that all hardware is in a sane state
196: \ (e.g. assert that no background DMA is running anymore)
197: : quiesce ( -- )
198: \ The main quiesce call is defined in quiesce.fs
199: quiesce
200: ;
201:
202: \
203: \ User Interface, defined in 6.3.2.6
204: \
205: : interpret ( ... zstr -- result ... )
206: zcount ['] evaluate CATCH ;
207:
208: \ Allow the client to register a callback
209: : set-callback ( newfunc -- oldfunc )
210: client-callback @ swap client-callback ! ;
211:
212: PREVIOUS DEFINITIONS
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.