diff options
Diffstat (limited to 'qemu/roms/SLOF/slof/fs/client.fs')
| -rw-r--r-- | qemu/roms/SLOF/slof/fs/client.fs | 299 |
1 files changed, 299 insertions, 0 deletions
diff --git a/qemu/roms/SLOF/slof/fs/client.fs b/qemu/roms/SLOF/slof/fs/client.fs new file mode 100644 index 000000000..1b2bb0326 --- /dev/null +++ b/qemu/roms/SLOF/slof/fs/client.fs @@ -0,0 +1,299 @@ +\ ***************************************************************************** +\ * Copyright (c) 2004, 2008 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. + +0 VALUE debug-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 ! + \ Initialise client-stack-pointer + cistack ciregs >r1 ! + \ 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 + debug-client-interface? IF + ." ci: test " 2dup type cr + THEN + ALSO client-voc $find PREVIOUS IF + drop FALSE + ELSE + 2drop TRUE + THEN +; + +: finddevice ( zstr -- phandle ) + zcount + debug-client-interface? IF + ." ci: finddevice " 2dup type cr + THEN + 2dup " /memory" str= IF + \ Workaround: grub passes /memory instead of /memory@0 + 2drop + " /memory@0" + THEN + find-node dup 0= IF drop -1 THEN +; + +: getprop ( phandle zstr buf len -- len' ) + >r >r zcount rot ( str-adr str-len phandle R: len buf ) + debug-client-interface? IF + ." ci: getprop " 3dup . ." '" type ." '" + THEN + get-property + debug-client-interface? IF + dup IF ." ** not found **" THEN + cr + THEN + 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' ) + 2dup erase + >r >r zcount + >r dup c@ [char] / = IF + r> r> swap r> over >r min move r> + ELSE + r> find-alias ?dup 0= IF + r> r> 2drop -1 + ELSE + dup -rot r> swap r> min move + THEN + THEN +; + +: 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 + debug-client-interface? IF + ." ci: open " 2dup type cr + THEN + open-dev +; + +: close ( ihandle -- ) + debug-client-interface? IF + ." ci: close " dup . cr + THEN + s" stdin" get-chosen IF + decode-int nip nip over = IF + \ End of life of SLOF now, call platform quiesce as quiesce + \ is an undocumented extension and not everybody supports it + close-dev + quiesce + ELSE + close-dev + THEN + ELSE + close-dev + THEN +; + +\ 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 ) + debug-client-interface? IF + ." ci: claim " .s cr + THEN + dup IF rot drop + ['] claim CATCH IF 2drop -1 THEN + ELSE + ['] claim CATCH IF 3drop -1 THEN + THEN +; + +: release ( addr len -- ) + debug-client-interface? IF + ." ci: release " .s cr + THEN + 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 + debug-client-interface? IF + ." ci: call-method " 2dup type cr + THEN + 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 + debug-client-interface? IF + ." ci: test-method " 2dup type cr + THEN + 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 ( -- ) + debug-client-interface? IF + ." ci: quiesce" cr + THEN + \ The main quiesce call is defined in quiesce.fs + quiesce +; + +\ +\ User Interface, defined in 6.3.2.6 +\ +: interpret ( ... zstr -- result ... ) + zcount + debug-client-interface? IF + ." ci: interpret " 2dup type cr + THEN + ['] evaluate CATCH +; + +\ Allow the client to register a callback +: set-callback ( newfunc -- oldfunc ) + client-callback @ swap client-callback ! ; + +PREVIOUS DEFINITIONS |