loader.4th revision 242667
144603Sdcs\ Copyright (c) 1999 Daniel C. Sobral <dcs@freebsd.org> 244603Sdcs\ All rights reserved. 344603Sdcs\ 444603Sdcs\ Redistribution and use in source and binary forms, with or without 544603Sdcs\ modification, are permitted provided that the following conditions 644603Sdcs\ are met: 744603Sdcs\ 1. Redistributions of source code must retain the above copyright 844603Sdcs\ notice, this list of conditions and the following disclaimer. 944603Sdcs\ 2. Redistributions in binary form must reproduce the above copyright 1044603Sdcs\ notice, this list of conditions and the following disclaimer in the 1144603Sdcs\ documentation and/or other materials provided with the distribution. 1244603Sdcs\ 1344603Sdcs\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 1444603Sdcs\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 1544603Sdcs\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 1644603Sdcs\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 1744603Sdcs\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 1844603Sdcs\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 1944603Sdcs\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 2044603Sdcs\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 2144603Sdcs\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 2244603Sdcs\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 2344603Sdcs\ SUCH DAMAGE. 2444603Sdcs\ 2550477Speter\ $FreeBSD: head/sys/boot/forth/loader.4th 242667 2012-11-06 19:26:36Z dteske $ 2644603Sdcs 2761694Sdcss" arch-i386" environment? [if] [if] 2861694Sdcs s" loader_version" environment? [if] 2987636Sjhb 11 < [if] 3087636Sjhb .( Loader version 1.1+ required) cr 3161694Sdcs abort 3261694Sdcs [then] 3361694Sdcs [else] 3461694Sdcs .( Could not get loader version!) cr 3561694Sdcs abort 3661694Sdcs [then] 3761694Sdcs[then] [then] 3861379Sdcs 3977444Sdcs256 dictthreshold ! \ 256 cells minimum free space 4077444Sdcs2048 dictincrease ! \ 2048 additional cells each time 4177444Sdcs 4244603Sdcsinclude /boot/support.4th 43241361Sdteskeinclude /boot/color.4th 4444603Sdcs 4565883Sdcsonly forth also support-functions also builtins definitions 4661376Sdcs 47228985Spluknet: try-menu-unset 48229881Spluknet \ menu-unset may not be present 49229881Spluknet s" beastie_disable" getenv 50229881Spluknet dup -1 <> if 51229881Spluknet s" YES" compare-insensitive 0= if 52229881Spluknet exit 53229881Spluknet then 54229881Spluknet else 55229881Spluknet drop 56229881Spluknet then 57228985Spluknet s" menu-unset" 58229881Spluknet sfind if 59229881Spluknet execute 60229881Spluknet else 61229881Spluknet drop 62228985Spluknet then 63242667Sdteske s" menusets-unset" 64242667Sdteske sfind if 65242667Sdteske execute 66242667Sdteske else 67242667Sdteske drop 68242667Sdteske then 69228985Spluknet; 70228985Spluknet 7165883Sdcs: boot 7265949Sdcs 0= if ( interpreted ) get_arguments then 7361376Sdcs 74241361Sdteske loader_color? if 75241361Sdteske ." [37;44mBooting...[0m" cr 76241361Sdteske else 77241361Sdteske ." Booting..." cr 78241361Sdteske then 79241361Sdteske 8065630Sdcs \ Unload only if a path was passed 8165883Sdcs dup if 8265883Sdcs >r over r> swap 8365630Sdcs c@ [char] - <> if 8465630Sdcs 0 1 unload drop 8565630Sdcs else 8666871Sdcs s" kernelname" getenv? if ( a kernel has been loaded ) 87228985Spluknet try-menu-unset 8866871Sdcs 1 boot exit 8965938Sdcs then 9066871Sdcs load_kernel_and_modules 9166871Sdcs ?dup if exit then 92228985Spluknet try-menu-unset 9366346Sdcs 0 1 boot exit 9465630Sdcs then 9565630Sdcs else 9666871Sdcs s" kernelname" getenv? if ( a kernel has been loaded ) 97228985Spluknet try-menu-unset 9866871Sdcs 1 boot exit 9965938Sdcs then 10066871Sdcs load_kernel_and_modules 10166871Sdcs ?dup if exit then 102228985Spluknet try-menu-unset 10366346Sdcs 0 1 boot exit 10465630Sdcs then 10565945Sdcs load_kernel_and_modules 10665621Sdcs ?dup 0= if 0 1 boot then 10765621Sdcs; 10865621Sdcs 109228985Spluknet\ ***** boot-conf 110228985Spluknet\ 111228985Spluknet\ Prepares to boot as specified by loaded configuration files. 112228985Spluknet 11365621Sdcs: boot-conf 11465949Sdcs 0= if ( interpreted ) get_arguments then 11565630Sdcs 0 1 unload drop 11665945Sdcs load_kernel_and_modules 11765621Sdcs ?dup 0= if 0 1 autoboot then 11865621Sdcs; 11965621Sdcs 12065621Sdcsalso forth definitions also builtins 12165883Sdcs 12265621Sdcsbuiltin: boot 12361376Sdcsbuiltin: boot-conf 12465883Sdcs 12561376Sdcsonly forth definitions also support-functions 12661376Sdcs 127222417Sjulianinclude /boot/check-password.4th 12853672Sdcs 12944603Sdcs\ ***** start 13044603Sdcs\ 13144603Sdcs\ Initializes support.4th global variables, sets loader_conf_files, 13244603Sdcs\ process conf files, and, if any one such file was succesfully 13344603Sdcs\ read to the end, load kernel and modules. 13444603Sdcs 13544603Sdcs: start ( -- ) ( throws: abort & user-defined ) 13644603Sdcs s" /boot/defaults/loader.conf" initialize 13744603Sdcs include_conf_files 13897201Sgordon include_nextboot_file 13944603Sdcs \ Will *NOT* try to load kernel and modules if no configuration file 14044603Sdcs \ was succesfully loaded! 14144603Sdcs any_conf_read? if 14244603Sdcs load_kernel 14344603Sdcs load_modules 14444603Sdcs then 14544603Sdcs; 14644603Sdcs 14747198Sdcs\ ***** initialize 14847198Sdcs\ 14947198Sdcs\ Overrides support.4th initialization word with one that does 15047198Sdcs\ everything start one does, short of loading the kernel and 15147198Sdcs\ modules. Returns a flag 15247198Sdcs 15347198Sdcs: initialize ( -- flag ) 15447198Sdcs s" /boot/defaults/loader.conf" initialize 15547198Sdcs include_conf_files 15697201Sgordon include_nextboot_file 15747198Sdcs any_conf_read? 15847198Sdcs; 15947198Sdcs 16044603Sdcs\ ***** read-conf 16144603Sdcs\ 16244603Sdcs\ Read a configuration file, whose name was specified on the command 16344603Sdcs\ line, if interpreted, or given on the stack, if compiled in. 16444603Sdcs 16544603Sdcs: (read-conf) ( addr len -- ) 166186789Sluigi conf_files string= 16744603Sdcs include_conf_files \ Will recurse on new loader_conf_files definitions 16844603Sdcs; 16944603Sdcs 17044603Sdcs: read-conf ( <filename> | addr len -- ) ( throws: abort & user-defined ) 17144603Sdcs state @ if 17244603Sdcs \ Compiling 17344603Sdcs postpone (read-conf) 17444603Sdcs else 17544603Sdcs \ Interpreting 17644603Sdcs bl parse (read-conf) 17744603Sdcs then 17844603Sdcs; immediate 17944603Sdcs 180186789Sluigi\ show, enable, disable, toggle module loading. They all take module from 181186789Sluigi\ the next word 18246005Sdcs 183186789Sluigi: set-module-flag ( module_addr val -- ) \ set and print flag 184186789Sluigi over module.flag ! 185186789Sluigi dup module.name strtype 186186789Sluigi module.flag @ if ." will be loaded" else ." will not be loaded" then cr 18746005Sdcs; 18846005Sdcs 189186789Sluigi: enable-module find-module ?dup if true set-module-flag then ; 19046005Sdcs 191186789Sluigi: disable-module find-module ?dup if false set-module-flag then ; 19246005Sdcs 193186789Sluigi: toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ; 19446005Sdcs 19544603Sdcs\ ***** show-module 19644603Sdcs\ 19744603Sdcs\ Show loading information about a module. 19844603Sdcs 199186789Sluigi: show-module ( <module> -- ) find-module ?dup if show-one-module then ; 20044603Sdcs 20144603Sdcs\ Words to be used inside configuration files 20244603Sdcs 20344603Sdcs: retry false ; \ For use in load error commands 20444603Sdcs: ignore true ; \ For use in load error commands 20544603Sdcs 20644603Sdcs\ Return to strict forth vocabulary 20744603Sdcs 20865949Sdcs: #type 20965949Sdcs over - >r 21065949Sdcs type 21165949Sdcs r> spaces 21265949Sdcs; 21365949Sdcs 21465949Sdcs: .? 2 spaces 2swap 15 #type 2 spaces type cr ; 21565949Sdcs 21665949Sdcs: ? 21765949Sdcs ['] ? execute 21865949Sdcs s" boot-conf" s" load kernel and modules, then autoboot" .? 21965949Sdcs s" read-conf" s" read a configuration file" .? 22065949Sdcs s" enable-module" s" enable loading of a module" .? 22165949Sdcs s" disable-module" s" disable loading of a module" .? 22265949Sdcs s" toggle-module" s" toggle loading of a module" .? 22365949Sdcs s" show-module" s" show module load data" .? 22465949Sdcs; 22565949Sdcs 22644603Sdcsonly forth also 22747198Sdcs 228