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