Index: head/sys/boot/forth/beastie.4th =================================================================== --- head/sys/boot/forth/beastie.4th (revision 280923) +++ head/sys/boot/forth/beastie.4th (revision 280924) @@ -1,268 +1,268 @@ -\ Copyright (c) 2003 Scott Long +\ 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. \ \ $FreeBSD$ marker task-beastie.4th only forth definitions also support-functions variable logoX variable logoY \ Initialize logo placement to defaults 46 logoX ! 4 logoY ! : beastie-logo ( x y -- ) \ color BSD mascot (19 rows x 34 columns) 2dup at-xy ." , ," 1+ 2dup at-xy ." /( )`" 1+ 2dup at-xy ." \ \___ / |" 1+ 2dup at-xy ." /- _ `-/ '" 1+ 2dup at-xy ." (/\/ \ \ /\" 1+ 2dup at-xy ." / / | ` \" 1+ 2dup at-xy ." O O ) / |" 1+ 2dup at-xy ." `-^--'`< '" 1+ 2dup at-xy ." (_.) _ ) /" 1+ 2dup at-xy ." `.___/` /" 1+ 2dup at-xy ." `-----' /" 1+ 2dup at-xy ." <----. __ / __ \" 1+ 2dup at-xy ." <----|====O)))==) \) /====|" 1+ 2dup at-xy ." <----' `--' `.__,' \" 1+ 2dup at-xy ." | |" 1+ 2dup at-xy ." \ / /\" 1+ 2dup at-xy ." ______( (_ / \______/" 1+ 2dup at-xy ." ,' ,-----' |" 1+ at-xy ." `--{__________)" \ Put the cursor back at the bottom 0 25 at-xy ; : beastiebw-logo ( x y -- ) \ B/W BSD mascot (19 rows x 34 columns) 2dup at-xy ." , ," 1+ 2dup at-xy ." /( )`" 1+ 2dup at-xy ." \ \___ / |" 1+ 2dup at-xy ." /- _ `-/ '" 1+ 2dup at-xy ." (/\/ \ \ /\" 1+ 2dup at-xy ." / / | ` \" 1+ 2dup at-xy ." O O ) / |" 1+ 2dup at-xy ." `-^--'`< '" 1+ 2dup at-xy ." (_.) _ ) /" 1+ 2dup at-xy ." `.___/` /" 1+ 2dup at-xy ." `-----' /" 1+ 2dup at-xy ." <----. __ / __ \" 1+ 2dup at-xy ." <----|====O)))==) \) /====|" 1+ 2dup at-xy ." <----' `--' `.__,' \" 1+ 2dup at-xy ." | |" 1+ 2dup at-xy ." \ / /\" 1+ 2dup at-xy ." ______( (_ / \______/" 1+ 2dup at-xy ." ,' ,-----' |" 1+ at-xy ." `--{__________)" \ Put the cursor back at the bottom 0 25 at-xy ; : fbsdbw-logo ( x y -- ) \ "FreeBSD" logo in B/W (13 rows x 21 columns) \ We used to use the beastie himself as our default... until the \ eventual complaint derided his reign of the advanced boot-menu. \ \ This is the replacement of beastie to satiate the haters of our \ beloved helper-daemon (ready to track down and spear bugs with \ his trident and sporty sneakers; see above). \ \ Since we merely just changed the default and not the default- \ location, below is an adjustment to the passed-in coordinates, \ forever influenced by the proper location of beastie himself \ kept as the default loader_logo_x/loader_logo_y values. \ 5 + swap 6 + swap 2dup at-xy ." ______" 1+ 2dup at-xy ." | ____| __ ___ ___ " 1+ 2dup at-xy ." | |__ | '__/ _ \/ _ \" 1+ 2dup at-xy ." | __|| | | __/ __/" 1+ 2dup at-xy ." | | | | | | |" 1+ 2dup at-xy ." |_| |_| \___|\___|" 1+ 2dup at-xy ." ____ _____ _____" 1+ 2dup at-xy ." | _ \ / ____| __ \" 1+ 2dup at-xy ." | |_) | (___ | | | |" 1+ 2dup at-xy ." | _ < \___ \| | | |" 1+ 2dup at-xy ." | |_) |____) | |__| |" 1+ 2dup at-xy ." | | | |" 1+ at-xy ." |____/|_____/|_____/" \ Put the cursor back at the bottom 0 25 at-xy ; : orb-logo ( x y -- ) \ color Orb mascot (15 rows x 30 columns) 3 + \ beastie adjustment (see `fbsdbw-logo' comments above) 2dup at-xy ." ``` `" 1+ 2dup at-xy ." s` `.....---.......--.``` -/" 1+ 2dup at-xy ." +o .--` /y:` +." 1+ 2dup at-xy ." yo`:. :o `+-" 1+ 2dup at-xy ." y/ -/` -o/" 1+ 2dup at-xy ." .- ::/sy+:." 1+ 2dup at-xy ." / `-- /" 1+ 2dup at-xy ." `: :`" 1+ 2dup at-xy ." `: :`" 1+ 2dup at-xy ." / /" 1+ 2dup at-xy ." .- -." 1+ 2dup at-xy ." -- -." 1+ 2dup at-xy ." `:` `:`" 1+ 2dup at-xy ." .-- `--." 1+ at-xy ." .---.....----." \ Put the cursor back at the bottom 0 25 at-xy ; : orbbw-logo ( x y -- ) \ B/W Orb mascot (15 rows x 32 columns) 3 + \ beastie adjustment (see `fbsdbw-logo' comments above) 2dup at-xy ." ``` `" 1+ 2dup at-xy ." s` `.....---.......--.``` -/" 1+ 2dup at-xy ." +o .--` /y:` +." 1+ 2dup at-xy ." yo`:. :o `+-" 1+ 2dup at-xy ." y/ -/` -o/" 1+ 2dup at-xy ." .- ::/sy+:." 1+ 2dup at-xy ." / `-- /" 1+ 2dup at-xy ." `: :`" 1+ 2dup at-xy ." `: :`" 1+ 2dup at-xy ." / /" 1+ 2dup at-xy ." .- -." 1+ 2dup at-xy ." -- -." 1+ 2dup at-xy ." `:` `:`" 1+ 2dup at-xy ." .-- `--." 1+ at-xy ." .---.....----." \ Put the cursor back at the bottom 0 25 at-xy ; \ 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. \ \ Currently available: \ \ NAME DESCRIPTION \ beastie Color ``Helper Daemon'' mascot (19 rows x 34 columns) \ beastiebw B/W ``Helper Daemon'' mascot (19 rows x 34 columns) \ fbsdbw "FreeBSD" logo in B/W (13 rows x 21 columns) \ orb Color ``Orb'' mascot (15 rows x 30 columns) (2nd default) \ orbbw B/W ``Orb'' mascot (15 rows x 32 columns) \ tribute Color ``Tribute'' (must fit 19 rows x 34 columns) (default) \ tributebw B/W ``Tribute'' (must fit 19 rows x 34 columns) \ \ NOTE: Setting `loader_logo' to an undefined value (such as "none") will \ prevent beastie from being 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 s" loader_logo" getenv dup -1 <> if dup 5 + allocate if ENOMEM throw then 0 2swap strcat s" -logo" strcat over -rot ( a-addr/u -- a-addr a-addr/u ) sfind ( a-addr a-addr/u -- a-addr xt bool ) rot ( a-addr xt bool -- xt bool a-addr ) free ( xt bool a-addr -- xt bool ior ) if EFREE throw then else 0 ( cruft -- cruft bool ) \ load the default below then 0= if drop ( cruft -- ) loader_color? if ['] orb-logo else ['] orbbw-logo then then logoX @ logoY @ rot execute ; : clear-beastie ( -- ) \ clears beastie from the screen logoX @ logoY @ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 1+ 2dup at-xy 34 spaces 2drop \ Put the cursor back at the bottom 0 25 at-xy ; : beastie-start ( -- ) \ starts the menu s" console" getenv dup -1 <> if s" efi" 2swap contains? if s" set beastie_disable=YES" evaluate then else drop then 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/menu.rc" evaluate else drop ." Loading Menu (Ctrl-C to Abort)" cr s" set delay_command='include /boot/menu.rc'" evaluate s" set delay_showdots" evaluate delay_execute then ; only forth also Index: head/sys/boot/forth/brand.4th =================================================================== --- head/sys/boot/forth/brand.4th (revision 280923) +++ head/sys/boot/forth/brand.4th (revision 280924) @@ -1,93 +1,93 @@ \ 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. \ \ $FreeBSD$ marker task-brand.4th variable brandX variable brandY -\ Initialize logo placement +\ Initialize brand placement to defaults 2 brandX ! 1 brandY ! : fbsd-logo ( x y -- ) \ "FreeBSD" [wide] logo in B/W (7 rows x 42 columns) 2dup at-xy ." ______ ____ _____ _____ " 1+ 2dup at-xy ." | ____| | _ \ / ____| __ \ " 1+ 2dup at-xy ." | |___ _ __ ___ ___ | |_) | (___ | | | |" 1+ 2dup at-xy ." | ___| '__/ _ \/ _ \| _ < \___ \| | | |" 1+ 2dup at-xy ." | | | | | __/ __/| |_) |____) | |__| |" 1+ 2dup at-xy ." | | | | | | || | | |" 1+ at-xy ." |_| |_| \___|\___||____/|_____/|_____/ " \ Put the cursor back at the bottom 0 25 at-xy ; \ This function draws any number of company logos at (loader_brand_x, \ loader_brand_y) if defined, or (2,1) (top-left) if not defined. To choose \ your logo, set the variable `loader_brand' to the respective logo name. \ \ Currently available: \ \ NAME DESCRIPTION \ fbsd FreeBSD logo \ \ NOTE: Setting `loader_brand' to the value of an existing function \ (such as "mycustom-brand") will cause that symbol to be executed. \ NOTE: Setting `loader_brand' to an undefined value (such as "none") will \ prevent any brand from being drawn. \ -: draw-brand ( -- ) +: 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 s" loader_brand" getenv dup -1 = if brandX @ brandY @ fbsd-logo drop exit then 2dup s" fbsd" compare-insensitive 0= if brandX @ brandY @ fbsd-logo 2drop exit then \ if it refers to a raw symbol then run that function sfind if brandX @ brandY @ 2 roll execute else drop then 2drop ; Index: head/sys/boot/forth/check-password.4th =================================================================== --- head/sys/boot/forth/check-password.4th (revision 280923) +++ head/sys/boot/forth/check-password.4th (revision 280924) @@ -1,154 +1,154 @@ \ 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. \ \ $FreeBSD$ marker task-check-password.4th include /boot/screen.4th 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 @ 25 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 ; : read ( c-addr/u -- ) \ Expects string prompt as stack input 0 25 at-xy \ 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 @ 25 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 @ 25 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 ; : 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 ( c-addr/u ) else drop ( -1 ) \ getenv cruft 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 - 2drop exit \ Correct password + 2dup readval readlen @ compare 0= if \ Correct password? + 2drop exit then 3000 ms ." loader: incorrect password" 10 emit again ; Index: head/sys/boot/forth/frames.4th =================================================================== --- head/sys/boot/forth/frames.4th (revision 280923) +++ head/sys/boot/forth/frames.4th (revision 280924) @@ -1,128 +1,153 @@ -\ Words implementing frame drawing -\ XXX Filled boxes are left as an exercise for the reader... ;-/ +\ Copyright (c) 2003 Scott Long +\ Copyright (c) 2012-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-frames.4th + +\ 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 124 constant ascii_pipe 43 constant ascii_plus s" arch-pc98" environment? [if] \ Single frames 149 constant sh_el 150 constant sv_el 152 constant slt_el 154 constant slb_el 153 constant srt_el 155 constant srb_el \ Double frames 149 constant dh_el 150 constant dv_el 152 constant dlt_el 154 constant dlb_el 153 constant drt_el 155 constant drb_el \ Fillings 0 constant fill_none 32 constant fill_blank 135 constant fill_dark 135 constant fill_med 135 constant fill_bright [else] \ Single frames 196 constant sh_el 179 constant sv_el 218 constant slt_el 192 constant slb_el 191 constant srt_el 217 constant srb_el \ Double frames 205 constant dh_el 186 constant dv_el 201 constant dlt_el 200 constant dlb_el 187 constant drt_el 188 constant drb_el \ Fillings 0 constant fill_none 32 constant fill_blank 176 constant fill_dark 177 constant fill_med 178 constant fill_bright [then] : hline ( len x y -- ) \ Draw horizontal single line at-xy \ move cursor 0 do h_el @ emit 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 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 @ emit 1+ 2dup loop 2drop 2drop drop ; : box ( w h x y -- ) \ Draw a box 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 @ emit \ Draw left-top corner 2dup 4 pick + at-xy lb_el @ emit \ Draw left bottom corner 2dup swap 5 pick + swap at-xy rt_el @ emit \ Draw right top corner 2 pick + swap 3 pick + swap at-xy rb_el @ emit 2drop ; f_single fill_none fill ! Index: head/sys/boot/forth/loader.4th =================================================================== --- head/sys/boot/forth/loader.4th (revision 280923) +++ head/sys/boot/forth/loader.4th (revision 280924) @@ -1,249 +1,250 @@ -\ Copyright (c) 1999 Daniel C. Sobral +\ 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$ s" arch-i386" environment? [if] [if] s" loader_version" environment? [if] 11 < [if] .( Loader version 1.1+ required) cr abort [then] [else] .( Could not get loader version!) cr abort [then] [then] [then] 256 dictthreshold ! \ 256 cells minimum free space 2048 dictincrease ! \ 2048 additional cells each time include /boot/support.4th include /boot/color.4th include /boot/delay.4th only forth also support-functions also builtins definitions : bootmsg ( -- ) loader_color? if ." Booting..." cr else ." Booting..." cr then ; : 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 ; : boot 0= if ( interpreted ) get_arguments then \ Unload only if a path was passed 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 also builtins builtin: boot builtin: boot-conf only forth definitions also support-functions include /boot/check-password.4th \ ***** start \ \ Initializes support.4th global variables, sets loader_conf_files, \ processes conf files, and, if any one such file was succesfully \ read to the end, loads kernel and modules. : start ( -- ) ( throws: abort & user-defined ) s" /boot/defaults/loader.conf" initialize include_conf_files include_nextboot_file \ Will *NOT* try to load kernel and modules if no configuration file \ was succesfully 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_conf_files include_nextboot_file 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 ; \ 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" .? ; : 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) only forth also Index: head/sys/boot/forth/menu.4th =================================================================== --- head/sys/boot/forth/menu.4th (revision 280923) +++ head/sys/boot/forth/menu.4th (revision 280924) @@ -1,1285 +1,1287 @@ -\ Copyright (c) 2003 Scott Long +\ Copyright (c) 2003 Scott Long \ Copyright (c) 2003 Aleksander Fafula -\ Copyright (c) 2006-2013 Devin Teske +\ 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. \ \ $FreeBSD$ marker task-menu.4th \ Frame drawing include /boot/frames.4th 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 key association/detection +\ Menu-item elements variable menukey1 variable menukey2 variable menukey3 variable menukey4 variable menukey5 variable menukey6 variable menukey7 variable menukey8 variable menureboot variable menurebootadded variable menuacpi variable menuoptions variable menukernel \ Parsing of kernels into menu-items variable kernidx variable kernlen variable kernmenuidx \ 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 \ 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 \ Containers for parsing kernels into menu-items create kerncapbuf 64 allot create kerndefault 64 allot create kernelsbuf 256 allot : +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 ) ; : 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 ; +\ Forth variables : menukeyN ( N -- ADDR ) s" menukeyN" 7 +c! evaluate ; : init_stateN ( N -- ADDR ) s" init_stateN" 10 +c! evaluate ; : toggle_stateN ( N -- ADDR ) s" toggle_stateN" 12 +c! evaluate ; : cycle_stateN ( N -- ADDR ) s" cycle_stateN" 11 +c! evaluate ; : init_textN ( N -- C-ADDR ) s" init_textN" 9 +c! evaluate ; +\ Environment variables : kernel[x] ( N -- C-ADDR/U ) s" kernel[x]" 7 +c! ; : 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! ; : arch-i386? ( -- BOOL ) \ Returns TRUE (-1) on i386, FALSE (0) otherwise. s" arch-i386" environment? dup if drop then ; \ 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 ) 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? if ." " (  ) then menuidx @ . loader_color? if ." " (  ) 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 + ; : 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 ; : 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 ; \ This function prints the appropriate menuitem basename to the stack if an \ ACPI option is to be presented to the user, otherwise returns -1. Used \ internally by menu-create, you need not (nor should you) call this directly. \ : acpimenuitem ( -- C-Addr/U | -1 ) arch-i386? if acpipresent? if acpienabled? if loader_color? if s" toggled_ansi[x]" else s" toggled_text[x]" then else loader_color? if s" ansi_caption[x]" else s" menu_caption[x]" then then else menuidx dup @ 1+ swap ! ( increment menuidx ) -1 then else -1 then ; \ This function parses $kernels into variables that are used by the menu to \ display wich kernel to boot when the [overloaded] `boot' word is interpreted. \ Used internally by menu-create, you need not (nor should you) call this \ directly. \ : parse-kernels ( N -- ) \ kernidx kernidx ! ( n -- ) \ store provided `x' value [char] 0 kernmenuidx ! \ initialize `y' value for menu_caption[x][y] \ Attempt to get a list of kernels, fall back to sensible default s" kernels" getenv dup -1 = if drop ( cruft ) s" kernel kernel.old" then ( -- c-addr/u ) \ Check to see if the user has altered $kernel by comparing it against \ $kernel[N] where N is kernel_state (the actively displayed kernel). s" kernel_state" evaluate @ 48 + s" kernel[N]" 7 +c! getenv dup -1 <> if s" kernel" getenv dup -1 = if drop ( cruft ) s" " then 2swap 2over compare 0= if 2drop FALSE ( skip below conditional ) else \ User has changed $kernel TRUE ( slurp in new value ) then else \ We haven't yet parsed $kernels into $kernel[N] drop ( getenv cruft ) s" kernel" getenv dup -1 = if drop ( cruft ) s" " then TRUE ( slurp in initial value ) then ( c-addr/u -- c-addr/u c-addr/u,-1 | 0 ) if \ slurp new value into kerndefault kerndefault 1+ 0 2swap strcat swap 1- c! then \ Clear out existing parsed-kernels kernidx @ [char] 0 begin dup kernel[x] unsetenv 2dup menu_caption[x][y] unsetenv 2dup ansi_caption[x][y] unsetenv 1+ dup [char] 8 > until 2drop \ Step through the string until we find the end begin 0 kernlen ! \ initialize length of value \ Skip leading whitespace and/or comma delimiters begin dup 0<> if over c@ delim? ( c-addr/u -- c-addr/u bool ) else false ( c-addr/u -- c-addr/u bool ) then while 1- swap 1+ swap ( c-addr/u -- c-addr'/u' ) repeat ( c-addr/u -- c-addr'/u' ) dup 0= if \ end of string while eating whitespace 2drop ( c-addr/u -- ) kernmenuidx @ [char] 0 <> if \ found at least one exit \ all done then \ No entries in $kernels; use $kernel instead s" kernel" getenv dup -1 = if drop ( cruft ) s" " then ( -- c-addr/u ) dup kernlen ! \ store entire value length as kernlen else \ We're still within $kernels parsing toward the end; \ find delimiter/end to determine kernlen 2dup ( c-addr/u -- c-addr/u c-addr/u ) begin dup 0<> while over c@ delim? if drop 0 ( break ) \ found delimiter else kernlen @ 1+ kernlen ! \ incrememnt 1- swap 1+ swap \ c-addr++ u-- then repeat 2drop ( c-addr/u c-addr'/u' -- c-addr/u ) \ If this is the first entry, compare it to $kernel \ If different, then insert $kernel beforehand kernmenuidx @ [char] 0 = if over kernlen @ kerndefault count compare if kernelsbuf 0 kerndefault count strcat s" ," strcat 2swap strcat kerndefault count swap drop kernlen ! then then then ( c-addr/u -- c-addr'/u' ) \ At this point, we should have something on the stack to store \ as the next kernel menu option; start assembling variables over kernlen @ ( c-addr/u -- c-addr/u c-addr/u2 ) \ Assign first to kernel[x] 2dup kernmenuidx @ kernel[x] setenv \ Assign second to menu_caption[x][y] kerncapbuf 0 s" [K]ernel: " strcat 2over strcat kernidx @ kernmenuidx @ menu_caption[x][y] setenv \ Assign third to ansi_caption[x][y] kerncapbuf 0 s" Kernel: " strcat kernmenuidx @ [char] 0 = if s" default/" else s" " then strcat 2over strcat s" " strcat kernidx @ kernmenuidx @ ansi_caption[x][y] setenv 2drop ( c-addr/u c-addr/u2 -- c-addr/u ) kernmenuidx @ 1+ dup kernmenuidx ! [char] 8 > if 2drop ( c-addr/u -- ) exit then kernlen @ - swap kernlen @ + swap ( c-addr/u -- c-addr'/u' ) again ; \ This function goes through the kernels that were discovered by the \ parse-kernels function [above], adding " (# of #)" text to the end of each \ caption. \ : tag-kernels ( -- ) kernidx @ ( -- x ) dup 0= if exit then [char] 0 s" (Y of Z)" ( x -- x y c-addr/u ) kernmenuidx @ -rot 7 +c! \ Replace 'Z' with number of kernels parsed begin 2 pick 1+ -rot 2 +c! \ Replace 'Y' with current ASCII num 2over menu_caption[x][y] getenv dup -1 <> if 2dup + 1- c@ [char] ) = if 2drop \ Already tagged else kerncapbuf 0 2swap strcat 2over strcat 5 pick 5 pick menu_caption[x][y] setenv then else drop ( getenv cruft ) then 2over ansi_caption[x][y] getenv dup -1 <> if 2dup + 1- c@ [char] ) = if 2drop \ Already tagged else kerncapbuf 0 2swap strcat 2over strcat 5 pick 5 pick ansi_caption[x][y] setenv then else drop ( getenv cruft ) then rot 1+ dup [char] 8 > if -rot 2drop TRUE ( break ) else -rot FALSE then until 2drop ( x y -- ) ; \ This function creates the list of menu items. This function is called by the -\ menu-display function. You need not be call it directly. +\ 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 FreeBSD" 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 ACPI option status. \ 0 menuacpi ! s" menu_acpi" getenv -1 <> if c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' ) menuacpi ! arch-i386? if acpipresent? if \ \ Set menu toggle state to active state \ (required by generic toggle_menuitem) \ acpienabled? menuacpi @ toggle_stateN ! then then else drop then then \ \ Initialize kernel captions after parsing $kernels \ 0 menukernel ! s" menu_kernel" getenv -1 <> if c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' ) dup menukernel ! dup parse-kernels tag-kernels \ Get the current cycle state (entry to use) s" kernel_state" evaluate @ 48 + ( n -- n y ) \ If state is invalid, reset dup kernmenuidx @ 1- > if drop [char] 0 ( n y -- n 48 ) 0 s" kernel_state" evaluate ! over s" init_kernel" evaluate drop then \ Set the current non-ANSI caption 2dup swap dup ( n y -- n y y n n ) s" set menu_caption[x]=$menu_caption[x][y]" 17 +c! 34 +c! 37 +c! evaluate ( n y y n n c-addr/u -- n y ) \ Set the current ANSI caption 2dup swap dup ( n y -- n y y n n ) s" set ansi_caption[x]=$ansi_caption[x][y]" 17 +c! 34 +c! 37 +c! evaluate ( n y y n n c-addr/u -- n y ) \ Initialize cycle state from stored value 48 - ( n y -- n k ) s" init_cyclestate" evaluate ( n k -- n ) \ Set $kernel to $kernel[y] s" activate_kernel" 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 \ If this is the ACPI menu option, act accordingly. dup menuacpi @ = if dup acpimenuitem ( n -- n n c-addr/u | n n -1 ) dup -1 <> if 13 +c! ( n n c-addr/u -- n c-addr/u ) \ replace 'x' with n else swap drop ( n n -1 -- n -1 ) over menu_command[x] unsetenv then else \ 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 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 a single integer on the stack and updates the timeout display. The \ integer must be between 0 and 9 (we will only update a single digit in the \ source message). \ : menu-timeout-update ( N -- ) \ Enforce minimum/maximum dup 9 > if drop 9 then dup 0 < if drop 0 then s" Autoboot in N seconds. [Space] to pause" ( n -- n c-addr/u ) 2 pick 0> if rot 48 + -rot ( n c-addr/u -- n' c-addr/u ) \ convert to ASCII 12 +c! ( n' c-addr/u -- c-addr/u ) \ replace 'N' above menu_timeout_x @ menu_timeout_y @ at-xy \ position cursor type ( c-addr/u -- ) \ print message else menu_timeout_x @ menu_timeout_y @ at-xy \ position cursor spaces ( n c-addr/u -- n c-addr ) \ erase message 2drop ( n c-addr -- ) then 0 25 at-xy ( position cursor back at bottom-left ) ; \ 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. \ : 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 exit else drop then then 50 ms \ sleep for 50 milliseconds (see loader(8)) again ; : menu-erase ( -- ) \ Erases menu and resets positioning variable to positon 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 ! ; \ 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 ; \ 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 ! \ 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 0 25 at-xy \ Move cursor to the bottom for output ; \ 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 0 25 at-xy 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 menu-create begin \ Loop forever 0 25 at-xy \ Move cursor to the bottom for output getkey \ Block here, waiting for a key to be pressed dup -1 = if 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 ) 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 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 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 evaluate 0= if 2drop exit then 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_kernel" unsetenv \ Kernel 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 menuoptions ! ; \ 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 ! \ 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! Index: head/sys/boot/forth/pcibios.4th =================================================================== --- head/sys/boot/forth/pcibios.4th (revision 280923) +++ head/sys/boot/forth/pcibios.4th (revision 280924) @@ -1,47 +1,47 @@ -\ Copyright (c) 2014 M. Warner Losh +\ 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 Index: head/sys/boot/forth/pnp.4th =================================================================== --- head/sys/boot/forth/pnp.4th (revision 280923) +++ head/sys/boot/forth/pnp.4th (revision 280924) @@ -1,205 +1,205 @@ -\ Copyright (c) 2000 Daniel C. Sobral +\ 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 ; Index: head/sys/boot/forth/screen.4th =================================================================== --- head/sys/boot/forth/screen.4th (revision 280923) +++ head/sys/boot/forth/screen.4th (revision 280924) @@ -1,36 +1,60 @@ -\ Screen manipulation related words. +\ Copyright (c) 2003 Scott Long +\ Copyright (c) 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-screen.4th : escc ( -- ) \ emit Esc-[ 91 27 emit emit ; : ho ( -- ) \ Home cursor escc 72 emit \ Esc-[H ; : cld ( -- ) \ Clear from current position to end of display escc 74 emit \ Esc-[J ; : clear ( -- ) \ clear screen ho cld ; : at-xy ( x y -- ) \ move cursor to x rows, y cols (1-based coords) escc .# 59 emit .# 72 emit \ Esc-[%d;%dH ; : fg ( x -- ) \ Set foreground color escc 3 .# .# 109 emit \ Esc-[3%dm ; : bg ( x -- ) \ Set background color escc 4 .# .# 109 emit \ Esc-[4%dm ; : me ( -- ) \ Mode end (clear attributes) escc 109 emit ; Index: head/sys/boot/forth/support.4th =================================================================== --- head/sys/boot/forth/support.4th (revision 280923) +++ head/sys/boot/forth/support.4th (revision 280924) @@ -1,1586 +1,1586 @@ -\ Copyright (c) 1999 Daniel C. Sobral +\ Copyright (c) 1999 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$ \ Loader.rc support functions: \ \ initialize ( addr len -- ) as above, plus load_conf_files \ load_conf ( addr len -- ) load conf file given \ 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 \ string module.args flags to be passed during load \ 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 succesfully 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.args 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 string nextboot_conf_file 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? 0 value nextboot? \ 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 ; : 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 : getenv? getenv -1 = if false else drop true then ; \ 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 s" comconsole" 2swap contains? else drop false then s" boot_serial" getenv dup -1 <> if swap drop 0> else drop false then or \ console contains comconsole ( or ) boot_serial s" boot_multicons" getenv dup -1 <> if swap drop 0> else drop false then or \ previous boolean ( or ) boot_multicons ; \ 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_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 also \ File data temporary storage string read_buffer 0 value read_buffer_ptr \ File's line reading function support-functions definitions string line_buffer 0 value end_of_file? variable fd line-reading 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 ) >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 -- ) 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 ! ; support-functions definitions : 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 '"' \ ::= '#'{} \ \ exported: \ line_pointer \ process_conf 0 value line_pointer vocabulary file-processing also file-processing definitions \ parser functions \ \ exported: \ get_assignment vocabulary parser also parser definitions also 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] " = ; : 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] . = ; \ 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? 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 ( -- addr len ) line_pointer skip_character end_of_line? if ESYNTAX throw then begin quote? 0= while backslash? if skip_character end_of_line? if ESYNTAX throw then then skip_character end_of_line? if ESYNTAX throw then repeat skip_character line_pointer over - remove_backslashes ; : read_name parse_name ( -- addr len ) name_buffer strset ; : read_value quote? if parse_quote ( -- addr len ) else parse_name ( -- addr len ) 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 letter? digit? quote? 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 ; file-processing definitions : 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 ; only forth also support-functions also file-processing definitions also \ 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? ; : nextboot_flag? s" nextboot_enable" assignment_type? ; : nextboot_conf? s" nextboot_conf" 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_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= ; : set_nextboot_conf \ XXX maybe do as set_conf_files ? value_buffer strget unquote nextboot_conf_file 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 \ XXX could use unquote 2dup s' "YES"' compare >r 2dup s' "yes"' compare >r 2dup s" YES" compare >r s" yes" compare r> r> r> and and and 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_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_nextboot_flag yes_value? to nextboot? ; : 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 nextboot_flag? if set_nextboot_flag exit then nextboot_conf? if set_nextboot_conf 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_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 support-functions definitions : 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 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 ; only forth also support-functions definitions \ Interface to loading conf files : load_conf ( addr len -- ) \ ." ----- Trying conf " 2dup type cr \ debugging 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 ; \ 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 ) 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" 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 ; 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 succesfully read 0 value any_conf_read? \ loader_conf_files processing support functions : get_conf_files ( -- addr len ) \ put addr/len on stack, reset var \ ." -- starting on <" conf_files strtype ." >" cr \ debugging conf_files strget 0 0 conf_files strset ; : 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> - \ 2dup ." get_file_name has " type cr \ debugging ; : 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_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 ; : get_nextboot_conf_file ( -- addr len ) nextboot_conf_file strget strdup \ XXX is the strdup a leak ? ; : rewrite_nextboot_file ( -- ) get_nextboot_conf_file O_WRONLY fopen fd ! fd @ -1 = if EOPEN throw then fd @ s' nextboot_enable="NO" ' fwrite fd @ fclose ; : include_nextboot_file get_nextboot_conf_file ['] peek_file catch nextboot? if get_nextboot_conf_file ['] load_conf catch process_conf_errors ['] rewrite_nextboot_file catch then ; \ Module loading functions : load_parameters { addr -- addr addrN lenN ... addr1 len1 N } addr addr module.args 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_succesful_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_succesful_message true \ Succesful, 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" /boot/" ; : 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 \ replacement, not working yet : newparse-; { addr len | a1 -- a' len-x addr x } addr len [char] ; strchr dup if ( a1 len1 ) swap to a1 ( store address ) 1 - a1 @ 1 + swap ( remove match ) addr a1 addr - else 0 0 addr len then ; : 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 1 load 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 succesful, 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 succesful, 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 ; : kernel_options ( -- addr len 1 | 0 ) s" kernel_options" 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 ) kernel_options standard_kernel_search abort" Unable to load a kernel!" ; : load_xen ( -- ) s" xen_kernel" getenv dup -1 <> if 1 1 load else drop 0 then ; : load_xen_throw ( -- ) ( throws: abort ) load_xen abort" Unable to load Xen!" ; : set_defaultoptions ( -- ) s" kernel_options" 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 ; \ Go back to straight forth vocabulary only forth also definitions Index: head/sys/boot/forth/version.4th =================================================================== --- head/sys/boot/forth/version.4th (revision 280923) +++ head/sys/boot/forth/version.4th (revision 280924) @@ -1,87 +1,88 @@ -\ Copyright (c) 2006-2013 Devin Teske +\ 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. \ \ $FreeBSD$ marker task-version.4th 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 ! : 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 - \ Default version if no logo is requested + \ 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 beastie.4th) 2dup s" tribute" compare-insensitive 0= if 2drop s" tribute-logo" sfind if drop exit \ see beastie tribute-text else drop str_loader_version then else 2dup s" tributebw" compare-insensitive 0= if 2drop s" tributebw-logo" sfind if drop exit \ see beastie tribute-text 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? if ." " type ." " else type then ;