# # This file and its contents are supplied under the terms of the # Common Development and Distribution License ("CDDL"), version 1.0. # You may only use this file in accordance with the terms of version # 1.0 of the CDDL. # # A full copy of the text of the CDDL should have accompanied this # source. A copy of the CDDL is also available via the Internet at # http://www.illumos.org/license/CDDL. # # # Copyright 2022 Toomas Soome # include $(SRC)/Makefile.master ROOT_BOOT= $(ROOT)/boot ROOT_BOOT_DEFAULTS= $(ROOT)/boot/defaults ROOT_BOOT_FORTH= $(ROOT)/boot/forth ROOT_BOOT_CONF= $(ROOT)/boot/conf.d ROOTBOOTFILES=$(FILES:%=$(ROOT_BOOT)/%) ROOTBOOTFORTH=$(FORTH:%=$(ROOT_BOOT_FORTH)/%) ROOTBOOTDEFAULTS=$(DEFFILES:%=$(ROOT_BOOT_DEFAULTS)/%) FILEMODE=0444 FORTH = beastie.4th FORTH += beadm.4th FORTH += brand.4th FORTH += brand-hammerhead.4th FORTH += check-password.4th FORTH += color.4th FORTH += delay.4th FORTH += efi.4th FORTH += frames.4th FORTH += loader.4th DEFFILES = loader.conf FORTH += menu.4th FORTH += menu.rc FORTH += menu-commands.4th FORTH += menusets.4th FORTH += pcibios.4th FORTH += screen.4th FORTH += shortcuts.4th FORTH += support.4th FORTH += version.4th FILES += hammerhead-brand.png FILES += loader.rc all clean clobber: install: $(ROOT_BOOT_DEFAULTS) $(ROOT_BOOT_FORTH) $(ROOTBOOTFILES) \ $(ROOTBOOTDEFAULTS) $(ROOT_BOOT_CONF) $(ROOTBOOTFORTH) $(ROOT_BOOT)/%: % $(ROOT_BOOT) $(INS.file) $(ROOT_BOOT_DEFAULTS)/%: % $(ROOT_BOOT_DEFAULTS) $(INS.file) $(ROOT_BOOT_FORTH)/%: % $(ROOT_BOOT_FORTH) $(INS.file) $(ROOT_BOOT_DEFAULTS) $(ROOT_BOOT_CONF) $(ROOT_BOOT_FORTH): $(INS.dir) \ \ This file and its contents are supplied under the terms of the \ Common Development and Distribution License ("CDDL"), version 1.0. \ You may only use this file in accordance with the terms of version \ 1.0 of the CDDL. \ \ A full copy of the text of the CDDL should have accompanied this \ source. A copy of the CDDL is also available via the Internet at \ http://www.illumos.org/license/CDDL. \ Copyright 2017 Toomas Soome \ Copyright 2019 OmniOS Community Edition (OmniOSce) Association. \ Copyright 2019 Joyent, Inc. \ This module is implementing the beadm user command to support listing \ and switching Boot Environments (BE) from command line and \ support words to provide data for BE menu in loader menu system. \ Note: this module needs an update to provide proper BE vocabulary. only forth also support-functions also file-processing also file-processing definitions also parser also line-reading definitions also builtins definitions variable page_count variable page_remainder 0 page_count ! 0 page_remainder ! \ from menu.4th : +c! ( N C-ADDR/U K -- C-ADDR/U ) 3 pick 3 pick ( n c-addr/u k -- n c-addr/u k n c-addr ) rot + c! ( n c-addr/u k n c-addr -- n c-addr/u ) rot drop ( n c-addr/u -- c-addr/u ) ; : get_value ( -- ) eat_space line_pointer skip_to_end_of_line line_pointer over - strdup value_buffer strset ['] exit to parsing_function ; : get_name ( -- ) read_name ['] get_value to parsing_function ; : get_name_value line_buffer strget + to end_of_line line_buffer .addr @ to line_pointer ['] get_name to parsing_function begin end_of_line? 0= while parsing_function execute repeat ; \ beadm support : beadm_longest_title ( addr len -- width ) 0 to end_of_file? O_RDONLY fopen fd ! reset_line_reading fd @ -1 = if EOPEN throw then 0 >r \ length into return stack begin end_of_file? 0= while free_buffers read_line get_name_value value_buffer .len @ r@ > if r> drop value_buffer .len @ >r then free_buffers read_line repeat fd @ fclose r> 1 + \ space between columns ; \ Pretty print BE list : beadm_list ( width addr len -- ) 0 to end_of_file? O_RDONLY fopen fd ! reset_line_reading fd @ -1 = if EOPEN throw then ." BE" dup 2 - spaces ." Type Device" cr begin end_of_file? 0= while free_buffers read_line get_name_value value_buffer strget type dup value_buffer .len @ - spaces free_buffers read_line get_name_value name_buffer strget type name_buffer strget s" bootfs" compare 0= if 2 spaces then name_buffer strget s" chain" compare 0= if 3 spaces then value_buffer strget type cr free_buffers repeat fd @ fclose drop ; \ we are called with strings be_name menu_file, to simplify the stack \ management, we open the menu and free the menu_file. : beadm_bootfs ( be_addr be_len maddr mlen -- addr len taddr tlen flag | flag ) 0 to end_of_file? 2dup O_RDONLY fopen fd ! drop free-memory fd @ -1 = if EOPEN throw then reset_line_reading begin end_of_file? 0= while free_buffers read_line get_name_value 2dup value_buffer strget compare 0= if ( title == be ) 2drop \ drop be_name free_buffers read_line get_name_value value_buffer strget strdup name_buffer strget strdup -1 free_buffers 1 to end_of_file? \ mark end of file to skip the rest else read_line \ skip over next line then repeat fd @ fclose line_buffer strfree read_buffer strfree dup -1 > if ( be_addr be_len ) 2drop 0 then ; : current-dev ( -- addr len ) \ return current dev s" currdev" getenv 2dup [char] / strchr nip dup 0> if ( strchr '/' != NULL ) - else drop then \ we have now zfs:pool or diskname: ; \ chop trailing ':' : colon- ( addr len -- addr len - 1 | addr len ) 2dup 1 - + C@ [char] : = if ( string[len-1] == ':' ) 1 - then ; \ add trailing ':' : colon+ ( addr len -- addr len+1 ) 2dup + \ addr len -- addr+len [char] : swap c! \ save ':' at the end of the string 1+ \ addr len -- addr len+1 ; \ make menu.lst path : menu.lst ( addr len -- addr' len' ) colon- \ need to allocate space for len + 16 dup 16 + allocate if ENOMEM throw then swap 2dup 2>R \ copy of new addr len to return stack move 2R> s" :/boot/menu.lst" strcat ; \ list be's on device : list-dev ( addr len -- ) menu.lst 2dup 2>R beadm_longest_title line_buffer strfree read_buffer strfree R@ swap 2R> \ addr width addr len beadm_list free-memory ." Current boot device: " s" currdev" getenv type cr line_buffer strfree read_buffer strfree ; \ activate be on device. \ if be name was not given, set currdev \ otherwize, we query device:/boot/menu.lst for bootfs and \ if found, and bootfs type is chain, attempt chainload. \ set currdev to bootfs. \ if we were able to set currdev, reload the config : activate-dev ( dev.addr dev.len be.addr be.len -- ) dup 0= if 2drop colon- \ remove : at the end of the dev name dup 1+ allocate if ENOMEM throw then dup 2swap 0 -rot strcat colon+ s" currdev" setenv \ setenv currdev = device free-memory else 2swap menu.lst beadm_bootfs if ( addr len taddr tlen ) 2dup s" chain" compare 0= if drop free-memory \ free type 2dup dup 6 + allocate if ENOMEM throw then dup >R 0 s" chain " strcat 2swap strcat ['] evaluate catch drop \ We are still there? R> free-memory \ free chain command drop free-memory \ free addr exit then drop free-memory \ free type \ check last char in the name 2dup + c@ [char] : <> if \ have dataset and need to get zfs:pool/ROOT/be: dup 5 + allocate if ENOMEM throw then 0 s" zfs:" strcat 2swap strcat colon+ then 2dup s" currdev" setenv drop free-memory else ." No such BE in menu.lst or menu.lst is missing." cr exit then then \ reset BE menu 0 page_count ! \ need to do: 0 unload drop free-module-options \ unset the env variables with kernel arguments s" acpi-user-options" unsetenv s" boot-args" unsetenv s" boot_ask" unsetenv s" boot_single" unsetenv s" boot_verbose" unsetenv s" boot_kmdb" unsetenv s" boot_drop_into_kmdb" unsetenv s" boot_reconfigure" unsetenv s" boot_noncluster" unsetenv start \ load config, kernel and modules ." Current boot device: " s" currdev" getenv type cr ; \ beadm list [device] \ beadm activate BE [device] | device \ \ lists BE's from current or specified device /boot/menu.lst file \ activates specified BE by unloading modules, setting currdev and \ running start to load configuration. : beadm ( -- ) ( throws: abort ) 0= if ( interpreted ) get_arguments then dup 0= if ." Usage:" cr ." beadm activate {beName [device] | device}" cr ." beadm list [device]" cr ." Use lsdev to get device names." cr drop exit then \ First argument is 0 when we're interprated. See support.4th \ for get_arguments reading the rest of the line and parsing it \ stack: argN lenN ... arg1 len1 N \ rotate arg1 len1, dont use argv[] as we want to get arg1 out of stack -rot 2dup s" list" compare-insensitive 0= if ( list ) 2drop argc 1 = if ( list currdev ) \ add dev to list of args and switch to case 2 current-dev rot 1 + then 2 = if ( list device ) list-dev exit then ." too many arguments" cr abort then s" activate" compare-insensitive 0= if ( activate ) argc 1 = if ( missing be ) drop ." missing bName" cr abort then argc 2 = if ( activate be ) \ need to set arg list into proper order 1+ >R \ save argc+1 to return stack \ if the prefix is fd, cd, net or disk and we have : \ in the name, it is device and inject empty be name over 2 s" fd" compare 0= >R over 2 s" cd" compare 0= R> or >R over 3 s" net" compare 0= R> or >R over 4 s" disk" compare 0= R> or if ( prefix is fd or cd or net or disk ) 2dup [char] : strchr nip if ( its : in name ) true else false then else false then if ( it is device name ) 0 0 R> else \ add device, swap with be and receive argc current-dev 2swap R> then then 3 = if ( activate be device ) activate-dev exit then ." too many arguments" cr abort then ." Unknown argument" cr abort ; also forth definitions also builtins \ make beadm available as user command. builtin: beadm \ count the pages of BE list \ leave FALSE in stack in case of error : be-pages ( -- flag ) 1 local flag 0 0 2local currdev 0 0 2local title end-locals current-dev menu.lst 2dup 2>R 0 to end_of_file? O_RDONLY fopen fd ! 2R> drop free-memory reset_line_reading fd @ -1 = if FALSE else s" currdev" getenv over ( addr len addr ) 4 s" zfs:" compare 0= if 5 - \ len -= 5 swap 4 + \ addr += 4 swap to currdev then 0 begin end_of_file? 0= while read_line get_name_value s" title" name_buffer strget compare 0= if 1+ then flag if \ check for title value_buffer strget strdup to title free_buffers read_line \ get bootfs get_name_value value_buffer strget currdev compare 0= if title s" zfs_be_active" setenv 0 to flag then title drop free-memory 0 0 to title free_buffers else free_buffers read_line \ get bootfs then repeat fd @ fclose line_buffer strfree read_buffer strfree 5 /mod swap dup page_remainder ! \ save remainder if 1+ then dup page_count ! \ save count n2s s" zfs_be_pages" setenv TRUE then ; : be-set-page { | entry count n device -- } page_count @ 0= if be-pages page_count @ 0= if exit then then 0 to device 1 s" zfs_be_currpage" getenvn 5 * page_count @ 5 * page_remainder @ if 5 page_remainder @ - - then swap - dup to entry 0 < if entry 5 + to count 0 to entry else 5 to count then current-dev menu.lst 2dup 2>R 0 to end_of_file? O_RDONLY fopen fd ! 2R> drop free-memory reset_line_reading fd @ -1 = if EOPEN throw then 0 to n begin end_of_file? 0= while n entry < if read_line \ skip title read_line \ skip bootfs n 1+ to n else \ Use reverse loop to display descending order \ for BE list. 0 count 1- do read_line \ read title line get_name_value value_buffer strget 52 i + \ ascii 4 + i s" bootenvmenu_caption[4]" 20 +c! setenv value_buffer strget 52 i + \ ascii 4 + i s" bootenvansi_caption[4]" 20 +c! setenv free_buffers read_line \ read value line get_name_value \ set menu entry command name_buffer strget s" chain" compare 0= if s" set_be_chain" else s" set_bootenv" then 52 i + \ ascii 4 + i s" bootenvmenu_command[4]" 20 +c! setenv \ set device name name_buffer strget s" chain" compare 0= if \ for chain, use the value as is value_buffer strget else \ check last char in the name value_buffer strget 2dup + c@ [char] : <> if \ make zfs device name swap drop 5 + allocate if ENOMEM throw then s" zfs:" ( addr addr' len' ) 2 pick swap move ( addr ) dup to device 4 value_buffer strget strcat ( addr len ) s" :" strcat then then 52 i + \ ascii 4 + i s" bootenv_root[4]" 13 +c! setenv device free-memory 0 to device free_buffers -1 +loop 5 count do \ unset unused entries 52 i + \ ascii 4 + i dup s" bootenvmenu_caption[4]" 20 +c! unsetenv dup s" bootenvansi_caption[4]" 20 +c! unsetenv dup s" bootenvmenu_command[4]" 20 +c! unsetenv s" bootenv_root[4]" 13 +c! unsetenv loop 1 to end_of_file? \ we are done then repeat fd @ fclose line_buffer strfree read_buffer strfree ; \ Copyright (c) 2003 Scott Long \ Copyright (c) 2003 Aleksander Fafula \ Copyright (c) 2006-2015 Devin Teske \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. marker task-beastie.4th only forth definitions variable logoX variable logoY \ Initialize logo placement to defaults 46 logoX ! 4 logoY ! \ This function draws any number of beastie logos at (loader_logo_x, \ loader_logo_y) if defined, else (46,4) (to the right of the menu). To choose \ your beastie, set the variable `loader_logo' to the respective logo name. \ \ NOTE: Each is defined as a logo function in /boot/logo-${loader_logo}.4th \ NOTE: If `/boot/logo-${loader_logo}.4th' does not exist or does not define \ a `logo' function, no beastie is drawn. \ : draw-beastie ( -- ) \ at (loader_logo_x,loader_logo_y), else (46,4) s" loader_logo_x" getenv dup -1 <> if ?number 1 = if logoX ! then else drop then s" loader_logo_y" getenv dup -1 <> if ?number 1 = if logoY ! then else drop then \ If `logo' is defined, execute it s" logo" sfind ( -- xt|0 bool ) if logoX @ logoY @ rot execute else \ Not defined; try-include desired logo file drop ( xt = 0 ) \ cruft s" loader_logo" getenv dup -1 = over 0= or if dup 0= if 2drop else drop then \ getenv result unused \ Hammerhead default: no small logo (brand PNG only). \ Leaves `logo' undefined so draw-beastie renders nothing. s" " else 2drop ( c-addr/u -- ) \ getenv result unused s" try-include /boot/forth/logo-${loader_logo}.4th" then evaluate 1 spaces \ Execute `logo' if defined now s" logo" sfind if logoX @ logoY @ rot execute else drop then then ; : draw-beastie ['] draw-beastie console-iterate ; also support-functions : beastie-start ( -- ) \ starts the menu s" beastie_disable" getenv dup -1 <> if s" YES" compare-insensitive 0= if any_conf_read? if load_xen_throw load_kernel load_modules then exit \ to autoboot (default) then else drop then s" loader_delay" getenv -1 = if s" include /boot/forth/menu.rc" evaluate else drop ." Loading Menu (Ctrl-C to Abort)" cr s" set delay_command='include /boot/forth/menu.rc'" evaluate s" set delay_showdots" evaluate delay_execute then ; only forth definitions \ Copyright 2026 Chris Tusa / Hammerhead project. \ \ Permission is hereby granted, free of charge, to any person obtaining a \ copy of this software and associated documentation files (the "Software"), \ to deal in the Software without restriction. Based on FreeBSD/illumos \ brand-illumos.4th (CDDL), retained structure and brand+ helper. 2 brandX ! 1 brandY ! \ Initialize brand placement defaults : brand+ ( x y c-addr/u -- x y' ) 2swap 2dup at-xy 2swap \ position the cursor type \ print to the screen 1+ \ increase y for next time we're called ; : brand ( x y -- ) \ "Zygaena" brand (PNG if framebuffer, ASCII fallback) framebuffer? if s" term-putimage" sfind if \ 0, 0 upper-left origin, 0, 7 lower-right \ preserves aspect ratio >r 0 0 0 0 7 s" /boot/hammerhead-brand.png" r> execute if 2drop exit then else drop then then s" _____ " brand+ s" |__ /_ _ __ _ __ _ ___ _ __ __ _ " brand+ s" / /| | | |/ _` |/ _` |/ _ \ '_ \ / _` | " brand+ s" / /_| |_| | (_| | (_| | __/ | | | (_| | " brand+ s" /____|\__, |\__, |\__,_|\___|_| |_|\__,_| " brand+ s" |___/ |___/ " brand+ 2drop ; \ Copyright (c) 2006-2015 Devin Teske \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. marker task-brand.4th variable brandX variable brandY \ Initialize brand placement to defaults 2 brandX ! 1 brandY ! \ This function draws any number of company brands at (loader_brand_x, \ loader_brand_y) if defined, or (2,1) (top-left). To choose your brand, set \ the variable `loader_brand' to the respective brand name. \ \ NOTE: Each is defined as a brand function in /boot/brand-${loader_brand}.4th \ NOTE: If `/boot/brand-${loader_brand}.4th' does not exist or does not define \ a `brand' function, no brand is drawn. \ : draw-brand ( -- ) \ at (loader_brand_x,loader_brand_y), else (2,1) s" loader_brand_x" getenv dup -1 <> if ?number 1 = if brandX ! then else drop then s" loader_brand_y" getenv dup -1 <> if ?number 1 = if brandY ! then else drop then \ If `brand' is defined, execute it s" brand" sfind ( -- xt|0 bool ) if brandX @ brandY @ rot execute else \ Not defined; try-include desired brand file drop ( xt = 0 ) \ cruft s" loader_brand" getenv dup -1 = over 0= or if dup 0= if 2drop else drop then \ getenv result unused s" try-include /boot/forth/brand-hammerhead.4th" else 2drop ( c-addr/u -- ) \ getenv result unused s" try-include /boot/forth/brand-${loader_brand}.4th" then evaluate 1 spaces \ Execute `brand' if defined now s" brand" sfind if brandX @ brandY @ rot execute else drop then then ; : draw-brand ['] draw-brand console-iterate ; \ Copyright (c) 2006-2015 Devin Teske \ Copyright 2019 OmniOS Community Edition (OmniOSce) Association. \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. marker task-check-password.4th include /boot/forth/screen.4th vocabulary password-processing only forth also password-processing definitions 13 constant enter_key \ The decimal ASCII value for Enter key 8 constant bs_key \ The decimal ASCII value for Backspace key 21 constant ctrl_u \ The decimal ASCII value for Ctrl-U sequence 255 constant readmax \ Maximum number of characters for the password variable read-tick \ Twiddle position (used by read) variable read-start \ Starting X offset (column)(used by read) create readval readmax allot \ input obtained (up to readmax characters) variable readlen \ input length \ This function blocks program flow (loops forever) until a key is pressed. \ The key that was pressed is added to the top of the stack in the form of its \ decimal ASCII representation. Note: the stack cannot be empty when this \ function starts or an underflow exception will occur. Simplest way to prevent \ this is to pass 0 as a stack parameter (ie. `0 sgetkey'). This function is \ called by the read function. You need not call it directly. NOTE: arrow keys \ show as 0 on the stack \ : sgetkey ( -- ) begin \ Loop forever key? if \ Was a key pressed? (see loader(8)) drop \ Remove stack-cruft key \ Get the key that was pressed \ Check key pressed (see loader(8)) and input limit dup 0<> if ( and ) readlen @ readmax < if \ Spin the twiddle and then exit this function read-tick @ dup 1+ 4 mod read-tick ! 2 spaces dup 0 = if ( 1 ) ." /" else dup 1 = if ( 2 ) ." -" else dup 2 = if ( 3 ) ." \" else dup 3 = if ( 4 ) ." |" else 1 spaces then then then then drop read-start @ sr at-xy exit then then \ Always allow Backspace, Enter, and Ctrl-U dup bs_key = if exit then dup enter_key = if exit then dup ctrl_u = if exit then then 50 ms \ Sleep for 50 milliseconds (see loader(8)) again ; : cfill ( c c-addr/u -- ) begin dup 0> while -rot 2dup c! 1+ rot 1- repeat 2drop drop ; : read-reset ( -- ) 0 readlen ! 0 readval readmax cfill ; : read ( c-addr/u -- ) \ Expects string prompt as stack input at-bl \ Move the cursor to the bottom-left dup 1+ read-start ! \ Store X offset after the prompt 0 readlen ! \ Initialize the read length type \ Print the prompt begin \ Loop forever 0 sgetkey \ Block here, waiting for a key to be pressed \ We are not going to echo the password to the screen (for \ security reasons). If Enter is pressed, we process the \ password, otherwise augment the key to a string. dup enter_key = if drop \ Clean up stack cruft 3 spaces \ Erase the twiddle 10 emit \ Echo new line exit else dup ctrl_u = if 3 spaces read-start @ sr at-xy \ Erase the twiddle 0 readlen ! \ Reset input to NULL else dup bs_key = if readlen @ 1 - dup readlen ! \ Decrement input length dup 0< if drop 0 dup readlen ! then \ Don't go negative 0= if 3 spaces read-start @ sr at-xy then \ Twiddle else dup \ Store the character \ NB: sgetkey prevents overflow by way of blocking \ at readmax except for Backspace or Enter readlen @ 1+ dup readlen ! 1- readval + c! then then then drop \ last key pressed again \ Enter was not pressed; repeat ; only forth definitions also password-processing : check-password ( -- ) \ Do not allow the user to proceed beyond this point if a boot-lock \ password has been set (preventing even boot from proceeding) s" bootlock_password" getenv dup -1 <> if dup readmax > if drop readmax then begin s" Boot Password: " read ( prompt -- ) 2dup readval readlen @ compare 0<> while 3000 ms ." loader: incorrect password" 10 emit repeat 2drop read-reset else drop then \ Prompt for GEOM ELI (geli(8)) passphrase if enabled s" geom_eli_passphrase_prompt" getenv dup -1 <> if s" YES" compare-insensitive 0= if s" GELI Passphrase: " read ( prompt -- ) readval readlen @ s" kern.geom.eli.passphrase" setenv read-reset then else drop then \ Exit if a password was not set s" password" getenv -1 = if exit else drop then \ We should prevent the user from visiting the menu or dropping to the \ interactive loader(8) prompt, but still allow the machine to boot... 0 autoboot \ Only reached if autoboot fails for any reason (including if/when \ the user aborts/escapes the countdown sequence leading to boot). s" password" getenv dup readmax > if drop readmax then begin s" Password: " read ( prompt -- ) 2dup readval readlen @ compare 0= if \ Correct password? 2drop read-reset exit then 3000 ms ." loader: incorrect password" 10 emit again ; only forth definitions \ Copyright (c) 2011-2013 Devin Teske \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. \ marker task-color.4th \ This function returns FALSE if the `loader_color' environment variable is set \ to NO, no, or 0. Otherwise, TRUE is returned. \ : loader_color? ( -- N ) s" loader_color" getenv dup -1 <> if \ `loader_color' is set. \ Check if it is explicitly disabled. 2dup s" NO" compare-insensitive 0= if 2drop FALSE exit then 2dup s" 0" compare 0= if 2drop FALSE exit then drop then drop \ It is enabled. TRUE ; \ Copyright (c) 2008-2015 Devin Teske \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. \ \ $FreeBSD$ marker task-delay.4th vocabulary delay-processing only forth also delay-processing definitions 2 constant delay_default \ Default delay (in seconds) 3 constant etx_key \ End-of-Text character produced by Ctrl+C 13 constant enter_key \ Carriage-Return character produce by ENTER 27 constant esc_key \ Escape character produced by ESC or Ctrl+[ variable delay_tstart \ state variable used for delay timing variable delay_delay \ determined configurable delay duration variable delay_cancelled \ state variable for user cancellation variable delay_showdots \ whether continually print dots while waiting only forth definitions also delay-processing : delay_execute ( -- ) \ make sure that we have a command to execute s" delay_command" getenv dup -1 = if drop exit then \ read custom time-duration (if set) s" loader_delay" getenv dup -1 = if drop \ no custom duration (remove dup'd bunk -1) delay_default \ use default setting (replacing bunk -1) else \ make sure custom duration is a number ?number 0= if delay_default \ use default if otherwise then then \ initialize state variables delay_delay ! \ stored value is on the stack from above seconds delay_tstart ! \ store the time we started 0 delay_cancelled ! \ boolean flag indicating user-cancelled event false delay_showdots ! \ reset to zero and read from environment s" delay_showdots" getenv dup -1 <> if 2drop \ don't need the value, just existence true delay_showdots ! else drop then \ Loop until we have exceeded the desired time duration begin 25 ms \ sleep for 25 milliseconds (40 iterations/sec) \ throw some dots up on the screen if desired delay_showdots @ if ." ." \ dots visually aid in the perception of time then \ was a key depressed? key? if key \ obtain ASCII value for keystroke dup enter_key = if -1 delay_delay ! \ break loop then dup etx_key = swap esc_key = OR if -1 delay_delay ! \ break loop -1 delay_cancelled ! \ set cancelled flag then then \ if the time duration is set to zero, loop forever \ waiting for either ENTER or Ctrl-C/Escape to be pressed delay_delay @ 0> if \ calculate elapsed time seconds delay_tstart @ - delay_delay @ > else -1 \ break loop then until \ if we were throwing up dots, throw up a line-break delay_showdots @ if cr then \ did the user press either Ctrl-C or Escape? delay_cancelled @ if 2drop \ we don't need the command string anymore else evaluate \ evaluate/execute the command string then ; only forth definitions \ Copyright (c) 2016 Netflix, Inc \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. \ only forth definitions \ Place holder for more functions .( EFI boot environment) cr \ Copyright (c) 2003 Scott Long \ Copyright (c) 2012-2015 Devin Teske \ Copyright 2019 OmniOS Community Edition (OmniOSce) Association. \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. \ marker task-frames.4th vocabulary frame-drawing only forth also frame-drawing definitions \ XXX Filled boxes are left as an exercise for the reader... ;-/ variable h_el variable v_el variable lt_el variable lb_el variable rt_el variable rb_el variable fill \ ASCII frames (used when serial console is detected) 45 constant ascii_dash 61 constant ascii_equal 124 constant ascii_pipe 43 constant ascii_plus \ Single frames $2500 constant sh_el $2502 constant sv_el $250c constant slt_el $2514 constant slb_el $2510 constant srt_el $2518 constant srb_el \ Double frames $2550 constant dh_el $2551 constant dv_el $2554 constant dlt_el $255a constant dlb_el $2557 constant drt_el $255d constant drb_el \ Fillings 0 constant fill_none 32 constant fill_blank $2591 constant fill_dark $2592 constant fill_med $2593 constant fill_bright only forth definitions also frame-drawing : hline ( len x y -- ) \ Draw horizontal single line at-xy \ move cursor 0 do h_el @ xemit loop ; : f_ascii ( -- ) ( -- ) \ set frames to ascii ascii_dash h_el ! ascii_pipe v_el ! ascii_plus lt_el ! ascii_plus lb_el ! ascii_plus rt_el ! ascii_plus rb_el ! ; : f_single ( -- ) \ set frames to single boot_serial? if f_ascii exit then sh_el h_el ! sv_el v_el ! slt_el lt_el ! slb_el lb_el ! srt_el rt_el ! srb_el rb_el ! ; : f_double ( -- ) \ set frames to double boot_serial? if f_ascii ascii_equal h_el ! exit then dh_el h_el ! dv_el v_el ! dlt_el lt_el ! dlb_el lb_el ! drt_el rt_el ! drb_el rb_el ! ; : vline ( len x y -- ) \ Draw vertical single line 2dup 4 pick 0 do at-xy v_el @ xemit 1+ 2dup loop 2drop 2drop drop ; : box ( w h x y -- ) \ Draw a box framebuffer? if rot ( w x y h ) over + >R ( w x y -- R: y+h ) swap rot ( y x w -- R: y+h ) over + >R ( y x -- R: y+h x+w ) swap R> R> term-drawrect exit then \ Non-framebuffer version 2dup 1+ 4 pick 1- -rot vline \ Draw left vert line 2dup 1+ swap 5 pick + swap 4 pick 1- -rot vline \ Draw right vert line 2dup swap 1+ swap 5 pick 1- -rot hline \ Draw top horiz line 2dup swap 1+ swap 4 pick + 5 pick 1- -rot hline \ Draw bottom horiz line 2dup at-xy lt_el @ xemit \ Draw left-top corner 2dup 4 pick + at-xy lb_el @ xemit \ Draw left bottom corner 2dup swap 5 pick + swap at-xy rt_el @ xemit \ Draw right top corner 2 pick + swap 3 pick + swap at-xy rb_el @ xemit 2drop ; f_single fill_none fill ! only forth definitions PNG  IHDR<,mhQPLTEݯp\)5ÿz+qd|s-_n*iIXv(VwMm_ Gg B]Mer tk7ճ&+ê?Nf7 Z%^>w\̟ wٻt7| Kշt'$=]@Z7i4Ź,̭Bzҵh_' h73lc ҁk #sG3~[:xt}ǂgyrMA\Xxw {I&o=;Mc}֊O/'(ς`MYP0oF)M3.h;_ff>- א$jZdJW&Ou'.y`26]d'_E xk!x_{+ Юmj/\( 5iUυ٘֙Q1Zl򲫿5ˎWFdxqP0F$34A^Q I07DmS0|1)k,P={iV+f4x;t C鑧I $j6cg;T)38ЀvGL \:%"O戴mrO'4o2Dy2(N'R>n$.?h#q;5/{P78WRxB -맅#OۀpO#,RX(rZVm[)e&JDU7{imUxfJȊGmA'X)kF$&@3Sx>$@gw;jk<RP+U-g$$tE׶kTPvⲨB@^eR7QN{V?8~sdsmڷ[52v,R$`L0&lxi1Ҷ%“Pe2\!2l*vŖ č"G&ת& fI ˯ܻaUxZYrVעxZr!&%6kh׀'z9TG %eڹjfGh! 70*JA{)4&mrVd-sa6EFK_~r. I%zG]ҟ2OS@[SIP>Zure>k =+I'7t/?5+~GߕO?>dVߣzQ5>:tgon<O#`|'qK~?_J NmƼczi]h;0_Z2чGKosȰdIo,o?9R[YK1nh+h!TldD[ݩTtC" #'afsB:e-'ᶦM;Ü(o% $J8b+\օ(#U&]@ w9EΜE!dg[יGS5: d*tDr e8֘9ŝ"6HTW߼cX.TA`3FN˝v> >7$CTKMZ#:͂*wz1<%:b+aEIMY"a&1LGuMWՆSsBT1yxFA] <}Pf&C,u@Ĺ]HX7DЋdoka6H!;(KG'Uܠ[݊0р'ʫժr&I^<Mۚ{2G-Hѫ $jHVDz#hx G7/Yչ|kSu3ᚣ!-MzAԷ J)T7W2i#>UJ T)$p7?“ ~5,<Mh-30Ծop[yZͣT$álA;X$> d?>+o5"u1$d9QD <&Qp"-4x 8LM<ŬWذmQ N #eMԶ.4E=m_XgRDRZYTG[aG0Ld0omΉ%~Lz,C` v ϛ1n=ާj W1'9@?↯]&":|t !ϒnec[h4<_>Vg#;4oD!r$  ZrZDʷXGj1l C3nA^L~ebH8ZM7XZb}Ѓ-V+vϷgGuP{t7FǿCAZ6)rhXfKtkO ]kW:ڕ)l%b1BcA|kV(Z@3$Wi .߶UoYr9'T[|.pcu6KL}ʉhFaOLJu@A2VkVCI#QZf4Awk$f{اr1dF"Jŭ$07 - &kDq4:ƺ8^_rRv/ʘK7n .hY7(ebI7彫Tl+TmIVyXPyՄ,0xסxz=R+ͽBg9ȉ3pF#M$'ܒwH#4ŭϖ3]i֛bS 7UB=^t!M?rask ݸˢWiscAoqhbL'.زRqSb{KIJ˨sɆΐ;խVӝ@27CKPĨ*xxdm[b uMWuT!7%w+ď K!EE6L@~KP.\c-ҭ)`G(^iBUρF){bżO\1i[ xiu:uE9(zS6g4b8dكx)=ܖT!rsQ˼Ն:j#-*<5ThSIZ3Ү;#C|XR0y/%OFOp1Uxk,i[bOCH{d5~ ΊnRzHFUf9|~LyOc0<T$ٌ9OO V34M O,Ewkq5Ynh~` <ƅzVÓk @O2F%v}ℲD'̀gr@%w#+mx2g@.h+Φ6RnANM!<,a+t%&rEb*gR^@j9ȘҨGAfX$7Z@^j32 Ngc,5(%(C4Na.'S-(OynPt7Գ{<8DnIӶnP++<('B5LJ2ز1Xnװ I-iPXiU OGi,9<1Fw"X,sAZlK 8N9ѩiۤ`_\i4q*vOj۞Xz 9*d'/Yp&1yxd@G!Xh7^s’6.\fT<9nspnfć^}mviJ uݘOۊ-ZeLa,֋&y,1-]B~)i}")qjm{r8%Gy;QDXEqF~i=@iBߐ9𹟌E7f8P4'r ;@ ?pܻ)ծxƕW_suxT|&ȫ]ND'ga$WnOvN/Oʳ #CQ N,>49;Qr! + ļR Of} /Cw+7zm_ly1E<2sDh;-8/b@- v˶C{de~[rɦq7_02u'dja׫v !%EE=~`~Zz֫lvLclO(%!YfjEs}" IE!+c"^kdZܠ,(\9ju+# qU_ yèJ rRj I(('5g˗rlMMٷ-ލ ]U3Wϼ{dB3Uo_ijs[ خJbQ>-2IlSlPdOONٳEN0}Bpէ_KQi )$oF/`'Sn71ʢ\4;Є:t5bзEN '5ŶQZ9ۄ R"S欯;V "WG ,2Z粌bU<*ݵ›Sx*+PFF p6l4xM #< =a:mDAltiKeR2YeRVd5X@VRhSOp5Uۈm+s P+Oi9b0׹3Ն'7uulqY77 ܿebӶnM< F7(ߚQ[-D4x.Dqu7RmKʣ`H!-5Xr/O}+NWG˭ذc`"yg!Dx;S Oz".1t!,<]wrx 9Ő:-nAn49TT l!]nOՎpSm_V T*5`̅'HBaIORIl0| !a:A% =Uk[eo+u);7<5Aتêu RdÐs&9|#9 KoTߴ^ERNO%&iYq_< ^囀ԙ{1[[3X%;WaO'ʮuN9NxfW8)rxTkU7GSf/xf|0ni rDBGj4$%lOu1(5ON[:DP\lUiiEZFk'W #& vu׼m)$y jbZr0ITj:+cqJ#? 2SxxZ(ے|RÕ՜oU1ӌ,6D5m`Ӫy΅'jc9"YjZE 6&m [r|:ږ<19&7*W4-YRab.56̩yZ"%+xTK! 2SyE6V(4zTJsٴ|AA0?D,aX嬿aBP5a/ TIFMi'mtN8}; !x):kR"mku<GH-? ?gdðshhdăӨRѽܳiC2ѩ@ =~,ZnϦ0󅍣Y|g6ßS+np>*-NNщ@5<1 _ٕzW$KɎ3wIFם|q @YmOhwfLq'm 7 Ӕp3Pҫn<[v 8g."Jb0T2 r-Vi{ʹLϫg12U_-X2^rXΎ.+ t.Հbr<*`{Y.xfK*$Em4|9raT*g1Vcuke8m4둍y@ˣsQlIobgdIFN3`4joA %u;WƯ?.Kw2&`N\^,hFx"E!{O92{9uYKdt'4* XnaeŠ~n3*,pIMy6)*pH|w5HYۗ̑hK5h^x<.Y6W|uY+]gtSdMa, -x Ui6} \x 6pTx8+3ş \T '(7Sو-Kk+=` q'$4w\1> #O}'sBsO0%]Qmٓ3i&E&Z >^ڑg+u턬o]j8Wj:jU `#-k v&3p{ obIU|0d4^NFږU!xi[x h,T{x\3 k^|C-kh<P yj^ ~YOouqLJ5s$ӳNYܺjrmFEe#z{ 󜯭Ġ]m˝C"{l &<LjU?MƵh~9{b.<{u%C'P ϙf0@\7 OvVH.7]-̂:C! ALӧK6,F ,CʌV˼r|]gOP#O:_3;+Aa$`sQLJG bN#tbR=՞äfS/JJ%7Sj^*-S# e4:W`eቴiURѺ-K3ɪU n{Z5nYe36$fSO O~N'#h-ft\Մ$VF8*S˖e}9[Tr xJ֪2W w;x]\͖|:4ؠopzOWݱ\^;K^e=UYiuYtxrF굤3TI eX:&A[ONpl |af#a Պ"DQAz :/i QeIj[+iHy/*YN'.e~z[lP~תb߷υ*1|]&<~[yãI~ Y۶1'sxOf3:eˠ.1$Ubgvcw95Db2&TypUw|]fQ7B5F$5,jۖwoQ?#LA|'8fmI1Ҩi[nԽ/' *ie[܇JqT`HE$kl|NjJ/ |l H+Zry )?<%E3 5kFZm2ąM%p(1.V, _IBw50 +ϋd*(Sls*x`yt~:4%m>|^]]?>QƓj%y54Uzx Np? bWmP0S;嚧[UuII/(Yx.hd-RW8]; 3F ORrVIfK,S e*F1EqC;ޅo%\gqyuÐ8U*1AvDs[rԖgQDppÉ,;)9ϬiťGz֬>?AU2i9{“];bw^F ΍z]}|}&^qw`'n*DK}CߞGtq>sSEfiO0flxMv2 VebG(;C _6O-{6Ѽ,Is[|0C|0'z~x\î#OMTYr` +$0zx~[_Y9l˙|˴ԧhNI6ȟ>\}/˖K*wz8W=H TI Y3h3y2u8r!EJ_?i ϝFu+Sk7>2%,1ŤwV\LNW^0ר3dޫ!Bx/տAHY\,УgZF62B~mhSՆYykƞfhxNY aPYk@AFk I )S1ؑD/>U+הpTG7bJFݳ+.E $.1x@`ZLUiqqp!Aa-5Xæ"=|Z_\ܣz 295p @5x<գVlnlF0:_Y}ܹ:)<;;[}8Z:v^]||}}weo2UPU(.=C7DZl ŷZ~a 5@nC7GWOkԴ|q`"=>CT 3V]`22%D5/6+9ykSJs4Jsjε->vҫِ_B676Cm1K$?_\^fx_27\ < }BY*1'E’$:ڑ# D yx:Y4eJ\*/aOxj_gD-BeWbY*txڙm3<9NǼ'{3hP?0mI&O$4󹮴8c61|}wLY!.Xx:s)^sz.³IԜ4^^1-ќ-'4_ OT• T5Ee}8DxԿh ~w4F1 ;AKSsHko LarVw%𔯏jOat,ONπ#Ohs!Ҁ-2Xq}f)VVӠa{,l6ih-'gD'im5wc_DFg+~u3ϳsgzaz[3ddz_wUyz:Ys FS #鵆F_|͂)k"UF-02mx"OP"ϞOȧmH GG4Qt=ҶNx YsYBO^<4iݪ !CmXgzS&*aᩨ[.[ Z ͢N;H3Km˹9 \B0l26j[Zul͓ *3ʓ q_^V'݈[<5u͈ȓT2exV+>SiJrr (T*OܐA2'TM>sָ6P4F˂ ƲwC\s<%-Sl65`< TIuyHWoI5譬iS.iqzV.&.RnK{N;佤b}Y2GN!}I18S6qu=>gO73 dI ҥU: ]'wūXQ /!<RȍH)Ԍcgޠ Mm&y|=ôry.YB/ kG1`K$3@'j8ZϥO7"a#OG;m 'DЀgd_ jVN(sԙٸgOe|gKqGFYŸ,B۶ OײiywB,XC򘓫m=`pa]LӬZ:[kFєOA61{jlңPV{52_)Nb Zub1ҋi[RvB!%Ʈ UŇH$S|w۷YrzU獅.})wzx.Of}a2\LJ;_ḿ'KWU,2 z&m[9XD[J4xUPթx[Sf@v`'µ ^tqvO';OCj,X?NJZIO$# ?Fk6l ?i OUԓǣ[xA*[𬟶v<9=:ӵ^aqr{VAqσzɹ䥦ϱ;E%2O m#}:z]G*[]ef#XR[U\6ΩҤ< 8[(:1<[iShJC\LIf-h9/nZlmD2 Z3GyrCx< Oʞ _m]0ONgn}UGdU]I&O5c GZ#1̨26K&Χ~k>:QPN=4Jl'$6R -/-ɄxGG=9{vv˓ׁ]y|x)[Dݐ7whyB fZE,t~Bs\_$1@ꐟt9͉t RgPsEV%2 r&BvF G}] [G7|/ "O O\2Rp'rKxFyl6$aLSȢ g,FDX}{;|Th#ԑ]=]yRv,CaU2y6~^Πwz <?3 @ 5ּ5P5a<];fγ ay}u>@xQ'=d[m}QoR I^{)|ʋ=r?MvN{9Ȁ]hWMA`[d ŷ OX@ݷuo~e7}hn|ɖu*fܲQ)iuX{Y3+5/~h-\*Vi3>` $k#8"|91x@3CB77Ǐ_ -q. }d>/1d,TlVQ soL=Jr72=PiFtaszd+BͻTj[2 K)x}ǿZXpv;I>.6 *"?Ԓay︻&`&$U|ۛSP6ef5JI`#e 7].!hUlc :4T'Pڥ&R{Tq]b5jͺ<9v\vNM5B"]{eˋ3@=̶q(ș%MϳLmge7hOLG*QnQ񦧺;Ƴ$͛H0q`k)dPb,HGӂ~c UR\[PqX7M説ˎ7Cq{Z],Z0i,NxD%QM^_RƙǍ[Z:~nF =_ (bN7J/E!dÍTr{}ߤ!e9 $G흜-|geIXi[y0b4}U9 8Y.%v QĎ2 10Vyk}+,ˉ]ߦYk珎?Da!h.~K.Dq<~g/n"`iOb/p vwHVPf$ʜ:%!h3VAt^L1vPDF.^Iw0SkSL[m>CzkpD=B0(#og48YKP+n]"4DX̗O;i`hx xˑ'F@D,dكy aC7 !xS̓moݱvwٳ~syI3/ >VIuERw<ǤmD1*ULd\_ɷB.6܊&7j8Rȓ %-%yhHZ ߬l (ź dV>۶ᩈPsQț&~$`GqmE2K%xڑu<ٽ< wfumjyHIgŝKK#*tvޗӻ#l,"it^z!:v!< Fg~bA#{x%$3NQcGc9oZ3nxi[cPaYO/3s.Z! l.< =ImMag%},)6X,ec3+;0Ζ'm=/O{o;dn*]|~sxְ!kh<%]d*%KϬ'F9U0Cr&,3Ya{j:lbF.6Juitxo<6R˾mJJ'Πp|ٺ+Wyjvl!;w!%l~aNXI/އzx@=gwxPx \Qj[y4xL;"W|][rwO>~~sC4ZERFZPcKd{BU*-Ԉ[˝]vA XkFma{ 65)<'!E+[I2%dg%gEP+\,+yU#{1w6}C<߽յq8Ivmpm:@s9g||e˥GPURyO>gϳ}`UxJj[IyWA j#>p ]|6G<[0썥 jr[UxSwVc @MԖ:4gf0$+O4ϓ ͹g^Gγ-Ӫ2/ Op@R1m; =eߧUe~f8#iOKvhp<9I)4i[z@BvФҫl M+jUc!^$?FMqt4T<%rڪP"m@j[OڲPnAO,K~6᙭|![v|US(LVf'T|Zm*JkTjZv$>,6 :qD1-ʸo"OEiZSm 7!1 EhPScgYuI'~( GVjdr<< j: M“ FV ZObLw OJYTV?usKd$a<5WB;O|䙺TymyDpjG@.љk.b롏*;BW =j& X<ۖYxK,b(9\ͬyY8ZI@XU !&Q$D#UY^A#GDG⋚2[Aom[ ™طlIMi#OLH(3M@TRPt.SchM V* Ji"`#ϘO`\rVۑAk-%עuXuKQ Mg|:V+¿jgIVMx.~< 6Mg'_] (xdv._:t>g-l:H+Nyb*|B֛5$x&[Q_ ki~H\K@ )QVb䉪?K2Sؽ"O+Mt)N7"/F֊',c݄'(T(caΌFhWFζPml߽QD\"x th"5,jUF+'s1jy_φѶHA?,wv{A<"; gλϟ^B3Х2Y˳mYxI*F5X3{ISP AL:"vj3Mc%A5W/>>O\d) F$Mü$CՒ;L8x׶;WD_itjb[ѭVV}ZJ OɺOB)tx0 BRWlnSZPro]hZ@OG憦 el߇mMq )*yB5/<<<YIjBCɁr<2lT(<AvM䇍%YHۦ_d\6d$2/pE<(`iW T m? (sTx+<6 xi[˻2fCeTxHVNҶe{2< ux3o;=ZgԶ=Pyw /^=^燇#ҹȻ>xvݞ#[{ӴBJJ8h{j[ + 49;ʿf(w6v>?+H=[v <%lD7^Yvն 0"I#?B6T`G`mؠWeJix?˿4e9q`+Nm$-x 𜗶 &`k :0YlP)g!wBw}s7, I)b!;O'R7?\zO"'}dFQ耝/zr O]Dju< 7!upi['7yնFv .'~||Na$ CRyZZmɂ֚T͌Ƿ- -蟩ZUԉ%iqeKm TT*m@珽6\Q_6 '()Fb0v$qJO1̡3sIN/J. ѷWqJkyKmASꡏQTЧ&m><0gP$tlj $%ՠ1ZHI9 ¤7ܠGښ`?-b9g6OжP11smPLU(v1|3 m?ݒ0|^8^Se Ԯǁ/qʊc4HWe7h[=d}=tnT#1y(==.ɸ ǹgwp|=TGs<'L}I:}>Y{ߩgJTY( o}pyƑ*?Ъ nON\^>>>>+x>qp[E)d#:L*gkQ ;6F>E_'6k[ A=w(6Qx^<Ϸ<~OCaN^$院ϛD ϲo0YG7S3 CN3MWJj&" Kd}lF2eݮ[Q9V-d6w jx34>Yjh v[vK8ׯ[~DŒ gh]qDbJ߇/hr$+27 L-3yT]FDI0 „O3-SS]KSoAkFTIX;z%O)=R_Q{|3? B^-[i2]G0#4G|ᑁ'x32w9!iۻ!o:0!x$CC(I2e>{ˆzȳVz³yBe+x.TkPB}gy9S53\HZE5|dx:K٦2S瓰$&,D똕T+^zr?yhIraO7 -LK~s >S1F6,hjl˻ 3s4@ȩG^ FSƏBRE@d'jVYuǸ㲶2;Uc_H ykV j !75#Hs`+)w.\VsӇ*X-4O+,(x@f^Ж55Gv)u$4Cْ O*+̷T؎Fh".@9ۗI\~4x}DI#}6cjgcOY0Ch+<;9cʶns3,3$C|˟=מ@3B3³{\@Sd U"OR J77iuNɌebgACO+wHۏ~ -{F,6<-5O]e r:3a6 z@exZr`hfۜR"Cfee̴"DMOs>'gJ2''7Syœԩ=`FTHIP'&B;:I"x*KW/J̞|Y)tlQ`Yޗ*k?~vyxbs\yZgremOX}zIP =iۛ7=kOՀz4˲[^>C790F4d08_}-WԦL\L''@IOV& E:<<QVo{Ų« `ȡvFr B9G ^莣QF":?3pOe03em߽.ï3=O>m3&yV4fT~՗P%G$I눫[Tec4DVDc?@ R)^;f7a"<ŁMe\VӶџVҶES1^ ''Zj[5Q0#FAfhex4SMigq\๢0/m;u*ݔǏwx)֪͂:x3/5"OV0w ;<<;^׼~oULp\.sܡQ?i*tmm 11)[A[Gr8'.*s*e9a4[󔜄c 5mK e Fԣ~RiSٛ'9t0;P47GMEܜy)k0_:\xkum=@= %.D)Rk@ 5rusDz *!?<%)Ƭu xol2F]V [0KGj>*<%4‰`vz>=VW_~UO@QMaA@7~qճy\ϒ."OT;o>'?*v~yKOn_yCKkUKʍ'5ϖ^k9 YiGg.A;O4!d3 64fO!}\>sMݏ. zyy2<Ə235-JÓwdo>_Ta3LKOOU-M >Oj$;.].]K碑 O@ub6_q2 zqa ߶ݗ.L{z5 J-3:.ΌYq>^w[ssf&߁﫟M$KGVo =#qWR+3 V00j;>3M6SӓԽ曒VwFTk굘QRkf W1=[燏>/_=Pe[U %O+Μ]gB"LNM"U,\Mptջ;h3B[_\žJMaM<'NgEkYQX&(U Dx4Qno}%Ƒ9V`LjtU*,q8x;`E\DOSF7.sz[f2<ȓ40կVHbNVߺ8vУO>zs ?AW[;J>W@igٷd:;gj%M^³ѫWrw}\g1ƕ~! "at1ռ^]^7z-ݫÃQJEDKt Bha`]@چ=J|S疹:2x*5,kcf)G'gSǘ/7BN?bІC-͘v|M9]KKpX'֧MQL BڶZ)¼ j- xӳ ]7>μe-ͧ+o7~[.;YoONHkN^/fHI%ѫ_:L铎6SH"Bс;|w?2;!?xs-"hPiS/FiqAUn9*YHuKzqZHcBY!P'J5Z-g{#msqoZӎm.}R !ֺi"d<\;Nshx8@쥄j^%S<jv  ڜ=F?VG?zﶷz({_ -ovC|^m ?}v}y<''ȹ8u3@ݻw?zqxǻ<PxS<txBiW cg[z~#$$ȞdRwPǤN` b*O,i.z〬wj73وfFxY@JJ,OOal^uI Oe8 }Ky<=|:>E7E׫qtwg3{Ĺ:ӧϽ{ѷjTu궏?/3ϳGCgG>wWuٳlYOgl?5~k]Ծ#)w~jh< F 4j<ٛXLKbZu M#Dx"4T=堪-mSr3rm%82-m`ώʔ._k钇rx@j K#I<s1 TƳy8m۸ Oث)7 v;7!,@aUCLH>4}^p^|nc:~nR׊'nC3kb?fo9_XÃgϟ$Y8Ux.Rt=!e#=3'2u^d&y71ozvF)i[y;#;R3)ؽEB?fЎ[Y{*jʏa|.?}W_}BI4EC>sug!+ OǫmwTlWoy|KT ytz I'F ~YZo-25m+hdMf2]}OێZm%,x+:AYr-x"?&<<g.]L5[4 O+3/]8OW9 +ɮ>v|:~qg_ (*{?heħO\1C&q^ܫN)b^˃WwwSOo}C,g|'wmXw#Od7k5)tX%R:3^ے>3i[76m< H R'H#FW!.ֽsm38dlcg7fX*{ΐdrZ04+m=øBE_!|fg ΃/Q􃤯#=cٱsMkM2=5y>|h󏣣]?H;|k{zv߅PM}ɻ(y{fKR4̑g21቗ hd}V+ev~N]Wg߶W70]qyHho}Ǟuԩmg)7UJX!MLѼکc L2~xh+>5 hFw\2\lDYR|"aGu5ʰVOs oD^mim{VV 1 ? OܰdNyԦlo[mCwwtqK tvy~Oz};:aҲ)D+eiUI ;C6.{鐩w}gG[P0xyWyEωi]yUm;w=Lٰ.gMEQ"Oa7 Vuo,Ab Q%mAu = w ̊Ozy=,F٣{xz[p<Od-84,/w"{Y:,lrgƔD[7Ҩ6W+,cmsĔ%ilCd.m'Y{bz>wg|Vؼ/6=W>Bz}CuYvLr>~g|i4[덋[o&wSJSiZmZp~~'ޠet/o7JœLDj"Y] C5fu~:<ր!9O i_Oȟ9PiFI(߆pm/x2>uR; p8S(JZp9<%Q; Gi[3sm0UwRDh[ybϫ^GzCϯ?.{+x%ʢ&SzzhSDl{MzP ?+㤈`yp}1>KC<'U3Pf竃'~5 (jX] @` l? aZЈK\bD)L-Kc5Kh^#jtB[ul ս"Z\+ʰtS z)G:}@ghfcGA0pӰBq+v;4'A?qѯjտaMX/zL [x-4O.쇨t́gҶyFu,lyv.DG1l?oR(.4<}z~=kig8GY1X&~8\2#+%e{u ;oot5˟"4=Cϟ.oJ*2PvpbVQgNA}ҡ[d'C&k,vdZ=>a(kȆ _#1怲5wxe1LBivM>!كb/UyS=&A0Ҧm>.5!;%#Ci=6]$kէ}'>"ƛW]$򢦙_8$zn=xv uy|޶[=$Sz`؇)'ˤvuJ!Q_#J+v6>Ϗ1#l)'lx>Z ҝ%lbM ~wsOU(cC;[ߜ4L9@]m佴|b;@s30CxYW\OF`AtpKVkw%v9I=f=;L>mo~|;O(FHxu:Ic:hqr>ʖ~LxCFn/:x~X_{SԇQGG7!q-3@{jh}Ok==9ILG:<ԫzP]L/<|ٳvy[N(3;xOie3O ϔeSRD2zhԜҍ9}W#A ߬O1k " O~%G^<3>q2k,Ljit= Ka-%m[q}ٳ~z_Ǭ-^ϓ CxIxZU"|P8WYf{R!Ҩ ƟmYU2DԨKE"OOV+3gI*O'3;ݒ<x򂡔(&m0>DOۖDꅭ 8+WYܻIhޑTSFEσGMdg =+T#nۗ/_v"m$j=Sf6Iᶂkgho+bƒg x2T4Ķϓ^x? L$bUa y|pԧz?:wؙi%C1`_PThS[a5{Dn<=x˄w{]vgօw%  +''o%oWh>\Mb< gg ;_Sovg[$д\ΗRfΰ׹m1;a],!jٰ[DAbcWiA'=΂:9b 82+LPM`j}y֯Z+{EVgP5O(Z~DPT=y/c66tavP?ϳ>>?Y9&K0$s(Ur64Jf2#&y"[&L[ mk'홶Uj߈f+ *ɉk5Ȅ Ux޶7s9NҸI'%KFmG9G =BnҤK`VT͞3%}Pm㣳X;Z3*3'yOMelX9iޓRl^KoC ϋ.Eৡ3}L5י_}.g_!}o{W]ΛCSɺ_1sM*՞z6`|Dg7պPB7ل3IHꋾ_3Z$mc/'Nbʀ$Rc{OOȳIi Ls ogZKY w'2G{s }P8N{y4`E}ӌAWW'y۫ݷ.oɥɊ>N2|x}f!}{:<?EpnRt a+w3smzVTIӐ9"NlS# Rـ4K a"=2Kj)6Yt8+\{ }D0E0G_,{d>w3~=D/QhwO}O/7蹻X?)kem7z`xV!u((yV=mIg?yŞ~6Jyvۉ/@C?_3ȢđF83}u{ o'|u{T6A|Rܹכu ͪy>]˞a pUN9 Mu Ϙ`jм$x<y.Ȗ1<{oɈ%oΧ/z{aPwu@̼W!DyV yOԃ(_)Xw~>!iǁ<_*x64L$Jƀ{($*>!=}&?ijH(γ;mfmυ+`ǒٹ BWqMϟu M4CfU~Ol+7wl9, <~Sa?mhT'0}ɞGygD ꆔ,efyx>{%x,7?;Z47hdV\.x7mn={ۄ^+0==K/aFn$=s7^zc{_\ex<>@UΔG{wWU4eo>7|߬TX3eP ;7^^³yx[kݞN;==;Џw/!4V1 d٦ +DILrTiڕ8oy+45[sMO|L%rR9\{>{=+qR W;*3Mо崷=ҤzI[/ږAp@K?{+fՍ/ <:j7dA~s/BVK, LUNuNVݖȩnU~̡9gx1Mv`hC.N 2X̆" M]Uӵ[A[O40C4/TGF $:?O?@@2hf9 y~ڔTj&P5- 骄gɛpxlՊ:)tJYo .eD#o([[WvG$&4G{ +X +^zU}`xA{z:lGu|Aea^v쵵BnWGǫll3foOzy9vg<:<"ݐ>>Gf<9)|aj >=nŀyQӨ6<ԦP\AYd ɋRMR@H|޲jhʗ~@_M!2i-hP=~>vB?8;Ix.*xNq}=N?.bԩbq/_]\KX<,%>}-*;cd3&O;x^yPGx~iɍ=m,SU6^z;\nGϬ:?- ΃G{;w~"SJu)h:_bvovuyI4órGp9iDf5z (o t?pr\Z`fنsl0:=wY.Dl&1~/'tlAg懎c k50^ói嫏w9$mx7kALC=гCZs???y|~ GbR=vpԌP Ş!|g?8%Du`M2"RbzuSv/'w)9q]f/᮷WgnQv.i7T^ usѸOR&[Jy_O.P;9hmSs}߈iC?C%$xYY:}O|\u|)?8<=?ai@qtmG͇o>B[]C <9d~7LHhAdx)6 b2y$,oST41/HHQ#Oqfp:Llڤ\JJ7;P㫑?{YOQɄo6ҝ ŴŽϖ \AT-=Gf=a1 Sf߻wj窃qg^gGxi7>"(R~GpK}C8o]}zuo_xWGt{R7_A_Ras5==oCvE]y_nfE]_r~2ҡy“D\YH<ӓ]::[O(u7Zv Bx*Dxޓ$ r,ҡ%ơg^nn#<%sPzy^ny 7˃2dQ۱s-vSoz®!;Orn;ABg熵_QwO)c8*/9f3NRdx:a&}Kxn_#<gUe\iDx#1XҼU0-mk̉O./H(c3FJm<'p7]0IUBQ0 m-1=L&߳83N^<3a Fz?cy=<5 {;*0'0c>x\\"*ұZ+XX[ klSnj_x|fu.GW$aO:uGl#gy\^Rjbv^Of~ JOk,^\v'mO;BqϯY- .!i9J2kPPbL:S OO+#O$ OTx0AOYS0dSY PA͓$aybVHZ-( vljj􂑢xi>pod?|jlcggAKq^"~<.cYXzU?_w9>ZBĶ>>3w#MMVg%'lKyj| A'vU{~==žyww*7#B5ퟟҾɽnzwobgxR=`<yڹᝣ;V=C?0{"Os"O$6䚧bi>.JƢ g2=SGOLjT7gc!ANY݉(2<A׾.cZU^0" j޸ =w{wa\ٻb};g`eO6g룣Ml3Co:{f=O.SCg/*0}|cKqqm_l7]]_w՛K܉|JLW7gi&5.X~+3{Gt5LXx⮃YvI"<~.P9̞9mkGÓ Ê Ϟ1%C,;UeyFX>t_TYgfst鯃'[Ntt&UEEyj@rO.<=Q궣gLK%OV(`d(v͗=}+]# 3|=esUݕkom?{ xUU&`x̳Tu䛣mF$~}Ѿ*6b+ómk V$*{ x[8W'8UgOlđdi,=ӶOG<O49f\_։OB%duTx:d<ϫݑsٷ y[%ywWƏ>}01K1ʊ!컕+>oh"*hhwy mpkΧm󪟿X ٴ7B,(`OB'Em<:1B)'CpDz8Ք\Cm.yy (ʊ"Zro=|ov{x9ח3櫹!F!E0eTQrpOvt=Φ4#wD}(Cd0MIHd aK'Dbuܹjy"4C=r͇1Q~a!;)Sӧc nۖw^N֙/W瑞ɃOR\N :^(rKu1 2gwn*ib=Q%j_)g듶 ϏD{\naO.dRi+Ggr" )H`Ÿ~Z$)-d{\9Нm=;pƎ&iudv9p'i\/.0w6+ 51obZU\x2X!Zvqrqe;!U1N 8bsT~I`_D^p *.v.䗎4A1޽5DsyչX4dkYǞo.]>{鐇oUh`7Oy0‘xfǶb'Έ Ġ|]#yfeZᪧ]lQƶdUq-bvS}hzyǾpt* k4x2jg|=v)x'Jž% WJx*N|a͓ꯘ ;)Jjo+{=SġD:xHf์m% *]Ӷ(t/ l0fh͓<!x σ+?>г;%LU88A`g?as ]nWѹ{vGɅ:5GW qSUId_qS˔i[ڧoT|`F Ш!<&'#H_j2k$^rZkY.4J0ybSFWYRм`0H9 >#ͧƗʹVnd{ܧNNӞZm+me?%\W σGcg*`uyQ6c~(<W6!mc6](${J:2?[z^ 7j铴7taϰz:IC/eIiz Jٿ5Jb_:-P h-EM/`Ag+j9tlvmADd,-R޴ OPk_| ĴraOMUM';5+m{w4eOtgޟJQ)m1}G>ٞmK;dWTzp @<;?#\zF];YKCOYRSiyn3W! ?~|fUğ_sT"Oy>-< 5yKݸ?m v!7Y%5d$hF57-ƚl p#b]%cN.g>B G"!iR֌Ox+L|yȓz| yc7yk)9#>wZ= dy'gMKc}8/]4?B%;>Z_nΛ>ih/oV'.mAAM  6^?m)͜yf9A3Զ{=`ն5sV󌳭GLV3 n'~v4 ڑM fRA[qP.5s ϣ~bp#L|y훭*ex^V /SEn9> .CcKygBo1=nvc붞'׿,9tNϸo"=Ġ~ ;>tGzf0z{mTqSlϹJ | vy4&/6:LjoFdzD=mkp3K1< Oj&T) O @4'q46|NJ b5OuAKZVمP^j?_<[Z6/?vq}:6 ;?qgC{\ڟ]zzh~^3}zw4Ů}Qt)Aljid퇢ݢg:ӛϗ2pSEm Ob;΃U Cz*xZ"!}ȭMK*EL^exex2g9Զ1tC\AEf$³sm-xž$pp|P#҃GLh9I*ΘϪb:"F&!ZfP ݌")چ-u?\Ouce3&Ev:B`Im!$l~I 1O3Qg k1.Y#3]5*o RR!D_g|&=zx_1 ~l6^9Z3Ju=yarYOOTf4R($rpL4b(MAO #~SmKdJV|hOd#Dy3O9k76_P\Eݑ'U˩$xJ%f9bٌ@O`8S?֞ O?<ZRF5LX W^p> erާm V8zBJU =q AZ4& S|_OT2 ;ƕڡmƓ FuM:BJp|e\uH񈬶ܞ-_\RS9k7nu H3Fw)lj{fyiG$x ͆X^۴$+ Te^;9@Ϥ9ç?˾vRIےB # 9xy+{tPhLr~Y+wޅ=a1'@|^k_\Bw߿?>b?]Squ5p{_U#M3_G SצGϻqV~x0w9GrKkUQ]һl\_?|sae^.Ыœ 2Н)+Wh!JfyƕU[(o^<ݡ>]\.:Cy O/R bU+М7s=}bEij#xO)txTۉCRy#d3uDŽG]is3b2"4$n@fkkg9~EyXʛc6xR~-shW7?zQfSig}{h5I7+}[}iOO\ +HO;7d"Dȩj D`}գ OQ?j8bIW-Ht~ѿJ@͵ʅ$9 GSNMe4Hyon/v[d>K{z>dx>u/#||_e|zR4 4uI^gWQ. {VD#O7L^P]zz^}EF6'%P(Ǹgӄk3 r&< xt5gDT "=,Jt1?Xxb1mV3 b]b)s]=_gm3$ yR]MxpnLlp V~>P9c A`ݢVME므wܠoeBdD>~ǞW7lF]bVHo}3fxG]v3Y$L7f#~(bՠ_pMw:KBɐ%܉:{ޮ$q|Ԛu׾DzY8.~:K9DPNv#'fsA_x?_PڳK^axf>Oo딴<^ṫ"gWkclO_PogIǏ?5'$1ԗ|?_^vAs ȓ܎C4))W6$'tUU>6@hǓoՂmQbSrǢ鵩2!&S8]M>FILӶ@.b\2<4MIW-Q{>K**6X%x&5_ 6DurM.#RSmo6<,A!]tzmGwe7 )_+(~̫yVkyr 6Ꝕ̳nRJФFXǯY0dyùXxJ ?mP.O,VƄ.D+gX݆' $| oz#O<93m*7VB{-,X)?&k t~j< 57-~CŰ0+,7<OhFhjra xz`!"oGOG3& 1ccx\^N?}uYҮW!L} MAhmO3Ior |sww}ӧ`o`<坓>PXlMH~^ \QVG2K'iߛ, lq φi`\Be)2V#cp^ < #uys$ b<3yҶ3>v^(Ich(?}"O< m[}BmˎόI[_H#ћo;ts69쌚[O{~=^|[&?_c|*s8? ei#P}|?^}qυU' 7i;ўfX2Ik0O<1XROɯUoP3e/JlX v=޽ 38;#eDԧVhN9:os6أ珯^vľ˗Cjrd?~޽ O`2"OgO1*?#hӲi[T$V S Ry.?GhhxJc'Jg'Ȭ9Fm 0a(k<ͦfZuc~ӹls+yڷ=CSc>H1@EV1Gό<'=i9==~,skE{s*mk's1? < xV<|23!I= f{-cnw'Ȗ0L\T]ZiJMUr}jTF+4˟ё'MIpGtwPl[]OZFh۲ɹ((ȁgc6ͤ_kB<_m #mqms`z"{yU* xN" Lsq-y"aqO.' p⼘G'+uE |y|ƋO(R| O34=F{v~гEF8onSԫUH|@g{|%d75lr t-/% i亠0RDAm 5Nyb!av^% wjJ:" ŚsDސ4X6TGLC!{Hƨk.MΜ73m6;'l[6 M;{SƋ5]y8`uƍGgƊϭFDTv7BN-ʕ"Wq*&AoFy;qnҴ;hb팽l}~}pn vûaSޗ^,XBuΟ,SgL~_"zۏ;Aҙ=]ÏCcH9r/`cg΋"aFb~!5xsSxm5cɮK]$ 0U3|Tix/3/Vb =QSwp}h2e~IDATŇQ[NhZwдmP(Ł0bT|YNjM̪@%·WG3X))3R#Pk}'#Tf%eEj^G1ι@d Ugރg;oateec> 8ӧĨ?gEۇr:PNdfjNskܢ&󏯑gT-+#);c.I&0~e]Ķ|ˊ Axf; ::'[Lg$?!E+9}2QZ0袐rxZ䴓Fрm.0SzgƕHk$S֜6o R&ǻ+VX469C7yGޔְ$Ş=ݿk ͡'N:]h %KFOX['M׉ bsx>07ʿ] *%WB%7 #;\"~.MEsYWjTE 둡%Jj`H*$RuMJBIaq$΂bncuO6سk|q ?UG co '_l}>' ?"#|`(>8I\=wrmt8ϻ8v$2flYVmM V-D`GOj2V8DJ}EZ vOAVGOږA"Tjql&яC=D24[y2*c|#%sdޛ7<3IFHpߪrڶTem6Fu~>j|6|zm߂v{z3%n=+Sp ?9C!*{O. +vrVi##]>_9y>?,!(8?Dk9O%?qyO]Pؑ:9wX~,{pxLOcSQ.cx;2x2I"Ҷxz"EOR)2Ņ"A &% NS$_\yFG$S v|fT$A3󲒜*ۄVچCi[i*lABSǔPƆ(0A%ɥAp*x"xfRyxJZ!920h B?"~O3<{uE45vajY wrVORg: _0vy*_ I[|y}f zv͞oSSZ@ƯAYQ#O(\KES`{Ha貴95m S<xe n_]Yo;* J~x~~j^&Eb/:ُ=߻O?BCLJۡ5PK 'M@f}ţ]v(3y:zs%zږgS l[ )ZC+ 1˶QQ*`BPNGR19;QKM!bMmyb%Py^yY)Φ|RxydsT3?H~o A5<㽃P/^.=xf?-ɇˢ?_7ԗWQG2=qg1Ok΅ӡ'a=-k;>8%]"Ä7*i)gGT+XAPM.''Mdۖ9\9w*0$g~BYfK;u!Z)ly˛5,r;xj.IP߭D [ȒdmY3og ߢTqꞟbz\ެVwk1\;chb?u-#[{, m˷G>it)ӕB+ Ş/_?=G++>[3{b}<y~yy#Zآf"$­mBWbg0QQγR֍ں $pKNe c\OӘ)-mmL!Z0i`z/gOJzeY *if"_ <% &/{eqr~ÇEϹEO"z瑱z6P8qǷEV(h6#)=>ޮ׷>vS&d=usޞ6ѯ722TO̱Be//Q'Չ! .8=gm) FsSE*x*mz ,4֒'|b֕V]p̙E6Reqt;j~A^Hrc>2@V&\aŽ܍F |:IyJ!k篩.ZXÇs+;4tVݧ g@NBNkovnyn}>تk>F~xY-ww/vMb)$|B+-,ʅ7[|q}`#Ϧ3̡́P>Ȓ~Te/ް12JޅB?O_V4aaPSTGw7#yTjo5ﱼ =k_v'էiGaXREB2mPȅiuUUQ#Y\4MNpWkM&ufG tߠ$m] xyM~^,zUa\8V ?yZM:`COkgS?=n_>-jދ뗱!g{!>гv]rˍ Uhy$ju[褵O|ne|*,&$^b܈8DAà .9ʠ BଟTBWhvf%A=cu]3aUS&T ,/į낧zK}_gd.-stD~Af>M xO+S<]hjP @enuOĥm?=g㏷vY[1ڇU\ޭ-)Ey~is鯿~NCzyX!՝bL.p+|vg>5:SS%%a_pw(+R˔؎ ]i},% ~b >E)3`+1M !T%p7^X{ [/Ծ 9`9?kix 1"xDUlmRH-Z.P -m6qVs4xI^yl\EГ!S/]wY>?u!LqYZA1.z{mh~˗J *FJ '=>mu1P6ɐc;JO/>L"G-4&j{V~Ӆ,k67!v %rUOǺ]vv_?ߐ!WJyPO+W_Pplsy !7<2xD (8*^(qDdS[za`uςޞ8#Zg W^=X WrV>vީ kUy뼃jsH"EdYh_ރO|n3K8ϡKԏKBX5gX?{.B *Z0.>?~[ߎӝJyIGJ= PZZ|bΩ &X|j15?hUz [R҄]bvw"m8H} By(|Y^O' R̓4 Y-jDYr%quǧm aIR Bvbqk#Oɣex꒓O ̚7I$܄6?]K}V:sϫ7lAh(xJZ_/1Ɠ7(wPRzB+ IVCҢcoZ80.ڣe]ϸi5XϪD.;q0??羌e)'n:/_TWTA ).XS YS _;뙊 ȳCA|jE7w;ф??<LuZi otk?'{=+~ ,/[I`aEYnc:' 㛂 H|z#XPc8]s 4#MMB!9ZDRܤ@ Cl~XA.9q `Y}|I)u3Ğ]׷bj}?~MˇN˟eQMc] hx1_u-_Q^ ԙDu+$1TLdVZjt(C"RTm [[UH̙O(oSpawݲȤz^.0&]"5f6zY5&^Qs]ӚLG|:|n#=)Yo~1?jm8v8qE5O~)ޱ|X;1kw}g`>,/.7Ǐws<$RW{-f릆wP>?EoV/%Eh~K ˛pU9 >eT b>6F^L ZAF(YIAZ! 71< Ҷ0=bҶ ^|!Ҫ r=_ڐv@%6yuf{@W{5[hpȬlV̫FXPQO,ݐyA*on1t2'C 5f<[[Sr ։L篡nip`aer/m<Ec~ڴ=,RsH@24j MʂM=٩< V𨀃Is_T|74_. 7BP 2I5׺֢B=if=g#^kiQ8 TbX _m D_zㆡёùiڃ?;'5>nb˙*KbCfPSO|7Qg.{# 5Z&6Qt-uGFٴY+mv`8 yR@KDS{ӟe(a+f"{ @58cm;(/N?{=??uD[gfibϟ߻§UU?'Rbho6T[d!wǟ;p|(wZZ\GE*ַ͘L!SX4e9/]!ץ?T_N⃩|ґˆr|>/XϬ'B@I8: 3o_?4r`o*|6sLCۙ>4K~cj|aM `]= SL9Ԁ6hYIxBt:O~|+gr(Dbe-M&OdqqX,? mU2XK6xN"QR3\W%Ji}I {U!#ktYu^gϲJxB?(EV$g}lѡO>j&'_=㏞OގkX:R"j2X}uA 2x0 <ˁ)OS90գƥPA&^O1l"aܗ\NOhtVgX4 \<5ϜW" T5m;9j3i)YT PԨoX1#Ok+UW7]Q]<௒}cu%+a9m;@mpx.]img;~.0yιkm[r~ڢ3b L{Y *d#vZ<~smed<Fk*)p+i`ќ,j~yN?>ѰIR=zw׏3-k)DQtm}Լ*D8~ ! 5k>t.q|" &Oy;4ҋY1}JMKު2w) Mm 3ys0xO1m܂ߗ#f=>uϨx&!L i[="ZO)T3vB(EЧ? qcGx6эڶ V#%?0D?W 4] @` 4#["'wmrn2abagl?t j(x:Ώ6yv_>?,O!v' 4XOE {zGN+M0|#! 7pK&6MC$v'tc4 ]XH3t[rR䶚x r1KؼlAU&+kz 8Mü{U >6W@WyRGo/N_RlR0:ƸnM5rƸ)_GVK]vӈ"yi&y:Pzy]*,MZpel};wq>sPew'wssOn'ċO<:&P+g|x{&=׬XYy#kZRjjF6 ]@T!5T3o:Ku͌8|Q77\˶VI~pfئoJ{'E{S C#Lo? ;8m;l+s!:ugs ozper :Iu6(=nTfOf4;V(/iRw?wi{駧r) j&o?G]9hi.j|I;H3웟x~VֈTukpg"ԹõY/p[|I z4+#K"m+ǂ'r/ ?Uey.ωTP>.\vrLL,*CG ?]EmY޽{! 3L6_ZՌwR -ީ8 6C&To p Uj"R{AhUpy4nU|1Im؇2xVw"Y סE;6M=$d;['c6C+0`>MZɼuԳ D3lmtgvٌϬ[Q>S l6&׍<&R;ʐ攂Cb, ""OO7"O/a@p-ٝAyV(Ҷ0@ ozJxEOH(|dm.'ei uҶᕐQ0cSSxƼn}2c"Ov>ZHo|sX~Hly(cKzBpO,RCA%G&PiQ Ĺ9)@MJ8t,lmPd)7B[O=ѱ=&GoPy^ƶk)\]Lۂ|W ˶9ҾuT3#OQ# CDW4rŚ'ɃgpXRe?ݛLb [Vy̩_ƶmyNLΪYYU8& U[foSMOoًfpw0'l8`v88F 2y*epL\4D2hbVA_MlsO%/bXȏR6c` x,H3.,~lu9 * \[i.*& Ro >ɑ'JAm+0I$!3pC+x Eٶ3Ggs)ayZږyY<,KlBNPy"­NPO&'xWT o_LVS>m9jw- ?< g]v@mɠgf36u @sԐU+L#m5L˅Sq̭ bZLe=ah5K"O5=K+G$5ZH~%,C-Qk1Ƃezq֚{gADvVL ǻJn;d+'ǃ2h%`9 X i*?glV2I\T8D[BE*Bx Ʊ:2# U!6 T" {Md,8<ҶuxTMV OUOyQ^WoIrFC?%M eyhȄh&PCG(cp&Ato*ᦵz hdq`q})i\ Lyzoإbc]yF"B%/.fҶxu]ۤmQRCZU'gq Kc cﬨ:2myUtvaS]XRSH>8EXhH7"D1-ɩN<%dmń! <}mm `A 5O2WZ97w:ɫҫQ$wK5:#@P& oIl|X͓J)a#+Ifyߪmg'Mk3YZ}Q@UsɽQ aH\ˏ]E3fUdҶ%ꬡY72K' |*c(OO5+ʋr(@B/J=5 GodE\0#*\z;7(ו)9C`L,#g]`{Z@Mk6΍z 5vvk3ZFw`7x?jhښirat ݙ5Je+SX dJoόoeY5n4:ۿ3VcQu~$^EP=D dk[y&{`1~+o3B X#o4$pt@{Uҍ+!h Z{N'n]E '|V`z2UT9R˜װ8Yݳd6`UCq# iS%Cϸdi>ՀL4{W{{lSVVU`$unkS[uwsfv .R[c;Qo6\YU>qD;YG^\Z(׊T03 DHf(U4sEE9q-Cf6P#7"FjAgE v4kFDUey9Rnk2A-\49*XD >OC80 #D,UXe8M>ͫe" r`C:AO`Ϋ%je^% ĮPQgIGHCcqVILV4u(Sٔ͘3S?`7ȷ< < b^qrrG6@.50y6ä-%T"xR}#SmR cL,]Hj6Q p|{1J ͥ9YJȓŘ <#)jse<0 12e4l䩋MAiIAqp1s^¨40T SjEgWJ *mH1BRIT`xr&jO͋!s{Sq(] m5ٶD<ˤ0l[S)jE(]CP`DLiBwdێ|At HwN6~.+E :] )-8YASN)Ir*]ddA?mĤZp]3m^'\+ ']J=,m;s^<}5pf*JV&9m[Ly߆y" [$Va2X1|,]BBX /^uU@x彜BmK* 3 5m[V"o(jԪH++85V1ݯQSc)KWoJB{3 Hg'U>ʹ;YtY%_~ ?my*px{Xj"Mzd8@ǒpGM4X힭j,U&%y0缨m;ζ™r:rp(̒o @q'u 0՟fwHۚQ'L aԇ8Vn x$2$L-ROu^g CQjU||;Gت"'YmlMT( WzdҶ|#̽,m籬9 C0*m;<2* US# E^xUC+Sm[V2@kv-%*dZK mk S=> RodYO@Q .(V$)H4QȤE9 <{M;' 67Sd. ƂMTX77 Ɗ 9X& 2}P0LQv"OҹYWt4O:7TpM40Z7K@Tosgsq/O;sփ:yUF4$現^p8aڄ2)wfŗGǤu]Տnޮ降> ej0/ yMemrpaH@3a26h rT>T' ;e/<@jFZKzY@f''St' a;U$O|lj}nIoI*~.'%Ŋ^Ҟ-PnӃrhHD6`Pbb?Me2:'v>B-OMh~x:·p[?m~lfO ^zv I&V!)6cqMI 5Hm& 䒞 I^Ae0c@3S%8$St)술2Tp9X&3ӟr{7}/O>D3BCѤA~O2-$IWgnQeR$-z0*}Y)6fupY"q8Ђp>;&/?v|X ǏF(0n{_> uA%rP.g̻EvmTjڡQҝ#v?Q$`G;QL!#3I[/kô<$D^ObojYE4Elj;'ajZdAHʽEyb35cƅg<}v)xٕu F-[!dBy˿WZ/c,,SC)zJC) ]S2  ԨRs =M^Jkʺ5R+'K$ ureV(ה \=!"[eٲFH%i9r{|Ɨ7!8ϊ oڪ o<Jvxr()˫Ծva_%,M@KFoɀw%C~&ߠYē,}=} < xjW2J[څ<9XU)4P%c‹ɂg '8K@!BlMv_,UO:U(-< UOgj:etL!Ds0xi „PIRajOG9w9<1O8.ȓ Syi[SrT#gsl[ m;BcxΈ|H4hiPӪRQE#a+K۾&/'52K'hr2xvʏ.ጨ_Ԥi[`ZUtqyQQVeۀ'k?rhOS_+mK !IQ*{'ۖ&_Z'EN+;7;7.{:ĵgY,T1>k-r _ Ŵm 7~Or؋v0A`j S\mIif"3}yPi1mEF*p;5U2jr.urVKT`TH󒥻cڭ2%or1UzqQj@^I7]#4 5K.+f(1RGa~fTX?<_FlcC&qK\f_[$ Ѱ5DY+ aU$xbWBp `I"z>l:3Z>=pLa^~>>>m-6]5ZR-vvÉaiӛXCaCҙJ$z!8("Tꇟ&/qvk%A`4yBug*}2Iٔ,s lq0!/v8V?E] n>c~ee87$^ݘ硋3F!shorFZ_QY27FG)D>ܭ$P*Eqbfyk_7)_t"Nx|l6vm6/-;bd!z/ v.(nt# k@K%iŹ Ğ;9t<+e133Sn0=3*(3cx4|@@L aN)b \t֭6a8\^eW z"М\,AU= )`J̳ŨlYؽ\C 8KVr|o}=ՃE3̪B*vj~ect8R7탈x wJeyH@|CgsK'\1zTYSqй@ ,Rx~E0ٜBFߖfdOpO5Ur_"Fz-P1+:r .y>4 ;W%7gw}t4^*Fu6& jyy|8Rx*x{SUKiIWtA| u<:6,;ZD;,0Ʈ"bx xep D\.=ܭ׷nYV7˅m7x"-VS7m,ǎgbzGh](*V+</%\SM<t jpS^P[udڡ߅ ozz- IM-#ͭ4gFmv:Zy84-ϝ|᯿Ӹ}ǀ=w~\`}<%9dj,l1өB$áw(!yʫܡ%!˛.Yv9C { s+XGZ-E5QCo8R/y 2_7#ʱc<'N#O?/ЅqwI^Pj&2;j۪mf(rdK-w5e5> ="j?dCMnkqwtw8;|P>O"F/c.yvT^iqU2?oOp^+'/\6婐6MyZp]aBcq(}{ql|LDfSKL&)sTďE<6Grx3R!D԰;(iw. xV#3@jz2LNvhz.xCxpָàK@߀5[Ͽnn cHN \t֮_w4 ;LEuLr< /j<$-'+Oyg10Xhl^razx̓^zkHq7q4tOrtnŝΝӉSJKxK<`PķŦ<Ę;7GTdҙY~k*]L\"ޞVE (Ptw-U+2q: -OL.B8zG`Lֆ+jn>/UiaV:A_I֔ M +b|CYkڿ - .lK=yte5koߛCn*ۡz>bG:J؉ y}NݪE|bN_Y=#udM1QĒA ^KuaPVۉ )%UjYaiI,v%0F/6O.HIơbR} 9Y4mRy.fCJ\-R-%bYUVt5Do,^1kYN+*)㛁40# (㶮's# Q€|J*u 9Nҭ#G7װyzQ#8:-Z2U N>Eb^@tܡ=TBTUT]Ak4 [.ucWl˭vNLj,ZPY\a^tdkct 7 rμF/NLRm 0ن\9 kކVLlK܂wh4 T,/kQJdIloo-EҶj԰.}{D-U-5QQ(l5 -ƀ)TMAx$ nZ `LB =̦ Ӷ1)+LvUùwZ'-FI%u+c5O 檶=fs Yoꎍbmwd+V2QH?nnV7K'3YY?sk`Bv&'"nCۻw0nitp"ߎ3*O8{r>o}/6X/_j/9^ \ؗ#h7جmf9iHMs.<%i ]!Hi[?"+ j<hn5"`Ҷmy->Dg=02~A95 3)VjO- *3: Ŭ/fb*A,z5O,و݂S`ecL=糅հT5C7\γϣ@x}4.$Y${ycef4:MA(Z]RI'ap|y[dziS "۹.r}rWlgV3Ȩc -ȽҶj@Ys^O>O e+M~2]b SSW7&bi[Syr;ԟq<24C8- U6 ͺĶmrΛ\x9qW`3d#O͛:#tu>ȬY)cȜj32`33u?/힂gǶuqBeDžyYM\_J!)bV-xI35l oB hg! )C&>z-{,Q}ak|ⓛW3 oS0ϳ%2ӞS7V KZ3G{El9+l6 HρVX Py^ <=bhY<x6c ЈmS|i[7̜՚(BPqD)ޔ ß, WK߻L]:Cj/ Kd'b /3l莤Y89LY:!vٚc5´IBij]7;v*xqk]{uA"-6\VWL?.0瓍ك'=m4|< [+Kow;΅`텶f4xz|H20 NP#2uaaN),J$~]<$)qyƔ+hW>x&K ܖG =@Ư/36CU@tBo-г H:xWEW"Od=Z Q&Z1 *v캞h05zHwpf fw N3W8ɕ=k) ސweل?25U<]Oۻ]u7H ߛtD~ڶ.4gc.lxs8yM vݬ۵qĸn[)EN羋-@҂goS+Q#:rCl؄ȋ'(MC%g{l;ujiRnou›J3NIް)2' %QOBgfф :pQ %ޚt\ڶ36r9 :qw*+6_;aUѲS増e݇Ⳍuvc;1cs{ź:#6QIs>O)D!ez1tV.uÀjSk`彫/tPvY3 |r5Wqq?qܡgO<;?䝍\n;;ۗn8xrJ9lhܨPԥ^&m+CaOSWM[N ulB1=ey@' 1ZKxDG ICAVC&EEy0{&E ӶjЎdNwvޮj0OM<\LZ#w@emPFJ=.uxvמY!D6| K5eds` U<ilOI"]~;Ry Le-<r,@E.%@ - -NVc{F Û-iv!&lj@*&V.X~%g-m :I,x ;(A<%gZIԔxy0uxrǁReyTdS!JLںD tqKɘFZrCSa\ڶ3*S)<<`og}-CP| uT)'hEfN]G+][7ȃN<td%c@]2G8~<Y%i[ tVd Yw[<yj'5y:w#xr'2A. _ϛl`nZ1Bǿ摖]mNP&aNOr˗^hXHHM߲ySr=-/^gls({l3;-WA;khvut8E_yy%F)<,Ka窢x< #EG-x'DYmCT׃'UkR),`%a x.@_zg3/"a81oV=LEE_%E%ȓ|>:jg)7>PusIy ݠ_<ĂWC}X/{Mn?ܢ+_|td5 '9o2G3-M.3 #It[&;ş;X ;}gc; Aee&P!K˸.vꚡHٝZ,6*Lw^9c(<K+LxL 滪L4aєj7;'6VTq,WLmZm]8đX[[6 x"3l;wW0fٝ6qIHhce]s`F%9# tk8s I't02 $`޽3ª%@Bf֭XU\PkrՆU/;EHRR.K՘>T):wKD͟eWvl#ЫcWU:omInZο.ʚU.r,2aܹqRM`"Wg9\G1*q#3U:UGp<ϝӢQApicUp]CpĊ(jнOfmτm{h3fu=W]^~doRtA0w~Zt 7 IC統3%e>;EgЃ|oUn=$7&dMcC_|ܩ)* XC59O>ӶSx@^?V%Y'x\v^rGz~a*\gpf'R7v=ޭSc+ϱ2*q;[j2?9IhIa lV#$Cb ̛ʁDb~ n0 u8T{!HeNl.I <},}DŽ5Ɩ=m{I P҂f6*Pn0p͹8(a7/y?yPJZ列e*vejF/w\'1oӫՎM۪. ߘ/5g+Ãx%ҶehdA lk1Xr 9y6&KCJ/Y]a~Ӱ[}Rnz P314ɚS  D@\S.1u!m5PRz'Wϔ10W4`;c4Ir( 4:jDMȴJ9x: GP.9sCC)F5XkcX$ZrH*[\,IFh\t R_,ͅA~Uy[z-_LqP q=8Oyy6oNTuݥK73z" T` g|V6Yx%Q6m YNu1CH'*P@C9m[<|tPb/ FvhCF x6 nnwƞ݆&l\7p{ߋ>9Bwp"myqPy";sg-3s'*4TX"9xքTgN N mIB[I>M!x~3 4qQ.kn3G0& E YD0!b Pz.-a ٠ؚ') 2<)ΰUi\0=ֻo aUFFu<Ή§uo;bVm}J&ԁsYo;QT٥h\Z9Hu*S{bm/*3K1}wj%ErsOǁl.ct.g4 CK:: {PB; zQi 4ٽj:N#uic7jƜI"Ok]ϫtz@f>Yj`S _xdTmC9*;RϞ䂛(!9p aٶPG % 1e,_6闿z2)\M]SB" 1보J IUo:m/m;'ıy%l-#AÁgI]g.X"%u]܃'yhc1ӃK>``]Qx.# [i㭽RPǶ=LHvſ"uL3$b5鋉,RX9{&8=wXD (3~9:W$l`ʡdi#M<ݰYbZ7+egˇey# )T1mR.BI.4.%kՃ_:9V<ۣgvs|YC-e g3{˞p3H3U4d;3k3 AP=Q ΎLIvٮJH^\wNWM=+-۸^ݸ :_{۩Lc67ÖB^>>/'-Zڿ~ )Stx"7(]hY=> Ⱉφr}ܝ0(tJع ,>2B1[v=Ii YzG:F[.gDRo_at|yXOvY 7_;cLۚz8)E^Y4ԭjd^uis&]bO:(2 RKg!pMC:yT)רfHӬ4WOwNm鞎Z~t)xƷoOMCk-9|i$afg9ov9/ t< yc|ʇc~/, :áP5C3L ­*<;ax ۆ ;7b&?O )<ɧ Mmx|[o6/kzn`û.IY)<2F .x>&V~ʥgp~XbRree` Lm٬J YF5i4N%poLD-xlv΀'TSc9<L<Fc* tSЌRc cCJk%XExn+j* [Ld7&'xRZ8*Wlr;es0+ n| ž?҉GTtx&x)'xf$k! f $TU=Lq:m[}d.rU%㼹W1lԁ(  N]? F Wv2-xb{K9i3O\oOQ&SZ!NQ|v xo^r^&'DRSiLo&P-K Dpl6S*iHhY 5<}'"N ފ[)bi<nEPBπ- Hi| !<mAw*- KuGǡĭύ.v^~k Zp ElOwfuϻE'V$'W(ذDmFMQau.ۗ]a qo^fʋf,\i\PzbfdOZ|TT9C$=~i&tU(IHς' N$O#>SY\[(PɳII}x MϠpl[T3d\*j]lo&iXm 76~*1f$&s_y#OSZZP.V3<{PB6;Zi߾,0 %Ύр˒Xm)qǂ\-3Uk۪y>S6]d9{"; #xQa 0ڮq1prݟӿ?;MHt~AM-]%˻LC+s 337 A]*}8LH<pzJj]͛VmcN{mE% ENN ^hyos 4GpE1aqi#ۡM[H=#4d9q˻rm+] MlwDQɽw`czC49ƛ̏{(@]}J <Ը3\ҡ'_o>-H@ӡhD(:G>}zJL&jI+̨pTMOۮTI(ӶcсH_=pʲx{suy8 B ǐzUZU*O<}\<Ӡ@q^R*[L!ec{tl[ϊ嬼"]TM'E^!E5O`bgwF=[<ðAbn^ -Swrq;bm?KB·͉rB:Hj(aBU<P\#M'ϸ:ʐ]ܥ!ŝIw]ݿss%3k ϗE&'J$`@a6S e*VO=`o "x6d+wsy}:z6}}%)aPs t`EyFF*I{+gv0vkU֭YUƶ@ƪ(a|>P7Q҇Lw; JfBD ЈOʜ0<<,'>5 '7ډ]*gصzq8p5όfzT&m#x-&hj" %yV8/4jC='NUe^ϑQ )gߕؤ%=SLOZAהI\ ' D2&~f6 ojXVb=jޞRC;7;t'uZ]OR>>) %ؗa"ABnn׫iOa$qkFB 6rЉ6Vve{Nu d!m"pf0T Γ[4o6Ly`sgnfpY=fPt?+Nl*V+943+|þ4j1:鼄egjA(N6TXoW r V(BߌX@r۵HJVwP9гCm8/U·Q(\0?k|5]S=\^T pixGm?wwly%v< ޒ,XMJx*>1OMޢm/.Ժ;ٌ3 TDTh 2-OX5):x8#4ɁgR"p)rZ[dF / ہKT[x>bc]>1n  7-llC->HeH7B ˰<0vy'Saxpki\ueV>?=-|P,Q1qxxek# wɝ;HT\KO̢Dl:ǀQZ'\ʀ`ԋ3&jvP| Hz}t$؀oUy ]i[k{ p1Ocps-նbFV,\O B9@EB164,m*py 4:*q]h"Z_J8!;Z΍tI^xOI7\ +BX}r稡 arxgdrv>'~'°6=z5fmőz>_F\eD@(ӈn?qP Ry?ZmS g+*hMlRSTטjRX\;6{GTF@O2)L'fw=84m LI`2XM l$Tɮ.wV|ν*wS*xƻ6o_$\8u=SAyQ ʊ)tJ-yVZ7x}8@vʆrI!xCXMyoܗOI 5OS~&<.+@Ff*UQzJi):H!Sz HMBN 0<+JfGD~.dgSݺ,P<*0JGӶSvZZO3-vnOWxqh 9yai&h ˭YFyרr,}c:>)+]4N^4U.3'ʅׁtkG"0*ztWRt9ݏH| ]"rc_>p s eQB4W=r@wR֑Ǣ?n5As %ov ȨQ%$Cc^"|aylhٵ@&'m$goFE5wn JV)sF4oF,pcZB ,ɸygNrkyVE~eUЗ_DK{F!Em+:EC4EX@|=]!MkZ캐խg&g&~B8QnځB4R(Z)B`Ft^tps׆}x g$EΎ[K%25aB|'=H-H@<=rTSdq`5ɂϜBd$ҢsUxLGXd1ucMOρ plBC +D:>$>x7Kr|fz6BYrrSӶy+T yWS=Sv Uf(jepB1JSNlN>t"}pAЪמerk E[;Zm=c"x8s2m9YHW*@ &dIn Y7 ;`(xRdo#BqMҀy#kLO(|xBU6E.VQ5(9<<. CH5}y f5>\(h!"YlLXݚ<.b %R}lbgj~ۓ??:k%3lcе jBm۵нZGOϣ\z%2-ynjS!ûHƃ(D&h7!SEҞߪscph#6AqM QBReIj`䩇g?һ`ݿbv(x4ǭsHVn@fh,y pyE\DG!BP} x<.f*$ L% 13Tx8]ͺDHTX,ﶏO{0\:9ܟZ|Y-) k,eRN$"Ohg#9^ͯ\S,i[,a#6OK}]7ġajHOd`[i[-2$u13s<5Rj+YfvգIҕqgےi[`Ҷȳ)Eo4(m;8<=wpݒˢ̼*NxCt#@E=p;g{1iB t|)#'-85)'xRϔ@< BCi/]IHƵSIScUMPq"qmaaq<3ժ8,hbq} ʺ)LG؅3-H:W&Av-2TCbHx 1]J{*g8D-+!Fm9D"⚢'>g^6 7"B*N(0}xiwȠϋh(0a'y* U͑$)UbSOF͢anٽ Rl3*;؍;ǞPq.t. xt` O^525gULIJX\|ג@?x< "dӶ gr{ZpTtpl a-,pC9mD PjEì[S]ⱓNu]Xm(dF C󮌛?6 _c'Ę99{or?dӶ䧇]59gyjT@wJੲz) uMr24<)@hW _SBO<\;,=bqbm[;/O9w/ks_$7"CL˽;]z;]bQދBgia6Vz-BĒ9J !2\$ExUwY|'o7IMc%o vw>i|,VM^D|Q *ͯM榰dZҺPK*|ʺ, //%snyksn*Wݪ֡9{sL]̙QLDѼ8@#f(. Db ~FdILfJ%ݸ$she >ƒ!J*v%#/}o eC&cOj4(7A%gqN\ySvugnzJqKT-7q#o-|[gL4gvaLG4Ȳ]Bp40$<RYF,"HNMW<͑Q@EF{OV3%.3L]e8(M =xO(l4w'П`K_\!kl'zɨ©.r=pf|X @ڇR.a`Vؽv钻5 9A޻ZRBo/$ߋ~; 9`[/e-H־ʅOaMviՒ%f(F^,Fḏ/6.}yY߭nPЩ r.R%YPGj0N x_j'$ $=PC:I8 $:*׏TcDv{/3 DisRQ &uȅ{[^ըV2{ ‹X"7씳s㡳N9˭\Ą uhMbYp*Ah16cƝs&=϶.kfbKC6]=ܭ׷/oQW-l2& A$EъeZ%0 4r hI? T2 o9Qف^_'ft>׬J=Ҹm"TsL0DX(Oxsl^F^l%QS2Ȅ`܋jp8 "@H_xP314D6R~" B3R !JR Skiv\Wk5OYJzi[>#]R0_Vg[DC›JQpԲdD9fܔ)Қkyඥen'ق@'H9K0)tpQU.hnX& hѸ[^|m"FP7%@':*lmMDQy'q>m~8 ܿfPy+fwy1ʵ&H&qXjӍ»]2xr @q[s'%sEh֤ r<0Ca3us:~=ic +_wg51r<xΖL+98;b"oVNUmHPyT\8fx҃oy2X5/_ZazܰS-,\ Y#k_,@ݘTX"&dlsIrOG22gj[(]1b؂ (+x>nG' Xtx$Ab7ݤG,%s4VHbbvW8;@~z%[ݎ;@czx>~*Ԥ\ʦGZET\yC0+eQ9*#Sѫ-8YDG#S{=<ծ'>s/ﳣ8j /dSxꖎ\,?kY UO4'Z[+b.(]%F̏CSOng= ԕ= ͫWMYv-1XðM[/ۃmC NAUʧ 4] R4:VZwp]Ztj" >jk&ެÁ:&0j/Ɠ: =Υ-~f3:< 2[mw) *."1>]SlT D9L,* ^N !7˝݂@HU/$%kF'tA:r'ӿgg|4x. nһEӅvn$Ĺ+{#i^_j"Ҹ}iLN9{%F+ۉk`Q uǫ,!LhDq3dko Onަ8wv݅$Wy;"ɤzA[\312Rc<i(JotHO(O վ?t lA6XdwY[+\~kWܴ v-QLmGW 'a{k7FΟ,tUbIDATaod+OadR;(0Xy1wE-x9Z/nVt HntjNc4ɓXYYxḶ*O;r[t=c}agV/MhߥׂC`BTG&lmޕ۲+@0d$'? "_V R}'Sb.hdd?/<1qh؉=hӡ:NYb65}H)Q9 2XY0m{#B٢x"~neֿeOa2߀-\䂖%NZ[w5C̟0sZ^<9 ˧irC 3CK]BD;CLOb`l퀅+OO=J6[~gLRDrZ=|n.N[7ڜ@bt*3euuӶEa7}X Ǡ .mڹ6(|T_'ŕg & Ystǹg| 7BK2V7O&7_LK$C{9:Q>u B %Ԡ^O{1qx5#Cv#* wlD@OXj硶(gWMKV#*%~y0Gbe 1JZxѫ)hxU3f9dZ]t= GR#2xfӕҼ9zZA;VQuJ"pL, :h XQ-q N)0rzVEI֨04a:ƦZ%#8€-o9^~x(腆PRk W>Qb=<O ܳ3J3xfk{9i t_-sSyy7x? X%Ml8^lpv[wysО U֚PZDלw}9iT4xWVS{' ~ɯ'XOqRmIݮ<9Ov@=*޵#bb&,'2Ѐ?q딇2{g+^gGltr}bG-iM1r_gm1h[ui-{bD -ps x^UYg*xJ!TGj]~اYUXSb7sZ''WsUϽ "x`h;ڥm7@_歞'A=-xQP.œ'*\ )lu C)&)m6yI 3՞guRp OK:50s'I?g7b*m]n0C^RJ۞)›kkg-\m>7Q$sWΡTkǁh[@{ עT"xKAoǡpS)!W5@iwِ ݺZ)'!D<9z7ng0&[P)-xzi}u|9=&x!9+x\m{kZV;8~.` j_i=>FȜs93k W:stɋ'x+[ؓ KIENDB`\ Copyright (c) 1999 Daniel C. Sobral \ Copyright (c) 2011-2015 Devin Teske \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. \ \ $FreeBSD$ only forth definitions include /boot/forth/support.4th include /boot/forth/color.4th include /boot/forth/delay.4th include /boot/forth/check-password.4th efi? [if] include /boot/forth/efi.4th [then] only forth definitions : bootmsg ( -- ) loader_color? dup ( -- bool bool ) if 7 fg 4 bg then ." Booting..." if me then cr ; : try-menu-unset \ menu-unset may not be present s" beastie_disable" getenv dup -1 <> if s" YES" compare-insensitive 0= if exit then else drop then s" menu-unset" sfind if execute else drop then s" menusets-unset" sfind if execute else drop then ; only forth also support-functions also builtins definitions \ the boot-args was parsed to individual options while loaded \ now compose boot-args, so the boot can set kernel arguments \ note the command line switched for boot command will cause \ environment variable boot-args to be ignored \ There are 2 larger strings, acpi-user-options and existing boot-args \ other switches are 1 byte each, so allocate boot-args+acpi + extra bytes \ for rest. Be sure to review this, if more options are to be added into \ environment. : set-boot-args { | addr len baddr blen aaddr alen -- } s" boot-args" getenv dup -1 <> if to blen to baddr else drop then s" acpi-user-options" getenv dup -1 <> if to alen to aaddr else drop then \ allocate temporary space. max is: \ 8 kernel switches \ 26 for acpi, so use 40 for safety blen alen 40 + + allocate abort" out of memory" to addr \ boot-addr may have file name before options, copy it to addr baddr 0<> if baddr c@ [char] - <> if baddr blen [char] - strchr ( addr len ) dup 0= if \ no options, copy all 2drop baddr addr blen move blen to len 0 to blen 0 to baddr else ( addr len ) dup blen swap - to len ( addr len ) to blen ( addr ) baddr addr len move ( addr ) to baddr \ baddr points now to first option then then then \ now add kernel switches len 0<> if bl addr len + c! len 1+ to len then [char] - addr len + c! len 1+ to len s" boot_single" getenv dup -1 <> if s" YES" compare-insensitive 0= if [char] s addr len + c! len 1+ to len then else drop then s" boot_verbose" getenv dup -1 <> if s" YES" compare-insensitive 0= if [char] v addr len + c! len 1+ to len then else drop then s" boot_kmdb" getenv dup -1 <> if s" YES" compare-insensitive 0= if [char] k addr len + c! len 1+ to len then else drop then s" boot_drop_into_kmdb" getenv dup -1 <> if s" YES" compare-insensitive 0= if [char] d addr len + c! len 1+ to len then else drop then s" boot_reconfigure" getenv dup -1 <> if s" YES" compare-insensitive 0= if [char] r addr len + c! len 1+ to len then else drop then s" boot_ask" getenv dup -1 <> if s" YES" compare-insensitive 0= if [char] a addr len + c! len 1+ to len then else drop then s" boot_noncluster" getenv dup -1 <> if s" YES" compare-insensitive 0= if [char] x addr len + c! len 1+ to len then else drop then \ now add remining boot args if blen != 0. \ baddr[0] is '-', if baddr[1] != 'B' append to addr, \ otherwise add space then copy blen 0<> if baddr 1+ c@ [char] B = if addr len + 1- c@ [char] - = if \ if addr[len -1] == '-' baddr 1+ to baddr blen 1- to blen else bl addr len + c! len 1+ to len then else baddr 1+ to baddr blen 1- to blen then baddr addr len + blen move len blen + to len 0 to baddr 0 to blen then \ last part - add acpi. alen 0<> if addr len + 1- c@ [char] - <> if bl addr len + c! len 1+ to len [char] - addr len + c! len 1+ to len then s" B acpi-user-options=" dup -rot ( len addr len ) addr len + swap move ( len ) len + to len aaddr addr len + alen move len alen + to len then \ check for left over '-' addr len 1- + c@ [char] - = if len 1- to len \ but now we may also have left over ' ' len if ( len <> 0 ) addr len 1- + c@ bl = if len 1- to len then then then \ if len != 0, set boot-args len 0<> if addr len s" boot-args" setenv then addr free drop ; : boot 0= if ( interpreted ) get_arguments then set-boot-args \ Unload only if a path was passed. Paths start with / dup if >r over r> swap c@ [char] / = if 0 1 unload drop else s" kernelname" getenv? if ( a kernel has been loaded ) try-menu-unset bootmsg 1 boot exit then load_kernel_and_modules ?dup if exit then try-menu-unset bootmsg 0 1 boot exit then else s" kernelname" getenv? if ( a kernel has been loaded ) try-menu-unset bootmsg 1 boot exit then load_kernel_and_modules ?dup if exit then try-menu-unset bootmsg 0 1 boot exit then load_kernel_and_modules ?dup 0= if bootmsg 0 1 boot then ; \ ***** boot-conf \ \ Prepares to boot as specified by loaded configuration files. : boot-conf 0= if ( interpreted ) get_arguments then 0 1 unload drop load_kernel_and_modules ?dup 0= if 0 1 autoboot then ; also forth definitions previous builtin: boot builtin: boot-conf only forth definitions also support-functions \ \ in case the boot-args is set, parse it and extract following options: \ -a to boot_ask=YES \ -s to boot_single=YES \ -v to boot_verbose=YES \ -k to boot_kmdb=YES \ -d to boot_drop_into_kmdb=YES \ -r to boot_reconfigure=YES \ -x to boot_noncluster=YES \ -B acpi-user-options=X to acpi-user-options=X \ \ This is needed so that the menu can manage these options. Unfortunately, this \ also means that boot-args will override previously set options, but we have no \ way to control the processing order here. boot-args will be rebuilt at boot. \ \ NOTE: The best way to address the order is to *not* set any above options \ in boot-args. : parse-boot-args { | baddr blen -- } s" boot-args" getenv dup -1 = if drop exit then to blen to baddr baddr blen \ loop over all instances of switch blocks, starting with '-' begin [char] - strchr 2dup to blen to baddr dup 0<> while ( addr len ) \ points to - \ block for switch B. keep it on top of the stack for case \ the property list will get empty. over 1+ c@ [char] B = if 2dup \ save "-B ...." in case options is empty 2 - swap 2 + ( addr len len-2 addr+2 ) \ skip -B begin \ skip spaces dup c@ bl = while 1+ swap 1- swap repeat ( addr len len' addr' ) \ its 3 cases now: end of string, -switch, or option list over 0= if \ end of string, remove trailing -B 2drop ( addr len ) swap 0 swap c! \ store 0 at -B blen swap ( blen len ) - ( rem ) baddr swap ( addr rem ) dup 0= if s" boot-args" unsetenv 2drop exit then \ trailing space(s) begin over ( addr rem addr ) over + 1- ( addr rem addr+rem-1 ) c@ bl = while 1- swap ( rem-1 addr ) over ( rem-1 addr rem-1 ) over + ( rem-1 addr addr+rem-1 ) 0 swap c! swap repeat s" boot-args" setenv recurse \ restart exit then ( addr len len' addr' ) dup c@ [char] - = if \ it is switch. set to boot-args swap s" boot-args" setenv 2drop recurse \ restart exit then ( addr len len' addr' ) \ its options string "option1,option2,... -..." \ cut acpi-user-options=xxx and restart the parser \ or skip to next option block begin dup c@ dup 0<> swap bl <> and \ stop if space or 0 while dup 18 s" acpi-user-options=" compare 0= if \ matched ( addr len len' addr' ) \ addr' points to acpi options, find its end [',' or ' ' or 0 ] \ set it as acpi-user-options and move remaining to addr' 2dup ( addr len len' addr' len' addr' ) \ skip to next option in list \ loop to first , or bl or 0 begin dup c@ [char] , <> >r dup c@ bl <> >r dup c@ 0<> r> r> and and while 1+ swap 1- swap repeat ( addr len len' addr' len" addr" ) >r >r ( addr len len' addr' R: addr" len" ) over r@ - ( addr len len' addr' proplen R: addr" len" ) dup 5 + ( addr len len' addr' proplen proplen+5 ) allocate abort" out of memory" 0 s" set " strcat ( addr len len' addr' proplen caddr clen ) >r >r 2dup r> r> 2swap strcat ( addr len len' addr' proplen caddr clen ) 2dup + 0 swap c! \ terminate with 0 2dup evaluate drop free drop ( addr len len' addr' proplen R: addr" len" ) \ acpi-user-options is set, now move remaining string to its place. \ addr: -B, addr': acpi... addr": reminder swap ( addr len len' proplen addr' ) r> r> ( addr len len' proplen addr' len" addr" ) dup c@ [char] , = if \ skip , and move addr" to addr' 1+ swap 1- ( addr len len' proplen addr' addr" len" ) rot swap 1+ move ( addr len len' proplen ) else \ its bl or 0 ( addr len len' proplen addr' len" addr" ) \ for both bl and 0 we need to copy to addr'-1 to remove \ comma, then reset boot-args, and recurse will clear -B \ if there are no properties left. dup c@ 0= if 2drop ( addr len len' proplen addr' ) 1- 0 swap c! ( addr len len' proplen ) else >r >r ( addr len len' proplen addr' R: addr" len" ) 1- swap 1+ swap r> r> ( addr len len' proplen addr' len" addr" ) rot rot move ( addr len len' proplen ) then then 2swap 2drop ( len' proplen ) nip ( proplen ) baddr blen rot - s" boot-args" setenv recurse exit else ( addr len len' addr' ) \ not acpi option, skip to next option in list \ loop to first , or bl or 0 begin dup c@ [char] , <> >r dup c@ bl <> >r dup c@ 0<> r> r> and and while 1+ swap 1- swap repeat \ if its ',', skip over dup c@ [char] , = if 1+ swap 1- swap then then repeat ( addr len len' addr' ) \ this block is done, remove addr and len from stack 2swap 2drop swap then over c@ [char] - = if ( addr len ) 2dup 1- swap 1+ ( addr len len' addr' ) begin \ loop till ' ' or 0 dup c@ dup 0<> swap bl <> and while dup c@ [char] s = if s" set boot_single=YES" evaluate TRUE else dup c@ [char] v = if s" set boot_verbose=YES" evaluate TRUE else dup c@ [char] k = if s" set boot_kmdb=YES" evaluate TRUE else dup c@ [char] d = if s" set boot_drop_into_kmdb=YES" evaluate TRUE else dup c@ [char] r = if s" set boot_reconfigure=YES" evaluate TRUE else dup c@ [char] a = if s" set boot_ask=YES" evaluate TRUE else dup c@ [char] x = if s" set boot_noncluster=YES" evaluate TRUE then then then then then then then dup TRUE = if drop dup >r ( addr len len' addr' R: addr' ) 1+ swap 1- ( addr len addr'+1 len'-1 R: addr' ) r> swap move ( addr len ) 2drop baddr blen 1- \ check if we have space after '-', if so, drop '- ' swap dup 1+ c@ bl = if 2 + swap 2 - else swap then dup dup 0= swap 1 = or if \ empty or only '-' is left. 2drop s" boot-args" unsetenv exit else s" boot-args" setenv then recurse exit then 1+ swap 1- swap repeat 2swap 2drop dup c@ 0= if \ end of string 2drop exit else swap then then repeat 2drop ; \ ***** start \ \ Initializes support.4th global variables, sets loader_conf_files, \ processes conf files, and, if any one such file was successfully \ read to the end, loads kernel and modules. : start ( -- ) ( throws: abort & user-defined ) s" /boot/defaults/loader.conf" initialize include_bootenv include_conf_files include_transient \ If the user defined a post-initialize hook, call it now s" post-initialize" sfind if execute else drop then parse-boot-args \ Will *NOT* try to load kernel and modules if no configuration file \ was successfully loaded! any_conf_read? if s" loader_delay" getenv -1 = if load_xen_throw load_kernel load_modules else drop ." Loading Kernel and Modules (Ctrl-C to Abort)" cr s" also support-functions" evaluate s" set delay_command='load_xen_throw load_kernel load_modules'" evaluate s" set delay_showdots" evaluate delay_execute then then ; \ ***** initialize \ \ Overrides support.4th initialization word with one that does \ everything start one does, short of loading the kernel and \ modules. Returns a flag. : initialize ( -- flag ) s" /boot/defaults/loader.conf" initialize include_bootenv include_conf_files include_transient \ If the user defined a post-initialize hook, call it now s" post-initialize" sfind if execute else drop then parse-boot-args any_conf_read? ; \ ***** read-conf \ \ Read a configuration file, whose name was specified on the command \ line, if interpreted, or given on the stack, if compiled in. : (read-conf) ( addr len -- ) conf_files string= include_conf_files \ Will recurse on new loader_conf_files definitions ; : read-conf ( | addr len -- ) ( throws: abort & user-defined ) state @ if \ Compiling postpone (read-conf) else \ Interpreting bl parse (read-conf) then ; immediate \ show, enable, disable, toggle module loading. They all take module from \ the next word : set-module-flag ( module_addr val -- ) \ set and print flag over module.flag ! dup module.name strtype module.flag @ if ." will be loaded" else ." will not be loaded" then cr ; : enable-module find-module ?dup if true set-module-flag then ; : disable-module find-module ?dup if false set-module-flag then ; : toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ; \ ***** show-module \ \ Show loading information about a module. : show-module ( -- ) find-module ?dup if show-one-module then ; : set-module-path ( addr len -- ) find-module ?dup if module.loadname string= then ; \ Words to be used inside configuration files : retry false ; \ For use in load error commands : ignore true ; \ For use in load error commands \ Return to strict forth vocabulary : #type over - >r type r> spaces ; : .? 2 spaces 2swap 15 #type 2 spaces type cr ; : ? ['] ? execute s" boot-conf" s" load kernel and modules, then autoboot" .? s" read-conf" s" read a configuration file" .? s" enable-module" s" enable loading of a module" .? s" disable-module" s" disable loading of a module" .? s" toggle-module" s" toggle loading of a module" .? s" show-module" s" show module load data" .? s" try-include" s" try to load/interpret files" .? s" beadm" s" list or activate Boot Environments" .? ; : try-include ( -- ) \ see loader.4th(8) ['] include ( -- xt ) \ get the execution token of `include' catch ( xt -- exception# | 0 ) if \ failed LF parse ( c -- s-addr/u ) 2drop \ advance >in to EOL (drop data) \ ... prevents words unused by `include' from being interpreted then ; immediate \ interpret immediately for access to `source' (aka tib) include /boot/forth/beadm.4th only forth definitions # This is loader.conf - a file full of useful variables that you can # set to change the default load behavior of your system. You should # not edit this file! Put any overrides into one of the # loader_conf_files instead and you will be able to update these # defaults later without spamming your local configuration information. # # All arguments must be in double quotes. # ############################################################## ### Basic configuration options ############################ ############################################################## exec=".( Loading /boot/defaults/loader.conf ) cr" bootfile="/kernel/unix" # Kernel binary (absolute path) # boot-args="" # Flags to be passed to the kernel # default list of explicit config files. # the load order for config files is: # /boot/defaults/loader.conf, files listed in loader_conf_files, # config snippets in /boot/conf.d in lexicographical order # last is /boot/transient.conf # note the transient.conf is for automatic temporary options # managed by bootadm # /boot/conf.d is managed by bootadm and preferred directory for # custom options. loader_conf_files="/boot/loader.conf /boot/loader.conf.local" verbose_loading="NO" # Set to YES for verbose loader output ############################################################## ### Splash screen configuration ############################ ############################################################## # splash_bmp_load="NO" # Set this to YES for bmp splash screen! # splash_pcx_load="NO" # Set this to YES for pcx splash screen! # splash_txt_load="NO" # Set this to YES for TheDraw splash screen! # vesa_load="NO" # Set this to YES to load the vesa module # bitmap_load="NO" # Set this to YES if you want splash screen! # bitmap_name="splash.bmp" # Set this to the name of the file # bitmap_type="splash_image_data" # and place it on the module_path ############################################################## ### Loader settings ######################################## ############################################################## #loader_delay="3" # Delay in seconds before loading anything. # Default is unset and disabled (no delay). autoboot_delay="10" # Delay in seconds before autobooting, # set to -1 if you don't want user to be # allowed to interrupt autoboot process and # escape to the loader prompt, set to # "NO" to disable autobooting beastie_disable="NO" # Turn the beastie boot menu on and off loader_logo="none" # No small logo (Hammerhead uses brand PNG only) loader_brand="hammerhead" # Hammerhead/Zygaena brand console="text,ttya,ttyb,ttyc,ttyd" # A comma separated list of console(s) #currdev="disk1s1a" # Set the current device module_path="/kernel/" # Set the module search path #prompt="\\${interpret}" # Set the command prompt #root_disk_unit="0" # Force the root disk unit number #rootdev="disk1s1a" # Set the root filesystem #tftp.blksize="1428" # Set the RFC 2348 TFTP block size. # If the TFTP server does not support RFC 2348, # the block size is set to 512. If the value # is out of range ( < 8 || > 9008 ) an error is # returned. #twiddle_divisor="16" # >16 slows down the progress indicator; # <16 speeds up the progress indicator. ############################################################## ### boot archive ########################################### ############################################################## boot_archive_load="YES" # illumos will not boot without rootfs boot_archive_type="rootfs" boot_archive_name="/boot/boot_archive" boot_archive.hash_load="YES" boot_archive.hash_type="hash" boot_archive.hash_name="/boot/boot_archive.hash" ############################################################## ### Module loading syntax example ########################## ############################################################## #module_load="YES" # loads module "module" #module_name="realname" # uses "realname" instead of "module" #module_type="type" # passes "-t type" to load #module_flags="flags" # passes "flags" to the module #module_before="cmd" # executes "cmd" before loading the module #module_after="cmd" # executes "cmd" after loading the module #module_error="cmd" # executes "cmd" if load fails \ Loader.rc \ \ Includes additional commands include /boot/forth/loader.4th try-include /boot/loader.rc.local \ Reads and processes loader.conf variables \ NOTE: Change to `start' if you disable the below boot menu \ also note that initialize will leave flag in stack from any_conf_read? \ start initialize drop \ Tests for password -- executes autoboot first if a password was defined check-password \ Load in the boot menu include /boot/forth/beastie.4th \ Start the boot menu beastie-start \ Copyright (c) 2006-2015 Devin Teske \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. \ \ Copyright 2015 Toomas Soome \ Copyright 2019 Joyent, Inc. \ Copyright 2020 OmniOS Community Edition (OmniOSce) Association. marker task-menu-commands.4th include /boot/forth/menusets.4th only forth definitions variable osconsole_state variable acpi_state variable kmdb_state 0 osconsole_state ! 0 acpi_state ! 0 kmdb_state ! also menu-namespace also menu-command-helpers \ \ Boot \ : init_boot ( N -- N ) dup s" smartos" getenv? if s" set menu_keycode[N]=98" \ base command to execute else s" boot_single" getenv -1 <> if drop ( n n c-addr -- n n ) \ unused toggle_menuitem ( n n -- n n ) s" set menu_keycode[N]=115" \ base command to execute else s" set menu_keycode[N]=98" \ base command to execute then then 17 +c! \ replace 'N' with ASCII numeral evaluate ; \ \ Alternate Boot \ : init_altboot ( N -- N ) dup s" smartos" getenv? if s" set menu_keycode[N]=114" \ base command to execute else s" boot_single" getenv -1 <> if drop ( n c-addr -- n ) \ unused toggle_menuitem ( n -- n ) s" set menu_keycode[N]=109" \ base command to execute else s" set menu_keycode[N]=115" \ base command to execute then then 17 +c! \ replace 'N' with ASCII numeral evaluate ; : altboot ( N -- NOTREACHED ) s" smartos" getenv? if s" alt-boot-args" getenv dup -1 <> if s" boot-args" setenv ( c-addr/u -- ) then ." NoInstall/Recovery mode boot. login/pw: root/root" cr else s" boot_single" 2dup getenv -1 <> if drop ( c-addr/u c-addr -- c-addr/u ) \ unused unsetenv ( c-addr/u -- ) else 2drop ( c-addr/u -- ) \ unused s" set boot_single=YES" evaluate then then 0 boot ( state -- ) ; \ \ Single User Mode \ : singleuser_enabled? ( -- flag ) s" boot_single" getenv -1 <> dup if swap drop ( c-addr flag -- flag ) then ; : singleuser_enable ( -- ) s" set boot_single=YES" evaluate ; : singleuser_disable ( -- ) s" boot_single" unsetenv ; : init_singleuser ( N -- N ) singleuser_enabled? if toggle_menuitem ( n -- n ) then ; : toggle_singleuser ( N -- N TRUE ) toggle_menuitem menu-redraw \ Now we're going to make the change effective dup toggle_stateN @ 0= if singleuser_disable else singleuser_enable then TRUE \ loop menu again ; \ \ Verbose Boot \ : verbose_enabled? ( -- flag ) s" boot_verbose" getenv -1 <> dup if swap drop ( c-addr flag -- flag ) then ; : verbose_enable ( -- ) s" set boot_verbose=YES" evaluate ; : verbose_disable ( -- ) s" boot_verbose" unsetenv ; : init_verbose ( N -- N ) verbose_enabled? if toggle_menuitem ( n -- n ) then ; : toggle_verbose ( N -- N TRUE ) toggle_menuitem menu-redraw \ Now we're going to make the change effective dup toggle_stateN @ 0= if verbose_disable else verbose_enable then TRUE \ loop menu again ; \ \ Reconfiguration boot \ : reconfigure_enabled? ( -- flag ) s" boot_reconfigure" getenv -1 <> dup if swap drop ( c-addr flag -- flag ) then ; : reconfigure_enable ( -- ) s" set boot_reconfigure=YES" evaluate ; : reconfigure_disable ( -- ) s" boot_reconfigure" unsetenv ; : init_reconfigure ( N -- N ) reconfigure_enabled? if toggle_menuitem ( n -- n ) then ; : toggle_reconfigure ( N -- N TRUE ) toggle_menuitem menu-redraw \ Now we're going to make the change effective dup toggle_stateN @ 0= if reconfigure_disable else reconfigure_enable then TRUE \ loop menu again ; \ \ Framebuffer \ : init_framebuffer ( N -- N ) framebuffer? if toggle_menuitem ( n -- n ) then ; : toggle_framebuffer ( N -- N TRUE ) toggle_menuitem dup toggle_stateN @ 0= if s" off" else s" on" then 1 framebuffer draw-beastie draw-brand menu-init \ needed to reset menu position menu-redraw TRUE \ loop menu again ; \ \ Escape to Prompt \ : goto_prompt ( N -- N FALSE ) s" set autoboot_delay=NO" evaluate cr ." To get back to the menu, type `menu' and press ENTER" cr ." or type `boot' and press ENTER to start illumos." cr cr FALSE \ exit the menu ; \ \ Cyclestate (used by osconsole/acpi/kmdb below) \ : init_cyclestate ( N K -- N ) over cycle_stateN ( n k -- n k addr ) begin tuck @ ( n k addr -- n addr k c ) over <> ( n addr k c -- n addr k 0|-1 ) while rot ( n addr k -- addr k n ) cycle_menuitem swap rot ( addr k n -- n k addr ) repeat 2drop ( n k addr -- n ) ; \ \ OS Console \ getenv os_console, if not set getenv console, if not set, default to "text" \ allowed serial consoles: ttya .. ttyd \ if new console will be added (graphics?), this section needs to be updated \ : init_osconsole ( N -- N ) s" os_console" getenv dup -1 = if drop s" console" getenv dup -1 = if drop 0 \ default to text then then ( n c-addr/u | n 0 ) dup 0<> if ( n c-addr/u ) \ because all usable console names have 4 chars, \ we can only compare first 4 chars. drop 4 2dup s" ttyd" compare 0= if 2drop 4 else 2dup s" ttyc" compare 0= if 2drop 3 else 2dup s" ttyb" compare 0= if 2drop 2 else 2dup s" ttya" compare 0= if 2drop 1 else 2drop 0 \ anything else defaults to text then then then then then osconsole_state ! ; : activate_osconsole ( N -- N ) dup cycle_stateN @ ( n -- n n2 ) dup osconsole_state ! ( n n2 -- n n2 ) \ copy for re-initialization case 0 of s" text" endof 1 of s" ttya" endof 2 of s" ttyb" endof 3 of s" ttyc" endof 4 of s" ttyd" endof dup s" unknown state: " type . cr endcase s" os_console" setenv ; : cycle_osconsole ( N -- N TRUE ) cycle_menuitem \ cycle cycle_stateN to next value activate_osconsole \ apply current cycle_stateN menu-redraw \ redraw menu TRUE \ loop menu again ; \ \ ACPI \ : init_acpi ( N -- N ) s" acpi-user-options" getenv dup -1 <> if evaluate \ use ?number parse step \ translate option to cycle state case 1 of 1 acpi_state ! endof 2 of 2 acpi_state ! endof 4 of 3 acpi_state ! endof 8 of 4 acpi_state ! endof 0 acpi_state ! endcase else drop then ; : activate_acpi ( N -- N ) dup cycle_stateN @ ( n -- n n2 ) dup acpi_state ! ( n n2 -- n n2 ) \ copy for re-initialization \ if N == 0, it's default, just unset env. dup 0= if drop s" acpi-user-options" unsetenv else case 1 of s" 1" endof 2 of s" 2" endof 3 of s" 4" endof 4 of s" 8" endof endcase s" acpi-user-options" setenv then ; : cycle_acpi ( N -- N TRUE ) cycle_menuitem \ cycle cycle_stateN to next value activate_acpi \ apply current cycle_stateN menu-redraw \ redraw menu TRUE \ loop menu again ; \ \ kmdb \ : kmdb_disable s" boot_kmdb" unsetenv s" boot_drop_into_kmdb" unsetenv ; : init_kmdb ( N -- N ) \ Retrieve the contents of "nmi" or default to "panic" ( N -- N c-addr/u ) s" nmi" getenv dup -1 <> if else drop s" panic" then \ Store the string in "nmi_initial" if not already set \ (to support re-entering the menu from the loader prompt) s" nmi_initial" getenv? if else 2dup s" nmi_initial" setenv then ( N caddr/u -- N flag ) s" kmdb" compare if false else true then s" boot_kmdb" getenv -1 <> if drop s" boot_drop_into_kmdb" getenv -1 <> if drop if 4 else 3 then else if 2 else 1 then then else drop \ drop flag 0 then kmdb_state ! ; : activate_kmdb ( N -- N ) dup cycle_stateN @ ( n -- n n2 ) dup kmdb_state ! ( n n2 -- n n2 ) \ Reset "nmi" to its initial value s" nmi_initial" getenv s" nmi" setenv case 4 of \ drop + nmi=kmdb s" set boot_kmdb=YES" evaluate s" set boot_drop_into_kmdb=YES" evaluate s" set nmi=kmdb" evaluate endof 3 of \ drop s" set boot_kmdb=YES" evaluate s" set boot_drop_into_kmdb=YES" evaluate endof 2 of \ load + nmi=kmdb s" set boot_kmdb=YES" evaluate s" boot_drop_into_kmdb" unsetenv s" set nmi=kmdb" evaluate endof 1 of \ load s" set boot_kmdb=YES" evaluate s" boot_drop_into_kmdb" unsetenv endof kmdb_disable endcase ; : cycle_kmdb ( N -- N TRUE ) cycle_menuitem \ cycle cycle_stateN to next value activate_kmdb \ apply current cycle_stateN menu-redraw \ redraw menu TRUE \ loop menu again ; \ \ Menusets \ : goto_menu ( N M -- N TRUE ) menu-unset menuset-loadsetnum ( n m -- n ) menu-redraw TRUE \ Loop menu again ; \ \ Defaults \ : unset_boot_options 0 acpi_state ! s" acpi-user-options" unsetenv s" boot-args" unsetenv s" boot_ask" unsetenv singleuser_disable verbose_disable kmdb_disable \ disables drop_into_kmdb as well reconfigure_disable ; : set_default_boot_options ( N -- N TRUE ) unset_boot_options 2 goto_menu ; \ \ Set boot environment defaults \ : init_bootenv ( -- ) s" set menu_caption[1]=${bemenu_current}${zfs_be_active}" evaluate s" set ansi_caption[1]=${beansi_current}${zfs_be_active}" evaluate s" set menu_caption[2]=${bemenu_bootfs}${currdev}" evaluate s" set ansi_caption[2]=${beansi_bootfs}${currdev}" evaluate s" set menu_caption[3]=${bemenu_page}${zfs_be_currpage}${bemenu_pageof}${zfs_be_pages}" evaluate s" set ansi_caption[3]=${beansi_page}${zfs_be_currpage}${bemenu_pageof}${zfs_be_pages}" evaluate ; \ \ Redraw the entire screen. A long BE name can corrupt the menu \ : be_draw_screen clear \ Clear the screen (in screen.4th) print_version \ print version string (bottom-right; see version.4th) draw-beastie \ Draw FreeBSD logo at right (in beastie.4th) draw-brand \ Draw brand.4th logo at top (in brand.4th) menu-init \ Initialize menu and draw bounding box (in menu.4th) ; \ \ Select a boot environment \ : set_bootenv ( N -- N TRUE ) dup s" bootenv_root[E]" 13 +c! getenv s" currdev" getenv compare 0= if s" zfs_be_active" getenv type ." is already active" else dup s" set currdev=${bootenv_root[E]}" 27 +c! evaluate dup s" bootenvmenu_caption[E]" 20 +c! getenv s" zfs_be_active" setenv ." Activating " s" currdev" getenv type cr s" unload" evaluate free-module-options unset_boot_options s" /boot/defaults/loader.conf" read-conf s" /boot/loader.conf" read-conf s" /boot/loader.conf.local" read-conf init_bootenv s" 1" s" zfs_be_currpage" setenv s" be-set-page" evaluate then 500 ms \ sleep so user can see the message be_draw_screen menu-redraw TRUE ; \ \ Chainload this entry. Normally we do not return, in case of error \ from chain load, we continue with normal menu code. \ : set_be_chain ( N -- no return | N TRUE ) dup s" chain ${bootenv_root[E]}" 21 +c! evaluate catch drop menu-redraw TRUE ; \ \ Switch to the next page of boot environments \ : set_be_page ( N -- N TRUE ) s" zfs_be_currpage" getenv dup -1 = if drop s" 1" else s2n 1+ \ increment the page number dup s" zfs_be_pages" getenv s2n > if drop 1 then n2s then s" zfs_be_currpage" setenv s" be-set-page" evaluate 3 goto_menu ; only forth definitions \ Copyright (c) 2003 Scott Long \ Copyright (c) 2003 Aleksander Fafula \ Copyright (c) 2006-2015 Devin Teske \ Copyright 2020 OmniOS Community Edition (OmniOSce) Association. \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. marker task-menu.4th \ Frame drawing include /boot/forth/frames.4th vocabulary menu-infrastructure vocabulary menu-namespace vocabulary menu-command-helpers only forth also menu-infrastructure definitions f_double \ Set frames to double (see frames.4th). Replace with \ f_single if you want single frames. 46 constant dot \ ASCII definition of a period (in decimal) 5 constant menu_default_x \ default column position of timeout 10 constant menu_default_y \ default row position of timeout msg 4 constant menu_timeout_default_x \ default column position of timeout 23 constant menu_timeout_default_y \ default row position of timeout msg 10 constant menu_timeout_default \ default timeout (in seconds) \ Customize the following values with care 1 constant menu_start \ Numerical prefix of first menu item dot constant bullet \ Menu bullet (appears after numerical prefix) 5 constant menu_x \ Row position of the menu (from the top) 10 constant menu_y \ Column position of the menu (from left side) \ Menu Appearance variable menuidx \ Menu item stack for number prefixes variable menurow \ Menu item stack for positioning variable menubllt \ Menu item bullet \ Menu Positioning variable menuX \ Menu X offset (columns) variable menuY \ Menu Y offset (rows) \ Menu-item elements variable menurebootadded \ Menu timer [count-down] variables variable menu_timeout_enabled \ timeout state (internal use only) variable menu_time \ variable for tracking the passage of time variable menu_timeout \ determined configurable delay duration variable menu_timeout_x \ column position of timeout message variable menu_timeout_y \ row position of timeout message only forth also menu-namespace definitions \ Menu-item key association/detection variable menukey1 variable menukey2 variable menukey3 variable menukey4 variable menukey5 variable menukey6 variable menukey7 variable menukey8 variable menureboot variable menuacpi variable menuosconsole variable menukmdb variable menuoptions \ Menu initialization status variables variable init_state1 variable init_state2 variable init_state3 variable init_state4 variable init_state5 variable init_state6 variable init_state7 variable init_state8 \ Boolean option status variables variable toggle_state1 variable toggle_state2 variable toggle_state3 variable toggle_state4 variable toggle_state5 variable toggle_state6 variable toggle_state7 variable toggle_state8 \ Array option status variables variable cycle_state1 variable cycle_state2 variable cycle_state3 variable cycle_state4 variable cycle_state5 variable cycle_state6 variable cycle_state7 variable cycle_state8 \ Containers for storing the initial caption text create init_text1 64 allot create init_text2 64 allot create init_text3 64 allot create init_text4 64 allot create init_text5 64 allot create init_text6 64 allot create init_text7 64 allot create init_text8 64 allot only forth definitions : arch-i386? ( -- BOOL ) \ Returns TRUE (-1) on i386, FALSE (0) otherwise. \ FICL_PLATFORM_ARCHITECTURE is always defined, drop flag s" FICL_PLATFORM_ARCHITECTURE" environment? drop s" i386" compare 0<> if true else false then ; : acpipresent? ( -- flag ) \ Returns TRUE if ACPI is present, FALSE otherwise s" hint.acpi.0.rsdp" getenv dup -1 = if drop false exit then 2drop true ; : acpienabled? ( -- flag ) \ Returns TRUE if ACPI is enabled, FALSE otherwise s" hint.acpi.0.disabled" getenv dup -1 <> if s" 0" compare 0<> if false exit then else drop then true ; : +c! ( N C-ADDR/U K -- C-ADDR/U ) 3 pick 3 pick ( n c-addr/u k -- n c-addr/u k n c-addr ) rot + c! ( n c-addr/u k n c-addr -- n c-addr/u ) rot drop ( n c-addr/u -- c-addr/u ) ; only forth also menu-namespace definitions \ Forth variables : namespace ( C-ADDR/U N -- ) also menu-namespace +c! evaluate previous ; : menukeyN ( N -- ADDR ) s" menukeyN" 7 namespace ; : init_stateN ( N -- ADDR ) s" init_stateN" 10 namespace ; : toggle_stateN ( N -- ADDR ) s" toggle_stateN" 12 namespace ; : cycle_stateN ( N -- ADDR ) s" cycle_stateN" 11 namespace ; : init_textN ( N -- C-ADDR ) s" init_textN" 9 namespace ; \ Environment variables : menu_init[x] ( N -- C-ADDR/U ) s" menu_init[x]" 10 +c! ; : menu_command[x] ( N -- C-ADDR/U ) s" menu_command[x]" 13 +c! ; : menu_caption[x] ( N -- C-ADDR/U ) s" menu_caption[x]" 13 +c! ; : ansi_caption[x] ( N -- C-ADDR/U ) s" ansi_caption[x]" 13 +c! ; : menu_keycode[x] ( N -- C-ADDR/U ) s" menu_keycode[x]" 13 +c! ; : toggled_text[x] ( N -- C-ADDR/U ) s" toggled_text[x]" 13 +c! ; : toggled_ansi[x] ( N -- C-ADDR/U ) s" toggled_ansi[x]" 13 +c! ; : menu_caption[x][y] ( N M -- C-ADDR/U ) s" menu_caption[x][y]" 16 +c! 13 +c! ; : ansi_caption[x][y] ( N M -- C-ADDR/U ) s" ansi_caption[x][y]" 16 +c! 13 +c! ; also menu-infrastructure definitions \ This function prints a menu item at menuX (row) and menuY (column), returns \ the incremental decimal ASCII value associated with the menu item, and \ increments the cursor position to the next row for the creation of the next \ menu item. This function is called by the menu-create function. You need not \ call it directly. \ : printmenuitem ( menu_item_str -- ascii_keycode ) loader_color? if [char] ^ escc! then menurow dup @ 1+ swap ! ( increment menurow ) menuidx dup @ 1+ swap ! ( increment menuidx ) \ Calculate the menuitem row position menurow @ menuY @ + \ Position the cursor at the menuitem position dup menuX @ swap at-xy \ Print the value of menuidx loader_color? dup ( -- bool bool ) if b then menuidx @ . if me then \ Move the cursor forward 1 column dup menuX @ 1+ swap at-xy menubllt @ emit \ Print the menu bullet using the emit function \ Move the cursor to the 3rd column from the current position \ to allow for a space between the numerical prefix and the \ text caption menuX @ 3 + swap at-xy \ Print the menu caption (we expect a string to be on the stack \ prior to invoking this function) type \ Here we will add the ASCII decimal of the numerical prefix \ to the stack (decimal ASCII for `1' is 49) as a "return value" menuidx @ 48 + ; : delim? ( C -- BOOL ) dup 32 = ( c -- c bool ) \ [sp] space over 9 = or ( c bool -- c bool ) \ [ht] horizontal tab over 10 = or ( c bool -- c bool ) \ [nl] newline over 13 = or ( c bool -- c bool ) \ [cr] carriage return over [char] , = or ( c bool -- c bool ) \ comma swap drop ( c bool -- bool ) \ return boolean ; \ illumos kernel acpi-user-options has following values: \ default: 0 - system will enable acpi based on bios date \ on: 1 - acpi is set on \ off: 2 - acpi is set off \ madt: 4 - use only MADT \ legacy: 8 - use legacy mode : acpi-captions ( N -- ) \ first entry dup s" [A]CPI................ default" rot 48 menu_caption[x][y] setenv dup s" ^[1mA^[mCPI.............. ^[32;7mdefault^[m" rot 48 ansi_caption[x][y] setenv dup s" [A]CPI................ On" rot 49 menu_caption[x][y] setenv dup s" ^[1mA^[mCPI.............. ^[34;1mOn^[m" rot 49 ansi_caption[x][y] setenv dup s" [A]CPI................ Off" rot 50 menu_caption[x][y] setenv dup s" ^[1mA^[mCPI.............. ^[34;1mOff^[m" rot 50 ansi_caption[x][y] setenv dup s" [A]CPI................ MADT" rot 51 menu_caption[x][y] setenv dup s" ^[1mA^[mCPI.............. ^[34;1mMADT^[m" rot 51 ansi_caption[x][y] setenv dup s" [A]CPI................ Legacy" rot 52 menu_caption[x][y] setenv s" ^[1mA^[mCPI.............. ^[34;1mLegacy^[m" rot 52 ansi_caption[x][y] setenv ; \ illumos console has following values: \ text, ttya, ttyb, ttyc, ttyd : osconsole-captions ( N -- ) \ first entry dup s" Os[C]onsole........... text" rot 48 menu_caption[x][y] setenv dup s" Os^[1mC^[monsole............ ^[32;7mtext^[m" rot 48 ansi_caption[x][y] setenv dup s" Os[C]onsole........... ttya" rot 49 menu_caption[x][y] setenv dup s" Os^[1mC^[monsole............ ^[34;1mttya^[m" rot 49 ansi_caption[x][y] setenv dup s" Os[C]onsole........... ttyb" rot 50 menu_caption[x][y] setenv dup s" Os^[1mC^[monsole............ ^[34;1mttyb^[m" rot 50 ansi_caption[x][y] setenv dup s" Os[C]onsole........... ttyc" rot 51 menu_caption[x][y] setenv dup s" Os^[1mC^[monsole............ ^[34;1mttyc^[m" rot 51 ansi_caption[x][y] setenv dup s" Os[C]onsole........... ttyd" rot 52 menu_caption[x][y] setenv s" Os^[1mC^[monsole............ ^[34;1mttyd^[m" rot 52 ansi_caption[x][y] setenv ; \ kmdb options are as follows \ default: 0 - disabled \ 1 - boot with -k option \ 2 - as 1 + configure NMI to drop to kmdb \ 3 - boot with -k and -d options \ 4 - as 3 + configure NMI to drop to kmdb : kmdb-captions ( N -- ) \ first entry dup s" [k]mdb Mode........... Off" rot 48 menu_caption[x][y] setenv dup s" ^[1mk^[mmdb Mode............. ^[34;1mOff^[m" rot 48 ansi_caption[x][y] setenv dup s" [k]mdb Mode........... Loaded" rot 49 menu_caption[x][y] setenv dup s" ^[1mk^[mmdb Mode............. ^[32;7mLoaded^[m" rot 49 ansi_caption[x][y] setenv dup s" [k]mdb Mode........... On NMI" rot 50 menu_caption[x][y] setenv dup s" ^[1mk^[mmdb Mode............. ^[32;7mOn NMI^[m" rot 50 ansi_caption[x][y] setenv dup s" [k]mdb Mode........... On Boot" rot 51 menu_caption[x][y] setenv dup s" ^[1mk^[mmdb Mode............. ^[32;7mOn Boot^[m" rot 51 ansi_caption[x][y] setenv dup s" [k]mdb Mode........... On Boot/NMI" rot 52 menu_caption[x][y] setenv s" ^[1mk^[mmdb Mode............. ^[32;7mOn Boot/NMI^[m" rot 52 ansi_caption[x][y] setenv ; : set-captions ( x y - x y ) \ Set the current non-ANSI caption 2dup swap dup ( x y -- x y y x x ) s" set menu_caption[x]=$menu_caption[x][y]" 17 +c! 34 +c! 37 +c! evaluate ( x y y x x c-addr/u -- x y ) \ Set the current ANSI caption 2dup swap dup ( x y -- x y y x x ) s" set ansi_caption[x]=$ansi_caption[x][y]" 17 +c! 34 +c! 37 +c! evaluate ( x y y x x c-addr/u -- x y ) ; \ This function creates the list of menu items. This function is called by the \ menu-display function. You need not call it directly. \ : menu-create ( -- ) \ Print the frame caption at (x,y) s" loader_menu_title" getenv dup -1 = if drop s" Welcome to illumos" then TRUE ( use default alignment ) s" loader_menu_title_align" getenv dup -1 <> if 2dup s" left" compare-insensitive 0= if ( 1 ) 2drop ( c-addr/u ) drop ( bool ) menuX @ menuY @ 1- FALSE ( don't use default alignment ) else ( 1 ) 2dup s" right" compare-insensitive 0= if ( 2 ) 2drop ( c-addr/u ) drop ( bool ) menuX @ 42 + 4 - over - menuY @ 1- FALSE ( don't use default alignment ) else ( 2 ) 2drop ( c-addr/u ) then ( 1 ) then else drop ( getenv cruft ) then if ( use default center alignement? ) menuX @ 19 + over 2 / - menuY @ 1- then at-xy type \ If $menu_init is set, evaluate it (allowing for whole menus to be \ constructed dynamically -- as this function could conceivably set \ the remaining environment variables to construct the menu entirely). \ s" menu_init" getenv dup -1 <> if evaluate else drop then \ Print our menu options with respective key/variable associations. \ `printmenuitem' ends by adding the decimal ASCII value for the \ numerical prefix to the stack. We store the value left on the stack \ to the key binding variable for later testing against a character \ captured by the `getkey' function. \ Note that any menu item beyond 9 will have a numerical prefix on the \ screen consisting of the first digit (ie. 1 for the tenth menu item) \ and the key required to activate that menu item will be the decimal \ ASCII of 48 plus the menu item (ie. 58 for the tenth item, aka. `:') \ which is misleading and not desirable. \ \ Thus, we do not allow more than 8 configurable items on the menu \ (with "Reboot" as the optional ninth and highest numbered item). \ \ Initialize the OsConsole option status. \ 0 menuosconsole ! s" menu_osconsole" getenv -1 <> if c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' ) dup menuosconsole ! dup osconsole-captions s" init_osconsole" evaluate \ Get the current cycle state (entry to use) s" osconsole_state" evaluate @ 48 + ( n -- n y ) set-captions \ Initialize cycle state from stored value 48 - ( n y -- n k ) s" init_cyclestate" evaluate ( n k -- n ) \ Set $os_console s" activate_osconsole" evaluate ( n -- n ) then drop then \ \ Initialize the ACPI option status. \ 0 menuacpi ! s" menu_acpi" getenv -1 <> if c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' ) dup menuacpi ! dup acpi-captions s" init_acpi" evaluate \ Get the current cycle state (entry to use) s" acpi_state" evaluate @ 48 + ( n -- n y ) set-captions \ Initialize cycle state from stored value 48 - ( n y -- n k ) s" init_cyclestate" evaluate ( n k -- n ) \ Set $acpi-user-options s" activate_acpi" evaluate ( n -- n ) then drop then \ \ Initialize the kmdb option status. \ 0 menukmdb ! s" menu_kmdb" getenv -1 <> if c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' ) dup menukmdb ! dup kmdb-captions s" init_kmdb" evaluate \ Get the current cycle state (entry to use) s" kmdb_state" evaluate @ 48 + ( n -- n y ) set-captions \ Initialize cycle state from stored value 48 - ( n y -- n k ) s" init_cyclestate" evaluate ( n k -- n ) \ Activate the current option s" activate_kmdb" evaluate ( n -- n ) then drop then \ \ Initialize the menu_options visual separator. \ 0 menuoptions ! s" menu_options" getenv -1 <> if c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' ) menuoptions ! else drop then then \ Initialize "Reboot" menu state variable (prevents double-entry) false menurebootadded ! menu_start 1- menuidx ! \ Initialize the starting index for the menu 0 menurow ! \ Initialize the starting position for the menu 49 \ Iterator start (loop range 49 to 56; ASCII '1' to '8') begin \ If the "Options:" separator, print it. dup menuoptions @ = if \ Optionally add a reboot option to the menu s" menu_reboot" getenv -1 <> if drop s" Reboot" printmenuitem menureboot ! true menurebootadded ! then menuX @ menurow @ 2 + menurow ! menurow @ menuY @ + at-xy s" menu_optionstext" getenv dup -1 <> if type else drop ." Options:" then then \ make sure we have not already initialized this item dup init_stateN dup @ 0= if 1 swap ! \ If this menuitem has an initializer, run it dup menu_init[x] getenv dup -1 <> if evaluate else drop then else drop then dup loader_color? if ansi_caption[x] else menu_caption[x] then dup -1 <> if \ test for environment variable getenv dup -1 <> if printmenuitem ( c-addr/u -- n ) dup menukeyN ! else drop then else drop then 1+ dup 56 > \ add 1 to iterator, continue if less than 57 until drop \ iterator \ Optionally add a reboot option to the menu menurebootadded @ true <> if s" menu_reboot" getenv -1 <> if drop \ no need for the value s" Reboot" \ menu caption (required by printmenuitem) printmenuitem menureboot ! else 0 menureboot ! then then ; \ Takes an integer on the stack and updates the timeout display. \ : menu-timeout-update ( N -- ) \ Enforce minimum dup 0 < if drop 0 then menu_timeout_x @ menu_timeout_y @ at-xy \ position cursor dup 0> if s" Autoboot in " type dup . s" second" type 1 > if [char] s emit then s" . [Space] to pause " type else drop 40 spaces \ erase message then at-bl ; \ This function blocks program flow (loops forever) until a key is pressed. \ The key that was pressed is added to the top of the stack in the form of its \ decimal ASCII representation. This function is called by the menu-display \ function. You need not call it directly. \ note, the esc sequences will be dropped, this needs to be changed if \ menu is built based on arrow keys. \ : getkey ( -- ascii_keycode ) begin \ loop forever menu_timeout_enabled @ 1 = if ( -- ) seconds ( get current time: -- N ) dup menu_time @ <> if ( has time elapsed?: N N N -- N ) \ At least 1 second has elapsed since last loop \ so we will decrement our "timeout" (really a \ counter, insuring that we do not proceed too \ fast) and update our timeout display. menu_time ! ( update time record: N -- ) menu_timeout @ ( "time" remaining: -- N ) dup 0> if ( greater than 0?: N N 0 -- N ) 1- ( decrement counter: N -- N ) dup menu_timeout ! ( re-assign: N N Addr -- N ) then ( -- N ) dup 0= swap 0< or if ( N <= 0?: N N -- ) \ halt the timer 0 menu_timeout ! ( 0 Addr -- ) 0 menu_timeout_enabled ! ( 0 Addr -- ) then \ update the timer display ( N -- ) menu_timeout @ menu-timeout-update menu_timeout @ 0= if \ We've reached the end of the timeout \ (user did not cancel by pressing ANY \ key) s" menu_timeout_command" getenv dup -1 = if drop \ clean-up else evaluate then then else ( -- N ) \ No [detectable] time has elapsed (in seconds) drop ( N -- ) then ( -- ) then key? if \ Was a key pressed? (see loader(8)) \ An actual key was pressed (if the timeout is running, \ kill it regardless of which key was pressed) menu_timeout @ 0<> if 0 menu_timeout ! 0 menu_timeout_enabled ! \ clear screen of timeout message 0 menu-timeout-update then \ get the key that was pressed and exit (if we \ get a non-zero ASCII code) key dup 0<> if dup 0x1b = if key? if ( is it sequence? ) drop begin key? while key drop repeat else exit then else exit then else drop then then 50 ms \ sleep for 50 milliseconds (see loader(8)) again ; : menu-erase ( -- ) \ Erases menu and resets positioning variable to position 1. \ Clear the screen area associated with the interactive menu menuX @ menuY @ 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 2drop \ Reset the starting index and position for the menu menu_start 1- menuidx ! 0 menurow ! ; only forth also menu-infrastructure also menu-namespace also menu-command-helpers definitions : toggle_menuitem ( N -- N ) \ toggles caption text and internal menuitem state \ ASCII numeral equal to user-selected menu item must be on the stack. \ We do not modify the stack, so the ASCII numeral is left on top. dup init_textN c@ 0= if \ NOTE: no need to check toggle_stateN since the first time we \ are called, we will populate init_textN. Further, we don't \ need to test whether menu_caption[x] (ansi_caption[x] when \ loader_color?=1) is available since we would not have been \ called if the caption was NULL. \ base name of environment variable dup ( n -- n n ) \ key pressed loader_color? if ansi_caption[x] else menu_caption[x] then getenv dup -1 <> if 2 pick ( n c-addr/u -- n c-addr/u n ) init_textN ( n c-addr/u n -- n c-addr/u c-addr ) \ now we have the buffer c-addr on top \ ( followed by c-addr/u of current caption ) \ Copy the current caption into our buffer 2dup c! -rot \ store strlen at first byte begin rot 1+ \ bring alt addr to top and increment -rot -rot \ bring buffer addr to top 2dup c@ swap c! \ copy current character 1+ \ increment buffer addr rot 1- \ bring buffer len to top and decrement dup 0= \ exit loop if buffer len is zero until 2drop \ buffer len/addr drop \ alt addr else drop then then \ Now we are certain to have init_textN populated with the initial \ value of menu_caption[x] (ansi_caption[x] with loader_color enabled). \ We can now use init_textN as the untoggled caption and \ toggled_text[x] (toggled_ansi[x] with loader_color enabled) as the \ toggled caption and store the appropriate value into menu_caption[x] \ (again, ansi_caption[x] with loader_color enabled). Last, we'll \ negate the toggled state so that we reverse the flow on subsequent \ calls. dup toggle_stateN @ 0= if \ state is OFF, toggle to ON dup ( n -- n n ) \ key pressed loader_color? if toggled_ansi[x] else toggled_text[x] then getenv dup -1 <> if \ Assign toggled text to menu caption 2 pick ( n c-addr/u -- n c-addr/u n ) \ key pressed loader_color? if ansi_caption[x] else menu_caption[x] then setenv else \ No toggled text, keep the same caption drop ( n -1 -- n ) \ getenv cruft then true \ new value of toggle state var (to be stored later) else \ state is ON, toggle to OFF dup init_textN count ( n -- n c-addr/u ) \ Assign init_textN text to menu caption 2 pick ( n c-addr/u -- n c-addr/u n ) \ key pressed loader_color? if ansi_caption[x] else menu_caption[x] then setenv false \ new value of toggle state var (to be stored below) then \ now we'll store the new toggle state (on top of stack) over toggle_stateN ! ; : cycle_menuitem ( N -- N ) \ cycles through array of choices for a menuitem \ ASCII numeral equal to user-selected menu item must be on the stack. \ We do not modify the stack, so the ASCII numeral is left on top. dup cycle_stateN dup @ 1+ \ get value and increment \ Before assigning the (incremented) value back to the pointer, \ let's test for the existence of this particular array element. \ If the element exists, we'll store index value and move on. \ Otherwise, we'll loop around to zero and store that. dup 48 + ( n addr k -- n addr k k' ) \ duplicate array index and convert to ASCII numeral 3 pick swap ( n addr k k' -- n addr k n k' ) \ (n,k') as (x,y) loader_color? if ansi_caption[x][y] else menu_caption[x][y] then ( n addr k n k' -- n addr k c-addr/u ) \ Now test for the existence of our incremented array index in the \ form of $menu_caption[x][y] ($ansi_caption[x][y] with loader_color \ enabled) as set in loader.rc(5), et. al. getenv dup -1 = if \ No caption set for this array index. Loop back to zero. drop ( n addr k -1 -- n addr k ) \ getenv cruft drop 0 ( n addr k -- n addr 0 ) \ new value to store later 2 pick [char] 0 ( n addr 0 -- n addr 0 n 48 ) \ (n,48) as (x,y) loader_color? if ansi_caption[x][y] else menu_caption[x][y] then ( n addr 0 n 48 -- n addr 0 c-addr/u ) getenv dup -1 = if \ Highly unlikely to occur, but to ensure things move \ along smoothly, allocate a temporary NULL string drop ( cruft ) s" " then then \ At this point, we should have the following on the stack (in order, \ from bottom to top): \ \ n - Ascii numeral representing the menu choice (inherited) \ addr - address of our internal cycle_stateN variable \ k - zero-based number we intend to store to the above \ c-addr/u - string value we intend to store to menu_caption[x] \ (or ansi_caption[x] with loader_color enabled) \ \ Let's perform what we need to with the above. \ Assign array value text to menu caption 4 pick ( n addr k c-addr/u -- n addr k c-addr/u n ) loader_color? if ansi_caption[x] else menu_caption[x] then setenv swap ! ( n addr k -- n ) \ update array state variable ; only forth definitions also menu-infrastructure \ Erase and redraw the menu. Useful if you change a caption and want to \ update the menu to reflect the new value. \ : menu-redraw ( -- ) menu-erase menu-create ; : menu-box ( -- ) \ Interpret a custom frame type for the menu TRUE ( draw a box? default yes, but might be altered below ) s" loader_menu_frame" getenv dup -1 = if ( 1 ) drop \ no custom frame type else ( 1 ) 2dup s" single" compare-insensitive 0= if ( 2 ) f_single ( see frames.4th ) else ( 2 ) 2dup s" double" compare-insensitive 0= if ( 3 ) f_double ( see frames.4th ) else ( 3 ) s" none" compare-insensitive 0= if ( 4 ) drop FALSE \ don't draw a box ( 4 ) then ( 3 ) then ( 2 ) then ( 1 ) then if 42 13 menuX @ 3 - menuY @ 1- box \ Draw frame (w,h,x,y) then ; \ This function initializes the menu. Call this from your `loader.rc' file \ before calling any other menu-related functions. \ : menu-init ( -- ) menu_start 1- menuidx ! \ Initialize the starting index for the menu 0 menurow ! \ Initialize the starting position for the menu \ Assign configuration values s" loader_menu_y" getenv dup -1 = if drop \ no custom row position menu_default_y else \ make sure custom position is a number ?number 0= if menu_default_y \ or use default then then menuY ! s" loader_menu_x" getenv dup -1 = if drop \ no custom column position menu_default_x else \ make sure custom position is a number ?number 0= if menu_default_x \ or use default then then menuX ! ['] menu-box console-iterate at-bl ; also menu-namespace \ Main function. Call this from your `loader.rc' file. \ : menu-display ( -- ) 0 menu_timeout_enabled ! \ start with automatic timeout disabled \ check indication that automatic execution after delay is requested s" menu_timeout_command" getenv -1 <> if ( Addr C -1 -- | Addr ) drop ( just testing existence right now: Addr -- ) \ initialize state variables seconds menu_time ! ( store the time we started ) 1 menu_timeout_enabled ! ( enable automatic timeout ) \ read custom time-duration (if set) s" autoboot_delay" getenv dup -1 = if drop \ no custom duration (remove dup'd bunk -1) menu_timeout_default \ use default setting else 2dup ?number 0= if ( if not a number ) \ disable timeout if "NO", else use default s" NO" compare-insensitive 0= if 0 menu_timeout_enabled ! 0 ( assigned to menu_timeout below ) else menu_timeout_default then else -rot 2drop \ boot immediately if less than zero dup 0< if drop menu-create at-bl 0 boot then then then menu_timeout ! ( store value on stack from above ) menu_timeout_enabled @ 1 = if \ read custom column position (if set) s" loader_menu_timeout_x" getenv dup -1 = if drop \ no custom column position menu_timeout_default_x \ use default setting else \ make sure custom position is a number ?number 0= if menu_timeout_default_x \ or use default then then menu_timeout_x ! ( store value on stack from above ) \ read custom row position (if set) s" loader_menu_timeout_y" getenv dup -1 = if drop \ no custom row position menu_timeout_default_y \ use default setting else \ make sure custom position is a number ?number 0= if menu_timeout_default_y \ or use default then then menu_timeout_y ! ( store value on stack from above ) then then cursor-invisible cursor-set menu-create begin \ Loop forever at-bl \ restore cursor for case the getkey ends up in \ booting the kernel. This does restore cursor for \ serial terminals. cursor-normal cursor-set getkey \ Block here, waiting for a key to be pressed cursor-invisible cursor-set dup -1 = if cursor-normal cursor-set drop exit \ Caught abort (abnormal return) then \ Boot if the user pressed Enter/Ctrl-M (13) or \ Ctrl-Enter/Ctrl-J (10) dup over 13 = swap 10 = or if drop ( no longer needed ) cursor-normal cursor-set s" boot" evaluate exit ( pedantic; never reached ) then dup menureboot @ = if 0 reboot then \ Evaluate the decimal ASCII value against known menu item \ key associations and act accordingly 49 \ Iterator start (loop range 49 to 56; ASCII '1' to '8') begin dup menukeyN @ rot tuck = if \ Adjust for missing ACPI menuitem on non-i386 \ arch-i386? true <> menuacpi @ 0<> and if \ menuacpi @ over 2dup < -rot = or \ over 58 < and if \ ( key >= menuacpi && key < 58: N -- N ) \ 1+ \ then \ then \ Test for the environment variable dup menu_command[x] getenv dup -1 <> if \ Execute the stored procedure cursor-normal cursor-set evaluate \ We expect there to be a non-zero \ value left on the stack after \ executing the stored procedure. \ If so, continue to run, else exit. 0= if drop \ key pressed drop \ loop iterator exit else swap \ need iterator on top then cursor-invisible cursor-set then \ Re-adjust for missing ACPI menuitem \ arch-i386? true <> menuacpi @ 0<> and if \ swap \ menuacpi @ 1+ over 2dup < -rot = or \ over 59 < and if \ 1- \ then \ swap \ then else swap \ need iterator on top then \ \ Check for menu keycode shortcut(s) \ dup menu_keycode[x] getenv dup -1 = if drop else ?number 0<> if rot tuck = if swap dup menu_command[x] getenv dup -1 <> if cursor-normal cursor-set evaluate 0= if 2drop exit then cursor-invisible cursor-set else drop then else swap then then then 1+ dup 56 > \ increment iterator \ continue if less than 57 until drop \ loop iterator drop \ key pressed again \ Non-operational key was pressed; repeat ; \ This function unsets all the possible environment variables associated with \ creating the interactive menu. \ : menu-unset ( -- ) 49 \ Iterator start (loop range 49 to 56; ASCII '1' to '8') begin dup menu_init[x] unsetenv \ menu initializer dup menu_command[x] unsetenv \ menu command dup menu_caption[x] unsetenv \ menu caption dup ansi_caption[x] unsetenv \ ANSI caption dup menu_keycode[x] unsetenv \ menu keycode dup toggled_text[x] unsetenv \ toggle_menuitem caption dup toggled_ansi[x] unsetenv \ toggle_menuitem ANSI caption 48 \ Iterator start (inner range 48 to 57; ASCII '0' to '9') begin \ cycle_menuitem caption and ANSI caption 2dup menu_caption[x][y] unsetenv 2dup ansi_caption[x][y] unsetenv 1+ dup 57 > until drop \ inner iterator 0 over menukeyN ! \ used by menu-create, menu-display 0 over init_stateN ! \ used by menu-create 0 over toggle_stateN ! \ used by toggle_menuitem 0 over init_textN c! \ used by toggle_menuitem 0 over cycle_stateN ! \ used by cycle_menuitem 1+ dup 56 > \ increment, continue if less than 57 until drop \ iterator s" menu_timeout_command" unsetenv \ menu timeout command s" menu_reboot" unsetenv \ Reboot menu option flag s" menu_acpi" unsetenv \ ACPI menu option flag s" menu_kmdb" unsetenv \ kmdb menu option flag s" menu_osconsole" unsetenv \ osconsole menu option flag s" menu_options" unsetenv \ Options separator flag s" menu_optionstext" unsetenv \ separator display text s" menu_init" unsetenv \ menu initializer 0 menureboot ! 0 menuacpi ! 0 menukmdb ! 0 menuosconsole ! 0 menuoptions ! ; only forth definitions also menu-infrastructure \ This function both unsets menu variables and visually erases the menu area \ in-preparation for another menu. \ : menu-clear ( -- ) menu-unset menu-erase ; bullet menubllt ! also menu-namespace \ Initialize our menu initialization state variables 0 init_state1 ! 0 init_state2 ! 0 init_state3 ! 0 init_state4 ! 0 init_state5 ! 0 init_state6 ! 0 init_state7 ! 0 init_state8 ! \ Initialize our boolean state variables 0 toggle_state1 ! 0 toggle_state2 ! 0 toggle_state3 ! 0 toggle_state4 ! 0 toggle_state5 ! 0 toggle_state6 ! 0 toggle_state7 ! 0 toggle_state8 ! \ Initialize our array state variables 0 cycle_state1 ! 0 cycle_state2 ! 0 cycle_state3 ! 0 cycle_state4 ! 0 cycle_state5 ! 0 cycle_state6 ! 0 cycle_state7 ! 0 cycle_state8 ! \ Initialize string containers 0 init_text1 c! 0 init_text2 c! 0 init_text3 c! 0 init_text4 c! 0 init_text5 c! 0 init_text6 c! 0 init_text7 c! 0 init_text8 c! only forth definitions \ Menu.rc \ \ Load required Forth modules include /boot/forth/version.4th include /boot/forth/brand.4th include /boot/forth/menu.4th include /boot/forth/menu-commands.4th include /boot/forth/shortcuts.4th \ Screen prep clear \ clear the screen (see `screen.4th') print_version \ print version string (bottom-right; see `version.4th') draw-beastie \ draw freebsd mascot (on right; see `beastie.4th') draw-brand \ draw the FreeBSD title (top-left; see `brand.4th') menu-init \ initialize the menu area (see `menu.4th') \ Initialize main menu constructs (see `menu.4th') \ NOTE: To use `non-ansi' variants, add `loader_color=0' to loader.conf(5) \ NOTE: ANSI variants can use `^' in place of literal `Esc' (ASCII 27) \ \ MAIN MENU \ set menuset_name1="main" set mainmenu_init[1]="init_boot" s" smartos" getenv? [if] set mainmenu_caption[1]="Boot SmartOS [Enter]" set maintoggled_text[1]="R[e]covery (root/root) [Enter]" set mainansi_caption[1]="^[1mB^[moot SmartOS ^[1m[Enter]^[m" set maintoggled_ansi[1]="R^[1me^[mcovery (root/root) ^[1m[Enter]^[m" [else] set mainmenu_caption[1]="Boot Multi User [Enter]" set maintoggled_text[1]="Boot [S]ingle User [Enter]" set mainansi_caption[1]="^[1mB^[moot Multi User ^[1m[Enter]^[m" set maintoggled_ansi[1]="Boot ^[1mS^[mingle User ^[1m[Enter]^[m" [then] set mainmenu_command[1]="boot" \ keycode set by init_boot set mainmenu_init[2]="init_altboot" s" smartos" getenv? [if] set mainmenu_caption[2]="[R]ecovery (root/root)" set maintoggled_text[2]="[B]oot SmartOS" set mainansi_caption[2]="^[1mR^[mecovery (root/root)" set maintoggled_ansi[2]="^[1mB^[oot SmartOS" [else] set mainmenu_caption[2]="Boot [S]ingle User" set maintoggled_text[2]="Boot [M]ulti User" set mainansi_caption[2]="Boot ^[1mS^[mingle User" set maintoggled_ansi[2]="Boot ^[1mM^[multi User" [then] set mainmenu_command[2]="altboot" \ keycode set by init_altboot set mainmenu_caption[3]="[Esc]ape to loader prompt" set mainmenu_command[3]="goto_prompt" set mainmenu_keycode[3]=27 set mainansi_caption[3]="^[1mEsc^[mape to loader prompt" \ Enable built-in "Reboot" trailing menuitem \ NOTE: appears before menu_options if configured \ set mainmenu_reboot \ Enable "Options:" separator. When set to a numerical value (1-8), a visual \ separator is inserted before that menuitem number. \ set mainmenu_options=5 set mainmenu_caption[5]="Configure Boot [O]ptions..." set mainmenu_command[5]="2 goto_menu" set mainmenu_keycode[5]=111 set mainansi_caption[5]="Configure Boot ^[1mO^[mptions..." \ Boot Environments are (supported) only on ZFS s" currdev" getenv drop 4 s" zfs:" compare 0= be-pages and [if] set mainmenu_caption[6]="Select Boot [E]nvironment..." set mainmenu_command[6]="3 goto_menu" set mainmenu_keycode[6]=101 set mainansi_caption[6]="Select Boot ^[1mE^[mnvironment..." s" chain_disk" getenv? [if] set mainmenu_caption[7]="Chain[L]oad ${chain_disk}" set mainmenu_command[7]="chain ${chain_disk}" set mainmenu_keycode[7]=108 set mainansi_caption[7]="Chain^[1mL^[moad ${chain_disk}" [then] [else] s" chain_disk" getenv? [if] set mainmenu_caption[6]="Chain[L]oad ${chain_disk}" set mainmenu_command[6]="chain ${chain_disk}" set mainmenu_keycode[6]=108 set mainansi_caption[6]="Chain^[1mL^[moad ${chain_disk}" [then] [then] \ \ BOOT OPTIONS MENU \ set menuset_name2="options" set optionsmenu_caption[1]="Back to Main Menu [Backspace]" set optionsmenu_command[1]="1 goto_menu" set optionsmenu_keycode[1]=8 set optionsansi_caption[1]="Back to Main Menu ^[1m[Backspace]^[m" \ set optionsmenu_caption[2]="Load System [D]efaults" \ set optionsmenu_command[2]="set_default_boot_options" \ set optionsmenu_keycode[2]=100 \ set optionsansi_caption[2]="Load System ^[1mD^[mefaults" set optionsmenu_options=2 set optionsmenu_optionstext="Boot Options:" set optionsmenu_osconsole=2 set optionsmenu_command[2]="cycle_osconsole" set optionsmenu_keycode[2]=99 set optionsmenu_acpi=3 set optionsmenu_command[3]="cycle_acpi" set optionsmenu_keycode[3]=97 set optionsmenu_init[4]="init_singleuser" set optionsmenu_caption[4]="[S]ingle User......... Off" set optionstoggled_text[4]="[S]ingle User......... On" set optionsmenu_command[4]="toggle_singleuser" set optionsmenu_keycode[4]=115 set optionsansi_caption[4]="^[1mS^[mingle User........... ^[34;1mOff^[m" set optionstoggled_ansi[4]="^[1mS^[mingle User........... ^[32;7mOn^[m" set optionsmenu_init[5]="init_verbose" set optionsmenu_caption[5]="[V]erbose............. Off" set optionstoggled_text[5]="[V]erbose............. On" set optionsmenu_command[5]="toggle_verbose" set optionsmenu_keycode[5]=118 set optionsansi_caption[5]="^[1mV^[merbose............... ^[34;1mOff^[m" set optionstoggled_ansi[5]="^[1mV^[merbose............... ^[32;7mOn^[m" set optionsmenu_init[6]="init_reconfigure" set optionsmenu_caption[6]="[R]econfigure......... Off" set optionstoggled_text[6]="[R]econfigure......... On" set optionsmenu_command[6]="toggle_reconfigure" set optionsmenu_keycode[6]=114 set optionsansi_caption[6]="^[1mR^[meconfigure........... ^[34;1mOff^[m" set optionstoggled_ansi[6]="^[1mR^[meconfigure........... ^[32;7mOn^[m" set optionsmenu_kmdb=7 set optionsmenu_command[7]="cycle_kmdb" set optionsmenu_keycode[7]=107 \ \ In EFI mode the framebuffer cannot be disabled. Although "framebuffer off" \ does switch to a simple text protocol, it doesn't affect the kernel which \ still ends up with a framebuffer console. This option is therefore only \ exposed in a non-EFI environment. \ efi? invert [if] set optionsmenu_init[8]="init_framebuffer" set optionsmenu_caption[8]="[G]raphical Console... Off" set optionstoggled_text[8]="[G]raphical Console... On" set optionsmenu_command[8]="toggle_framebuffer" set optionsmenu_keycode[8]=103 set optionsansi_caption[8]="^[1mG^[mraphical Console..... ^[34;1mOff^[m" set optionstoggled_ansi[8]="^[1mG^[mraphical Console..... ^[32;7mOn^[m" [then] \ \ BOOT ENVIRONMENT MENU \ \ the BE list is read from [pool]/boot/menu.lst, the list in file \ is ordered from oldest to most recent. \ the BE menu will list entries from most recent to oldest, \ so the first page in menu is last page in menu.lst be-pages [if] set zfs_be_currpage=1 be-set-page \ set page data set menuset_name3="bootenv" set bootenvmenu_command[1]="be_draw_screen 1 goto_menu" set bootenvmenu_keycode[1]=8 set bootenvmenu_keycode[2]=8 set bootenvmenu_command[2]="be_draw_screen 1 goto_menu" set bemenu_current="Active: " set beansi_current="^[1m${bemenu_current}^[m" set bemenu_bootfs="bootfs: " set beansi_bootfs="^[1m${bemenu_bootfs}^[m" set bemenu_page="[P]age: " set beansi_page="^[1mP^[mage: " set bemenu_pageof=" of " set beansi_pageof="${bemenu_pageof}" set bootenvmenu_init="init_bootenv" set bootenvmenu_keycode[3]=112 set bootenvmenu_command[3]="set_be_page" set bootenvmenu_options=4 set bootenvmenu_optionstext="Boot Environments:" [then] \ Enable automatic booting (add ``autoboot_delay=N'' to loader.conf(5) to \ customize the timeout; default is 10-seconds) \ set menu_timeout_command="boot" \ Include optional elements defined in a local file \ try-include /boot/menu.rc.local \ Display the main menu (see `menu.4th') set menuset_initial=1 menuset-loadinitial menu-display \ Copyright (c) 2012 Devin Teske \ Copyright 2020 OmniOS Community Edition (OmniOSce) Association. \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. \ marker task-menusets.4th vocabulary menusets-infrastructure only forth also menusets-infrastructure definitions variable menuset_use_name create menuset_affixbuf 255 allot create menuset_x 1 allot create menuset_y 1 allot : menuset-loadvar ( -- ) \ menuset_use_name is true or false \ $type should be set to one of: \ menu toggled ansi \ $var should be set to one of: \ caption command keycode text ... \ $affix is either prefix (menuset_use_name is true) \ or infix (menuset_use_name is false) s" set cmdbuf='set ${type}_${var}=\$'" evaluate s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length menuset_use_name @ true = if s" set cmdbuf=${cmdbuf}${affix}${type}_${var}" ( u1 -- u1 c-addr2 u2 ) else s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}" ( u1 -- u1 c-addr2 u2 ) then evaluate ( u1 c-addr2 u2 -- u1 ) s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 ) rot 2 pick 2 pick over + -rot + tuck - ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 ) \ Generate a string representing rvalue inheritance var getenv dup -1 = if ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 ) \ NOT set -- clean up the stack drop ( c-addr2 u2 -1 -- c-addr2 u2 ) 2drop ( c-addr2 u2 -- ) else ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 ) \ SET -- execute cmdbuf (c-addr2/u2) to inherit value 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 ) evaluate ( c-addr2 u2 -- ) then s" cmdbuf" unsetenv ; : menuset-unloadvar ( -- ) \ menuset_use_name is true or false \ $type should be set to one of: \ menu toggled ansi \ $var should be set to one of: \ caption command keycode text ... \ $affix is either prefix (menuset_use_name is true) \ or infix (menuset_use_name is false) menuset_use_name @ true = if s" set buf=${affix}${type}_${var}" else s" set buf=${type}set${affix}_${var}" then evaluate s" buf" getenv unsetenv s" buf" unsetenv ; : menuset-loadmenuvar ( -- ) s" set type=menu" evaluate menuset-loadvar ; : menuset-unloadmenuvar ( -- ) s" set type=menu" evaluate menuset-unloadvar ; : menuset-loadxvar ( -- ) \ menuset_use_name is true or false \ $type should be set to one of: \ menu toggled ansi \ $var should be set to one of: \ caption command keycode text ... \ $x is "1" through "8" \ $affix is either prefix (menuset_use_name is true) \ or infix (menuset_use_name is false) s" set cmdbuf='set ${type}_${var}[${x}]=\$'" evaluate s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length menuset_use_name @ true = if s" set cmdbuf=${cmdbuf}${affix}${type}_${var}[${x}]" ( u1 -- u1 c-addr2 u2 ) else s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}[${x}]" ( u1 -- u1 c-addr2 u2 ) then evaluate ( u1 c-addr2 u2 -- u1 ) s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 ) rot 2 pick 2 pick over + -rot + tuck - ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 ) \ Generate a string representing rvalue inheritance var getenv dup -1 = if ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 ) \ NOT set -- clean up the stack drop ( c-addr2 u2 -1 -- c-addr2 u2 ) 2drop ( c-addr2 u2 -- ) else ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 ) \ SET -- execute cmdbuf (c-addr2/u2) to inherit value 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 ) evaluate ( c-addr2 u2 -- ) then s" cmdbuf" unsetenv ; : menuset-unloadxvar ( -- ) \ menuset_use_name is true or false \ $type should be set to one of: \ menu toggled ansi \ $var should be set to one of: \ caption command keycode text ... \ $x is "1" through "8" \ $affix is either prefix (menuset_use_name is true) \ or infix (menuset_use_name is false) menuset_use_name @ true = if s" set buf=${affix}${type}_${var}[${x}]" else s" set buf=${type}set${affix}_${var}[${x}]" then evaluate s" buf" getenv unsetenv s" buf" unsetenv ; : menuset-loadansixvar ( -- ) s" set type=ansi" evaluate menuset-loadxvar ; : menuset-unloadansixvar ( -- ) s" set type=ansi" evaluate menuset-unloadxvar ; : menuset-loadmenuxvar ( -- ) s" set type=menu" evaluate menuset-loadxvar ; : menuset-unloadmenuxvar ( -- ) s" set type=menu" evaluate menuset-unloadxvar ; : menuset-unloadtypelessxvar ( -- ) s" set type=" evaluate menuset-unloadxvar ; : menuset-loadtoggledxvar ( -- ) s" set type=toggled" evaluate menuset-loadxvar ; : menuset-unloadtoggledxvar ( -- ) s" set type=toggled" evaluate menuset-unloadxvar ; : menuset-loadxyvar ( -- ) \ menuset_use_name is true or false \ $type should be set to one of: \ menu toggled ansi \ $var should be set to one of: \ caption command keycode text ... \ $x is "1" through "8" \ $y is "0" through "9" \ $affix is either prefix (menuset_use_name is true) \ or infix (menuset_use_name is false) s" set cmdbuf='set ${type}_${var}[${x}][${y}]=\$'" evaluate s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length menuset_use_name @ true = if s" set cmdbuf=${cmdbuf}${affix}${type}_${var}[${x}][${y}]" ( u1 -- u1 c-addr2 u2 ) else s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}[${x}][${y}]" ( u1 -- u1 c-addr2 u2 ) then evaluate ( u1 c-addr2 u2 -- u1 ) s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 ) rot 2 pick 2 pick over + -rot + tuck - ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 ) \ Generate a string representing rvalue inheritance var getenv dup -1 = if ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 ) \ NOT set -- clean up the stack drop ( c-addr2 u2 -1 -- c-addr2 u2 ) 2drop ( c-addr2 u2 -- ) else ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 ) \ SET -- execute cmdbuf (c-addr2/u2) to inherit value 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 ) evaluate ( c-addr2 u2 -- ) then s" cmdbuf" unsetenv ; : menuset-unloadxyvar ( -- ) \ menuset_use_name is true or false \ $type should be set to one of: \ menu toggled ansi \ $var should be set to one of: \ caption command keycode text ... \ $x is "1" through "8" \ $y is "0" through "9" \ $affix is either prefix (menuset_use_name is true) \ or infix (menuset_use_name is false) menuset_use_name @ true = if s" set buf=${affix}${type}_${var}[${x}][${y}]" else s" set buf=${type}set${affix}_${var}[${x}][${y}]" then evaluate s" buf" getenv unsetenv s" buf" unsetenv ; : menuset-loadansixyvar ( -- ) s" set type=ansi" evaluate menuset-loadxyvar ; : menuset-unloadansixyvar ( -- ) s" set type=ansi" evaluate menuset-unloadxyvar ; : menuset-loadmenuxyvar ( -- ) s" set type=menu" evaluate menuset-loadxyvar ; : menuset-unloadmenuxyvar ( -- ) s" set type=menu" evaluate menuset-unloadxyvar ; : menuset-setnum-namevar ( N -- C-Addr/U ) s" menuset_nameNNNNN" ( n -- n c-addr1 u1 ) \ variable basename drop 12 ( n c-addr1 u1 -- n c-addr1 12 ) \ remove "NNNNN" rot ( n c-addr1 12 -- c-addr1 12 n ) \ move number on top \ convert to string n2s ( c-addr1 12 n -- c-addr1 12 c-addr2 u2 ) \ Combine strings begin ( using u2 in c-addr2/u2 pair as countdown to zero ) over ( c-addr1 u1 c-addr2 u2 -- continued below ) ( c-addr1 u1 c-addr2 u2 c-addr2 ) \ copy src-addr c@ ( c-addr1 u1 c-addr2 u2 c-addr2 -- continued below ) ( c-addr1 u1 c-addr2 u2 c ) \ get next src-addr byte 4 pick 4 pick ( c-addr1 u1 c-addr2 u2 c -- continued below ) ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 ) \ get destination c-addr1/u1 pair + ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 -- cont. below ) ( c-addr1 u1 c-addr2 u2 c c-addr3 ) \ combine dest-c-addr to get dest-addr for byte c! ( c-addr1 u1 c-addr2 u2 c c-addr3 -- continued below ) ( c-addr1 u1 c-addr2 u2 ) \ store the current src-addr byte into dest-addr 2swap 1+ 2swap \ increment u1 in destination c-addr1/u1 pair swap 1+ swap \ increment c-addr2 in source c-addr2/u2 pair 1- \ decrement u2 in the source c-addr2/u2 pair dup 0= \ time to break? until 2drop ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 ) \ drop temporary number-format conversion c-addr2/u2 ; : menuset-checksetnum ( N -- ) \ \ adjust input to be both positive and no-higher than 65535 \ abs dup 65535 > if drop 65535 then ( n -- n ) \ \ The next few blocks will determine if we should use the default \ methodology (referencing the original numeric stack-input), or if- \ instead $menuset_name{N} has been defined wherein we would then \ use the value thereof as the prefix to every menu variable. \ false menuset_use_name ! \ assume name is not set menuset-setnum-namevar \ \ We now have a string that is the assembled variable name to check \ for... $menuset_name{N}. Let's check for it. \ 2dup ( c-addr1 u1 -- c-addr1 u1 c-addr1 u1 ) \ save a copy getenv dup -1 <> if ( c-addr1 u1 c-addr1 u1 -- c-addr1 u1 c-addr2 u2 ) \ The variable is set. Let's clean up the stack leaving only \ its value for later use. true menuset_use_name ! 2swap 2drop ( c-addr1 u1 c-addr2 u2 -- c-addr2 u2 ) \ drop assembled variable name, leave the value else ( c-addr1 u1 c-addr1 u1 -- c-addr1 u1 -1 ) \ no such variable \ The variable is not set. Let's clean up the stack leaving the \ string [portion] representing the original numeric input. drop ( c-addr1 u1 -1 -- c-addr1 u1 ) \ drop -1 result 12 - swap 12 + swap ( c-addr1 u1 -- c-addr2 u2 ) \ truncate to original numeric stack-input then \ \ Now, depending on whether $menuset_name{N} has been set, we have \ either the value thereof to be used as a prefix to all menu_* \ variables or we have a string representing the numeric stack-input \ to be used as a "set{N}" infix to the same menu_* variables. \ \ For example, if the stack-input is 1 and menuset_name1 is NOT set \ the following variables will be referenced: \ ansiset1_caption[x] -> ansi_caption[x] \ ansiset1_caption[x][y] -> ansi_caption[x][y] \ menuset1_acpi -> menu_acpi \ menuset1_osconsole -> menu_osconsole \ menuset1_caption[x] -> menu_caption[x] \ menuset1_caption[x][y] -> menu_caption[x][y] \ menuset1_command[x] -> menu_command[x] \ menuset1_init -> ``evaluated'' \ menuset1_init[x] -> menu_init[x] \ menuset1_kernel -> menu_kernel \ menuset1_keycode[x] -> menu_keycode[x] \ menuset1_options -> menu_options \ menuset1_optionstext -> menu_optionstext \ menuset1_reboot -> menu_reboot \ toggledset1_ansi[x] -> toggled_ansi[x] \ toggledset1_text[x] -> toggled_text[x] \ otherwise, the following variables are referenced (where {name} \ represents the value of $menuset_name1 (given 1 as stack-input): \ {name}ansi_caption[x] -> ansi_caption[x] \ {name}ansi_caption[x][y] -> ansi_caption[x][y] \ {name}menu_acpi -> menu_acpi \ {name}menu_caption[x] -> menu_caption[x] \ {name}menu_caption[x][y] -> menu_caption[x][y] \ {name}menu_command[x] -> menu_command[x] \ {name}menu_init -> ``evaluated'' \ {name}menu_init[x] -> menu_init[x] \ {name}menu_kernel -> menu_kernel \ {name}menu_keycode[x] -> menu_keycode[x] \ {name}menu_options -> menu_options \ {name}menu_optionstext -> menu_optionstext \ {name}menu_reboot -> menu_reboot \ {name}toggled_ansi[x] -> toggled_ansi[x] \ {name}toggled_text[x] -> toggled_text[x] \ \ Note that menuset{N}_init and {name}menu_init are the initializers \ for the entire menu (for wholly dynamic menus) opposed to the per- \ menuitem initializers (with [x] afterward). The whole-menu init \ routine is evaluated and not passed down to $menu_init (which \ would result in double evaluation). By doing this, the initializer \ can initialize the menuset before we transfer it to active-duty. \ \ \ Copy our affixation (prefix or infix depending on menuset_use_name) \ to our buffer so that we can safely use the s-quote (s") buf again. \ menuset_affixbuf 0 2swap ( c-addr2 u2 -- c-addr1 0 c-addr2 u2 ) begin ( using u2 in c-addr2/u2 pair as countdown to zero ) over ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 c-addr2 u2 c-addr2 ) c@ ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 c-addr2 u2 c ) 4 pick 4 pick ( c-addr1 u1 c-addr2 u2 c -- continued below ) ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 ) + ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 -- continued below ) ( c-addr1 u1 c-addr2 u2 c c-addr3 ) c! ( c-addr1 u1 c-addr2 u2 c c-addr3 -- continued below ) ( c-addr1 u1 c-addr2 u2 ) 2swap 1+ 2swap \ increment affixbuf byte position/count swap 1+ swap \ increment strbuf pointer (source c-addr2) 1- \ decrement strbuf byte count (source u2) dup 0= \ time to break? until 2drop ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 ) \ drop strbuf c-addr2/u2 \ \ Create a variable for referencing our affix data (prefix or infix \ depending on menuset_use_name as described above). This variable will \ be temporary and only used to simplify cmdbuf assembly. \ s" affix" setenv ( c-addr1 u1 -- ) ; : menuset-cleanup ( -- ) s" type" unsetenv s" var" unsetenv s" x" unsetenv s" y" unsetenv s" affix" unsetenv ; only forth definitions also menusets-infrastructure : menuset-loadsetnum ( N -- ) menuset-checksetnum ( n -- ) \ \ From here out, we use temporary environment variables to make \ dealing with variable-length strings easier. \ \ menuset_use_name is true or false \ $affix should be used appropriately w/respect to menuset_use_name \ \ ... menu_init ... s" set var=init" evaluate menuset-loadmenuvar \ If menu_init was set by the above, evaluate it here-and-now \ so that the remaining variables are influenced by its actions s" menu_init" 2dup getenv dup -1 <> if 2swap unsetenv \ don't want later menu-create to re-call this evaluate else drop 2drop ( n c-addr u -1 -- n ) then [char] 1 ( -- x ) \ Loop range ASCII '1' (49) to '8' (56) begin dup menuset_x tuck c! 1 s" x" setenv \ set loop iterator and $x s" set var=caption" evaluate \ ... menu_caption[x] ... menuset-loadmenuxvar \ ... ansi_caption[x] ... menuset-loadansixvar [char] 0 ( x -- x y ) \ Inner Loop ASCII '1' (48) to '9' (57) begin dup menuset_y tuck c! 1 s" y" setenv \ set inner loop iterator and $y \ ... menu_caption[x][y] ... menuset-loadmenuxyvar \ ... ansi_caption[x][y] ... menuset-loadansixyvar 1+ dup 57 > ( x y -- y' 0|-1 ) \ increment and test until drop ( x y -- x ) \ ... menu_command[x] ... s" set var=command" evaluate menuset-loadmenuxvar \ ... menu_init[x] ... s" set var=init" evaluate menuset-loadmenuxvar \ ... menu_keycode[x] ... s" set var=keycode" evaluate menuset-loadmenuxvar \ ... toggled_text[x] ... s" set var=text" evaluate menuset-loadtoggledxvar \ ... toggled_ansi[x] ... s" set var=ansi" evaluate menuset-loadtoggledxvar 1+ dup 56 > ( x -- x' 0|-1 ) \ increment iterator \ continue if less than 57 until drop ( x -- ) \ loop iterator \ ... menu_reboot ... s" set var=reboot" evaluate menuset-loadmenuvar \ ... menu_acpi ... s" set var=acpi" evaluate menuset-loadmenuvar \ ... menu_osconsole ... s" set var=osconsole" evaluate menuset-loadmenuvar \ ... menu_kmdb ... s" set var=kmdb" evaluate menuset-loadmenuvar \ ... menu_options ... s" set var=options" evaluate menuset-loadmenuvar \ ... menu_optionstext ... s" set var=optionstext" evaluate menuset-loadmenuvar menuset-cleanup ; : menusets-unset ( -- ) \ clean up BE menu internal variables s" beansi_bootfs" unsetenv s" beansi_current" unsetenv s" beansi_page" unsetenv s" beansi_pageof" unsetenv s" bemenu_bootfs" unsetenv s" bemenu_current" unsetenv s" bemenu_page" unsetenv s" bemenu_pageof" unsetenv s" zfs_be_active" unsetenv s" zfs_be_currpage" unsetenv s" zfs_be_pages" unsetenv s" menuset_initial" unsetenv 1 begin dup menuset-checksetnum ( n n -- n ) dup menuset-setnum-namevar ( n n -- n ) unsetenv \ If the current menuset does not populate the first menuitem, \ we stop completely. menuset_use_name @ true = if s" set buf=${affix}menu_command[1]" else s" set buf=menuset${affix}_command[1]" then evaluate s" buf" getenv getenv -1 = if drop ( n -- ) s" buf" unsetenv menuset-cleanup exit else drop ( n c-addr2 -- n ) \ unused then [char] 1 ( n -- n x ) \ Loop range ASCII '1' (49) to '8' (56) begin dup menuset_x tuck c! 1 s" x" setenv \ set $x to x s" set var=caption" evaluate menuset-unloadmenuxvar menuset-unloadmenuxvar menuset-unloadansixvar [char] 0 ( n x -- n x y ) \ Inner loop '0' to '9' begin dup menuset_y tuck c! 1 s" y" setenv \ sets $y to y menuset-unloadmenuxyvar menuset-unloadansixyvar 1+ dup 57 > ( n x y -- n x y' 0|-1 ) until drop ( n x y -- n x ) s" set var=command" evaluate menuset-unloadmenuxvar s" set var=init" evaluate menuset-unloadmenuxvar s" set var=keycode" evaluate menuset-unloadmenuxvar s" set var=root" evaluate menuset-unloadtypelessxvar s" set var=text" evaluate menuset-unloadtoggledxvar s" set var=ansi" evaluate menuset-unloadtoggledxvar 1+ dup 56 > ( x -- x' 0|-1 ) \ increment and test until drop ( n x -- n ) \ loop iterator s" set var=acpi" evaluate menuset-unloadmenuvar s" set var=osconsole" evaluate menuset-unloadmenuvar s" set var=kmdb" evaluate menuset-unloadmenuvar s" set var=init" evaluate menuset-unloadmenuvar s" set var=options" evaluate menuset-unloadmenuvar s" set var=optionstext" evaluate menuset-unloadmenuvar s" set var=reboot" evaluate menuset-unloadmenuvar 1+ dup 65535 > ( n -- n' 0|-1 ) \ increment and test until drop ( n' -- ) \ loop iterator s" buf" unsetenv menuset-cleanup ; only forth definitions : menuset-loadinitial ( -- ) s" menuset_initial" getenv dup -1 <> if ?number 0<> if menuset-loadsetnum then else drop \ cruft then ; \ Copyright (c) 2014 M. Warner Losh \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. \ \ $FreeBSD$ only forth also support-functions also builtins definitions \ pci-device-count pci-id \ \ Counts the number of instances of pci-id in the system and reports \ it to the user. : pci-device-count 0= if ( interpreted ) get_arguments then 0= if ." Need an argument" cr abort then \ First argument is 0 when we're interprated. See support.4th \ for get_arguments reading the rest of the line and parsing it \ stack: argN lenN ... arg1 len1 N hex ?number decimal 0= if ." Bad pci-id given (must be legal hex value)" cr abort then dup pcibios-device-count ." Found " . ." instances of " hex . decimal cr ; also forth definitions also builtins builtin: pci-device-count \ Copyright (c) 2000 Daniel C. Sobral \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. \ \ $FreeBSD$ \ The following pnp code is used in pnp.4th and pnp.c structure: STAILQ_HEAD ptr stqh_first \ type* ptr stqh_last \ type** ;structure structure: STAILQ_ENTRY ptr stqe_next \ type* ;structure structure: pnphandler ptr pnph.name ptr pnph.enumerate ;structure structure: pnpident ptr pnpid.ident \ char* sizeof STAILQ_ENTRY cells member: pnpid.link \ pnpident ;structure structure: pnpinfo \ sync with sys/boot/config/bootstrap.h ptr pnpi.desc int pnpi.revision ptr pnpi.module \ (char*) module args int pnpi.argc ptr pnpi.argv ptr pnpi.handler \ pnphandler sizeof STAILQ_HEAD member: pnpi.ident \ pnpident sizeof STAILQ_ENTRY member: pnpi.link \ pnpinfo ;structure \ end of pnp support pnpdevices drop : enumerate pnphandlers begin dup @ while ." Probing " dup @ pnph.name @ dup strlen type ." ..." cr 0 over @ pnph.enumerate @ ccall drop cell+ repeat ; : summary ." PNP scan summary:" cr pnpdevices stqh_first @ begin dup while dup pnpi.ident stqh_first @ pnpid.ident @ dup strlen type dup pnpi.desc @ ?dup if ." : " dup strlen type then cr pnpi.link stqe_next @ repeat drop ; : compare-pnpid ( addr addr' -- flag ) begin over c@ over c@ <> if drop drop false exit then over c@ over c@ and while char+ swap char+ swap repeat c@ swap c@ or 0= ; : search-pnpid ( id -- flag ) >r pnpdevices stqh_first @ begin ( pnpinfo ) dup while dup pnpi.ident stqh_first @ begin ( pnpinfo pnpident ) dup pnpid.ident @ r@ compare-pnpid if r> drop \ XXX Temporary debugging message ." Found " pnpid.ident @ dup strlen type pnpi.desc @ ?dup if ." : " dup strlen type then cr \ drop drop true exit then pnpid.link stqe_next @ ?dup 0= until pnpi.link stqe_next @ repeat r> drop drop false ; : skip-space ( addr -- addr' ) begin dup c@ bl = over c@ 9 = or while char+ repeat ; : skip-to-space ( addr -- addr' ) begin dup c@ bl <> over c@ 9 <> and over c@ and while char+ repeat ; : premature-end? ( addr -- addr flag ) postpone dup postpone c@ postpone 0= postpone if postpone exit postpone then ; immediate 0 value filename 0 value timestamp 0 value id only forth also support-functions : (load) load ; : check-pnpid ( -- ) line_buffer .addr @ \ Search for filename skip-space premature-end? dup to filename \ Search for end of filename skip-to-space premature-end? 0 over c! char+ \ Search for timestamp skip-space premature-end? dup to timestamp skip-to-space premature-end? 0 over c! char+ \ Search for ids begin skip-space premature-end? dup to id skip-to-space dup c@ >r 0 over c! char+ id search-pnpid if filename dup strlen 1 ['] (load) catch if drop drop drop ." Error loading " filename dup strlen type cr then r> drop exit then r> 0= until ; : load-pnp 0 to end_of_file? reset_line_reading s" /boot/pnpid.conf" O_RDONLY fopen fd ! fd @ -1 <> if begin end_of_file? 0= while read_line check-pnpid repeat fd @ fclose then ; \ Copyright (c) 2003 Scott Long \ Copyright (c) 2015 Devin Teske \ Copyright 2019 OmniOS Community Edition (OmniOSce) Association. \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. marker task-screen.4th \ emit Esc-[ : escc ( -- ) 27 emit [char] [ emit ; \ Home cursor ( Esc-[H ) : ho ( -- ) escc [char] H emit ; \ Clear from current position to end of display ( Esc-[J ) : cld ( -- ) escc [char] J emit ; \ clear screen : clear ( -- ) ho cld ; \ move cursor to x rows, y cols (1-based coords) ( Esc-[%d;%dH ) : at-xy ( x y -- ) escc .# [char] ; emit .# [char] H emit ; \ Set foreground color ( Esc-[3%dm ) : fg ( x -- ) escc 3 .# .# [char] m emit ; \ Set background color ( Esc-[4%dm ) : bg ( x -- ) escc 4 .# .# [char] m emit ; \ Mode end (clear attributes) : me ( -- ) escc [char] m emit ; \ Enable bold mode ( Esc-[1m ) : b ( -- ) escc 1 .# [char] m emit ; \ Disable bold mode ( Esc-[22m ) : -b ( -- ) escc 22 .# [char] m emit ; \ Enable inverse foreground/background mode ( Esc-[7m ) : inv ( -- ) escc 7 .# [char] m emit ; \ Disable inverse foreground/background mode ( Esc-[27m ) : -inv ( -- ) escc 27 .# [char] m emit ; \ Convert all occurrences of given character (c) in string (c-addr/u) to Esc : escc! ( c-addr/u c -- c-addr/u ) 2 pick 2 pick begin dup 0> while over c@ 3 pick = if over 27 swap c! then 1- swap 1+ swap repeat 2drop drop ; \ Get the number of screen rows/columns : sr ( -- y ) 25 s" screen-#rows" getenvn ; : sc ( -- x ) 80 s" screen-#cols" getenvn ; \ Place the cursor at the bottom left of the screen : at-bl 0 sr at-xy ; \ set cursor invisible or normal (civis/cnorm) : cursor-invisible ( -- ) [char] l ; : cursor-normal ( -- ) [char] h ; : cursor-set ( cursor-mode -- ) escc [char] ? emit 25 .# emit ; \ Copyright (c) 2008-2011 Devin Teske \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. \ \ $FreeBSD$ \ FICL words intended to be used as shortcuts for carrying out common tasks or \ producing common results. Generally, words defined here are simply groupings \ of other custom words that pull from multiple libraries (for example, if you \ want to define a custom word that uses words defined in three different \ libraries, this is a good place to define such a word). \ \ This script should be included after you have included any/all other \ libraries. This will prevent calling a word defined here before any required \ words have been defined. marker task-shortcuts.4th \ This "shortcut" word will not be used directly, but is defined here to \ offer the user a quick way to get back into the interactive PXE menu \ after they have escaped to the shell (perhaps by accident). \ : menu ( -- ) clear \ Clear the screen (in screen.4th) print_version \ print version string (bottom-right; see version.4th) draw-beastie \ Draw FreeBSD logo at right (in beastie.4th) draw-brand \ Draw FIS logo at top (in brand.4th) menu-init \ Initialize menu and draw bounding box (in menu.4th) menu-display \ Launch interactive menu (in menu.4th) ; \ Copyright (c) 1999 Daniel C. Sobral \ Copyright 2019 OmniOS Community Edition (OmniOSce) Association. \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. \ Loader.rc support functions: \ \ initialize ( addr len -- ) as above, plus load_conf_files \ load_conf ( addr len -- ) load conf file given \ include_bootenv ( -- ) load bootenv.rc \ include_conf_files ( -- ) load all conf files in load_conf_files \ print_syntax_error ( -- ) print line and marker of where a syntax \ error was detected \ print_line ( -- ) print last line processed \ load_kernel ( -- ) load kernel \ load_modules ( -- ) load modules flagged \ \ Exported structures: \ \ string counted string structure \ cell .addr string address \ cell .len string length \ module module loading information structure \ cell module.flag should we load it? \ string module.name module's name \ string module.loadname name to be used in loading the module \ string module.type module's type (file | hash | rootfs) \ string module.hash module's sha1 hash \ string module.args flags to be passed during load \ string module.largs internal argument list \ string module.beforeload command to be executed before load \ string module.afterload command to be executed after load \ string module.loaderror command to be executed if load fails \ cell module.next list chain \ \ Exported global variables; \ \ string conf_files configuration files to be loaded \ cell modules_options pointer to first module information \ value verbose? indicates if user wants a verbose loading \ value any_conf_read? indicates if a conf file was successfully read \ \ Other exported words: \ note, strlen is internal \ strdup ( addr len -- addr' len) similar to strdup(3) \ strcat ( addr len addr' len' -- addr len+len' ) similar to strcat(3) \ s' ( | string' -- addr len | ) similar to s" \ rudimentary structure support \ Exception values 1 constant ESYNTAX 2 constant ENOMEM 3 constant EFREE 4 constant ESETERROR \ error setting environment variable 5 constant EREAD \ error reading 6 constant EOPEN 7 constant EEXEC \ XXX never catched 8 constant EBEFORELOAD 9 constant EAFTERLOAD \ I/O constants 0 constant SEEK_SET 1 constant SEEK_CUR 2 constant SEEK_END 0 constant O_RDONLY 1 constant O_WRONLY 2 constant O_RDWR \ Crude structure support : structure: create here 0 , ['] drop , 0 does> create here swap dup @ allot cell+ @ execute ; : member: create dup , over , + does> cell+ @ + ; : ;structure swap ! ; : constructor! >body cell+ ! ; : constructor: over :noname ; : ;constructor postpone ; swap cell+ ! ; immediate : sizeof ' >body @ state @ if postpone literal then ; immediate : offsetof ' >body cell+ @ state @ if postpone literal then ; immediate : ptr 1 cells member: ; : int 1 cells member: ; \ String structure structure: string ptr .addr int .len constructor: 0 over .addr ! 0 swap .len ! ;constructor ;structure \ Module options linked list structure: module int module.flag sizeof string member: module.name sizeof string member: module.loadname sizeof string member: module.type sizeof string member: module.hash sizeof string member: module.args sizeof string member: module.largs sizeof string member: module.beforeload sizeof string member: module.afterload sizeof string member: module.loaderror ptr module.next ;structure \ Internal loader structures (preloaded_file, kernel_module, file_metadata) \ must be in sync with the C struct in sys/boot/common/bootstrap.h structure: preloaded_file ptr pf.name ptr pf.type ptr pf.args ptr pf.metadata \ file_metadata int pf.loader int pf.addr int pf.size ptr pf.modules \ kernel_module ptr pf.next \ preloaded_file ;structure structure: kernel_module ptr km.name ptr km.args ptr km.fp \ preloaded_file ptr km.next \ kernel_module ;structure structure: file_metadata int md.size 2 member: md.type \ this is not ANS Forth compatible (XXX) ptr md.next \ file_metadata 0 member: md.data \ variable size ;structure \ end of structures \ Global variables string conf_files create module_options sizeof module.next allot 0 module_options ! create last_module_option sizeof module.next allot 0 last_module_option ! 0 value verbose? \ Support string functions : strdup { addr len -- addr' len' } len allocate if ENOMEM throw then addr over len move len ; : strcat { addr len addr' len' -- addr len+len' } addr' addr len + len' move addr len len' + ; : strchr { addr len c -- addr' len' } begin len while addr c@ c = if addr len exit then addr 1 + to addr len 1 - to len repeat 0 0 ; : strspn { addr len addr1 len1 | paddr plen -- addr' len' } begin len while addr1 to paddr len1 to plen begin plen while addr c@ paddr c@ = if addr len exit then paddr 1+ to paddr plen 1- to plen repeat addr 1 + to addr len 1 - to len repeat 0 0 ; : s' \ same as s", allows " in the string [char] ' parse state @ if postpone sliteral then ; immediate : 2>r postpone >r postpone >r ; immediate : 2r> postpone r> postpone r> ; immediate : 2r@ postpone 2r> postpone 2dup postpone 2>r ; immediate \ Number to string : n2s ( n -- c-addr/u ) s>d <# #s #> ; \ String to number : s2n ( c-addr/u1 -- u2 | -1 ) ?number 0= if -1 then ; \ Test if an environment variable is set : getenv? getenv -1 = if false else drop true then ; \ Fetch a number from an environment variable, or a default if not set or does \ not parse (s2n returns -1). : getenvn ( n1 c-addr/u -- n1 | n2 ) getenv dup -1 = if \ environment variable not set drop ( n1 -1 -- n1 ) else s2n ( n1 c-addr/u1 -- n1 n2 ) dup -1 = if \ parse failed drop ( n1 n2 -- n1 ) else nip ( n1 n2 -- n2 ) then then ; \ execute xt for each device listed in console variable. \ this allows us to have device specific output for logos, menu frames etc : console-iterate { xt | caddr clen taddr tlen -- } \ get current console and save it s" console" getenv ['] strdup catch if 2drop exit then to clen to caddr clen to tlen caddr to taddr begin tlen while taddr tlen s" , " strspn \ we need to handle 3 cases for addr len pairs on stack: \ addr len are 0 0 - there was no comma nor space \ addr len are x 0 - the first char is either comma or space \ addr len are x y. 2dup + 0= if \ there was no comma nor space. 2drop taddr tlen s" console" setenv xt execute 0 to tlen else dup 0= if 2drop else dup ( taddr' tlen' tlen' ) tlen swap - dup 0= if \ sequence of comma and space? drop else taddr swap s" console" setenv xt execute then to tlen to taddr then then tlen 0> if \ step over separator tlen 1- to tlen taddr 1+ to taddr then repeat caddr clen s" console" setenv \ restore console setup caddr free drop ; \ Test if booted in an EFI environment : efi? ( -- flag ) s" efi-version" getenv? ; \ determine if a word appears in a string, case-insensitive : contains? ( addr1 len1 addr2 len2 -- 0 | -1 ) 2 pick 0= if 2drop 2drop true exit then dup 0= if 2drop 2drop false exit then begin begin swap dup c@ dup 32 = over 9 = or over 10 = or over 13 = or over 44 = or swap drop while 1+ swap 1- repeat swap 2 pick 1- over < while 2over 2over drop over compare-insensitive 0= if 2 pick over = if 2drop 2drop true exit then 2 pick tuck - -rot + swap over c@ dup 32 = over 9 = or over 10 = or over 13 = or over 44 = or swap drop if 2drop 2drop true exit then then begin swap dup c@ dup 32 = over 9 = or over 10 = or over 13 = or over 44 = or swap drop if false else true then 2 pick 0> and while 1+ swap 1- repeat swap repeat 2drop 2drop false ; : boot_serial? ( -- 0 | -1 ) s" console" getenv dup -1 <> if 2dup s" ttya" 2swap contains? ( addr len f ) -rot 2dup ( f addr len addr len ) s" ttyb" 2swap contains? ( f addr len f ) -rot 2dup ( f f addr len addr len ) s" ttyc" 2swap contains? ( f f addr len f ) -rot ( f f f addr len ) s" ttyd" 2swap contains? ( f f addr len f ) or or or else drop false then s" boot_serial" getenv dup -1 <> if swap drop 0> else drop false then or \ console contains tty ( or ) boot_serial s" boot_multicons" getenv dup -1 <> if swap drop 0> else drop false then or \ previous boolean ( or ) boot_multicons ; : framebuffer? ( -- t ) s" console" getenv s" text" compare 0<> if FALSE exit then s" screen-width" getenv? ; \ Private definitions vocabulary support-functions only forth also support-functions definitions \ Some control characters constants 7 constant bell 8 constant backspace 9 constant tab 10 constant lf 13 constant \ Read buffer size 80 constant read_buffer_size \ Standard suffixes : load_module_suffix s" _load" ; : module_loadname_suffix s" _name" ; : module_type_suffix s" _type" ; : module_hash_suffix s" _hash" ; : module_args_suffix s" _flags" ; : module_beforeload_suffix s" _before" ; : module_afterload_suffix s" _after" ; : module_loaderror_suffix s" _error" ; \ Support operators : >= < 0= ; : <= > 0= ; \ Assorted support functions : free-memory free if EFREE throw then ; : strget { var -- addr len } var .addr @ var .len @ ; \ assign addr len to variable. : strset { addr len var -- } addr var .addr ! len var .len ! ; \ free memory and reset fields : strfree { var -- } var .addr @ ?dup if free-memory 0 0 var strset then ; \ free old content, make a copy of the string and assign to variable : string= { addr len var -- } var strfree addr len strdup var strset ; : strtype ( str -- ) strget type ; \ assign a reference to what is on the stack : strref { addr len var -- addr len } addr var .addr ! len var .len ! addr len ; \ unquote a string : unquote ( addr len -- addr len ) over c@ [char] " = if 2 chars - swap char+ swap then ; \ Assignment data temporary storage string name_buffer string value_buffer \ Line by line file reading functions \ \ exported: \ line_buffer \ end_of_file? \ fd \ read_line \ reset_line_reading vocabulary line-reading also line-reading definitions \ File data temporary storage string read_buffer 0 value read_buffer_ptr \ File's line reading function get-current ( -- wid ) previous definitions string line_buffer 0 value end_of_file? variable fd >search ( wid -- ) definitions : skip_newlines begin read_buffer .len @ read_buffer_ptr > while read_buffer .addr @ read_buffer_ptr + c@ lf = if read_buffer_ptr char+ to read_buffer_ptr else exit then repeat ; : scan_buffer ( -- addr len ) read_buffer_ptr >r begin read_buffer .len @ r@ > while read_buffer .addr @ r@ + c@ lf = if read_buffer .addr @ read_buffer_ptr + ( -- addr ) r@ read_buffer_ptr - ( -- len ) r> to read_buffer_ptr exit then r> char+ >r repeat read_buffer .addr @ read_buffer_ptr + ( -- addr ) r@ read_buffer_ptr - ( -- len ) r> to read_buffer_ptr ; : line_buffer_resize ( len -- len ) dup 0= if exit then >r line_buffer .len @ if line_buffer .addr @ line_buffer .len @ r@ + resize if ENOMEM throw then else r@ allocate if ENOMEM throw then then line_buffer .addr ! r> ; : append_to_line_buffer ( addr len -- ) dup 0= if 2drop exit then line_buffer strget 2swap strcat line_buffer .len ! drop ; : read_from_buffer scan_buffer ( -- addr len ) line_buffer_resize ( len -- len ) append_to_line_buffer ( addr len -- ) ; : refill_required? read_buffer .len @ read_buffer_ptr = end_of_file? 0= and ; : refill_buffer 0 to read_buffer_ptr read_buffer .addr @ 0= if read_buffer_size allocate if ENOMEM throw then read_buffer .addr ! then fd @ read_buffer .addr @ read_buffer_size fread dup -1 = if EREAD throw then dup 0= if true to end_of_file? then read_buffer .len ! ; get-current ( -- wid ) previous definitions >search ( wid -- ) : reset_line_reading 0 to read_buffer_ptr ; : read_line line_buffer strfree skip_newlines begin read_from_buffer refill_required? while refill_buffer repeat ; only forth also support-functions definitions \ Conf file line parser: \ ::= '='[] | \ [] \ ::= {||'_'|'-'|'/'} \ ::= {||'_'|'-'|','} \ ::= '"'{|'\'}'"' | \ ::= ASCII 32 to 126, except '\' and '"' \ ::= '#'{} \ \ bootenv line parser: \ ::= setprop[] | \ [] \ \ exported: \ line_pointer \ process_conf \ process_conf 0 value line_pointer vocabulary file-processing also file-processing definitions \ parser functions \ \ exported: \ get_assignment \ get_prop vocabulary parser also parser definitions 0 value parsing_function 0 value end_of_line : end_of_line? line_pointer end_of_line = ; \ classifiers for various character classes in the input line : letter? line_pointer c@ >r r@ [char] A >= r@ [char] Z <= and r@ [char] a >= r> [char] z <= and or ; : digit? line_pointer c@ >r r@ [char] - = r@ [char] 0 >= r> [char] 9 <= and or ; : "quote? line_pointer c@ [char] " = ; : 'quote? line_pointer c@ [char] ' = ; : assignment_sign? line_pointer c@ [char] = = ; : comment? line_pointer c@ [char] # = ; : space? line_pointer c@ bl = line_pointer c@ tab = or ; : backslash? line_pointer c@ [char] \ = ; : underscore? line_pointer c@ [char] _ = ; : dot? line_pointer c@ [char] . = ; : dash? line_pointer c@ [char] - = ; : comma? line_pointer c@ [char] , = ; : at? line_pointer c@ [char] @ = ; : slash? line_pointer c@ [char] / = ; : colon? line_pointer c@ [char] : = ; \ manipulation of input line : skip_character line_pointer char+ to line_pointer ; : skip_to_end_of_line end_of_line to line_pointer ; : eat_space begin end_of_line? if 0 else space? then while skip_character repeat ; : parse_name ( -- addr len ) line_pointer begin end_of_line? if 0 else letter? digit? underscore? dot? dash? comma? slash? or or or or or or then while skip_character repeat line_pointer over - strdup ; : parse_value ( -- addr len ) line_pointer begin end_of_line? if 0 else letter? digit? underscore? dot? comma? dash? at? slash? colon? or or or or or or or or then while skip_character repeat line_pointer over - strdup ; : remove_backslashes { addr len | addr' len' -- addr' len' } len allocate if ENOMEM throw then to addr' addr >r begin addr c@ [char] \ <> if addr c@ addr' len' + c! len' char+ to len' then addr char+ to addr r@ len + addr = until r> drop addr' len' ; : parse_quote ( xt -- addr len ) >r ( R: xt ) line_pointer skip_character end_of_line? if ESYNTAX throw then begin r@ execute 0= while backslash? if skip_character end_of_line? if ESYNTAX throw then then skip_character end_of_line? if ESYNTAX throw then repeat r> drop skip_character line_pointer over - remove_backslashes ; : read_name parse_name ( -- addr len ) name_buffer strset ; : read_value "quote? if ['] "quote? parse_quote ( -- addr len ) else 'quote? if ['] 'quote? parse_quote ( -- addr len ) else parse_value ( -- addr len ) then then value_buffer strset ; : comment skip_to_end_of_line ; : white_space_4 eat_space comment? if ['] comment to parsing_function exit then end_of_line? 0= if ESYNTAX throw then ; : variable_value read_value ['] white_space_4 to parsing_function ; : white_space_3 eat_space slash? letter? digit? "quote? 'quote? or or or or if ['] variable_value to parsing_function exit then ESYNTAX throw ; : assignment_sign skip_character ['] white_space_3 to parsing_function ; : white_space_2 eat_space assignment_sign? if ['] assignment_sign to parsing_function exit then ESYNTAX throw ; : variable_name read_name ['] white_space_2 to parsing_function ; : white_space_1 eat_space letter? if ['] variable_name to parsing_function exit then comment? if ['] comment to parsing_function exit then end_of_line? 0= if ESYNTAX throw then ; : prop_name eat_space read_name ['] white_space_3 to parsing_function ; : get_prop_cmd eat_space s" setprop" line_pointer over compare 0= if line_pointer 7 + to line_pointer ['] prop_name to parsing_function exit then comment? if ['] comment to parsing_function exit then end_of_line? 0= if ESYNTAX throw then ; get-current ( -- wid ) previous definitions >search ( wid -- ) : get_assignment line_buffer strget + to end_of_line line_buffer .addr @ to line_pointer ['] white_space_1 to parsing_function begin end_of_line? 0= while parsing_function execute repeat parsing_function ['] comment = parsing_function ['] white_space_1 = parsing_function ['] white_space_4 = or or 0= if ESYNTAX throw then ; : get_prop line_buffer strget + to end_of_line line_buffer .addr @ to line_pointer ['] get_prop_cmd to parsing_function begin end_of_line? 0= while parsing_function execute repeat parsing_function ['] comment = parsing_function ['] get_prop_cmd = parsing_function ['] white_space_4 = or or 0= if ESYNTAX throw then ; only forth also support-functions also file-processing definitions \ Process line : assignment_type? ( addr len -- flag ) name_buffer strget compare 0= ; : suffix_type? ( addr len -- flag ) name_buffer .len @ over <= if 2drop false exit then name_buffer .len @ over - name_buffer .addr @ + over compare 0= ; : loader_conf_files? s" loader_conf_files" assignment_type? ; : verbose_flag? s" verbose_loading" assignment_type? ; : execute? s" exec" assignment_type? ; : module_load? load_module_suffix suffix_type? ; : module_loadname? module_loadname_suffix suffix_type? ; : module_type? module_type_suffix suffix_type? ; : module_hash? module_hash_suffix suffix_type? ; : module_args? module_args_suffix suffix_type? ; : module_beforeload? module_beforeload_suffix suffix_type? ; : module_afterload? module_afterload_suffix suffix_type? ; : module_loaderror? module_loaderror_suffix suffix_type? ; \ build a 'set' statement and execute it : set_environment_variable name_buffer .len @ value_buffer .len @ + 5 chars + \ size of result string allocate if ENOMEM throw then dup 0 \ start with an empty string and append the pieces s" set " strcat name_buffer strget strcat s" =" strcat value_buffer strget strcat ['] evaluate catch if 2drop free drop ESETERROR throw else free-memory then ; : set_conf_files set_environment_variable s" loader_conf_files" getenv conf_files string= ; : append_to_module_options_list ( addr -- ) module_options @ 0= if dup module_options ! last_module_option ! else dup last_module_option @ module.next ! last_module_option ! then ; : set_module_name { addr -- } \ check leaks name_buffer strget addr module.name string= ; : yes_value? value_buffer strget unquote s" yes" compare-insensitive 0= ; : find_module_option ( -- addr | 0 ) \ return ptr to entry matching name_buffer module_options @ begin dup while dup module.name strget name_buffer strget compare 0= if exit then module.next @ repeat ; : new_module_option ( -- addr ) sizeof module allocate if ENOMEM throw then dup sizeof module erase dup append_to_module_options_list dup set_module_name ; : get_module_option ( -- addr ) find_module_option ?dup 0= if new_module_option then ; : set_module_flag name_buffer .len @ load_module_suffix nip - name_buffer .len ! yes_value? get_module_option module.flag ! ; : set_module_args name_buffer .len @ module_args_suffix nip - name_buffer .len ! value_buffer strget unquote get_module_option module.args string= ; : set_module_loadname name_buffer .len @ module_loadname_suffix nip - name_buffer .len ! value_buffer strget unquote get_module_option module.loadname string= ; : set_module_type name_buffer .len @ module_type_suffix nip - name_buffer .len ! value_buffer strget unquote get_module_option module.type string= ; : set_module_hash name_buffer .len @ module_hash_suffix nip - name_buffer .len ! value_buffer strget unquote get_module_option module.hash string= ; : set_module_beforeload name_buffer .len @ module_beforeload_suffix nip - name_buffer .len ! value_buffer strget unquote get_module_option module.beforeload string= ; : set_module_afterload name_buffer .len @ module_afterload_suffix nip - name_buffer .len ! value_buffer strget unquote get_module_option module.afterload string= ; : set_module_loaderror name_buffer .len @ module_loaderror_suffix nip - name_buffer .len ! value_buffer strget unquote get_module_option module.loaderror string= ; : set_verbose yes_value? to verbose? ; : execute_command value_buffer strget unquote ['] evaluate catch if EEXEC throw then ; : process_assignment name_buffer .len @ 0= if exit then loader_conf_files? if set_conf_files exit then verbose_flag? if set_verbose exit then execute? if execute_command exit then module_load? if set_module_flag exit then module_loadname? if set_module_loadname exit then module_type? if set_module_type exit then module_hash? if set_module_hash exit then module_args? if set_module_args exit then module_beforeload? if set_module_beforeload exit then module_afterload? if set_module_afterload exit then module_loaderror? if set_module_loaderror exit then set_environment_variable ; \ free_buffer ( -- ) \ \ Free some pointers if needed. The code then tests for errors \ in freeing, and throws an exception if needed. If a pointer is \ not allocated, it's value (0) is used as flag. : free_buffers name_buffer strfree value_buffer strfree ; \ Higher level file processing get-current ( -- wid ) previous definitions >search ( wid -- ) : process_bootenv begin end_of_file? 0= while free_buffers read_line get_prop ['] process_assignment catch ['] free_buffers catch swap throw throw repeat ; : process_conf begin end_of_file? 0= while free_buffers read_line get_assignment ['] process_assignment catch ['] free_buffers catch swap throw throw repeat ; : peek_file ( addr len -- ) 0 to end_of_file? reset_line_reading O_RDONLY fopen fd ! fd @ -1 = if EOPEN throw then free_buffers read_line get_assignment ['] process_assignment catch ['] free_buffers catch fd @ fclose swap throw throw ; only forth also support-functions definitions \ Interface to loading conf files : load_conf ( addr len -- ) 0 to end_of_file? reset_line_reading O_RDONLY fopen fd ! fd @ -1 = if EOPEN throw then ['] process_conf catch fd @ fclose throw ; : print_line line_buffer strtype cr ; : print_syntax_error line_buffer strtype cr line_buffer .addr @ begin line_pointer over <> while bl emit char+ repeat drop ." ^" cr ; : load_bootenv ( addr len -- ) 0 to end_of_file? reset_line_reading O_RDONLY fopen fd ! fd @ -1 = if EOPEN throw then ['] process_bootenv catch fd @ fclose throw ; \ Debugging support functions only forth definitions also support-functions : test-file ['] load_conf catch dup . ESYNTAX = if cr print_syntax_error then ; \ find a module name, leave addr on the stack (0 if not found) : find-module ( -- ptr | 0 ) bl parse ( addr len ) dup 0= if 2drop then ( parse did not find argument, try stack ) depth 2 < if 0 exit then module_options @ >r ( store current pointer ) begin r@ while 2dup ( addr len addr len ) r@ module.name strget compare 0= if drop drop r> exit then ( found it ) r> module.next @ >r repeat type ." was not found" cr r> ; : show-nonempty ( addr len mod -- ) strget dup verbose? or if 2swap type type cr else drop drop drop drop then ; : show-one-module { addr -- addr } ." Name: " addr module.name strtype cr s" Path: " addr module.loadname show-nonempty s" Type: " addr module.type show-nonempty s" Hash: " addr module.hash show-nonempty s" Flags: " addr module.args show-nonempty s" Before load: " addr module.beforeload show-nonempty s" After load: " addr module.afterload show-nonempty s" Error: " addr module.loaderror show-nonempty ." Status: " addr module.flag @ if ." Load" else ." Don't load" then cr cr addr ; : show-module-options module_options @ begin ?dup while show-one-module module.next @ repeat ; : free-one-module { addr -- addr } addr module.name strfree addr module.loadname strfree addr module.type strfree addr module.hash strfree addr module.args strfree addr module.largs strfree addr module.beforeload strfree addr module.afterload strfree addr module.loaderror strfree addr ; : free-module-options module_options @ begin ?dup while free-one-module dup module.next @ swap free-memory repeat 0 module_options ! 0 last_module_option ! ; only forth also support-functions definitions \ Variables used for processing multiple conf files string current_file_name_ref \ used to print the file name \ Indicates if any conf file was successfully read 0 value any_conf_read? \ loader_conf_files processing support functions \ true if string in addr1 is smaller than in addr2 : compar ( addr1 addr2 -- flag ) swap ( addr2 addr1 ) dup cell+ ( addr2 addr1 addr ) swap @ ( addr2 addr len ) rot ( addr len addr2 ) dup cell+ ( addr len addr2 addr' ) swap @ ( addr len addr' len' ) compare -1 = ; \ insertion sort algorithm. we dont expect large amounts of data to be \ sorted, so insert should be ok. compar needs to implement < operator. : insert ( start end -- start ) dup @ >r ( r: v ) \ v = a[i] begin 2dup < \ j>0 while r@ over cell- @ compar \ a[j-1] > v while cell- \ j-- dup @ over cell+ ! \ a[j] = a[j-1] repeat then r> swap ! \ a[j] = v ; : sort ( array len -- ) 1 ?do dup i cells + insert loop drop ; : opendir s" /boot/conf.d" fopendir if fd ! else EOPEN throw then ; : readdir ( addr len flag | flag ) fd @ freaddir ; : closedir fd @ fclosedir ; : entries ( -- n ) \ count directory entries ['] opendir catch ( n array ) throw 0 ( i ) begin \ count the entries readdir ( i addr len flag | i flag ) dup -1 = if -ROT 2drop swap 1+ swap then 0= until closedir ; \ built-in prefix directory name; it must end with /, so we don't \ need to check and insert it. : make_cstring ( addr len -- addr' ) dup ( addr len len ) s" /boot/conf.d/" ( addr len len addr' len' ) rot ( addr len addr' len' len ) over + ( addr len addr' len' total ) \ space for prefix+str dup cell+ 1+ \ 1+ for '\0' allocate if -1 abort" malloc failed" then ( addr len addr' len' total taddr ) dup rot ( addr len addr' len' taddr taddr total ) swap ! ( addr len addr' len' taddr ) \ store length dup >r \ save reference cell+ \ point to string area 2dup 2>r ( addr len addr' len' taddr' ) ( R: taddr len' taddr' ) swap move ( addr len ) 2r> + ( addr len taddr' ) ( R: taddr ) swap 1+ move \ 1+ for '\0' r> ( taddr ) ; : scan_conf_dir ( -- addr len -1 | 0 ) s" currdev" getenv -1 <> if 3 \ we only need first 3 chars s" net" compare 0= if s" boot.tftproot.server" getenv? if 0 exit \ readdir does not work on tftp then then then ['] entries catch if 0 exit then dup 0= if exit then \ nothing to do dup cells allocate ( n array flag ) \ allocate array if 0 exit then ['] opendir catch if ( n array ) free drop drop 0 exit then over 0 do readdir ( n array addr len flag | n array flag ) 0= if -1 abort" unexpected readdir error" then \ shouldnt happen ( n array addr len ) \ we have relative name, make it absolute and convert to counted string make_cstring ( n array addr ) over I cells + ! ( n array ) loop closedir 2dup swap sort \ we have now array of strings with directory entry names. \ calculate size of concatenated string over 0 swap 0 do ( n array 0 ) over I cells + @ ( n array total array[I] ) @ + 1+ ( n array total' ) loop dup allocate if drop free 2drop 0 exit then ( n array len addr ) \ now concatenate all entries. 2swap ( len addr n array ) over 0 swap 0 do ( len addr n array 0 ) over I cells + @ ( len addr n array total array[I] ) dup @ swap cell+ ( len addr n array total len addr' ) over ( len addr n array total len addr' len ) 6 pick ( len addr n array total len addr' len addr ) 4 pick + ( len addr n array total len addr' len addr+total ) swap move + ( len addr n array total+len ) 3 pick ( len addr n array total addr ) over + bl swap c! 1+ ( len addr n array total ) over I cells + @ free drop \ free array[I] loop drop free drop drop ( len addr ) swap ( addr len ) -1 ; : get_conf_files ( -- addr len ) \ put addr/len on stack, reset var \ ." -- starting on <" conf_files strtype ." >" cr \ debugging scan_conf_dir if \ concatenate with conf_files ( addr len ) dup conf_files .len @ + 2 + allocate abort" out of memory" ( addr len addr' ) dup conf_files strget ( addr len addr' caddr clen ) rot swap move ( addr len addr' ) \ add space dup conf_files .len @ + ( addr len addr' addr'+clen ) dup bl swap c! 1+ ( addr len addr' addr'' ) 3 pick swap ( addr len addr' addr addr'' ) 3 pick move ( addr len addr' ) rot ( len addr' addr ) free drop swap ( addr' len ) conf_files .len @ + 1+ ( addr len ) conf_files strfree else conf_files strget 0 0 conf_files strset then ; : skip_leading_spaces { addr len pos -- addr len pos' } begin pos len = if 0 else addr pos + c@ bl = then while pos char+ to pos repeat addr len pos ; \ return the file name at pos, or free the string if nothing left : get_file_name { addr len pos -- addr len pos' addr' len' || 0 } pos len = if addr free abort" Fatal error freeing memory" 0 exit then pos >r begin \ stay in the loop until have chars and they are not blank pos len = if 0 else addr pos + c@ bl <> then while pos char+ to pos repeat addr len pos addr r@ + pos r> - ; : get_next_file ( addr len ptr -- addr len ptr' addr' len' | 0 ) skip_leading_spaces get_file_name ; : print_current_file current_file_name_ref strtype ; : process_conf_errors dup 0= if true to any_conf_read? drop exit then >r 2drop r> dup ESYNTAX = if ." Warning: syntax error on file " print_current_file cr print_syntax_error drop exit then dup ESETERROR = if ." Warning: bad definition on file " print_current_file cr print_line drop exit then dup EREAD = if ." Warning: error reading file " print_current_file cr drop exit then dup EOPEN = if verbose? if ." Warning: unable to open file " print_current_file cr then drop exit then dup EFREE = abort" Fatal error freeing memory" dup ENOMEM = abort" Out of memory" throw \ Unknown error -- pass ahead ; \ Process loader_conf_files recursively \ Interface to loader_conf_files processing : include_bootenv s" /boot/solaris/bootenv.rc" ['] load_bootenv catch dup 0= if drop exit then >r 2drop r> dup ESYNTAX = if ." Warning: syntax error on /boot/solaris/bootenv.rc" cr drop exit then dup EREAD = if ." Warning: error reading /boot/solaris/bootenv.rc" cr drop exit then dup EOPEN = if verbose? if ." Warning: unable to open /boot/solaris/bootenv.rc" cr then drop exit then dup EFREE = abort" Fatal error freeing memory" dup ENOMEM = abort" Out of memory" throw \ Unknown error -- pass ahead ; : include_transient s" /boot/transient.conf" ['] load_conf catch dup 0= if drop exit then \ no error >r 2drop r> dup ESYNTAX = if ." Warning: syntax error on file /boot/transient.conf" cr drop exit then dup ESETERROR = if ." Warning: bad definition on file /boot/transient.conf" cr drop exit then dup EREAD = if ." Warning: error reading file /boot/transient.conf" cr drop exit then dup EOPEN = if verbose? if ." Warning: unable to open file /boot/transient.conf" cr then drop exit then dup EFREE = abort" Fatal error freeing memory" dup ENOMEM = abort" Out of memory" throw \ Unknown error -- pass ahead ; : include_conf_files get_conf_files 0 ( addr len offset ) begin get_next_file ?dup ( addr len 1 | 0 ) while current_file_name_ref strref ['] load_conf catch process_conf_errors conf_files .addr @ if recurse then repeat ; \ Module loading functions \ concat two strings by allocating space : concat { a1 l1 a2 l2 -- a' l' } l1 l2 + allocate if ENOMEM throw then 0 a1 l1 strcat a2 l2 strcat ; \ build module argument list as: "hash= name= module.args" \ if type is hash, name= will have module name without .hash suffix \ will free old largs and set new. : build_largs { addr -- addr } addr module.largs strfree addr module.hash .len @ if ( set hash= ) s" hash=" addr module.hash strget concat addr module.largs strset \ largs = "hash=" + module.hash then addr module.type strget s" hash" compare 0= if ( module.type == "hash" ) addr module.largs strget s" name=" concat addr module.loadname .len @ if ( module.loadname != NULL ) addr module.loadname strget concat else addr module.name strget concat then addr module.largs strfree addr module.largs strset \ largs = largs + name \ last thing to do is to strip off ".hash" suffix addr module.largs strget [char] . strchr dup if ( strchr module.largs '.' ) s" .hash" compare 0= if ( it is ".hash" ) addr module.largs .len @ 5 - addr module.largs .len ! then else 2drop then then \ and now add up the module.args addr module.largs strget s" " concat addr module.args strget concat addr module.largs strfree addr module.largs strset addr ; : load_parameters { addr -- addr addrN lenN ... addr1 len1 N } addr build_largs addr module.largs strget addr module.loadname .len @ if addr module.loadname strget else addr module.name strget then addr module.type .len @ if addr module.type strget s" -t " 4 ( -t type name flags ) else 2 ( name flags ) then ; : before_load ( addr -- addr ) dup module.beforeload .len @ if dup module.beforeload strget ['] evaluate catch if EBEFORELOAD throw then then ; : after_load ( addr -- addr ) dup module.afterload .len @ if dup module.afterload strget ['] evaluate catch if EAFTERLOAD throw then then ; : load_error ( addr -- addr ) dup module.loaderror .len @ if dup module.loaderror strget evaluate \ This we do not intercept so it can throw errors then ; : pre_load_message ( addr -- addr ) verbose? if dup module.name strtype ." ..." then ; : load_error_message verbose? if ." failed!" cr then ; : load_successful_message verbose? if ." ok" cr then ; : load_module load_parameters load ; : process_module ( addr -- addr ) pre_load_message before_load begin ['] load_module catch if dup module.loaderror .len @ if load_error \ Command should return a flag! else load_error_message true \ Do not retry then else after_load load_successful_message true \ Successful, do not retry then until ; : process_module_errors ( addr ior -- ) dup EBEFORELOAD = if drop ." Module " dup module.name strtype dup module.loadname .len @ if ." (" dup module.loadname strtype ." )" then cr ." Error executing " dup module.beforeload strtype cr \ XXX there was a typo here abort then dup EAFTERLOAD = if drop ." Module " dup module.name .addr @ over module.name .len @ type dup module.loadname .len @ if ." (" dup module.loadname strtype ." )" then cr ." Error executing " dup module.afterload strtype cr abort then throw \ Don't know what it is all about -- pass ahead ; \ Module loading interface \ scan the list of modules, load enabled ones. : load_modules ( -- ) ( throws: abort & user-defined ) module_options @ ( list_head ) begin ?dup while dup module.flag @ if ['] process_module catch process_module_errors then module.next @ repeat ; \ h00h00 magic used to try loading either a kernel with a given name, \ or a kernel with the default name in a directory of a given name \ (the pain!) : bootpath s" /platform/" ; : modulepath s" module_path" ; \ Functions used to save and restore module_path's value. : saveenv ( addr len | -1 -- addr' len | 0 -1 ) dup -1 = if 0 swap exit then strdup ; : freeenv ( addr len | 0 -1 ) -1 = if drop else free abort" Freeing error" then ; : restoreenv ( addr len | 0 -1 -- ) dup -1 = if ( it wasn't set ) 2drop modulepath unsetenv else over >r modulepath setenv r> free abort" Freeing error" then ; : clip_args \ Drop second string if only one argument is passed 1 = if 2swap 2drop 1 else 2 then ; also builtins \ Parse filename from a semicolon-separated list : parse-; ( addr len -- addr' len-x addr x ) over 0 2swap ( addr 0 addr len ) begin dup 0 <> ( addr 0 addr len ) while over c@ [char] ; <> ( addr 0 addr len flag ) while 1- swap 1+ swap 2swap 1+ 2swap repeat then dup 0 <> if 1- swap 1+ swap then 2swap ; \ Try loading one of multiple kernels specified : try_multiple_kernels ( addr len addr' len' args -- flag ) >r begin parse-; 2>r 2over 2r> r@ clip_args s" DEBUG" getenv? if s" echo Module_path: ${module_path}" evaluate ." Kernel : " >r 2dup type r> cr dup 2 = if ." Flags : " >r 2over type r> cr then then \ if it's xen, the xen kernel is loaded, unix needs to be loaded as module s" xen_kernel" getenv -1 <> if drop \ drop address from getenv >r \ argument count to R s" kernel" s" -t " \ push 2 strings into the stack r> 2 + \ increment argument count then 1 ['] load catch dup if ( addr0 len0 addr1 len1 ... args 1 error ) >r \ error code to R drop \ drop 1 0 do 2drop loop \ drop addr len pairs r> \ set flag for while then while dup 0= until 1 >r \ Failure else 0 >r \ Success then 2drop 2drop r> r> drop ; \ Try to load a kernel; the kernel name is taken from one of \ the following lists, as ordered: \ \ 1. The "bootfile" environment variable \ 2. The "kernel" environment variable \ \ Flags are passed, if available. If not, dummy values must be given. \ \ The kernel gets loaded from the current module_path. : load_a_kernel ( flags len 1 | x x 0 -- flag ) local args 2local flags 0 0 2local kernel end-locals \ Check if a default kernel name exists at all, exits if not s" bootfile" getenv dup -1 <> if to kernel flags kernel args 1+ try_multiple_kernels dup 0= if exit then then drop s" kernel" getenv dup -1 <> if to kernel else drop 1 exit \ Failure then \ Try all default kernel names flags kernel args 1+ try_multiple_kernels ; \ Try to load a kernel; the kernel name is taken from one of \ the following lists, as ordered: \ \ 1. The "bootfile" environment variable \ 2. The "kernel" environment variable \ \ Flags are passed, if provided. \ \ The kernel will be loaded from a directory computed from the \ path given. Two directories will be tried in the following order: \ \ 1. /boot/path \ 2. path \ \ The module_path variable is overridden if load is successful, by \ prepending the successful path. : load_from_directory ( path len 1 | flags len' path len 2 -- flag ) local args 2local path args 1 = if 0 0 then 2local flags 0 0 2local oldmodulepath \ like a string 0 0 2local newmodulepath \ like a string end-locals \ Set the environment variable module_path, and try loading \ the kernel again. modulepath getenv saveenv to oldmodulepath \ Try prepending /boot/ first bootpath nip path nip + \ total length oldmodulepath nip dup -1 = if drop else 1+ + \ add oldpath -- XXX why the 1+ ? then allocate if ( out of memory ) 1 exit then \ XXX throw ? 0 bootpath strcat path strcat 2dup to newmodulepath modulepath setenv \ Try all default kernel names flags args 1- load_a_kernel 0= if ( success ) oldmodulepath nip -1 <> if newmodulepath s" ;" strcat oldmodulepath strcat modulepath setenv newmodulepath drop free-memory oldmodulepath drop free-memory then 0 exit then \ Well, try without the prepended /boot/ path newmodulepath drop swap move newmodulepath drop path nip 2dup to newmodulepath modulepath setenv \ Try all default kernel names flags args 1- load_a_kernel if ( failed once more ) oldmodulepath restoreenv newmodulepath drop free-memory 1 else oldmodulepath nip -1 <> if newmodulepath s" ;" strcat oldmodulepath strcat modulepath setenv newmodulepath drop free-memory oldmodulepath drop free-memory then 0 then ; \ Try to load a kernel; the kernel name is taken from one of \ the following lists, as ordered: \ \ 1. The "bootfile" environment variable \ 2. The "kernel" environment variable \ 3. The "path" argument \ \ Flags are passed, if provided. \ \ The kernel will be loaded from a directory computed from the \ path given. Two directories will be tried in the following order: \ \ 1. /boot/path \ 2. path \ \ Unless "path" is meant to be kernel name itself. In that case, it \ will first be tried as a full path, and, next, search on the \ directories pointed by module_path. \ \ The module_path variable is overridden if load is successful, by \ prepending the successful path. : load_directory_or_file ( path len 1 | flags len' path len 2 -- flag ) local args 2local path args 1 = if 0 0 then 2local flags end-locals \ First, assume path is an absolute path to a directory flags path args clip_args load_from_directory dup 0= if exit else drop then \ Next, assume path points to the kernel flags path args try_multiple_kernels ; : initialize ( addr len -- ) strdup conf_files strset ; : boot-args ( -- addr len 1 | 0 ) s" boot-args" getenv dup -1 = if drop 0 else 1 then ; : standard_kernel_search ( flags 1 | 0 -- flag ) local args args 0= if 0 0 then 2local flags s" kernel" getenv dup -1 = if 0 swap then 2local path end-locals path nip -1 = if ( there isn't a "kernel" environment variable ) flags args load_a_kernel else flags path args 1+ clip_args load_directory_or_file then ; : load_kernel ( -- ) ( throws: abort ) s" xen_kernel" getenv -1 = if boot-args standard_kernel_search abort" Unable to load a kernel!" exit then drop \ we have loaded the xen kernel, load unix as module s" bootfile" getenv dup -1 <> if s" kernel" s" -t " 3 1 load then abort" Unable to load a kernel!" ; : load_xen ( -- ) s" xen_kernel" getenv dup -1 <> if 1 1 load ( c-addr/u flag N -- flag ) else drop 0 ( -1 -- flag ) then ; : load_xen_throw ( -- ) ( throws: abort ) load_xen abort" Unable to load Xen!" ; : set_defaultoptions ( -- ) s" boot-args" getenv dup -1 = if drop else s" temp_options" setenv then ; \ pick the i-th argument, i starts at 0 : argv[] ( aN uN ... a1 u1 N i -- aN uN ... a1 u1 N ai+1 ui+1 ) 2dup = if 0 0 exit then \ out of range dup >r 1+ 2* ( skip N and ui ) pick r> 1+ 2* ( skip N and ai ) pick ; : drop_args ( aN uN ... a1 u1 N -- ) 0 ?do 2drop loop ; : argc dup ; : queue_argv ( aN uN ... a1 u1 N a u -- a u aN uN ... a1 u1 N+1 ) >r over 2* 1+ -roll r> over 2* 1+ -roll 1+ ; : unqueue_argv ( aN uN ... a1 u1 N -- aN uN ... a2 u2 N-1 a1 u1 ) 1- -rot ; \ compute the length of the buffer including the spaces between words : strlen(argv) ( aN uN .. a1 u1 N -- aN uN .. a1 u1 N len ) dup 0= if 0 exit then 0 >r \ Size 0 >r \ Index begin argc r@ <> while r@ argv[] nip r> r> rot + 1+ >r 1+ >r repeat r> drop r> ; : concat_argv ( aN uN ... a1 u1 N -- a u ) strlen(argv) allocate if ENOMEM throw then 0 2>r ( save addr 0 on return stack ) begin dup while unqueue_argv ( ... N a1 u1 ) 2r> 2swap ( old a1 u1 ) strcat s" " strcat ( append one space ) \ XXX this gives a trailing space 2>r ( store string on the result stack ) repeat drop_args 2r> ; : set_tempoptions ( addrN lenN ... addr1 len1 N -- addr len 1 | 0 ) \ Save the first argument, if it exists and is not a flag argc if 0 argv[] drop c@ [char] - <> if unqueue_argv 2>r \ Filename 1 >r \ Filename present else 0 >r \ Filename not present then else 0 >r \ Filename not present then \ If there are other arguments, assume they are flags ?dup if concat_argv 2dup s" temp_options" setenv drop free if EFREE throw then else set_defaultoptions then \ Bring back the filename, if one was provided r> if 2r> 1 else 0 then ; : get_arguments ( -- addrN lenN ... addr1 len1 N ) 0 begin \ Get next word on the command line parse-word ?dup while queue_argv repeat drop ( empty string ) ; : load_kernel_and_modules ( args -- flag ) set_tempoptions argc >r s" temp_options" getenv dup -1 <> if queue_argv else drop then load_xen ?dup 0= if ( success ) r> if ( a path was passed ) load_directory_or_file else standard_kernel_search then ?dup 0= if ['] load_modules catch then then ; only forth definitions \ Copyright (c) 2006-2015 Devin Teske \ Copyright 2019 OmniOS Community Edition (OmniOSce) Association. \ All rights reserved. \ \ Redistribution and use in source and binary forms, with or without \ modification, are permitted provided that the following conditions \ are met: \ 1. Redistributions of source code must retain the above copyright \ notice, this list of conditions and the following disclaimer. \ 2. Redistributions in binary form must reproduce the above copyright \ notice, this list of conditions and the following disclaimer in the \ documentation and/or other materials provided with the distribution. \ \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF \ SUCH DAMAGE. marker task-version.4th vocabulary version-processing only forth also version-processing definitions variable versionX variable versionY \ Default $loader_version value if not overridden or using tribute screen : str_loader_version ( -- C-ADDR/U|-1 ) -1 ; \ Initialize text placement to defaults 80 versionX ! \ NOTE: this is the ending column (text is right-justified) 24 versionY ! only forth definitions also version-processing : print_version ( -- ) \ Get the text placement position (if set) s" loader_version_x" getenv dup -1 <> if ?number drop versionX ! -1 then drop s" loader_version_y" getenv dup -1 <> if ?number drop versionY ! -1 then drop \ Default version if none was set s" loader_version" getenv dup -1 = if drop \ Use above default if no logo is requested s" loader_logo" getenv dup -1 = if drop str_loader_version else \ For tributes, do nothing (defer to logo-*.4th) 2dup s" tribute" compare-insensitive 0= if 2drop s" logo" sfind if drop exit \ see logo-tribute.4th else drop str_loader_version then else 2dup s" tributebw" compare-insensitive 0= if 2drop s" logo" sfind if drop exit \ see logo-tributebw.4th else drop str_loader_version then else 2drop str_loader_version then then then then dup -1 = if drop exit \ default version (above) is disabled then \ Right justify the text dup versionX @ swap - versionY @ at-xy \ Print the version (optionally in cyan) loader_color? dup ( c-addr/u -- c-addr/u bool bool ) if 6 fg then -rot type if me then at-bl ; only forth definitions