diff options
Diffstat (limited to 'qemu/roms/SLOF/slof/fs/envvar.fs')
| -rw-r--r-- | qemu/roms/SLOF/slof/fs/envvar.fs | 412 |
1 files changed, 412 insertions, 0 deletions
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? ; + |