X-Git-Url: https://gerrit.opnfv.org/gerrit/gitweb?a=blobdiff_plain;f=qemu%2Froms%2FSLOF%2Fslof%2Ffs%2Fclient.fs;fp=qemu%2Froms%2FSLOF%2Fslof%2Ffs%2Fclient.fs;h=1b2bb03268b41e438df343463410fce14c2d1a0f;hb=e44e3482bdb4d0ebde2d8b41830ac2cdb07948fb;hp=0000000000000000000000000000000000000000;hpb=9ca8dbcc65cfc63d6f5ef3312a33184e1d726e00;p=kvmfornfv.git

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