1 \ Copyright (c) 1999 Daniel C. Sobral <dcs@FreeBSD.org>
4 \ Redistribution and use in source and binary forms, with or without
5 \ modification, are permitted provided that the following conditions
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.
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
26 \ Loader.rc support functions:
28 \ initialize ( addr len -- ) as above, plus load_conf_files
29 \ load_conf ( addr len -- ) load conf file given
30 \ include_conf_files ( -- ) load all conf files in load_conf_files
31 \ print_syntax_error ( -- ) print line and marker of where a syntax
33 \ print_line ( -- ) print last line processed
34 \ load_kernel ( -- ) load kernel
35 \ load_modules ( -- ) load modules flagged
37 \ Exported structures:
39 \ string counted string structure
40 \ cell .addr string address
41 \ cell .len string length
42 \ module module loading information structure
43 \ cell module.flag should we load it?
44 \ string module.name module's name
45 \ string module.loadname name to be used in loading the module
46 \ string module.type module's type
47 \ string module.args flags to be passed during load
48 \ string module.beforeload command to be executed before load
49 \ string module.afterload command to be executed after load
50 \ string module.loaderror command to be executed if load fails
51 \ cell module.next list chain
53 \ Exported global variables;
55 \ string conf_files configuration files to be loaded
56 \ cell modules_options pointer to first module information
57 \ value verbose? indicates if user wants a verbose loading
58 \ value any_conf_read? indicates if a conf file was successfully read
60 \ Other exported words:
61 \ note, strlen is internal
62 \ strdup ( addr len -- addr' len) similar to strdup(3)
63 \ strcat ( addr len addr' len' -- addr len+len' ) similar to strcat(3)
64 \ s' ( | string' -- addr len | ) similar to s"
65 \ rudimentary structure support
72 4 constant ESETERROR \ error setting environment variable
73 5 constant EREAD \ error reading
75 7 constant EEXEC \ XXX never catched
76 8 constant EBEFORELOAD
89 \ Crude structure support
92 create here 0 , ['] drop , 0
93 does> create here swap dup @ allot cell+ @ execute
95 : member: create dup , over , + does> cell+ @ + ;
97 : constructor! >body cell+ ! ;
98 : constructor: over :noname ;
99 : ;constructor postpone ; swap cell+ ! ; immediate
100 : sizeof ' >body @ state @ if postpone literal then ; immediate
101 : offsetof ' >body cell+ @ state @ if postpone literal then ; immediate
102 : ptr 1 cells member: ;
103 : int 1 cells member: ;
117 \ Module options linked list
121 sizeof string member: module.name
122 sizeof string member: module.loadname
123 sizeof string member: module.type
124 sizeof string member: module.args
125 sizeof string member: module.beforeload
126 sizeof string member: module.afterload
127 sizeof string member: module.loaderror
131 \ Internal loader structures (preloaded_file, kernel_module, file_metadata)
132 \ must be in sync with the C struct in stand/common/bootstrap.h
133 structure: preloaded_file
137 ptr pf.metadata \ file_metadata
141 ptr pf.modules \ kernel_module
142 ptr pf.next \ preloaded_file
145 structure: kernel_module
148 ptr km.fp \ preloaded_file
149 ptr km.next \ kernel_module
152 structure: file_metadata
154 2 member: md.type \ this is not ANS Forth compatible (XXX)
155 ptr md.next \ file_metadata
156 0 member: md.data \ variable size
164 string nextboot_conf_file
165 create module_options sizeof module.next allot 0 module_options !
166 create last_module_option sizeof module.next allot 0 last_module_option !
170 \ Support string functions
171 : strdup { addr len -- addr' len' }
172 len allocate if ENOMEM throw then
173 addr over len move len
176 : strcat { addr len addr' len' -- addr len+len' }
177 addr' addr len + len' move
181 : strchr { addr len c -- addr' len' }
185 addr c@ c = if addr len exit then
192 : strspn { addr len addr1 len1 | paddr plen -- addr' len' }
201 addr c@ paddr c@ = if addr len exit then
211 : s' \ same as s", allows " in the string
213 state @ if postpone sliteral then
216 : 2>r postpone >r postpone >r ; immediate
217 : 2r> postpone r> postpone r> ; immediate
218 : 2r@ postpone 2r> postpone 2dup postpone 2>r ; immediate
220 : getenv? getenv -1 = if false else drop true then ;
222 \ execute xt for each device listed in console variable.
223 \ this allows us to have device specific output for logos, menu frames etc
224 : console-iterate { xt | caddr clen taddr tlen -- }
225 \ get current console and save it
227 ['] strdup catch if 2drop exit then
235 taddr tlen s" , " strspn
236 \ we need to handle 3 cases for addr len pairs on stack:
237 \ addr len are 0 0 - there was no comma nor space
238 \ addr len are x 0 - the first char is either comma or space
241 \ there was no comma nor space.
243 taddr tlen s" console" setenv
249 dup ( taddr' tlen' tlen' )
251 0= if \ sequence of comma and space?
254 taddr swap s" console" setenv
260 tlen 0> if \ step over separator
265 caddr clen s" console" setenv \ restore console setup
269 \ determine if a word appears in a string, case-insensitive
270 : contains? ( addr1 len1 addr2 len2 -- 0 | -1 )
271 2 pick 0= if 2drop 2drop true exit then
272 dup 0= if 2drop 2drop false exit then
275 swap dup c@ dup 32 = over 9 = or over 10 = or
276 over 13 = or over 44 = or swap drop
277 while 1+ swap 1- repeat
278 swap 2 pick 1- over <
280 2over 2over drop over compare-insensitive 0= if
281 2 pick over = if 2drop 2drop true exit then
282 2 pick tuck - -rot + swap over c@ dup 32 =
283 over 9 = or over 10 = or over 13 = or over 44 = or
284 swap drop if 2drop 2drop true exit then
286 swap dup c@ dup 32 = over 9 = or over 10 = or
287 over 13 = or over 44 = or swap drop
288 if false else true then 2 pick 0> and
289 while 1+ swap 1- repeat
295 : boot_serial? ( -- 0 | -1 )
296 s" console" getenv dup -1 <> if
297 s" comconsole" 2swap contains?
299 \ s" boot_serial" getenv dup -1 <> if
301 \ else drop false then
302 \ or \ console contains comconsole ( or ) boot_serial
303 \ s" boot_multicons" getenv dup -1 <> if
305 \ else drop false then
306 \ or \ previous boolean ( or ) boot_multicons
309 : framebuffer? ( -- t )
311 2dup s" efi" compare 0<> >r
312 s" vidconsole" compare 0<> r> and if
315 s" screen.depth" getenv?
318 \ Private definitions
320 vocabulary support-functions
321 only forth also support-functions definitions
323 \ Some control characters constants
333 80 constant read_buffer_size
337 : load_module_suffix s" _load" ;
338 : module_loadname_suffix s" _name" ;
339 : module_type_suffix s" _type" ;
340 : module_args_suffix s" _flags" ;
341 : module_beforeload_suffix s" _before" ;
342 : module_afterload_suffix s" _after" ;
343 : module_loaderror_suffix s" _error" ;
350 \ Assorted support functions
352 : free-memory free if EFREE throw then ;
354 : strget { var -- addr len } var .addr @ var .len @ ;
356 \ assign addr len to variable.
357 : strset { addr len var -- } addr var .addr ! len var .len ! ;
359 \ free memory and reset fields
360 : strfree { var -- } var .addr @ ?dup if free-memory 0 0 var strset then ;
362 \ free old content, make a copy of the string and assign to variable
363 : string= { addr len var -- } var strfree addr len strdup var strset ;
365 : strtype ( str -- ) strget type ;
367 \ assign a reference to what is on the stack
368 : strref { addr len var -- addr len }
369 addr var .addr ! len var .len ! addr len
373 : unquote ( addr len -- addr len )
374 over c@ [char] " = if 2 chars - swap char+ swap then
377 \ Assignment data temporary storage
382 \ Line by line file reading functions
391 vocabulary line-reading
392 also line-reading definitions
394 \ File data temporary storage
397 0 value read_buffer_ptr
399 \ File's line reading function
401 get-current ( -- wid ) previous definitions
407 >search ( wid -- ) definitions
411 read_buffer .len @ read_buffer_ptr >
413 read_buffer .addr @ read_buffer_ptr + c@ lf = if
414 read_buffer_ptr char+ to read_buffer_ptr
421 : scan_buffer ( -- addr len )
424 read_buffer .len @ r@ >
426 read_buffer .addr @ r@ + c@ lf = if
427 read_buffer .addr @ read_buffer_ptr + ( -- addr )
428 r@ read_buffer_ptr - ( -- len )
429 r> to read_buffer_ptr
434 read_buffer .addr @ read_buffer_ptr + ( -- addr )
435 r@ read_buffer_ptr - ( -- len )
436 r> to read_buffer_ptr
439 : line_buffer_resize ( len -- len )
442 line_buffer .len @ if
444 line_buffer .len @ r@ +
445 resize if ENOMEM throw then
447 r@ allocate if ENOMEM throw then
453 : append_to_line_buffer ( addr len -- )
454 dup 0= if 2drop exit then
462 scan_buffer ( -- addr len )
463 line_buffer_resize ( len -- len )
464 append_to_line_buffer ( addr len -- )
468 read_buffer .len @ read_buffer_ptr =
474 read_buffer .addr @ 0= if
475 read_buffer_size allocate if ENOMEM throw then
478 fd @ read_buffer .addr @ read_buffer_size fread
479 dup -1 = if EREAD throw then
480 dup 0= if true to end_of_file? then
484 get-current ( -- wid ) previous definitions >search ( wid -- )
502 only forth also support-functions definitions
504 \ Conf file line parser:
505 \ <line> ::= <spaces><name><spaces>'='<spaces><value><spaces>[<comment>] |
506 \ <spaces>[<comment>]
507 \ <name> ::= <letter>{<letter>|<digit>|'_'}
508 \ <value> ::= '"'{<character_set>|'\'<anything>}'"' | <name>
509 \ <character_set> ::= ASCII 32 to 126, except '\' and '"'
510 \ <comment> ::= '#'{<anything>}
518 vocabulary file-processing
519 also file-processing definitions
527 also parser definitions
529 0 value parsing_function
532 : end_of_line? line_pointer end_of_line = ;
534 \ classifiers for various character classes in the input line
553 : quote? line_pointer c@ [char] " = ;
555 : assignment_sign? line_pointer c@ [char] = = ;
557 : comment? line_pointer c@ [char] # = ;
559 : space? line_pointer c@ bl = line_pointer c@ tab = or ;
561 : backslash? line_pointer c@ [char] \ = ;
563 : underscore? line_pointer c@ [char] _ = ;
565 : dot? line_pointer c@ [char] . = ;
567 \ manipulation of input line
568 : skip_character line_pointer char+ to line_pointer ;
570 : skip_to_end_of_line end_of_line to line_pointer ;
574 end_of_line? if 0 else space? then
580 : parse_name ( -- addr len )
583 end_of_line? if 0 else letter? digit? underscore? dot? or or or then
591 : remove_backslashes { addr len | addr' len' -- addr' len' }
592 len allocate if ENOMEM throw then
596 addr c@ [char] \ <> if
597 addr c@ addr' len' + c!
607 : parse_quote ( -- addr len )
610 end_of_line? if ESYNTAX throw then
616 end_of_line? if ESYNTAX throw then
619 end_of_line? if ESYNTAX throw then
627 parse_name ( -- addr len )
633 parse_quote ( -- addr len )
635 parse_name ( -- addr len )
646 comment? if ['] comment to parsing_function exit then
647 end_of_line? 0= if ESYNTAX throw then
652 ['] white_space_4 to parsing_function
657 letter? digit? quote? or or if
658 ['] variable_value to parsing_function exit
665 ['] white_space_3 to parsing_function
670 assignment_sign? if ['] assignment_sign to parsing_function exit then
676 ['] white_space_2 to parsing_function
681 letter? if ['] variable_name to parsing_function exit then
682 comment? if ['] comment to parsing_function exit then
683 end_of_line? 0= if ESYNTAX throw then
686 get-current ( -- wid ) previous definitions >search ( wid -- )
689 line_buffer strget + to end_of_line
690 line_buffer .addr @ to line_pointer
691 ['] white_space_1 to parsing_function
695 parsing_function execute
697 parsing_function ['] comment =
698 parsing_function ['] white_space_1 =
699 parsing_function ['] white_space_4 =
700 or or 0= if ESYNTAX throw then
703 only forth also support-functions also file-processing definitions
707 : assignment_type? ( addr len -- flag )
712 : suffix_type? ( addr len -- flag )
713 name_buffer .len @ over <= if 2drop false exit then
714 name_buffer .len @ over - name_buffer .addr @ +
718 : loader_conf_files? s" loader_conf_files" assignment_type? ;
720 : nextboot_flag? s" nextboot_enable" assignment_type? ;
722 : nextboot_conf? s" nextboot_conf" assignment_type? ;
724 : verbose_flag? s" verbose_loading" assignment_type? ;
726 : execute? s" exec" assignment_type? ;
728 : module_load? load_module_suffix suffix_type? ;
730 : module_loadname? module_loadname_suffix suffix_type? ;
732 : module_type? module_type_suffix suffix_type? ;
734 : module_args? module_args_suffix suffix_type? ;
736 : module_beforeload? module_beforeload_suffix suffix_type? ;
738 : module_afterload? module_afterload_suffix suffix_type? ;
740 : module_loaderror? module_loaderror_suffix suffix_type? ;
742 \ build a 'set' statement and execute it
743 : set_environment_variable
744 name_buffer .len @ value_buffer .len @ + 5 chars + \ size of result string
745 allocate if ENOMEM throw then
746 dup 0 \ start with an empty string and append the pieces
748 name_buffer strget strcat
750 value_buffer strget strcat
751 ['] evaluate catch if
760 set_environment_variable
761 s" loader_conf_files" getenv conf_files string=
765 value_buffer strget unquote nextboot_conf_file string=
768 : append_to_module_options_list ( addr -- )
769 module_options @ 0= if
773 dup last_module_option @ module.next !
778 : set_module_name { addr -- } \ check leaks
779 name_buffer strget addr module.name string=
783 value_buffer strget \ XXX could use unquote
784 2dup s' "YES"' compare >r
785 2dup s' "yes"' compare >r
786 2dup s" YES" compare >r
787 s" yes" compare r> r> r> and and and 0=
790 : find_module_option ( -- addr | 0 ) \ return ptr to entry matching name_buffer
795 dup module.name strget
797 compare 0= if exit then
802 : new_module_option ( -- addr )
803 sizeof module allocate if ENOMEM throw then
804 dup sizeof module erase
805 dup append_to_module_options_list
809 : get_module_option ( -- addr )
811 ?dup 0= if new_module_option then
815 name_buffer .len @ load_module_suffix nip - name_buffer .len !
816 yes_value? get_module_option module.flag !
820 name_buffer .len @ module_args_suffix nip - name_buffer .len !
821 value_buffer strget unquote
822 get_module_option module.args string=
825 : set_module_loadname
826 name_buffer .len @ module_loadname_suffix nip - name_buffer .len !
827 value_buffer strget unquote
828 get_module_option module.loadname string=
832 name_buffer .len @ module_type_suffix nip - name_buffer .len !
833 value_buffer strget unquote
834 get_module_option module.type string=
837 : set_module_beforeload
838 name_buffer .len @ module_beforeload_suffix nip - name_buffer .len !
839 value_buffer strget unquote
840 get_module_option module.beforeload string=
843 : set_module_afterload
844 name_buffer .len @ module_afterload_suffix nip - name_buffer .len !
845 value_buffer strget unquote
846 get_module_option module.afterload string=
849 : set_module_loaderror
850 name_buffer .len @ module_loaderror_suffix nip - name_buffer .len !
851 value_buffer strget unquote
852 get_module_option module.loaderror string=
856 yes_value? to nextboot?
860 yes_value? to verbose?
864 value_buffer strget unquote
865 ['] evaluate catch if EEXEC throw then
869 name_buffer .len @ 0= if exit then
870 loader_conf_files? if set_conf_files exit then
871 nextboot_flag? if set_nextboot_flag exit then
872 nextboot_conf? if set_nextboot_conf exit then
873 verbose_flag? if set_verbose exit then
874 execute? if execute_command exit then
875 module_load? if set_module_flag exit then
876 module_loadname? if set_module_loadname exit then
877 module_type? if set_module_type exit then
878 module_args? if set_module_args exit then
879 module_beforeload? if set_module_beforeload exit then
880 module_afterload? if set_module_afterload exit then
881 module_loaderror? if set_module_loaderror exit then
882 set_environment_variable
887 \ Free some pointers if needed. The code then tests for errors
888 \ in freeing, and throws an exception if needed. If a pointer is
889 \ not allocated, it's value (0) is used as flag.
896 \ Higher level file processing
898 get-current ( -- wid ) previous definitions >search ( wid -- )
907 ['] process_assignment catch
908 ['] free_buffers catch
913 : peek_file ( addr len -- )
917 fd @ -1 = if EOPEN throw then
921 ['] process_assignment catch
922 ['] free_buffers catch
927 only forth also support-functions definitions
929 \ Interface to loading conf files
931 : load_conf ( addr len -- )
935 fd @ -1 = if EOPEN throw then
936 ['] process_conf catch
941 : print_line line_buffer strtype cr ;
944 line_buffer strtype cr
956 \ Debugging support functions
958 only forth definitions also support-functions
961 ['] load_conf catch dup .
962 ESYNTAX = if cr print_syntax_error then
965 \ find a module name, leave addr on the stack (0 if not found)
966 : find-module ( <module> -- ptr | 0 )
967 bl parse ( addr len )
968 module_options @ >r ( store current pointer )
972 2dup ( addr len addr len )
973 r@ module.name strget
974 compare 0= if drop drop r> exit then ( found it )
977 type ." was not found" cr r>
980 : show-nonempty ( addr len mod -- )
981 strget dup verbose? or if
987 : show-one-module { addr -- addr }
988 ." Name: " addr module.name strtype cr
989 s" Path: " addr module.loadname show-nonempty
990 s" Type: " addr module.type show-nonempty
991 s" Flags: " addr module.args show-nonempty
992 s" Before load: " addr module.beforeload show-nonempty
993 s" After load: " addr module.afterload show-nonempty
994 s" Error: " addr module.loaderror show-nonempty
995 ." Status: " addr module.flag @ if ." Load" else ." Don't load" then cr
1000 : show-module-options
1010 : free-one-module { addr -- addr }
1011 addr module.name strfree
1012 addr module.loadname strfree
1013 addr module.type strfree
1014 addr module.args strfree
1015 addr module.beforeload strfree
1016 addr module.afterload strfree
1017 addr module.loaderror strfree
1021 : free-module-options
1031 0 last_module_option !
1034 only forth also support-functions definitions
1036 \ Variables used for processing multiple conf files
1038 string current_file_name_ref \ used to print the file name
1040 \ Indicates if any conf file was successfully read
1042 0 value any_conf_read?
1044 \ loader_conf_files processing support functions
1046 : get_conf_files ( -- addr len ) \ put addr/len on stack, reset var
1047 conf_files strget 0 0 conf_files strset
1050 : skip_leading_spaces { addr len pos -- addr len pos' }
1052 pos len = if 0 else addr pos + c@ bl = then
1059 \ return the file name at pos, or free the string if nothing left
1060 : get_file_name { addr len pos -- addr len pos' addr' len' || 0 }
1062 addr free abort" Fatal error freeing memory"
1067 \ stay in the loop until have chars and they are not blank
1068 pos len = if 0 else addr pos + c@ bl <> then
1072 addr len pos addr r@ + pos r> -
1075 : get_next_file ( addr len ptr -- addr len ptr' addr' len' | 0 )
1080 : print_current_file
1081 current_file_name_ref strtype
1084 : process_conf_errors
1085 dup 0= if true to any_conf_read? drop exit then
1088 ." Warning: syntax error on file " print_current_file cr
1089 print_syntax_error drop exit
1092 ." Warning: bad definition on file " print_current_file cr
1093 print_line drop exit
1096 ." Warning: error reading file " print_current_file cr drop exit
1099 verbose? if ." Warning: unable to open file " print_current_file cr then
1102 dup EFREE = abort" Fatal error freeing memory"
1103 dup ENOMEM = abort" Out of memory"
1104 throw \ Unknown error -- pass ahead
1107 \ Process loader_conf_files recursively
1108 \ Interface to loader_conf_files processing
1110 : include_conf_files
1111 get_conf_files 0 ( addr len offset )
1113 get_next_file ?dup ( addr len 1 | 0 )
1115 current_file_name_ref strref
1118 conf_files .addr @ if recurse then
1122 : get_nextboot_conf_file ( -- addr len )
1123 nextboot_conf_file strget
1126 : rewrite_nextboot_file ( -- )
1127 get_nextboot_conf_file
1129 fd @ -1 = if EOPEN throw then
1130 fd @ s' nextboot_enable="NO" ' fwrite ( fd buf len -- nwritten ) drop
1134 : include_nextboot_file ( -- )
1135 s" nextboot_enable" getenv dup -1 <> if
1136 2dup s' "YES"' compare >r
1137 2dup s' "yes"' compare >r
1138 2dup s" YES" compare >r
1139 2dup s" yes" compare r> r> r> and and and 0= to nextboot?
1142 get_nextboot_conf_file
1143 ['] peek_file catch if 2drop then
1146 get_nextboot_conf_file
1147 current_file_name_ref strref
1150 ['] rewrite_nextboot_file catch if 2drop then
1152 s' "NO"' s" nextboot_enable" setenv
1155 \ Module loading functions
1157 : load_parameters { addr -- addr addrN lenN ... addr1 len1 N }
1159 addr module.args strget
1160 addr module.loadname .len @ if
1161 addr module.loadname strget
1163 addr module.name strget
1165 addr module.type .len @ if
1166 addr module.type strget
1168 4 ( -t type name flags )
1174 : before_load ( addr -- addr )
1175 dup module.beforeload .len @ if
1176 dup module.beforeload strget
1177 ['] evaluate catch if EBEFORELOAD throw then
1181 : after_load ( addr -- addr )
1182 dup module.afterload .len @ if
1183 dup module.afterload strget
1184 ['] evaluate catch if EAFTERLOAD throw then
1188 : load_error ( addr -- addr )
1189 dup module.loaderror .len @ if
1190 dup module.loaderror strget
1191 evaluate \ This we do not intercept so it can throw errors
1195 : pre_load_message ( addr -- addr )
1197 dup module.name strtype
1202 : load_error_message verbose? if ." failed!" cr then ;
1204 : load_successful_message verbose? if ." ok" cr then ;
1207 load_parameters load
1210 : process_module ( addr -- addr )
1214 ['] load_module catch if
1215 dup module.loaderror .len @ if
1216 load_error \ Command should return a flag!
1218 load_error_message true \ Do not retry
1222 load_successful_message true \ Successful, do not retry
1227 : process_module_errors ( addr ior -- )
1228 dup EBEFORELOAD = if
1231 dup module.name strtype
1232 dup module.loadname .len @ if
1233 ." (" dup module.loadname strtype ." )"
1236 ." Error executing "
1237 dup module.beforeload strtype cr \ XXX there was a typo here
1244 dup module.name .addr @ over module.name .len @ type
1245 dup module.loadname .len @ if
1246 ." (" dup module.loadname strtype ." )"
1249 ." Error executing "
1250 dup module.afterload strtype cr
1254 throw \ Don't know what it is all about -- pass ahead
1257 \ Module loading interface
1259 \ scan the list of modules, load enabled ones.
1260 : load_modules ( -- ) ( throws: abort & user-defined )
1261 module_options @ ( list_head )
1265 dup module.flag @ if
1266 ['] process_module catch
1267 process_module_errors
1273 \ h00h00 magic used to try loading either a kernel with a given name,
1274 \ or a kernel with the default name in a directory of a given name
1277 : bootpath s" /boot/" ;
1278 : modulepath s" module_path" ;
1280 \ Functions used to save and restore module_path's value.
1281 : saveenv ( addr len | -1 -- addr' len | 0 -1 )
1282 dup -1 = if 0 swap exit then
1285 : freeenv ( addr len | 0 -1 )
1286 -1 = if drop else free abort" Freeing error" then
1288 : restoreenv ( addr len | 0 -1 -- )
1289 dup -1 = if ( it wasn't set )
1295 r> free abort" Freeing error"
1299 : clip_args \ Drop second string if only one argument is passed
1310 \ Parse filename from a semicolon-separated list
1312 \ replacement, not working yet
1313 : newparse-; { addr len | a1 -- a' len-x addr x }
1314 addr len [char] ; strchr dup if ( a1 len1 )
1315 swap to a1 ( store address )
1316 1 - a1 @ 1 + swap ( remove match )
1323 : parse-; ( addr len -- addr' len-x addr x )
1324 over 0 2swap ( addr 0 addr len )
1326 dup 0 <> ( addr 0 addr len )
1328 over c@ [char] ; <> ( addr 0 addr len flag )
1339 \ Try loading one of multiple kernels specified
1341 : try_multiple_kernels ( addr len addr' len' args -- flag )
1347 s" DEBUG" getenv? if
1348 s" echo Module_path: ${module_path}" evaluate
1349 ." Kernel : " >r 2dup type r> cr
1350 dup 2 = if ." Flags : " >r 2over type r> cr then
1365 \ Try to load a kernel; the kernel name is taken from one of
1366 \ the following lists, as ordered:
1368 \ 1. The "bootfile" environment variable
1369 \ 2. The "kernel" environment variable
1371 \ Flags are passed, if available. If not, dummy values must be given.
1373 \ The kernel gets loaded from the current module_path.
1375 : load_a_kernel ( flags len 1 | x x 0 -- flag )
1381 \ Check if a default kernel name exists at all, exits if not
1382 s" bootfile" getenv dup -1 <> if
1384 flags kernel args 1+ try_multiple_kernels
1389 s" kernel" getenv dup -1 <> if
1396 \ Try all default kernel names
1397 flags kernel args 1+ try_multiple_kernels
1400 \ Try to load a kernel; the kernel name is taken from one of
1401 \ the following lists, as ordered:
1403 \ 1. The "bootfile" environment variable
1404 \ 2. The "kernel" environment variable
1406 \ Flags are passed, if provided.
1408 \ The kernel will be loaded from a directory computed from the
1409 \ path given. Two directories will be tried in the following order:
1414 \ The module_path variable is overridden if load is successful, by
1415 \ prepending the successful path.
1417 : load_from_directory ( path len 1 | flags len' path len 2 -- flag )
1420 args 1 = if 0 0 then
1422 0 0 2local oldmodulepath \ like a string
1423 0 0 2local newmodulepath \ like a string
1426 \ Set the environment variable module_path, and try loading
1428 modulepath getenv saveenv to oldmodulepath
1430 \ Try prepending /boot/ first
1431 bootpath nip path nip + \ total length
1432 oldmodulepath nip dup -1 = if
1435 1+ + \ add oldpath -- XXX why the 1+ ?
1437 allocate if ( out of memory ) 1 exit then \ XXX throw ?
1442 2dup to newmodulepath
1445 \ Try all default kernel names
1446 flags args 1- load_a_kernel
1448 oldmodulepath nip -1 <> if
1449 newmodulepath s" ;" strcat
1450 oldmodulepath strcat
1452 newmodulepath drop free-memory
1453 oldmodulepath drop free-memory
1458 \ Well, try without the prepended /boot/
1459 path newmodulepath drop swap move
1460 newmodulepath drop path nip
1461 2dup to newmodulepath
1464 \ Try all default kernel names
1465 flags args 1- load_a_kernel
1466 if ( failed once more )
1467 oldmodulepath restoreenv
1468 newmodulepath drop free-memory
1471 oldmodulepath nip -1 <> if
1472 newmodulepath s" ;" strcat
1473 oldmodulepath strcat
1475 newmodulepath drop free-memory
1476 oldmodulepath drop free-memory
1482 \ Try to load a kernel; the kernel name is taken from one of
1483 \ the following lists, as ordered:
1485 \ 1. The "bootfile" environment variable
1486 \ 2. The "kernel" environment variable
1487 \ 3. The "path" argument
1489 \ Flags are passed, if provided.
1491 \ The kernel will be loaded from a directory computed from the
1492 \ path given. Two directories will be tried in the following order:
1497 \ Unless "path" is meant to be kernel name itself. In that case, it
1498 \ will first be tried as a full path, and, next, search on the
1499 \ directories pointed by module_path.
1501 \ The module_path variable is overridden if load is successful, by
1502 \ prepending the successful path.
1504 : load_directory_or_file ( path len 1 | flags len' path len 2 -- flag )
1507 args 1 = if 0 0 then
1511 \ First, assume path is an absolute path to a directory
1512 flags path args clip_args load_from_directory
1513 dup 0= if exit else drop then
1515 \ Next, assume path points to the kernel
1516 flags path args try_multiple_kernels
1519 : initialize ( addr len -- )
1520 strdup conf_files strset
1523 : kernel_options ( -- addr len 1 | 0 )
1524 s" kernel_options" getenv
1525 dup -1 = if drop 0 else 1 then
1528 : standard_kernel_search ( flags 1 | 0 -- flag )
1533 dup -1 = if 0 swap then
1537 path nip -1 = if ( there isn't a "kernel" environment variable )
1538 flags args load_a_kernel
1540 flags path args 1+ clip_args load_directory_or_file
1544 : load_kernel ( -- ) ( throws: abort )
1545 kernel_options standard_kernel_search
1546 abort" Unable to load a kernel!"
1549 : load_xen ( -- flag )
1550 s" xen_kernel" getenv dup -1 <> if
1551 1 1 load ( c-addr/u flag N -- flag )
1558 : load_xen_throw ( -- ) ( throws: abort )
1560 abort" Unable to load Xen!"
1563 : set_defaultoptions ( -- )
1564 s" kernel_options" getenv dup -1 = if
1567 s" temp_options" setenv
1571 \ pick the i-th argument, i starts at 0
1572 : argv[] ( aN uN ... a1 u1 N i -- aN uN ... a1 u1 N ai+1 ui+1 )
1573 2dup = if 0 0 exit then \ out of range
1575 1+ 2* ( skip N and ui )
1578 1+ 2* ( skip N and ai )
1582 : drop_args ( aN uN ... a1 u1 N -- )
1590 : queue_argv ( aN uN ... a1 u1 N a u -- a u aN uN ... a1 u1 N+1 )
1598 : unqueue_argv ( aN uN ... a1 u1 N -- aN uN ... a2 u2 N-1 a1 u1 )
1602 \ compute the length of the buffer including the spaces between words
1603 : strlen(argv) ( aN uN .. a1 u1 N -- aN uN .. a1 u1 N len )
1604 dup 0= if 0 exit then
1619 : concat_argv ( aN uN ... a1 u1 N -- a u )
1620 strlen(argv) allocate if ENOMEM throw then
1621 0 2>r ( save addr 0 on return stack )
1626 unqueue_argv ( ... N a1 u1 )
1627 2r> 2swap ( old a1 u1 )
1629 s" " strcat ( append one space ) \ XXX this gives a trailing space
1630 2>r ( store string on the result stack )
1636 : set_tempoptions ( addrN lenN ... addr1 len1 N -- addr len 1 | 0 )
1637 \ Save the first argument, if it exists and is not a flag
1639 0 argv[] drop c@ [char] - <> if
1640 unqueue_argv 2>r \ Filename
1641 1 >r \ Filename present
1643 0 >r \ Filename not present
1646 0 >r \ Filename not present
1649 \ If there are other arguments, assume they are flags
1652 2dup s" temp_options" setenv
1653 drop free if EFREE throw then
1658 \ Bring back the filename, if one was provided
1659 r> if 2r> 1 else 0 then
1662 : get_arguments ( -- addrN lenN ... addr1 len1 N )
1665 \ Get next word on the command line
1670 drop ( empty string )
1673 : load_kernel_and_modules ( args -- flag )
1676 s" temp_options" getenv dup -1 <> if
1682 ?dup 0= if ( success )
1683 r> if ( a path was passed )
1684 load_directory_or_file
1686 standard_kernel_search
1688 ?dup 0= if ['] load_modules catch then
1692 only forth definitions