Return to client.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / SLOF / slof / fs

Annotation of qemu/roms/SLOF/slof/fs/client.fs, revision 1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.