usr/src/boot/sys/boot/forth/menusets.4th

   1 \ Copyright (c) 2012 Devin Teske <dteske@FreeBSD.org>
   2 \ All rights reserved.
   3 \
   4 \ Redistribution and use in source and binary forms, with or without
   5 \ modification, are permitted provided that the following conditions
   6 \ are met:
   7 \ 1. Redistributions of source code must retain the above copyright
   8 \    notice, this list of conditions and the following disclaimer.
   9 \ 2. Redistributions in binary form must reproduce the above copyright
  10 \    notice, this list of conditions and the following disclaimer in the
  11 \    documentation and/or other materials provided with the distribution.
  12 \
  13 \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
  14 \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  15 \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  16 \ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
  17 \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  18 \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  19 \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  20 \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  21 \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  22 \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  23 \ SUCH DAMAGE.
  24 \
  25
  26 marker task-menusets.4th
  27
  28 vocabulary menusets-infrastructure
  29 only forth also menusets-infrastructure definitions
  30
  31 variable menuset_use_name
  32
  33 create menuset_affixbuf 255 allot
  34 create menuset_x        1   allot
  35 create menuset_y        1   allot
  36
  37 : menuset-loadvar ( -- )
  38
  39         \ menuset_use_name is true or false
  40         \ $type should be set to one of:
  41         \       menu toggled ansi
  42         \ $var should be set to one of:
  43         \       caption command keycode text ...
  44         \ $affix is either prefix (menuset_use_name is true)
  45         \               or infix (menuset_use_name is false)
  46
  47         s" set cmdbuf='set ${type}_${var}=\$'" evaluate
  48         s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length
  49         menuset_use_name @ true = if
  50                 s" set cmdbuf=${cmdbuf}${affix}${type}_${var}"
  51                 ( u1 -- u1 c-addr2 u2 )
  52         else
  53                 s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}"
  54                 ( u1 -- u1 c-addr2 u2 )
  55         then
  56         evaluate ( u1 c-addr2 u2 -- u1 )
  57         s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 )
  58         rot 2 pick 2 pick over + -rot + tuck -
  59                 ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 )
  60                 \ Generate a string representing rvalue inheritance var
  61         getenv dup -1 = if
  62                 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 )
  63                 \ NOT set -- clean up the stack
  64                 drop ( c-addr2 u2 -1 -- c-addr2 u2 )
  65                 2drop ( c-addr2 u2 -- )
  66         else
  67                 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 )
  68                 \ SET -- execute cmdbuf (c-addr2/u2) to inherit value
  69                 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 )
  70                 evaluate ( c-addr2 u2 -- )
  71         then
  72
  73         s" cmdbuf" unsetenv
  74 ;
  75
  76 : menuset-unloadvar ( -- )
  77
  78         \ menuset_use_name is true or false
  79         \ $type should be set to one of:
  80         \       menu toggled ansi
  81         \ $var should be set to one of:
  82         \       caption command keycode text ...
  83         \ $affix is either prefix (menuset_use_name is true)
  84         \               or infix (menuset_use_name is false)
  85
  86         menuset_use_name @ true = if
  87                 s" set buf=${affix}${type}_${var}"
  88         else
  89                 s" set buf=${type}set${affix}_${var}"
  90         then
  91         evaluate
  92         s" buf" getenv unsetenv
  93         s" buf" unsetenv
  94 ;
  95
  96 : menuset-loadmenuvar ( -- )
  97         s" set type=menu" evaluate
  98         menuset-loadvar
  99 ;
 100
 101 : menuset-unloadmenuvar ( -- )
 102         s" set type=menu" evaluate
 103         menuset-unloadvar
 104 ;
 105
 106 : menuset-loadxvar ( -- )
 107
 108         \ menuset_use_name is true or false
 109         \ $type should be set to one of:
 110         \       menu toggled ansi
 111         \ $var should be set to one of:
 112         \       caption command keycode text ...
 113         \ $x is "1" through "8"
 114         \ $affix is either prefix (menuset_use_name is true)
 115         \               or infix (menuset_use_name is false)
 116
 117         s" set cmdbuf='set ${type}_${var}[${x}]=\$'" evaluate
 118         s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length
 119         menuset_use_name @ true = if
 120                 s" set cmdbuf=${cmdbuf}${affix}${type}_${var}[${x}]"
 121                 ( u1 -- u1 c-addr2 u2 )
 122         else
 123                 s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}[${x}]"
 124                 ( u1 -- u1 c-addr2 u2 )
 125         then
 126         evaluate ( u1 c-addr2 u2 -- u1 )
 127         s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 )
 128         rot 2 pick 2 pick over + -rot + tuck -
 129                 ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 )
 130                 \ Generate a string representing rvalue inheritance var
 131         getenv dup -1 = if
 132                 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 )
 133                 \ NOT set -- clean up the stack
 134                 drop ( c-addr2 u2 -1 -- c-addr2 u2 )
 135                 2drop ( c-addr2 u2 -- )
 136         else
 137                 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 )
 138                 \ SET -- execute cmdbuf (c-addr2/u2) to inherit value
 139                 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 )
 140                 evaluate ( c-addr2 u2 -- )
 141         then
 142
 143         s" cmdbuf" unsetenv
 144 ;
 145
 146 : menuset-unloadxvar ( -- )
 147
 148         \ menuset_use_name is true or false
 149         \ $type should be set to one of:
 150         \       menu toggled ansi
 151         \ $var should be set to one of:
 152         \       caption command keycode text ...
 153         \ $x is "1" through "8"
 154         \ $affix is either prefix (menuset_use_name is true)
 155         \               or infix (menuset_use_name is false)
 156
 157         menuset_use_name @ true = if
 158                 s" set buf=${affix}${type}_${var}[${x}]"
 159         else
 160                 s" set buf=${type}set${affix}_${var}[${x}]"
 161         then
 162         evaluate
 163         s" buf" getenv unsetenv
 164         s" buf" unsetenv
 165 ;
 166
 167 : menuset-loadansixvar ( -- )
 168         s" set type=ansi" evaluate
 169         menuset-loadxvar
 170 ;
 171
 172 : menuset-unloadansixvar ( -- )
 173         s" set type=ansi" evaluate
 174         menuset-unloadxvar
 175 ;
 176
 177 : menuset-loadmenuxvar ( -- )
 178         s" set type=menu" evaluate
 179         menuset-loadxvar
 180 ;
 181
 182 : menuset-unloadmenuxvar ( -- )
 183         s" set type=menu" evaluate
 184         menuset-unloadxvar
 185 ;
 186
 187 : menuset-unloadtypelessxvar ( -- )
 188         s" set type=" evaluate
 189         menuset-unloadxvar
 190 ;
 191
 192 : menuset-loadtoggledxvar ( -- )
 193         s" set type=toggled" evaluate
 194         menuset-loadxvar
 195 ;
 196
 197 : menuset-unloadtoggledxvar ( -- )
 198         s" set type=toggled" evaluate
 199         menuset-unloadxvar
 200 ;
 201
 202 : menuset-loadxyvar ( -- )
 203
 204         \ menuset_use_name is true or false
 205         \ $type should be set to one of:
 206         \       menu toggled ansi
 207         \ $var should be set to one of:
 208         \       caption command keycode text ...
 209         \ $x is "1" through "8"
 210         \ $y is "0" through "9"
 211         \ $affix is either prefix (menuset_use_name is true)
 212         \               or infix (menuset_use_name is false)
 213
 214         s" set cmdbuf='set ${type}_${var}[${x}][${y}]=\$'" evaluate
 215         s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length
 216         menuset_use_name @ true = if
 217                 s" set cmdbuf=${cmdbuf}${affix}${type}_${var}[${x}][${y}]"
 218                 ( u1 -- u1 c-addr2 u2 )
 219         else
 220                 s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}[${x}][${y}]"
 221                 ( u1 -- u1 c-addr2 u2 )
 222         then
 223         evaluate ( u1 c-addr2 u2 -- u1 )
 224         s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 )
 225         rot 2 pick 2 pick over + -rot + tuck -
 226                 ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 )
 227                 \ Generate a string representing rvalue inheritance var
 228         getenv dup -1 = if
 229                 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 )
 230                 \ NOT set -- clean up the stack
 231                 drop ( c-addr2 u2 -1 -- c-addr2 u2 )
 232                 2drop ( c-addr2 u2 -- )
 233         else
 234                 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 )
 235                 \ SET -- execute cmdbuf (c-addr2/u2) to inherit value
 236                 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 )
 237                 evaluate ( c-addr2 u2 -- )
 238         then
 239
 240         s" cmdbuf" unsetenv
 241 ;
 242
 243 : menuset-unloadxyvar ( -- )
 244
 245         \ menuset_use_name is true or false
 246         \ $type should be set to one of:
 247         \       menu toggled ansi
 248         \ $var should be set to one of:
 249         \       caption command keycode text ...
 250         \ $x is "1" through "8"
 251         \ $y is "0" through "9"
 252         \ $affix is either prefix (menuset_use_name is true)
 253         \               or infix (menuset_use_name is false)
 254
 255         menuset_use_name @ true = if
 256                 s" set buf=${affix}${type}_${var}[${x}][${y}]"
 257         else
 258                 s" set buf=${type}set${affix}_${var}[${x}][${y}]"
 259         then
 260         evaluate
 261         s" buf" getenv unsetenv
 262         s" buf" unsetenv
 263 ;
 264
 265 : menuset-loadansixyvar ( -- )
 266         s" set type=ansi" evaluate
 267         menuset-loadxyvar
 268 ;
 269
 270 : menuset-unloadansixyvar ( -- )
 271         s" set type=ansi" evaluate
 272         menuset-unloadxyvar
 273 ;
 274
 275 : menuset-loadmenuxyvar ( -- )
 276         s" set type=menu" evaluate
 277         menuset-loadxyvar
 278 ;
 279
 280 : menuset-unloadmenuxyvar ( -- )
 281         s" set type=menu" evaluate
 282         menuset-unloadxyvar
 283 ;
 284
 285 : menuset-setnum-namevar ( N -- C-Addr/U )
 286
 287         s" menuset_nameNNNNN" ( n -- n c-addr1 u1 )     \ variable basename
 288         drop 12 ( n c-addr1 u1 -- n c-addr1 12 )        \ remove "NNNNN"
 289         rot     ( n c-addr1 12 -- c-addr1 12 n )        \ move number on top
 290
 291         \ convert to string
 292         s>d <# #s #> ( c-addr1 12 n -- c-addr1 12 c-addr2 u2 )
 293
 294         \ Combine strings
 295         begin ( using u2 in c-addr2/u2 pair as countdown to zero )
 296                 over    ( c-addr1 u1 c-addr2 u2 -- continued below )
 297                         ( c-addr1 u1 c-addr2 u2 c-addr2 ) \ copy src-addr
 298                 c@      ( c-addr1 u1 c-addr2 u2 c-addr2 -- continued below )
 299                         ( c-addr1 u1 c-addr2 u2 c ) \ get next src-addr byte
 300                 4 pick 4 pick
 301                         ( c-addr1 u1 c-addr2 u2 c -- continued below )
 302                         ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 )
 303                         \ get destination c-addr1/u1 pair
 304                 +       ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 -- cont. below )
 305                         ( c-addr1 u1 c-addr2 u2 c c-addr3 )
 306                         \ combine dest-c-addr to get dest-addr for byte
 307                 c!      ( c-addr1 u1 c-addr2 u2 c c-addr3 -- continued below )
 308                         ( c-addr1 u1 c-addr2 u2 )
 309                         \ store the current src-addr byte into dest-addr
 310
 311                 2swap 1+ 2swap  \ increment u1 in destination c-addr1/u1 pair
 312                 swap 1+ swap    \ increment c-addr2 in source c-addr2/u2 pair
 313                 1-              \ decrement u2 in the source c-addr2/u2 pair
 314
 315                 dup 0= \ time to break?
 316         until
 317
 318         2drop   ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 )
 319                 \ drop temporary number-format conversion c-addr2/u2
 320 ;
 321
 322 : menuset-checksetnum ( N -- )
 323
 324         \
 325         \ adjust input to be both positive and no-higher than 65535
 326         \
 327         abs dup 65535 > if drop 65535 then ( n -- n )
 328
 329         \
 330         \ The next few blocks will determine if we should use the default
 331         \ methodology (referencing the original numeric stack-input), or if-
 332         \ instead $menuset_name{N} has been defined wherein we would then
 333         \ use the value thereof as the prefix to every menu variable.
 334         \
 335
 336         false menuset_use_name ! \ assume name is not set
 337
 338         menuset-setnum-namevar
 339         \
 340         \ We now have a string that is the assembled variable name to check
 341         \ for... $menuset_name{N}. Let's check for it.
 342         \
 343         2dup ( c-addr1 u1 -- c-addr1 u1 c-addr1 u1 ) \ save a copy
 344         getenv dup -1 <> if ( c-addr1 u1 c-addr1 u1 -- c-addr1 u1 c-addr2 u2 )
 345                 \ The variable is set. Let's clean up the stack leaving only
 346                 \ its value for later use.
 347
 348                 true menuset_use_name !
 349                 2swap 2drop     ( c-addr1 u1 c-addr2 u2 -- c-addr2 u2 )
 350                                 \ drop assembled variable name, leave the value
 351         else ( c-addr1 u1 c-addr1 u1 -- c-addr1 u1 -1 ) \ no such variable
 352                 \ The variable is not set. Let's clean up the stack leaving the
 353                 \ string [portion] representing the original numeric input.
 354
 355                 drop ( c-addr1 u1 -1 -- c-addr1 u1 ) \ drop -1 result
 356                 12 - swap 12 + swap ( c-addr1 u1 -- c-addr2 u2 )
 357                         \ truncate to original numeric stack-input
 358         then
 359
 360         \
 361         \ Now, depending on whether $menuset_name{N} has been set, we have
 362         \ either the value thereof to be used as a prefix to all menu_*
 363         \ variables or we have a string representing the numeric stack-input
 364         \ to be used as a "set{N}" infix to the same menu_* variables.
 365         \
 366         \ For example, if the stack-input is 1 and menuset_name1 is NOT set
 367         \ the following variables will be referenced:
 368         \       ansiset1_caption[x]             -> ansi_caption[x]
 369         \       ansiset1_caption[x][y]          -> ansi_caption[x][y]
 370         \       menuset1_acpi                   -> menu_acpi
 371         \       menuset1_osconsole              -> menu_osconsole
 372         \       menuset1_caption[x]             -> menu_caption[x]
 373         \       menuset1_caption[x][y]          -> menu_caption[x][y]
 374         \       menuset1_command[x]             -> menu_command[x]
 375         \       menuset1_init                   -> ``evaluated''
 376         \       menuset1_init[x]                -> menu_init[x]
 377         \       menuset1_kernel                 -> menu_kernel
 378         \       menuset1_keycode[x]             -> menu_keycode[x]
 379         \       menuset1_options                -> menu_options
 380         \       menuset1_optionstext            -> menu_optionstext
 381         \       menuset1_reboot                 -> menu_reboot
 382         \       toggledset1_ansi[x]             -> toggled_ansi[x]
 383         \       toggledset1_text[x]             -> toggled_text[x]
 384         \ otherwise, the following variables are referenced (where {name}
 385         \ represents the value of $menuset_name1 (given 1 as stack-input):
 386         \       {name}ansi_caption[x]           -> ansi_caption[x]
 387         \       {name}ansi_caption[x][y]        -> ansi_caption[x][y]
 388         \       {name}menu_acpi                 -> menu_acpi
 389         \       {name}menu_caption[x]           -> menu_caption[x]
 390         \       {name}menu_caption[x][y]        -> menu_caption[x][y]
 391         \       {name}menu_command[x]           -> menu_command[x]
 392         \       {name}menu_init                 -> ``evaluated''
 393         \       {name}menu_init[x]              -> menu_init[x]
 394         \       {name}menu_kernel               -> menu_kernel
 395         \       {name}menu_keycode[x]           -> menu_keycode[x]
 396         \       {name}menu_options              -> menu_options
 397         \       {name}menu_optionstext          -> menu_optionstext
 398         \       {name}menu_reboot               -> menu_reboot
 399         \       {name}toggled_ansi[x]           -> toggled_ansi[x]
 400         \       {name}toggled_text[x]           -> toggled_text[x]
 401         \
 402         \ Note that menuset{N}_init and {name}menu_init are the initializers
 403         \ for the entire menu (for wholly dynamic menus) opposed to the per-
 404         \ menuitem initializers (with [x] afterward). The whole-menu init
 405         \ routine is evaluated and not passed down to $menu_init (which
 406         \ would result in double evaluation). By doing this, the initializer
 407         \ can initialize the menuset before we transfer it to active-duty.
 408         \
 409
 410         \
 411         \ Copy our affixation (prefix or infix depending on menuset_use_name)
 412         \ to our buffer so that we can safely use the s-quote (s") buf again.
 413         \
 414         menuset_affixbuf 0 2swap ( c-addr2 u2 -- c-addr1 0 c-addr2 u2 )
 415         begin ( using u2 in c-addr2/u2 pair as countdown to zero )
 416                 over ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 c-addr2 u2 c-addr2 )
 417                 c@   ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 c-addr2 u2 c )
 418                 4 pick 4 pick
 419                      ( c-addr1 u1 c-addr2 u2 c -- continued below )
 420                      ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 )
 421                 +    ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 -- continued below )
 422                      ( c-addr1 u1 c-addr2 u2 c c-addr3 )
 423                 c!   ( c-addr1 u1 c-addr2 u2 c c-addr3 -- continued below )
 424                      ( c-addr1 u1 c-addr2 u2 )
 425                 2swap 1+ 2swap  \ increment affixbuf byte position/count
 426                 swap 1+ swap    \ increment strbuf pointer (source c-addr2)
 427                 1-              \ decrement strbuf byte count (source u2)
 428                 dup 0=          \ time to break?
 429         until
 430         2drop ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 ) \ drop strbuf c-addr2/u2
 431
 432         \
 433         \ Create a variable for referencing our affix data (prefix or infix
 434         \ depending on menuset_use_name as described above). This variable will
 435         \ be temporary and only used to simplify cmdbuf assembly.
 436         \
 437         s" affix" setenv ( c-addr1 u1 -- )
 438 ;
 439
 440 : menuset-cleanup ( -- )
 441         s" type"  unsetenv
 442         s" var"   unsetenv
 443         s" x"     unsetenv
 444         s" y"     unsetenv
 445         s" affix" unsetenv
 446 ;
 447
 448 only forth definitions also menusets-infrastructure
 449
 450 : menuset-loadsetnum ( N -- )
 451
 452         menuset-checksetnum ( n -- )
 453
 454         \
 455         \ From here out, we use temporary environment variables to make
 456         \ dealing with variable-length strings easier.
 457         \
 458         \ menuset_use_name is true or false
 459         \ $affix should be used appropriately w/respect to menuset_use_name
 460         \
 461
 462         \ ... menu_init ...
 463         s" set var=init" evaluate
 464         menuset-loadmenuvar
 465
 466         \ If menu_init was set by the above, evaluate it here-and-now
 467         \ so that the remaining variables are influenced by its actions
 468         s" menu_init" 2dup getenv dup -1 <> if
 469                 2swap unsetenv \ don't want later menu-create to re-call this
 470                 evaluate
 471         else
 472                 drop 2drop ( n c-addr u -1 -- n )
 473         then
 474
 475         [char] 1 ( -- x ) \ Loop range ASCII '1' (49) to '8' (56)
 476         begin
 477                 dup menuset_x tuck c! 1 s" x" setenv \ set loop iterator and $x
 478
 479                 s" set var=caption" evaluate
 480
 481                 \ ... menu_caption[x] ...
 482                 menuset-loadmenuxvar
 483
 484                 \ ... ansi_caption[x] ...
 485                 menuset-loadansixvar
 486
 487                 [char] 0 ( x -- x y ) \ Inner Loop ASCII '1' (48) to '9' (57)
 488                 begin
 489                         dup menuset_y tuck c! 1 s" y" setenv
 490                                 \ set inner loop iterator and $y
 491
 492                         \ ... menu_caption[x][y] ...
 493                         menuset-loadmenuxyvar
 494
 495                         \ ... ansi_caption[x][y] ...
 496                         menuset-loadansixyvar
 497
 498                         1+ dup 57 > ( x y -- y' 0|-1 ) \ increment and test
 499                 until
 500                 drop ( x y -- x )
 501
 502                 \ ... menu_command[x] ...
 503                 s" set var=command" evaluate
 504                 menuset-loadmenuxvar
 505
 506                 \ ... menu_init[x] ...
 507                 s" set var=init" evaluate
 508                 menuset-loadmenuxvar
 509
 510                 \ ... menu_keycode[x] ...
 511                 s" set var=keycode" evaluate
 512                 menuset-loadmenuxvar
 513
 514                 \ ... toggled_text[x] ...
 515                 s" set var=text" evaluate
 516                 menuset-loadtoggledxvar
 517
 518                 \ ... toggled_ansi[x] ...
 519                 s" set var=ansi" evaluate
 520                 menuset-loadtoggledxvar
 521
 522                 1+ dup 56 > ( x -- x' 0|-1 ) \ increment iterator
 523                                              \ continue if less than 57
 524         until
 525         drop ( x -- ) \ loop iterator
 526
 527         \ ... menu_reboot ...
 528         s" set var=reboot" evaluate
 529         menuset-loadmenuvar
 530
 531         \ ... menu_acpi ...
 532         s" set var=acpi" evaluate
 533         menuset-loadmenuvar
 534
 535         \ ... menu_osconsole ...
 536         s" set var=osconsole" evaluate
 537         menuset-loadmenuvar
 538
 539         \ ... menu_kernel ...
 540         s" set var=kernel" evaluate
 541         menuset-loadmenuvar
 542
 543         \ ... menu_options ...
 544         s" set var=options" evaluate
 545         menuset-loadmenuvar
 546
 547         \ ... menu_optionstext ...
 548         s" set var=optionstext" evaluate
 549         menuset-loadmenuvar
 550
 551         menuset-cleanup
 552 ;
 553
 554 : menusets-unset ( -- )
 555
 556         \ clean up BE menu internal variables
 557         s" beansi_bootfs"    unsetenv
 558         s" beansi_current"   unsetenv
 559         s" beansi_page"      unsetenv
 560         s" beansi_pageof"    unsetenv
 561         s" bemenu_bootfs"    unsetenv
 562         s" bemenu_current"   unsetenv
 563         s" bemenu_page"      unsetenv
 564         s" bemenu_pageof"    unsetenv
 565         s" zfs_be_active"    unsetenv
 566         s" zfs_be_currpage"  unsetenv
 567         s" zfs_be_pages"     unsetenv
 568
 569         s" menuset_initial"  unsetenv
 570
 571         1 begin
 572                 dup menuset-checksetnum ( n n -- n )
 573
 574                 dup menuset-setnum-namevar ( n n -- n )
 575                 unsetenv
 576
 577                 \ If the current menuset does not populate the first menuitem,
 578                 \ we stop completely.
 579
 580                 menuset_use_name @ true = if
 581                         s" set buf=${affix}menu_command[1]"
 582                 else
 583                         s" set buf=menuset${affix}_command[1]"
 584                 then
 585                 evaluate s" buf" getenv getenv -1 = if
 586                         drop ( n -- )
 587                         s" buf" unsetenv
 588                         menuset-cleanup
 589                         exit
 590                 else
 591                         drop ( n c-addr2 -- n ) \ unused
 592                 then
 593
 594                 [char] 1 ( n -- n x ) \ Loop range ASCII '1' (49) to '8' (56)
 595                 begin
 596                         dup menuset_x tuck c! 1 s" x" setenv \ set $x to x
 597
 598                         s" set var=caption" evaluate
 599                         menuset-unloadmenuxvar
 600                         menuset-unloadmenuxvar
 601                         menuset-unloadansixvar
 602                         [char] 0 ( n x -- n x y ) \ Inner loop '0' to '9'
 603                         begin
 604                                 dup menuset_y tuck c! 1 s" y" setenv
 605                                         \ sets $y to y
 606                                 menuset-unloadmenuxyvar
 607                                 menuset-unloadansixyvar
 608                                 1+ dup 57 > ( n x y -- n x y' 0|-1 )
 609                         until
 610                         drop ( n x y -- n x )
 611                         s" set var=command" evaluate menuset-unloadmenuxvar
 612                         s" set var=init"    evaluate menuset-unloadmenuxvar
 613                         s" set var=keycode" evaluate menuset-unloadmenuxvar
 614                         s" set var=root"    evaluate menuset-unloadtypelessxvar
 615                         s" set var=text"    evaluate menuset-unloadtoggledxvar
 616                         s" set var=ansi"    evaluate menuset-unloadtoggledxvar
 617
 618                         1+ dup 56 > ( x -- x' 0|-1 ) \ increment and test
 619                 until
 620                 drop ( n x -- n ) \ loop iterator
 621
 622                 s" set var=acpi"        evaluate menuset-unloadmenuvar
 623                 s" set var=osconsole"   evaluate menuset-unloadmenuvar
 624                 s" set var=init"        evaluate menuset-unloadmenuvar
 625                 s" set var=kernel"      evaluate menuset-unloadmenuvar
 626                 s" set var=options"     evaluate menuset-unloadmenuvar
 627                 s" set var=optionstext" evaluate menuset-unloadmenuvar
 628                 s" set var=reboot"      evaluate menuset-unloadmenuvar
 629
 630                 1+ dup 65535 > ( n -- n' 0|-1 ) \ increment and test
 631         until
 632         drop ( n' -- ) \ loop iterator
 633
 634         s" buf" unsetenv
 635         menuset-cleanup
 636 ;
 637
 638 only forth definitions
 639
 640 : menuset-loadinitial ( -- )
 641         s" menuset_initial" getenv dup -1 <> if
 642                 ?number 0<> if
 643                         menuset-loadsetnum
 644                 then
 645         else
 646                 drop \ cruft
 647         then
 648 ;