forth/admin/nvram.fs

   1 \ tag: nvram config handling
   2 \
   3 \ this code implements IEEE 1275-1994
   4 \
   5 \ Copyright (C) 2003, 2004 Samuel Rydh
   6 \
   7 \ See the file "COPYING" for further information about
   8 \ the copyright and warranty status of this work.
   9 \
  10
  11 struct ( config )
  12   2 cells field >cf.name
  13   2 cells field >cf.default            \ 0 -1 if no default
  14   /n field >cf.check-xt
  15   /n field >cf.exec-xt
  16   /n field >cf.next
  17 constant config-info.size
  18
  19 0 value config-root
  20
  21 \ --------------------------------------------------------
  22 \ config handling
  23 \ --------------------------------------------------------
  24
  25 : find-config ( name-str len -- 0|configptr )
  26   config-root
  27   begin ?dup while
  28     -rot
  29     2dup 4 pick >cf.name 2@
  30     strcmp 0= if
  31       2drop exit
  32     then
  33     rot  >cf.next @
  34   repeat
  35   2drop 0
  36 ;
  37
  38 : is-config-word ( configp -- )
  39   dup >cf.name 2@ $create ,
  40   does> @
  41     dup >cf.name 2@
  42     s" /options" find-dev if
  43       get-package-property if 0 -1 then
  44       ( configp prop-str prop-len )
  45       \ drop trailing zero
  46       ?dup if 1- then
  47     else
  48       2drop 0 -1
  49     then
  50     \ use default value if property is missing
  51     dup 0< if 2drop dup >cf.default 2@ then
  52     \ no default value, use empty string
  53     dup 0< if 2drop 0 0 then
  54
  55     rot >cf.exec-xt @ execute
  56 ;
  57
  58 : new-config ( name-str name-len -- configp )
  59   2dup find-config ?dup if
  60     nip nip
  61     0 0 2 pick >cf.default 2!
  62   else
  63     dict-strdup
  64     here config-info.size allot
  65     dup config-info.size 0 fill
  66     config-root over >cf.next !
  67     dup to config-root
  68     dup >r >cf.name 2! r>
  69     dup is-config-word
  70   then
  71   ( configp )
  72 ;
  73
  74 : config-default ( str len configp --  )
  75   -rot
  76   dup 0> if dict-strdup then
  77   rot >cf.default 2!
  78 ;
  79
  80 : no-conf-def ( configp --  )
  81   0 -1
  82 ;
  83
  84 \ --------------------------------------------------------
  85 \ config types
  86 \ --------------------------------------------------------
  87
  88 : exec-str-conf ( str len -- str len )
  89   \ trivial
  90 ;
  91 : check-str-conf ( str len -- str len valid? )
  92   \ nothing
  93   true
  94 ;
  95
  96 : str-config ( def-str len name len -- configp )
  97   new-config >r
  98   ['] exec-str-conf r@ >cf.exec-xt !
  99   ['] check-str-conf r@ >cf.check-xt !
 100   r> config-default
 101 ;
 102
 103 \ ------------------------------------------------------------
 104
 105 : exec-int-conf ( str len -- value )
 106   \ fixme
 107   parse-hex
 108 ;
 109 : check-int-conf ( str len -- str len valid? )
 110   true
 111 ;
 112
 113 : int-config ( def-str len name len -- configp )
 114   new-config >r
 115   ['] exec-int-conf r@ >cf.exec-xt !
 116   ['] check-int-conf r@ >cf.check-xt !
 117   r> config-default
 118 ;
 119
 120 \ ------------------------------------------------------------
 121
 122 : exec-secmode-conf ( str len -- n )
 123   2dup s" command" strcmp 0= if 2drop 1 exit then
 124   2dup s" full" strcmp 0= if 2drop 2 exit then
 125   2drop 0
 126 ;
 127 : check-secmode-conf ( str len -- str len valid? )
 128   2dup s" none" strcmp 0= if true exit then
 129   2dup s" command" strcmp 0= if true exit then
 130   2dup s" full" strcmp 0= if true exit then
 131   false
 132 ;
 133
 134 : secmode-config ( def-str len name len -- configp )
 135   new-config >r
 136   ['] exec-secmode-conf r@ >cf.exec-xt !
 137   ['] check-secmode-conf r@ >cf.check-xt !
 138   r> config-default
 139 ;
 140
 141 \ ------------------------------------------------------------
 142
 143 : exec-bool-conf ( str len -- value )
 144   2dup s" true" strcmp 0= if 2drop true exit then
 145   2dup s" false" strcmp 0= if 2drop false exit then
 146   2dup s" TRUE" strcmp 0= if 2drop false exit then
 147   2dup s" FALSE" strcmp 0= if 2drop false exit then
 148   parse-hex 0<>
 149 ;
 150
 151 : check-bool-conf ( name len -- str len valid? )
 152   2dup s" true" strcmp 0= if true exit then
 153   2dup s" false" strcmp 0= if true exit then
 154   2dup s" TRUE" strcmp 0= if 2drop s" true" true exit then
 155   2dup s" FALSE" strcmp 0= if 2drop s" false" true exit then
 156   false
 157 ;
 158
 159 : bool-config ( configp -- configp )
 160   new-config >r
 161   ['] exec-bool-conf r@ >cf.exec-xt !
 162   ['] check-bool-conf r@ >cf.check-xt !
 163   r> config-default
 164 ;
 165
 166
 167 \ --------------------------------------------------------
 168 \ 7.4.4    Nonvolatile memory
 169 \ --------------------------------------------------------
 170
 171 : $setenv    ( data-addr data-len name-str name-len -- )
 172   2dup find-config ?dup if
 173     >r 2swap r>
 174     ( name len data len configptr )
 175     >cf.check-xt @ execute
 176     0= abort" Invalid value."
 177     2swap
 178   else
 179     \ create string config type
 180     2dup no-conf-def 2swap str-config
 181   then
 182
 183   2swap encode-string 2swap
 184   s" /options" find-package drop
 185   encode-property
 186 ;
 187
 188 : setenv    ( "nv-param< >new-value<eol>" -- )
 189   parse-word
 190    \ XXX drop blanks
 191   dup if linefeed parse else 0 0 then
 192
 193   dup 0= abort" Invalid value."
 194   2swap $setenv
 195 ;
 196
 197 : printenv    ( "{param-name}<eol>" -- )
 198   \ XXX temporary implementation
 199   linefeed parse 2drop
 200
 201   active-package
 202   s" /options" find-device
 203   .properties
 204   active-package!
 205 ;
 206
 207 : (set-default) ( configptr -- )
 208     dup >cf.default 2@ dup 0>= if
 209       rot >cf.name 2@ $setenv
 210     else
 211       \ no default value
 212       3drop
 213     then
 214 ;
 215
 216 : set-default    ( "param-name<eol>" -- )
 217   linefeed parse
 218   find-config ?dup if
 219     (set-default)
 220   else
 221     ." No such parameter." -2 throw
 222   then
 223 ;
 224
 225 : set-defaults    ( -- )
 226   config-root
 227   begin ?dup while
 228     dup (set-default)
 229     >cf.next @
 230   repeat
 231 ;
 232
 233 ( maxlen "new-name< >" -- ) ( E: -- addr len )
 234 : nodefault-bytes
 235   ;
 236
 237
 238 \ --------------------------------------------------------
 239 \ initialize config from nvram
 240 \ --------------------------------------------------------
 241
 242 \ CHRP format (array of null-terminated strings, "variable=value")
 243 : nvram-load-configs ( data len -- )
 244   \ XXX: no len checking performed...
 245   drop
 246   begin dup c@ while
 247     ( data )
 248     dup cstrlen 2dup + 1+ -rot
 249     ( next str len )
 250     ascii = left-split ( next val len name str )
 251     ['] $setenv catch if
 252       2drop 2drop
 253     then
 254   repeat drop
 255 ;
 256
 257 : (nvram-store-one) ( buf len str len -- buf len success? )
 258   swap >r
 259   2dup < if r> 2drop 2drop false exit then
 260   ( buf len strlen R: str )
 261   swap over - r> swap >r -rot
 262   ( str buf strlen R: res_len )
 263   2dup + >r move r> r> true
 264 ;
 265
 266 : (make-configstr) ( configptr ph -- str len )
 267   >r
 268   >cf.name 2@
 269   2dup r> get-package-property if
 270     2drop 0 0 exit
 271   else
 272     dup if 1- then
 273   then
 274   ( name len value-str len )
 275   2swap s" =" 2swap
 276   pocket tmpstrcat tmpstrcat drop
 277   2dup + 0 swap c!
 278   1+
 279 ;
 280
 281 : nvram-store-configs ( data len -- )
 282   2 - \ make room for two trailing zeros
 283
 284   s" /options" find-dev 0= if 2drop exit then
 285   >r
 286   config-root
 287   ( data len configptr R: phandle )
 288   begin ?dup while
 289     r@ over >r (make-configstr)
 290     ( buf len val len R: configptr phandle )
 291     (nvram-store-one) drop
 292     r> >cf.next @
 293   repeat
 294   \ null terminate
 295   2 + 0 fill
 296   r> drop
 297 ;
 298
 299
 300 \ --------------------------------------------------------
 301 \ NVRAM variables
 302 \ --------------------------------------------------------
 303 \ fcode-debug? input-device output-device
 304 s" true"     s" auto-boot?"           bool-config   \ 7.4.3.5
 305 s" boot"     s" boot-command"         str-config    \ 7.4.3.5
 306 s" "         s" boot-file"            str-config    \ 7.4.3.5
 307 s" false"    s" diag-switch?"         bool-config   \ 7.4.3.5
 308 no-conf-def  s" diag-device"          str-config    \ 7.4.3.5
 309 no-conf-def  s" diag-file"            str-config    \ 7.4.3.5
 310 s" false"    s" fcode-debug?"         bool-config   \ 7.7
 311 s" "         s" nvramrc"              str-config    \ 7.4.4.2
 312 s" false"    s" oem-banner?"          bool-config
 313 s" "         s" oem-banner"           str-config
 314 s" false"    s" oem-logo?"            bool-config
 315 no-conf-def  s" oem-logo"             str-config
 316 s" false"    s" use-nvramrc?"         bool-config   \ 7.4.4.2
 317 s" keyboard" s" input-device"         str-config    \ 7.4.5
 318 s" screen"   s" output-device"        str-config    \ 7.4.5
 319 s" 80"       s" screen-#columns"      int-config    \ 7.4.5
 320 s" 24"       s" screen-#rows"         int-config    \ 7.4.5
 321 s" 0"        s" selftest-#megs"       int-config
 322 no-conf-def  s" security-mode"        secmode-config
 323
 324 \ --- devices ---
 325 s" -1"       s" pci-probe-mask"       int-config
 326 s" false"    s" default-mac-address"  bool-config
 327 s" false"    s" skip-netboot?"        bool-config
 328 s" true"     s" scroll-lock"          bool-config
 329
 330 [IFDEF] CONFIG_PPC
 331 \ ---- PPC ----
 332 s" disk"     s" boot-device"          str-config    \ 7.4.3.5
 333 s" false"    s" little-endian?"       bool-config
 334 s" false"    s" real-mode?"           bool-config
 335 s" -1"       s" real-base"            int-config
 336 s" -1"       s" real-size"            int-config
 337 s" 4000000"  s" load-base"          int-config
 338 s" -1"       s" virt-base"            int-config
 339 s" -1"       s" virt-size"            int-config
 340 [THEN]
 341
 342 [IFDEF] CONFIG_X86
 343 \ ---- X86 ----
 344 s" disk"     s" boot-device"          str-config    \ 7.4.3.5
 345 s" true"     s" little-endian?"       bool-config
 346 [THEN]
 347
 348 [IFDEF] CONFIG_SPARC32
 349 \ ---- SPARC32 ----
 350 s" true"     s" tpe-link-test?"        bool-config
 351 s" 9600,8,n,1,-" s" ttya-mode"         str-config
 352 s" true"     s" ttya-ignore-cd"        bool-config
 353 s" false"    s" ttya-rts-dtr-off"      bool-config
 354 s" 9600,8,n,1,-" s" ttyb-mode"         str-config
 355 s" true"     s" ttyb-ignore-cd"        bool-config
 356 s" false"    s" ttyb-rts-dtr-off"      bool-config
 357 [THEN]
 358
 359 [IFDEF] CONFIG_SPARC64
 360 \ ---- SPARC64 ----
 361 s" 4000000"  s" load-base"          int-config
 362 s" false"    s" little-endian?"       bool-config
 363 [THEN]
 364
 365 \ --- ??? ---
 366 s" "         s" boot-screen"          str-config
 367 s" "         s" boot-script"          str-config
 368 s" false"    s" use-generic?"         bool-config
 369 s" "         s" boot-args"            str-config    \ ???
 370
 371 \ defers
 372 ['] fcode-debug? to _fcode-debug?
 373 ['] diag-switch? to _diag-switch?
 374
 375 \ Hack for load-base: it seems that some Sun bootloaders try
 376 \ and execute "<value> to load-base" which will only work if
 377 \ load-base is value. Hence we redefine load-base here as a
 378 \ value using its normal default.
 379 [IFDEF] CONFIG_SPARC64
 380 load-base value load-base
 381 [THEN]
 382
 383 : release-load-area
 384     drop
 385 ;