home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2005 November / PCWELT_11_2005.ISO / pcwsoft / cdrom-1.11.iso / boot / loader.4th < prev    next >
Encoding:
FORTH Source  |  2004-05-29  |  9.0 KB  |  371 lines
  1. \ Copyright (c) 1999 Daniel C. Sobral <dcs@freebsd.org>
  2. \ All rights reserved.
  3. \
  4. \ Redistribution and use in source and binary forms, with or without
  5. \ modification, are permitted provided that the following conditions
  6. \ are met:
  7. \ 1. Redistributions of source code must retain the above copyright
  8. \    notice, this list of conditions and the following disclaimer.
  9. \ 2. Redistributions in binary form must reproduce the above copyright
  10. \    notice, this list of conditions and the following disclaimer in the
  11. \    documentation and/or other materials provided with the distribution.
  12. \
  13. \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
  14. \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  15. \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  16. \ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
  17. \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  18. \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  19. \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  20. \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  21. \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  22. \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  23. \ SUCH DAMAGE.
  24. \
  25. \ $FreeBSD: src/sys/boot/forth/loader.4th,v 1.5.2.1 2000/07/07 00:14:34 obrien Exp $
  26.  
  27. s" arch-alpha" environment? [if] [if]
  28.     s" loader_version" environment?  [if]
  29.         3 < [if]
  30.             .( Loader version 0.3+ required) cr
  31.             abort
  32.         [then]
  33.     [else]
  34.         .( Could not get loader version!) cr
  35.         abort
  36.     [then]
  37. [then] [then]
  38.  
  39. s" arch-i386" environment? [if] [if]
  40.     s" loader_version" environment?  [if]
  41.         8 < [if]
  42.             .( Loader version 0.8+ required) cr
  43.             abort
  44.         [then]
  45.     [else]
  46.         .( Could not get loader version!) cr
  47.         abort
  48.     [then]
  49. [then] [then]
  50.  
  51. include /boot/support.4th
  52.  
  53. only forth definitions also support-functions
  54.  
  55. \ ***** boot-conf
  56. \
  57. \    Prepares to boot as specified by loaded configuration files.
  58.  
  59. also support-functions definitions
  60.  
  61. : bootpath s" /boot/" ;
  62. : modulepath s" module_path" ;
  63. : saveenv ( addr len | 0 -1 -- addr' len | 0 -1 )
  64.   dup -1 = if exit then
  65.   dup allocate abort" Out of memory"
  66.   swap 2dup 2>r
  67.   move
  68.   2r>
  69. ;
  70. : freeenv ( addr len | 0 -1 )
  71.   -1 = if drop else free abort" Freeing error" then
  72. ;
  73. : restoreenv  ( addr len | 0 -1 -- )
  74.   dup -1 = if ( it wasn't set )
  75.     2drop
  76.     modulepath unsetenv
  77.   else
  78.     over >r
  79.     modulepath setenv
  80.     r> free abort" Freeing error"
  81.   then
  82. ;
  83.  
  84. only forth also support-functions also builtins definitions
  85.  
  86. : boot-conf  ( args 1 | 0 "args" -- flag )
  87.   0 1 unload drop
  88.  
  89.   0= if ( interpreted )
  90.     \ Get next word on the command line
  91.     bl word count
  92.     ?dup 0= if ( there wasn't anything )
  93.       drop 0
  94.     else ( put in the number of strings )
  95.       1
  96.     then
  97.   then ( interpreted )
  98.  
  99.   if ( there are arguments )
  100.     \ Try to load the kernel
  101.     s" kernel_options" getenv dup -1 = if drop 2dup 1 else 2over 2 then
  102.  
  103.     1 load if ( load command failed )
  104.       \ Remove garbage from the stack
  105.  
  106.       \ Set the environment variable module_path, and try loading
  107.       \ the kernel again.
  108.  
  109.       \ First, save module_path value
  110.       modulepath getenv saveenv dup -1 = if 0 swap then 2>r
  111.  
  112.       \ Sets the new value
  113.       2dup modulepath setenv
  114.  
  115.       \ Try to load the kernel
  116.       s" load ${kernel} ${kernel_options}" ['] evaluate catch
  117.       if ( load failed yet again )
  118.     \ Remove garbage from the stack
  119.     2drop
  120.  
  121.     \ Try prepending /boot/
  122.     bootpath 2over nip over + allocate
  123.     if ( out of memory )
  124.       2drop 2drop
  125.       2r> restoreenv
  126.       100 exit
  127.     then
  128.  
  129.     0 2swap strcat 2swap strcat
  130.     2dup modulepath setenv
  131.  
  132.     drop free if ( freeing memory error )
  133.       2drop
  134.       2r> restoreenv
  135.       100 exit
  136.     then
  137.  
  138.     \ Now, once more, try to load the kernel
  139.     s" load ${kernel} ${kernel_options}" ['] evaluate catch
  140.     if ( failed once more )
  141.       2drop
  142.       2r> restoreenv
  143.       100 exit
  144.     then
  145.  
  146.       else ( we found the kernel on the path passed )
  147.  
  148.     2drop ( discard command line arguments )
  149.  
  150.       then ( could not load kernel from directory passed )
  151.  
  152.       \ Load the remaining modules, if the kernel was loaded at all
  153.       ['] load_modules catch if 2r> restoreenv 100 exit then
  154.  
  155.       \ Call autoboot to perform the booting
  156.       0 1 autoboot
  157.  
  158.       \ Keep new module_path
  159.       2r> freeenv
  160.  
  161.       exit
  162.     then ( could not load kernel with name passed )
  163.  
  164.     2drop ( discard command line arguments )
  165.  
  166.   else ( try just a straight-forward kernel load )
  167.     s" load ${kernel} ${kernel_options}" ['] evaluate catch
  168.     if ( kernel load failed ) 2drop 100 exit then
  169.  
  170.   then ( there are command line arguments )
  171.  
  172.   \ Load the remaining modules, if the kernel was loaded at all
  173.   ['] load_modules catch if 100 exit then
  174.  
  175.   \ Call autoboot to perform the booting
  176.   0 1 autoboot
  177. ;
  178.  
  179. also forth definitions
  180. builtin: boot-conf
  181. only forth definitions also support-functions
  182.  
  183. \ ***** check-password
  184. \
  185. \    If a password was defined, execute autoboot and ask for
  186. \    password if autoboot returns.
  187.  
  188. : check-password
  189.   password .addr @ if
  190.     0 autoboot
  191.     false >r
  192.     begin
  193.       bell emit bell emit
  194.       ." Password: "
  195.       password .len @ read-password
  196.       dup password .len @ = if
  197.         2dup password .addr @ password .len @
  198.         compare 0= if r> drop true >r then
  199.       then
  200.       drop free drop
  201.       r@
  202.     until
  203.     r> drop
  204.   then
  205. ;
  206.  
  207. \ ***** start
  208. \
  209. \       Initializes support.4th global variables, sets loader_conf_files,
  210. \       process conf files, and, if any one such file was succesfully
  211. \       read to the end, load kernel and modules.
  212.  
  213. : start  ( -- ) ( throws: abort & user-defined )
  214.   s" /boot/defaults/loader.conf" initialize
  215.   include_conf_files
  216.   \ Will *NOT* try to load kernel and modules if no configuration file
  217.   \ was succesfully loaded!
  218.   any_conf_read? if
  219.     load_kernel
  220.     load_modules
  221.   then
  222. ;
  223.  
  224. \ ***** initialize
  225. \
  226. \    Overrides support.4th initialization word with one that does
  227. \    everything start one does, short of loading the kernel and
  228. \    modules. Returns a flag
  229.  
  230. : initialize ( -- flag )
  231.   s" /boot/defaults/loader.conf" initialize
  232.   include_conf_files
  233.   any_conf_read?
  234. ;
  235.  
  236. \ ***** read-conf
  237. \
  238. \    Read a configuration file, whose name was specified on the command
  239. \    line, if interpreted, or given on the stack, if compiled in.
  240.  
  241. : (read-conf)  ( addr len -- )
  242.   conf_files .addr @ ?dup if free abort" Fatal error freeing memory" then
  243.   strdup conf_files .len ! conf_files .addr !
  244.   include_conf_files \ Will recurse on new loader_conf_files definitions
  245. ;
  246.  
  247. : read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
  248.   state @ if
  249.     \ Compiling
  250.     postpone (read-conf)
  251.   else
  252.     \ Interpreting
  253.     bl parse (read-conf)
  254.   then
  255. ; immediate
  256.  
  257. \ ***** enable-module
  258. \
  259. \       Turn a module loading on.
  260.  
  261. : enable-module ( <module> -- )
  262.   bl parse module_options @ >r
  263.   begin
  264.     r@
  265.   while
  266.     2dup
  267.     r@ module.name dup .addr @ swap .len @
  268.     compare 0= if
  269.       2drop
  270.       r@ module.name dup .addr @ swap .len @ type
  271.       true r> module.flag !
  272.       ."  will be loaded." cr
  273.       exit
  274.     then
  275.     r> module.next @ >r
  276.   repeat
  277.   r> drop
  278.   type ."  wasn't found." cr
  279. ;
  280.  
  281. \ ***** disable-module
  282. \
  283. \       Turn a module loading off.
  284.  
  285. : disable-module ( <module> -- )
  286.   bl parse module_options @ >r
  287.   begin
  288.     r@
  289.   while
  290.     2dup
  291.     r@ module.name dup .addr @ swap .len @
  292.     compare 0= if
  293.       2drop
  294.       r@ module.name dup .addr @ swap .len @ type
  295.       false r> module.flag !
  296.       ."  will not be loaded." cr
  297.       exit
  298.     then
  299.     r> module.next @ >r
  300.   repeat
  301.   r> drop
  302.   type ."  wasn't found." cr
  303. ;
  304.  
  305. \ ***** toggle-module
  306. \
  307. \       Turn a module loading on/off.
  308.  
  309. : toggle-module ( <module> -- )
  310.   bl parse module_options @ >r
  311.   begin
  312.     r@
  313.   while
  314.     2dup
  315.     r@ module.name dup .addr @ swap .len @
  316.     compare 0= if
  317.       2drop
  318.       r@ module.name dup .addr @ swap .len @ type
  319.       r@ module.flag @ 0= dup r> module.flag !
  320.       if
  321.         ."  will be loaded." cr
  322.       else
  323.         ."  will not be loaded." cr
  324.       then
  325.       exit
  326.     then
  327.     r> module.next @ >r
  328.   repeat
  329.   r> drop
  330.   type ."  wasn't found." cr
  331. ;
  332.  
  333. \ ***** show-module
  334. \
  335. \    Show loading information about a module.
  336.  
  337. : show-module ( <module> -- )
  338.   bl parse module_options @ >r
  339.   begin
  340.     r@
  341.   while
  342.     2dup
  343.     r@ module.name dup .addr @ swap .len @
  344.     compare 0= if
  345.       2drop
  346.       ." Name: " r@ module.name dup .addr @ swap .len @ type cr
  347.       ." Path: " r@ module.loadname dup .addr @ swap .len @ type cr
  348.       ." Type: " r@ module.type dup .addr @ swap .len @ type cr
  349.       ." Flags: " r@ module.args dup .addr @ swap .len @ type cr
  350.       ." Before load: " r@ module.beforeload dup .addr @ swap .len @ type cr
  351.       ." After load: " r@ module.afterload dup .addr @ swap .len @ type cr
  352.       ." Error: " r@ module.loaderror dup .addr @ swap .len @ type cr
  353.       ." Status: " r> module.flag @ if ." Load" else ." Don't load" then cr
  354.       exit
  355.     then
  356.     r> module.next @ >r
  357.   repeat
  358.   r> drop
  359.   type ."  wasn't found." cr
  360. ;
  361.  
  362. \ Words to be used inside configuration files
  363.  
  364. : retry false ;         \ For use in load error commands
  365. : ignore true ;         \ For use in load error commands
  366.  
  367. \ Return to strict forth vocabulary
  368.  
  369. only forth also
  370.  
  371.