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

diff --git a/qemu/roms/SLOF/slof/fs/envvar.fs b/qemu/roms/SLOF/slof/fs/envvar.fs
new file mode 100644
index 000000000..33643130c
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/envvar.fs
@@ -0,0 +1,412 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2012 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
+\ ****************************************************************************/
+
+
+\ configuration variables
+
+wordlist CONSTANT envvars
+
+\ list the names in  envvars
+: listenv  ( -- )
+   get-current envvars set-current  words  set-current
+;
+
+\ create a definition in  envvars
+: create-env ( "name" -- )
+   get-current  envvars set-current  CREATE  set-current
+;
+
+\ lay out the data for the separate envvar types
+: env-int     ( n -- )  1 c, align , DOES> char+ aligned @ ;
+: env-bytes   ( a len -- )
+   2 c, align dup , here swap dup allot move
+   DOES> char+ aligned dup @ >r cell+ r>
+;
+: env-string  ( str len -- )  3 c, align dup , here over allot swap move DOES> char+ aligned dup @ >r cell+ r> ;
+: env-flag    ( f -- )  4 c, c, DOES> char+ c@ 0<> ;
+: env-secmode ( sm -- )  5 c, c, DOES> char+ c@ ;
+
+\ create default envvars
+: default-int     ( n "name" -- )      create-env env-int ;
+: default-bytes   ( a len "name" -- )  create-env env-bytes ;
+: default-string  ( a len "name" -- )  create-env env-string ;
+: default-flag    ( f "name" -- )      create-env env-flag ;
+: default-secmode ( sm "name" -- )     create-env env-secmode ;
+
+: set-option ( option-name len option len -- )
+   2swap encode-string
+   2swap s" /options" find-node dup IF set-property ELSE drop 2drop 2drop THEN
+;
+
+\ find an envvar's current and default value, and its type
+: findenv ( name len -- adr def-adr type | 0 )
+   2dup envvars voc-find dup 0<> IF ( ABORT" not a configuration variable" )
+      link> >body char+ >r (find-order) link> >body dup char+ swap c@ r> swap
+   ELSE
+      nip nip
+   THEN
+;
+
+
+: test-flag ( param len -- true | false )
+   2dup s" true" string=ci -rot s" false" string=ci or
+;
+
+: test-secmode ( param len -- true | false )
+   2dup s" none" string=ci -rot 2dup s" command" string=ci -rot s" full"
+   string=ci or or
+;
+
+: test-int ( param len -- true | false )
+  $dh-number IF false ELSE drop true THEN
+;
+
+: findtype ( param len name len -- param len name len type )
+   2dup findenv                         \ try to find type of envvar
+   dup IF                               \ found a type?
+      nip nip
+      EXIT
+   THEN
+
+   \ No type found yet, try to auto-detect:
+   drop 2swap
+   2dup test-flag IF
+      4 -rot                         \ boolean type
+   ELSE
+      2dup test-secmode IF
+         5 -rot                      \ secmode type
+      ELSE
+         2dup test-int IF
+            1 -rot                   \ integer type
+         ELSE
+            2dup test-string
+            IF 3 ELSE 2 THEN         \ 3 = string, 2 = default to bytes
+            -rot
+         THEN
+      THEN
+   THEN
+   rot
+   >r 2swap r>
+;
+
+\ set an envvar
+: $setenv ( param len name len -- )
+   4dup set-option
+   findtype
+   -rot $CREATE
+   CASE
+      1 OF $dh-number IF 0 THEN env-int ENDOF \ XXX: wants decimal and 0x...
+      2 OF env-bytes ENDOF
+      3 OF env-string ENDOF
+      4 OF evaluate env-flag ENDOF
+      5 OF evaluate env-secmode ENDOF \ XXX: recognize none, command, full
+   ENDCASE
+;
+
+\ print an envvar
+: (printenv) ( adr type -- )
+   CASE
+   1 OF aligned @ . ENDOF
+   2 OF aligned dup cell+ swap @ swap . . ENDOF
+   3 OF aligned dup @ >r cell+ r> type ENDOF
+   4 OF c@ IF ." true" ELSE ." false" THEN ENDOF
+   5 OF c@ . ENDOF \ XXX: print symbolically
+   ENDCASE
+;
+
+: .printenv-header ( -- )
+   cr
+   s" ---environment variable--------current value-------------default value------"
+   type cr
+;
+
+DEFER old-emit
+0 VALUE emit-counter
+
+: emit-and-count emit-counter 1 + to emit-counter old-emit ;
+
+: .enable-emit-counter
+   0 to emit-counter
+   ['] emit behavior to old-emit
+   ['] emit-and-count to emit
+;
+
+: .disable-emit-counter
+   ['] old-emit behavior to emit
+;
+
+: .spaces ( number-of-spaces -- )
+   dup 0 > IF
+      spaces
+   ELSE
+      drop space
+   THEN
+;
+
+: .print-one-env ( name len -- )
+   3 .spaces
+   2dup dup -rot type 1c swap - .spaces
+   findenv rot over
+   .enable-emit-counter
+   (printenv) .disable-emit-counter
+   1a emit-counter - .spaces
+   (printenv)
+;
+
+: .print-all-env
+   .printenv-header
+   envvars cell+
+   BEGIN
+      @ dup
+   WHILE
+      dup link> >name
+      name>string .print-one-env cr
+   REPEAT
+   drop
+;
+
+: printenv
+   parse-word dup 0= IF
+      2drop .print-all-env
+   ELSE
+      findenv dup 0= ABORT" not a configuration variable"
+      rot over cr ." Current: " (printenv)
+      cr ." Default: " (printenv)
+   THEN
+;
+
+\ set envvar(s) to default value
+: (set-default)  ( def-xt -- )
+   dup >name name>string $CREATE dup >body c@ >r execute r> CASE
+   1 OF env-int ENDOF
+   2 OF env-bytes ENDOF
+   3 OF env-string ENDOF
+   4 OF env-flag ENDOF
+   5 OF env-secmode ENDOF ENDCASE
+;
+
+\ Environment variables might be board specific
+
+#include <envvar_defaults.fs>
+
+VARIABLE nvoff \ offset in envvar partition
+
+: (nvupdate-one) ( adr type -- "value" )
+   CASE
+   1 OF aligned @ (.d) ENDOF
+   2 OF drop 0 0 ENDOF
+   3 OF aligned dup @ >r cell+ r> ENDOF
+   4 OF c@ IF s" true" ELSE s" false" THEN ENDOF
+   5 OF c@ (.) ENDOF \ XXX: print symbolically
+   ENDCASE
+;
+
+: nvupdate-one   ( def-xt -- )
+   >r nvram-partition-type-common get-nvram-partition       ( part.addr part.len FALSE|TRUE R: def-xt )
+   ABORT" No valid NVRAM." r>      ( part.addr part.len def-xt )
+   >name name>string               ( part.addr part.len var.a var.l )
+   2dup findenv nip (nvupdate-one)
+   ( part.addr part.len var.addr var.len val.addr val.len )
+   internal-add-env
+   drop
+;
+
+: (nvupdate) ( -- )
+   nvram-partition-type-common get-nvram-partition ABORT" No valid NVRAM."
+   erase-nvram-partition drop
+   envvars cell+
+   BEGIN @ dup WHILE dup link> nvupdate-one REPEAT
+   drop
+;
+
+: nvupdate ( -- )
+   ." nvupdate is obsolete." cr
+;
+
+: set-default
+   parse-word envvars voc-find
+   dup 0= ABORT" not a configuration variable" link> (set-default)
+;
+
+: (set-defaults)
+   envvars cell+
+   BEGIN @ dup WHILE dup link> (set-default) REPEAT
+   drop
+;
+
+\ Preset nvram variables in RAM, but do not overwrite them in NVRAM
+(set-defaults)
+
+: set-defaults
+   (set-defaults) (nvupdate)
+;
+
+: setenv  parse-word ( skipws ) 0d parse -leading 2swap $setenv (nvupdate) ;
+
+: get-nv  ( -- )
+   nvram-partition-type-common get-nvram-partition ( addr offset not-found | not-found ) \ find partition header
+   IF
+      ." No NVRAM common partition, re-initializing..." cr
+      internal-reset-nvram
+      (nvupdate)
+      nvram-partition-type-common get-nvram-partition IF ." NVRAM seems to be broken." cr EXIT THEN
+   THEN
+   \ partition header found: read data from nvram
+   drop ( addr )           \ throw away offset
+   BEGIN
+      dup rzcount  dup     \ make string from offset and make condition
+   WHILE                   ( offset offset length )
+      2dup [char] = split  \ Split string at equal sign (=)
+                           ( offset offset length name len param len )
+      2swap                ( offset offset length param len name len )
+      $setenv              \ Set envvar
+      nip                  \ throw away old string begin
+      + 1+                 \ calc new offset
+   REPEAT
+   2drop drop              \ cleanup
+;
+
+get-nv
+
+: check-for-nvramrc  ( -- )
+   use-nvramrc?  IF
+      s" Executing following code from nvramrc: "
+      s" nvramrc" evaluate $cat
+      nvramlog-write-string-cr
+      s" (!) Executing code specified in nvramrc" type
+      cr s"  SLOF Setup = " type
+      \ to remove the string from the console if the nvramrc is broken
+      \ we need to know how many chars are printed
+      .enable-emit-counter
+      s" nvramrc" evaluate ['] evaluate  CATCH  IF
+         \ dropping the rest of the nvram string
+         2drop
+         \ delete the chars we do not want to see
+         emit-counter 0  DO  8 emit  LOOP
+         s" (!) Code in nvramrc triggered exception. "
+         2dup nvramlog-write-string
+         type cr 12 spaces s" Aborting nvramrc execution" 2dup
+         nvramlog-write-string-cr type cr
+         s"  SLOF Setup = " type
+      THEN
+      .disable-emit-counter
+   THEN
+;
+
+
+: (nv-findalias) ( alias-ptr alias-len -- pos )
+   \ create a temporary empty string
+   here 0
+   \ append "devalias " to the temporary string
+   s" devalias " string-cat
+   \ append "<name-str>" to the temporary string
+   3 pick 3 pick string-cat
+   \ append a SPACE character to the temporary string
+   s"  " string-cat
+   \ get nvramrc
+   s" nvramrc" evaluate
+   \ get position of the temporary string inside of nvramrc
+   2swap find-substr
+   nip nip
+;
+
+: (nv-build-real-entry) ( name-ptr name-len dev-ptr dev-len -- str-ptr str-len )
+   \ create a temporary empty string
+   2swap here 0
+   \ append "devalias " to the temporary string
+   s" devalias " string-cat
+   \ append "<name-ptr>" to the temporary string
+   2swap string-cat
+   \ append a SPACE character to the temporary string
+   s"  " string-cat
+   \ append "<dev-ptr> to the temporary string
+   2swap string-cat
+   \ append a CR character to the temporary string
+   0d char-cat
+   \ append a LF character to the temporary string
+   0a char-cat
+;
+
+: (nv-build-null-entry) ( name-ptr name-len dev-ptr dev-len -- str-ptr str-len )
+   4drop here 0
+;
+
+: (nv-build-nvramrc) ( name-str name-len dev-str dev-len xt-build-entry -- )
+   \ *** PART 1: check if there is still an alias definition available ***
+   ( alias-ptr alias-len path-ptr path-ptr call-build-entry alias-pos )
+   4 pick 4 pick (nv-findalias)
+   \ if our alias definition is a new one
+   dup s" nvramrc" evaluate nip >= IF
+      \ call-build-entry
+      drop execute
+      \ append content of "nvramrc" to the temporary string
+      s" nvramrc" evaluate string-cat
+      \ Allocate the temporary string
+      dup allot
+      \ write the string into nvramrc
+      s" nvramrc" $setenv
+   ELSE  \ if our alias is still defined in nvramrc
+      \ *** PART 2: calculate the memory size for the new content of nvramrc ***
+      \ add number of bytes needed for nvramrc-prefix to number of bytes needed
+      \ for the new entry
+      5 pick 5 pick 5 pick 5 pick 5 pick execute nip over +
+      ( alias-ptr alias-len path-ptr path-ptr build-entry-xt alias-pos tmp-len )
+      \ add number of bytes needed for nvramrc-postfix
+      s" nvramrc" evaluate 3 pick string-at
+      2dup find-nextline string-at nip +
+      \ *** PART 3: build the new content ***
+      \ allocate enough memory for new content
+      alloc-mem 0
+      ( alias-ptr alias-len path-ptr path-ptr build-entry-xt alias-pos mem len )
+      \ add nvramrc-prefix
+      s" nvramrc" evaluate drop 3 pick string-cat
+      \ add new entry
+      rot >r >r >r execute r> r> 2swap string-cat
+      ( mem, len ) ( R: alias-pos )
+      \ add nvramrc-postfix
+      s" nvramrc" evaluate r> string-at
+      2dup find-nextline string-at string-cat
+      ( mem len )
+      \ write the temporary string into nvramrc and clean up memory
+      2dup s" nvramrc" $setenv free-mem
+   THEN
+;
+
+: $nvalias ( name-str name-len dev-str dev-len -- )
+   4dup ['] (nv-build-real-entry) (nv-build-nvramrc)
+   set-alias
+   s" true" s" use-nvramrc?" $setenv
+   (nvupdate)
+;
+
+: nvalias ( "alias-name< >device-specifier<eol>" -- )
+   parse-word parse-word dup 0<> IF
+      $nvalias
+   ELSE
+      2drop 2drop
+      cr
+      "    Usage: nvalias (""alias-name< >device-specifier<eol>"" -- )" type
+      cr
+   THEN    
+;
+
+: $nvunalias ( name-str name-len -- )
+   s" " ['] (nv-build-null-entry) (nv-build-nvramrc)
+   (nvupdate)
+;
+
+: nvunalias ( "alias-name< >" -- )
+   parse-word $nvunalias
+;
+
+: diagnostic-mode? ( -- diag-switch? ) diag-switch? ;
+