loader.4th revision 241361
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 241361 2012-10-08 23:02:35Z 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 63228985Spluknet; 64228985Spluknet 6565883Sdcs: boot 6665949Sdcs 0= if ( interpreted ) get_arguments then 6761376Sdcs 68241361Sdteske loader_color? if 69241361Sdteske ." [37;44mBooting...[0m" cr 70241361Sdteske else 71241361Sdteske ." Booting..." cr 72241361Sdteske then 73241361Sdteske 7465630Sdcs \ Unload only if a path was passed 7565883Sdcs dup if 7665883Sdcs >r over r> swap 7765630Sdcs c@ [char] - <> if 7865630Sdcs 0 1 unload drop 7965630Sdcs else 8066871Sdcs s" kernelname" getenv? if ( a kernel has been loaded ) 81228985Spluknet try-menu-unset 8266871Sdcs 1 boot exit 8365938Sdcs then 8466871Sdcs load_kernel_and_modules 8566871Sdcs ?dup if exit then 86228985Spluknet try-menu-unset 8766346Sdcs 0 1 boot exit 8865630Sdcs then 8965630Sdcs else 9066871Sdcs s" kernelname" getenv? if ( a kernel has been loaded ) 91228985Spluknet try-menu-unset 9266871Sdcs 1 boot exit 9365938Sdcs then 9466871Sdcs load_kernel_and_modules 9566871Sdcs ?dup if exit then 96228985Spluknet try-menu-unset 9766346Sdcs 0 1 boot exit 9865630Sdcs then 9965945Sdcs load_kernel_and_modules 10065621Sdcs ?dup 0= if 0 1 boot then 10165621Sdcs; 10265621Sdcs 103228985Spluknet\ ***** boot-conf 104228985Spluknet\ 105228985Spluknet\ Prepares to boot as specified by loaded configuration files. 106228985Spluknet 10765621Sdcs: boot-conf 10865949Sdcs 0= if ( interpreted ) get_arguments then 10965630Sdcs 0 1 unload drop 11065945Sdcs load_kernel_and_modules 11165621Sdcs ?dup 0= if 0 1 autoboot then 11265621Sdcs; 11365621Sdcs 11465621Sdcsalso forth definitions also builtins 11565883Sdcs 11665621Sdcsbuiltin: boot 11761376Sdcsbuiltin: boot-conf 11865883Sdcs 11961376Sdcsonly forth definitions also support-functions 12061376Sdcs 121222417Sjulianinclude /boot/check-password.4th 12253672Sdcs 12344603Sdcs\ ***** start 12444603Sdcs\ 12544603Sdcs\ Initializes support.4th global variables, sets loader_conf_files, 12644603Sdcs\ process conf files, and, if any one such file was succesfully 12744603Sdcs\ read to the end, load kernel and modules. 12844603Sdcs 12944603Sdcs: start ( -- ) ( throws: abort & user-defined ) 13044603Sdcs s" /boot/defaults/loader.conf" initialize 13144603Sdcs include_conf_files 13297201Sgordon include_nextboot_file 13344603Sdcs \ Will *NOT* try to load kernel and modules if no configuration file 13444603Sdcs \ was succesfully loaded! 13544603Sdcs any_conf_read? if 13644603Sdcs load_kernel 13744603Sdcs load_modules 13844603Sdcs then 13944603Sdcs; 14044603Sdcs 14147198Sdcs\ ***** initialize 14247198Sdcs\ 14347198Sdcs\ Overrides support.4th initialization word with one that does 14447198Sdcs\ everything start one does, short of loading the kernel and 14547198Sdcs\ modules. Returns a flag 14647198Sdcs 14747198Sdcs: initialize ( -- flag ) 14847198Sdcs s" /boot/defaults/loader.conf" initialize 14947198Sdcs include_conf_files 15097201Sgordon include_nextboot_file 15147198Sdcs any_conf_read? 15247198Sdcs; 15347198Sdcs 15444603Sdcs\ ***** read-conf 15544603Sdcs\ 15644603Sdcs\ Read a configuration file, whose name was specified on the command 15744603Sdcs\ line, if interpreted, or given on the stack, if compiled in. 15844603Sdcs 15944603Sdcs: (read-conf) ( addr len -- ) 160186789Sluigi conf_files string= 16144603Sdcs include_conf_files \ Will recurse on new loader_conf_files definitions 16244603Sdcs; 16344603Sdcs 16444603Sdcs: read-conf ( <filename> | addr len -- ) ( throws: abort & user-defined ) 16544603Sdcs state @ if 16644603Sdcs \ Compiling 16744603Sdcs postpone (read-conf) 16844603Sdcs else 16944603Sdcs \ Interpreting 17044603Sdcs bl parse (read-conf) 17144603Sdcs then 17244603Sdcs; immediate 17344603Sdcs 174186789Sluigi\ show, enable, disable, toggle module loading. They all take module from 175186789Sluigi\ the next word 17646005Sdcs 177186789Sluigi: set-module-flag ( module_addr val -- ) \ set and print flag 178186789Sluigi over module.flag ! 179186789Sluigi dup module.name strtype 180186789Sluigi module.flag @ if ." will be loaded" else ." will not be loaded" then cr 18146005Sdcs; 18246005Sdcs 183186789Sluigi: enable-module find-module ?dup if true set-module-flag then ; 18446005Sdcs 185186789Sluigi: disable-module find-module ?dup if false set-module-flag then ; 18646005Sdcs 187186789Sluigi: toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ; 18846005Sdcs 18944603Sdcs\ ***** show-module 19044603Sdcs\ 19144603Sdcs\ Show loading information about a module. 19244603Sdcs 193186789Sluigi: show-module ( <module> -- ) find-module ?dup if show-one-module then ; 19444603Sdcs 19544603Sdcs\ Words to be used inside configuration files 19644603Sdcs 19744603Sdcs: retry false ; \ For use in load error commands 19844603Sdcs: ignore true ; \ For use in load error commands 19944603Sdcs 20044603Sdcs\ Return to strict forth vocabulary 20144603Sdcs 20265949Sdcs: #type 20365949Sdcs over - >r 20465949Sdcs type 20565949Sdcs r> spaces 20665949Sdcs; 20765949Sdcs 20865949Sdcs: .? 2 spaces 2swap 15 #type 2 spaces type cr ; 20965949Sdcs 21065949Sdcs: ? 21165949Sdcs ['] ? execute 21265949Sdcs s" boot-conf" s" load kernel and modules, then autoboot" .? 21365949Sdcs s" read-conf" s" read a configuration file" .? 21465949Sdcs s" enable-module" s" enable loading of a module" .? 21565949Sdcs s" disable-module" s" disable loading of a module" .? 21665949Sdcs s" toggle-module" s" toggle loading of a module" .? 21765949Sdcs s" show-module" s" show module load data" .? 21865949Sdcs; 21965949Sdcs 22044603Sdcsonly forth also 22147198Sdcs 222