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 160 VALUE debug-client-interface? 17 18\ First, the machinery. 19 20VOCABULARY client-voc \ We store all client-interface callable words here. 21 226789 CONSTANT sc-exit 234711 CONSTANT sc-yield 24 25VARIABLE client-callback \ Address of client's callback function 26 27: client-data ciregs >r3 @ ; 28: nargs client-data la1+ l@ ; 29: nrets client-data la1+ la1+ l@ ; 30: client-data-to-stack 31 client-data 3 la+ nargs 0 ?DO dup l@ swap la1+ LOOP drop ; 32: stack-to-client-data 33 client-data nargs nrets + 2 + la+ nrets 0 ?DO tuck l! /l - LOOP drop ; 34 35: call-client ( args len client-entry -- ) 36 \ (args, len) describe the argument string, client-entry is the address of 37 \ the client's .entry symbol, i.e. where we eventually branch to. 38 \ ciregs is a variable that describes the register set of the host processor, 39 \ see slof/fs/exception.fs for details 40 \ client-entry-point maps to client_entry_point in slof/entry.S which is 41 \ the SLOF entry point when calling a SLOF client interface word from the 42 \ client. 43 \ We pass the arguments for the client in R6 and R7, the client interface 44 \ entry point address is passed in R5. 45 >r ciregs >r7 ! ciregs >r6 ! client-entry-point @ ciregs >r5 ! 46 \ Initialise client-stack-pointer 47 cistack ciregs >r1 ! 48 49 s" linux,initrd-end" get-chosen IF decode-int nip nip ELSE 0 THEN 50 s" linux,initrd-start" get-chosen IF decode-int nip nip ELSE 0 THEN 51 ( end start ) 52 tuck - ( start len ) 53 ciregs >r4 ! 54 ciregs >r3 ! 55 56 \ jump-client maps to call_client in slof/entry.S 57 \ When jump-client returns, R3 holds the address of a NUL-terminated string 58 \ that holds the client interface word the client wants to call, R4 holds 59 \ the return address. 60 r> jump-client drop 61 BEGIN 62 client-data-to-stack 63 \ Now create a Forth-style string, look it up in the client dictionary and 64 \ execute it, guarded by CATCH. Result of xt == 0 is stored on the return 65 \ stack 66 client-data l@ zcount 67 \ XXX: Should only look in client-voc... 68 ALSO client-voc $find PREVIOUS 69 dup 0= >r IF 70 CATCH 71 \ If a client interface word needs some special treatment, like exit and 72 \ yield, then the implementation needs to use THROW to indicate its needs 73 ?dup IF 74 dup CASE 75 sc-exit OF drop r> drop EXIT ENDOF 76 sc-yield OF drop r> drop EXIT ENDOF 77 ENDCASE 78 \ Some special call was made but we don't know that to do with it... 79 THROW 80 THEN 81 stack-to-client-data 82 ELSE 83 cr type ." NOT FOUND" 84 THEN 85 \ Return to the client 86 r> ciregs >r3 ! ciregs >r4 @ jump-client 87 UNTIL ; 88 89: flip-stack ( a1 ... an n -- an ... a1 ) ?dup IF 1 ?DO i roll LOOP THEN ; 90 91: (callback) ( "service-name<>" "arguments<cr>" -- ) 92 client-callback @ \ client-callback points to the function prolog 93 dup 8 + @ ciregs >r2 ! \ Set up the TOC pointer (???) 94 @ call-client ; \ Resolve the function's address from the prolog 95' (callback) to callback 96 97: (continue-client) 98 s" " \ make call-client happy, client won't use the string anyways. 99 ciregs >r4 @ call-client ; 100' (continue-client) to continue-client 101 102\ Utility. 103: string-to-buffer ( str len buf len -- len' ) 104 2dup erase rot min dup >r move r> ; 105 106\ Now come the actual client interface words. 107 108ALSO client-voc DEFINITIONS 109 110: exit sc-exit THROW ; 111 112: yield sc-yield THROW ; 113 114: test ( zstr -- missing? ) 115 \ XXX: Should only look in client-voc... 116 zcount 117 debug-client-interface? IF 118 ." ci: test " 2dup type cr 119 THEN 120 ALSO client-voc $find PREVIOUS IF 121 drop FALSE 122 ELSE 123 2drop TRUE 124 THEN 125; 126 127: finddevice ( zstr -- phandle ) 128 zcount 129 debug-client-interface? IF 130 ." ci: finddevice " 2dup type cr 131 THEN 132 2dup " /memory" str= IF 133 \ Workaround: grub passes /memory instead of /memory@0 134 2drop 135 " /memory@0" 136 THEN 137 find-node dup 0= IF drop -1 THEN 138; 139 140: getprop ( phandle zstr buf len -- len' ) 141 >r >r zcount rot ( str-adr str-len phandle R: len buf ) 142 debug-client-interface? IF 143 ." ci: getprop " 3dup . ." '" type ." '" 144 THEN 145 get-property 146 debug-client-interface? IF 147 dup IF ." ** not found **" THEN 148 cr 149 THEN 150 0= IF 151 r> swap dup r> min swap >r move r> 152 ELSE 153 r> r> 2drop -1 154 THEN 155; 156 157: getproplen ( phandle zstr -- len ) 158 zcount rot get-property 0= IF nip ELSE -1 THEN ; 159 160: setprop ( phandle zstr buf len -- size|-1 ) 161 dup >r \ save len 162 encode-bytes ( phandle zstr prop-addr prop-len ) 163 2swap zcount rot ( prop-addr prop-len name-addr name-len phandle ) 164 current-node @ >r \ save current node 165 set-node \ change to specified node 166 property \ set property 167 r> set-node \ restore original node 168 r> \ always return size, because we can not fail. 169; 170 171\ VERY HACKISH 172: canon ( zstr buf len -- len' ) 173 2dup erase 174 >r >r zcount 175 >r dup c@ [char] / = IF 176 r> r> swap r> over >r min move r> 177 ELSE 178 r> find-alias ?dup 0= IF 179 r> r> 2drop -1 180 ELSE 181 dup -rot r> swap r> min move 182 THEN 183 THEN 184; 185 186: nextprop ( phandle zstr buf -- flag ) \ -1 invalid, 0 end, 1 ok 187 >r zcount rot next-property IF r> zplace 1 ELSE r> drop 0 THEN ; 188 189: open ( zstr -- ihandle ) 190 zcount 191 debug-client-interface? IF 192 ." ci: open " 2dup type cr 193 THEN 194 open-dev 195; 196 197: close ( ihandle -- ) 198 debug-client-interface? IF 199 ." ci: close " dup . cr 200 THEN 201 s" stdin" get-chosen IF 202 decode-int nip nip over = IF 203 \ End of life of SLOF now, call platform quiesce as quiesce 204 \ is an undocumented extension and not everybody supports it 205 close-dev 206 quiesce 207 ELSE 208 close-dev 209 THEN 210 ELSE 211 close-dev 212 THEN 213; 214 215\ Now implemented: should return -1 if no such method exists in that node 216: write ( ihandle str len -- len' ) rot s" write" rot 217 ['] $call-method CATCH IF 2drop 3drop -1 THEN ; 218: read ( ihandle str len -- len' ) rot s" read" rot 219 ['] $call-method CATCH IF 2drop 3drop -1 THEN ; 220: seek ( ihandle hi lo -- status ) swap rot s" seek" rot 221 ['] $call-method CATCH IF 2drop 3drop -1 THEN ; 222 223\ A real claim implementation: 3.2% memory fat :-) 224: claim ( addr len align -- base ) 225 debug-client-interface? IF 226 ." ci: claim " .s cr 227 THEN 228 dup IF rot drop 229 ['] claim CATCH IF 2drop -1 THEN 230 ELSE 231 ['] claim CATCH IF 3drop -1 THEN 232 THEN 233; 234 235: release ( addr len -- ) 236 debug-client-interface? IF 237 ." ci: release " .s cr 238 THEN 239 release 240; 241 242: instance-to-package ( ihandle -- phandle ) 243 ihandle>phandle ; 244 245: package-to-path ( phandle buf len -- len' ) 246 2>r node>path 2r> string-to-buffer ; 247: instance-to-path ( ihandle buf len -- len' ) 248 2>r instance>path 2r> string-to-buffer ; 249: instance-to-interposed-path ( ihandle buf len -- len' ) 250 2>r instance>qpath 2r> string-to-buffer ; 251 252: call-method ( str ihandle arg ... arg -- result return ... return ) 253 nargs flip-stack zcount 254 debug-client-interface? IF 255 ." ci: call-method " 2dup type cr 256 THEN 257 rot ['] $call-method CATCH 258 nrets 0= IF drop ELSE \ if called with 0 return args do not return the catch result 259 dup IF nrets 1 ?DO -444 LOOP THEN 260 nrets flip-stack 261 THEN 262; 263 264\ From the PAPR. 265: test-method ( phandle str -- missing? ) 266 zcount 267 debug-client-interface? IF 268 ." ci: test-method " 2dup type cr 269 THEN 270 rot find-method dup IF nip THEN 0= 271; 272 273: milliseconds milliseconds ; 274 275: start-cpu ( phandle addr r3 -- ) 276 >r >r 277 s" reg" rot get-property 0= IF drop l@ 278 ELSE true ABORT" start-cpu called with invalid phandle" THEN 279 r> r> of-start-cpu drop 280; 281 282\ Quiesce firmware and assert that all hardware is in a sane state 283\ (e.g. assert that no background DMA is running anymore) 284: quiesce ( -- ) 285 debug-client-interface? IF 286 ." ci: quiesce" cr 287 THEN 288 \ The main quiesce call is defined in quiesce.fs 289 quiesce 290; 291 292\ 293\ Standard for Boot, defined in 6.3.2.5: 294\ 295: boot ( zstr -- ) 296 zcount 297 debug-client-interface? IF 298 ." ci: boot " 2dup type cr 299 THEN 300 " boot " 2swap $cat " boot-command" $setenv (nvupdate) 301 reset-all 302; 303 304\ 305\ User Interface, defined in 6.3.2.6 306\ 307: interpret ( ... zstr -- result ... ) 308 zcount 309 debug-client-interface? IF 310 ." ci: interpret " 2dup type cr 311 THEN 312 ['] evaluate CATCH 313; 314 315\ Allow the client to register a callback 316: set-callback ( newfunc -- oldfunc ) 317 client-callback @ swap client-callback ! ; 318 319\ Custom method to get FDT blob 320: fdt-fetch ( buf len -- ret ) 321 fdt-flatten-tree ( buf len dtb ) 322 dup >r 323 >fdth_tsize l@ ( buf len size r: dtb ) 324 2dup < IF 325 ." ERROR: need " .d ." bytes, the buffer is " .d ." bytes only" cr 326 drop 327 -1 328 ELSE 329 nip r@ -rot move 330 0 331 THEN 332 r> fdt-flatten-tree-free 333; 334 335PREVIOUS DEFINITIONS 336