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
27 \ Loader.rc support functions:
29 \ initialize ( addr len -- ) as above, plus load_conf_files
30 \ load_conf ( addr len -- ) load conf file given
31 \ include_conf_files ( -- ) load all conf files in load_conf_files
32 \ print_syntax_error ( -- ) print line and marker of where a syntax
34 \ print_line ( -- ) print last line processed
35 \ load_kernel ( -- ) load kernel
36 \ load_modules ( -- ) load modules flagged
38 \ Exported structures:
40 \ string counted string structure
41 \ cell .addr string address
42 \ cell .len string length
43 \ module module loading information structure
44 \ cell module.flag should we load it?
45 \ string module.name module's name
46 \ string module.loadname name to be used in loading the module
47 \ string module.type module's type
48 \ string module.args flags to be passed during load
49 \ string module.beforeload command to be executed before load
50 \ string module.afterload command to be executed after load
51 \ string module.loaderror command to be executed if load fails
52 \ cell module.next list chain
54 \ Exported global variables;
56 \ string conf_files configuration files to be loaded
57 \ cell modules_options pointer to first module information
58 \ value verbose? indicates if user wants a verbose loading
59 \ value any_conf_read? indicates if a conf file was succesfully read
61 \ Other exported words:
62 \ note, strlen is internal
63 \ strdup ( addr len -- addr' len) similar to strdup(3)
64 \ strcat ( addr len addr' len' -- addr len+len' ) similar to strcat(3)
65 \ s' ( | string' -- addr len | ) similar to s"
66 \ rudimentary structure support
73 4 constant ESETERROR \ error setting environment variable
74 5 constant EREAD \ error reading
76 7 constant EEXEC \ XXX never catched
77 8 constant EBEFORELOAD
90 \ Crude structure support
93 create here 0 , ['] drop , 0
94 does> create here swap dup @ allot cell+ @ execute
96 : member: create dup , over , + does> cell+ @ + ;
98 : constructor! >body cell+ ! ;
99 : constructor: over :noname ;
100 : ;constructor postpone ; swap cell+ ! ; immediate
101 : sizeof ' >body @ state @ if postpone literal then ; immediate
102 : offsetof ' >body cell+ @ state @ if postpone literal then ; immediate
103 : ptr 1 cells member: ;
104 : int 1 cells member: ;
118 \ Module options linked list
122 sizeof string member: module.name
123 sizeof string member: module.loadname
124 sizeof string member: module.type
125 sizeof string member: module.args
126 sizeof string member: module.beforeload
127 sizeof string member: module.afterload
128 sizeof string member: module.loaderror
132 \ Internal loader structures (preloaded_file, kernel_module, file_metadata)
133 \ must be in sync with the C struct in sys/boot/common/bootstrap.h
134 structure: preloaded_file
138 ptr pf.metadata \ file_metadata
142 ptr pf.modules \ kernel_module
143 ptr pf.next \ preloaded_file
146 structure: kernel_module
149 ptr km.fp \ preloaded_file
150 ptr km.next \ kernel_module
153 structure: file_metadata
155 2 member: md.type \ this is not ANS Forth compatible (XXX)
156 ptr md.next \ file_metadata
157 0 member: md.data \ variable size
165 string nextboot_conf_file
166 create module_options sizeof module.next allot 0 module_options !
167 create last_module_option sizeof module.next allot 0 last_module_option !
171 \ Support string functions
172 : strdup { addr len -- addr' len' }
173 len allocate if ENOMEM throw then
174 addr over len move len
177 : strcat { addr len addr' len' -- addr len+len' }
178 addr' addr len + len' move
182 : strchr { addr len c -- addr' len' }
186 addr c@ c = if addr len exit then
193 : s' \ same as s", allows " in the string
195 state @ if postpone sliteral then
198 : 2>r postpone >r postpone >r ; immediate
199 : 2r> postpone r> postpone r> ; immediate
200 : 2r@ postpone 2r> postpone 2dup postpone 2>r ; immediate
202 : getenv? getenv -1 = if false else drop true then ;
204 \ Private definitions
206 vocabulary support-functions
207 only forth also support-functions definitions
209 \ Some control characters constants
219 80 constant read_buffer_size
223 : load_module_suffix s" _load" ;
224 : module_loadname_suffix s" _name" ;
225 : module_type_suffix s" _type" ;
226 : module_args_suffix s" _flags" ;
227 : module_beforeload_suffix s" _before" ;
228 : module_afterload_suffix s" _after" ;
229 : module_loaderror_suffix s" _error" ;
236 \ Assorted support functions
238 : free-memory free if EFREE throw then ;
240 : strget { var -- addr len } var .addr @ var .len @ ;
242 \ assign addr len to variable.
243 : strset { addr len var -- } addr var .addr ! len var .len ! ;
245 \ free memory and reset fields
246 : strfree { var -- } var .addr @ ?dup if free-memory 0 0 var strset then ;
248 \ free old content, make a copy of the string and assign to variable
249 : string= { addr len var -- } var strfree addr len strdup var strset ;
251 : strtype ( str -- ) strget type ;
253 \ assign a reference to what is on the stack
254 : strref { addr len var -- addr len }
255 addr var .addr ! len var .len ! addr len
259 : unquote ( addr len -- addr len )
260 over c@ [char] " = if 2 chars - swap char+ swap then
263 \ Assignment data temporary storage
268 \ Line by line file reading functions
277 vocabulary line-reading
278 also line-reading definitions also
280 \ File data temporary storage
283 0 value read_buffer_ptr
285 \ File's line reading function
287 support-functions definitions
293 line-reading definitions
297 read_buffer .len @ read_buffer_ptr >
299 read_buffer .addr @ read_buffer_ptr + c@ lf = if
300 read_buffer_ptr char+ to read_buffer_ptr
307 : scan_buffer ( -- addr len )
310 read_buffer .len @ r@ >
312 read_buffer .addr @ r@ + c@ lf = if
313 read_buffer .addr @ read_buffer_ptr + ( -- addr )
314 r@ read_buffer_ptr - ( -- len )
315 r> to read_buffer_ptr
320 read_buffer .addr @ read_buffer_ptr + ( -- addr )
321 r@ read_buffer_ptr - ( -- len )
322 r> to read_buffer_ptr
325 : line_buffer_resize ( len -- len )
327 line_buffer .len @ if
329 line_buffer .len @ r@ +
330 resize if ENOMEM throw then
332 r@ allocate if ENOMEM throw then
338 : append_to_line_buffer ( addr len -- )
346 scan_buffer ( -- addr len )
347 line_buffer_resize ( len -- len )
348 append_to_line_buffer ( addr len -- )
352 read_buffer .len @ read_buffer_ptr =
358 read_buffer .addr @ 0= if
359 read_buffer_size allocate if ENOMEM throw then
362 fd @ read_buffer .addr @ read_buffer_size fread
363 dup -1 = if EREAD throw then
364 dup 0= if true to end_of_file? then
368 support-functions definitions
385 only forth also support-functions definitions
387 \ Conf file line parser:
388 \ <line> ::= <spaces><name><spaces>'='<spaces><value><spaces>[<comment>] |
389 \ <spaces>[<comment>]
390 \ <name> ::= <letter>{<letter>|<digit>|'_'}
391 \ <value> ::= '"'{<character_set>|'\'<anything>}'"' | <name>
392 \ <character_set> ::= ASCII 32 to 126, except '\' and '"'
393 \ <comment> ::= '#'{<anything>}
401 vocabulary file-processing
402 also file-processing definitions
410 also parser definitions also
412 0 value parsing_function
415 : end_of_line? line_pointer end_of_line = ;
417 \ classifiers for various character classes in the input line
436 : quote? line_pointer c@ [char] " = ;
438 : assignment_sign? line_pointer c@ [char] = = ;
440 : comment? line_pointer c@ [char] # = ;
442 : space? line_pointer c@ bl = line_pointer c@ tab = or ;
444 : backslash? line_pointer c@ [char] \ = ;
446 : underscore? line_pointer c@ [char] _ = ;
448 : dot? line_pointer c@ [char] . = ;
450 \ manipulation of input line
451 : skip_character line_pointer char+ to line_pointer ;
453 : skip_to_end_of_line end_of_line to line_pointer ;
457 end_of_line? if 0 else space? then
463 : parse_name ( -- addr len )
466 end_of_line? if 0 else letter? digit? underscore? dot? or or or then
474 : remove_backslashes { addr len | addr' len' -- addr' len' }
475 len allocate if ENOMEM throw then
479 addr c@ [char] \ <> if
480 addr c@ addr' len' + c!
490 : parse_quote ( -- addr len )
493 end_of_line? if ESYNTAX throw then
499 end_of_line? if ESYNTAX throw then
502 end_of_line? if ESYNTAX throw then
510 parse_name ( -- addr len )
516 parse_quote ( -- addr len )
518 parse_name ( -- addr len )
529 comment? if ['] comment to parsing_function exit then
530 end_of_line? 0= if ESYNTAX throw then
535 ['] white_space_4 to parsing_function
540 letter? digit? quote? or or if
541 ['] variable_value to parsing_function exit
548 ['] white_space_3 to parsing_function
553 assignment_sign? if ['] assignment_sign to parsing_function exit then
559 ['] white_space_2 to parsing_function
564 letter? if ['] variable_name to parsing_function exit then
565 comment? if ['] comment to parsing_function exit then
566 end_of_line? 0= if ESYNTAX throw then
569 file-processing definitions
572 line_buffer strget + to end_of_line
573 line_buffer .addr @ to line_pointer
574 ['] white_space_1 to parsing_function
578 parsing_function execute
580 parsing_function ['] comment =
581 parsing_function ['] white_space_1 =
582 parsing_function ['] white_space_4 =
583 or or 0= if ESYNTAX throw then
586 only forth also support-functions also file-processing definitions also
590 : assignment_type? ( addr len -- flag )
595 : suffix_type? ( addr len -- flag )
596 name_buffer .len @ over <= if 2drop false exit then
597 name_buffer .len @ over - name_buffer .addr @ +
601 : loader_conf_files? s" loader_conf_files" assignment_type? ;
603 : nextboot_flag? s" nextboot_enable" assignment_type? ;
605 : nextboot_conf? s" nextboot_conf" assignment_type? ;
607 : verbose_flag? s" verbose_loading" assignment_type? ;
609 : execute? s" exec" assignment_type? ;
611 : module_load? load_module_suffix suffix_type? ;
613 : module_loadname? module_loadname_suffix suffix_type? ;
615 : module_type? module_type_suffix suffix_type? ;
617 : module_args? module_args_suffix suffix_type? ;
619 : module_beforeload? module_beforeload_suffix suffix_type? ;
621 : module_afterload? module_afterload_suffix suffix_type? ;
623 : module_loaderror? module_loaderror_suffix suffix_type? ;
625 \ build a 'set' statement and execute it
626 : set_environment_variable
627 name_buffer .len @ value_buffer .len @ + 5 chars + \ size of result string
628 allocate if ENOMEM throw then
629 dup 0 \ start with an empty string and append the pieces
631 name_buffer strget strcat
633 value_buffer strget strcat
634 ['] evaluate catch if
643 set_environment_variable
644 s" loader_conf_files" getenv conf_files string=
647 : set_nextboot_conf \ XXX maybe do as set_conf_files ?
648 value_buffer strget unquote nextboot_conf_file string=
651 : append_to_module_options_list ( addr -- )
652 module_options @ 0= if
656 dup last_module_option @ module.next !
661 : set_module_name { addr -- } \ check leaks
662 name_buffer strget addr module.name string=
666 value_buffer strget \ XXX could use unquote
667 2dup s' "YES"' compare >r
668 2dup s' "yes"' compare >r
669 2dup s" YES" compare >r
670 s" yes" compare r> r> r> and and and 0=
673 : find_module_option ( -- addr | 0 ) \ return ptr to entry matching name_buffer
678 dup module.name strget
680 compare 0= if exit then
685 : new_module_option ( -- addr )
686 sizeof module allocate if ENOMEM throw then
687 dup sizeof module erase
688 dup append_to_module_options_list
692 : get_module_option ( -- addr )
694 ?dup 0= if new_module_option then
698 name_buffer .len @ load_module_suffix nip - name_buffer .len !
699 yes_value? get_module_option module.flag !
703 name_buffer .len @ module_args_suffix nip - name_buffer .len !
704 value_buffer strget unquote
705 get_module_option module.args string=
708 : set_module_loadname
709 name_buffer .len @ module_loadname_suffix nip - name_buffer .len !
710 value_buffer strget unquote
711 get_module_option module.loadname string=
715 name_buffer .len @ module_type_suffix nip - name_buffer .len !
716 value_buffer strget unquote
717 get_module_option module.type string=
720 : set_module_beforeload
721 name_buffer .len @ module_beforeload_suffix nip - name_buffer .len !
722 value_buffer strget unquote
723 get_module_option module.beforeload string=
726 : set_module_afterload
727 name_buffer .len @ module_afterload_suffix nip - name_buffer .len !
728 value_buffer strget unquote
729 get_module_option module.afterload string=
732 : set_module_loaderror
733 name_buffer .len @ module_loaderror_suffix nip - name_buffer .len !
734 value_buffer strget unquote
735 get_module_option module.loaderror string=
739 yes_value? to nextboot?
743 yes_value? to verbose?
747 value_buffer strget unquote
748 ['] evaluate catch if EEXEC throw then
752 name_buffer .len @ 0= if exit then
753 loader_conf_files? if set_conf_files exit then
754 nextboot_flag? if set_nextboot_flag exit then
755 nextboot_conf? if set_nextboot_conf exit then
756 verbose_flag? if set_verbose exit then
757 execute? if execute_command exit then
758 module_load? if set_module_flag exit then
759 module_loadname? if set_module_loadname exit then
760 module_type? if set_module_type exit then
761 module_args? if set_module_args exit then
762 module_beforeload? if set_module_beforeload exit then
763 module_afterload? if set_module_afterload exit then
764 module_loaderror? if set_module_loaderror exit then
765 set_environment_variable
770 \ Free some pointers if needed. The code then tests for errors
771 \ in freeing, and throws an exception if needed. If a pointer is
772 \ not allocated, it's value (0) is used as flag.
779 \ Higher level file processing
781 support-functions definitions
790 ['] process_assignment catch
791 ['] free_buffers catch
800 fd @ -1 = if EOPEN throw then
804 ['] process_assignment catch
805 ['] free_buffers catch
809 only forth also support-functions definitions
811 \ Interface to loading conf files
813 : load_conf ( addr len -- )
814 \ ." ----- Trying conf " 2dup type cr \ debugging
818 fd @ -1 = if EOPEN throw then
819 ['] process_conf catch
824 : print_line line_buffer strtype cr ;
827 line_buffer strtype cr
839 \ Debugging support functions
841 only forth definitions also support-functions
844 ['] load_conf catch dup .
845 ESYNTAX = if cr print_syntax_error then
848 \ find a module name, leave addr on the stack (0 if not found)
849 : find-module ( <module> -- ptr | 0 )
850 bl parse ( addr len )
851 module_options @ >r ( store current pointer )
855 2dup ( addr len addr len )
856 r@ module.name strget
857 compare 0= if drop drop r> exit then ( found it )
860 type ." was not found" cr r>
863 : show-nonempty ( addr len mod -- )
864 strget dup verbose? or if
870 : show-one-module { addr -- addr }
871 ." Name: " addr module.name strtype cr
872 s" Path: " addr module.loadname show-nonempty
873 s" Type: " addr module.type show-nonempty
874 s" Flags: " addr module.args show-nonempty
875 s" Before load: " addr module.beforeload show-nonempty
876 s" After load: " addr module.afterload show-nonempty
877 s" Error: " addr module.loaderror show-nonempty
878 ." Status: " addr module.flag @ if ." Load" else ." Don't load" then cr
883 : show-module-options
893 only forth also support-functions definitions
895 \ Variables used for processing multiple conf files
897 string current_file_name_ref \ used to print the file name
899 \ Indicates if any conf file was succesfully read
901 0 value any_conf_read?
903 \ loader_conf_files processing support functions
905 : get_conf_files ( -- addr len ) \ put addr/len on stack, reset var
906 \ ." -- starting on <" conf_files strtype ." >" cr \ debugging
907 conf_files strget 0 0 conf_files strset
910 : skip_leading_spaces { addr len pos -- addr len pos' }
912 pos len = if 0 else addr pos + c@ bl = then
919 \ return the file name at pos, or free the string if nothing left
920 : get_file_name { addr len pos -- addr len pos' addr' len' || 0 }
922 addr free abort" Fatal error freeing memory"
927 \ stay in the loop until have chars and they are not blank
928 pos len = if 0 else addr pos + c@ bl <> then
932 addr len pos addr r@ + pos r> -
933 \ 2dup ." get_file_name has " type cr \ debugging
936 : get_next_file ( addr len ptr -- addr len ptr' addr' len' | 0 )
942 current_file_name_ref strtype
945 : process_conf_errors
946 dup 0= if true to any_conf_read? drop exit then
949 ." Warning: syntax error on file " print_current_file cr
950 print_syntax_error drop exit
953 ." Warning: bad definition on file " print_current_file cr
957 ." Warning: error reading file " print_current_file cr drop exit
960 verbose? if ." Warning: unable to open file " print_current_file cr then
963 dup EFREE = abort" Fatal error freeing memory"
964 dup ENOMEM = abort" Out of memory"
965 throw \ Unknown error -- pass ahead
968 \ Process loader_conf_files recursively
969 \ Interface to loader_conf_files processing
972 get_conf_files 0 ( addr len offset )
974 get_next_file ?dup ( addr len 1 | 0 )
976 current_file_name_ref strref
979 conf_files .addr @ if recurse then
983 : get_nextboot_conf_file ( -- addr len )
984 nextboot_conf_file strget strdup \ XXX is the strdup a leak ?
987 : rewrite_nextboot_file ( -- )
988 get_nextboot_conf_file
990 fd @ -1 = if EOPEN throw then
991 fd @ s' nextboot_enable="NO" ' fwrite
995 : include_nextboot_file
996 get_nextboot_conf_file
999 get_nextboot_conf_file
1002 ['] rewrite_nextboot_file catch
1006 \ Module loading functions
1008 : load_parameters { addr -- addr addrN lenN ... addr1 len1 N }
1010 addr module.args strget
1011 addr module.loadname .len @ if
1012 addr module.loadname strget
1014 addr module.name strget
1016 addr module.type .len @ if
1017 addr module.type strget
1019 4 ( -t type name flags )
1025 : before_load ( addr -- addr )
1026 dup module.beforeload .len @ if
1027 dup module.beforeload strget
1028 ['] evaluate catch if EBEFORELOAD throw then
1032 : after_load ( addr -- addr )
1033 dup module.afterload .len @ if
1034 dup module.afterload strget
1035 ['] evaluate catch if EAFTERLOAD throw then
1039 : load_error ( addr -- addr )
1040 dup module.loaderror .len @ if
1041 dup module.loaderror strget
1042 evaluate \ This we do not intercept so it can throw errors
1046 : pre_load_message ( addr -- addr )
1048 dup module.name strtype
1053 : load_error_message verbose? if ." failed!" cr then ;
1055 : load_succesful_message verbose? if ." ok" cr then ;
1058 load_parameters load
1061 : process_module ( addr -- addr )
1065 ['] load_module catch if
1066 dup module.loaderror .len @ if
1067 load_error \ Command should return a flag!
1069 load_error_message true \ Do not retry
1073 load_succesful_message true \ Succesful, do not retry
1078 : process_module_errors ( addr ior -- )
1079 dup EBEFORELOAD = if
1082 dup module.name strtype
1083 dup module.loadname .len @ if
1084 ." (" dup module.loadname strtype ." )"
1087 ." Error executing "
1088 dup module.beforeload strtype cr \ XXX there was a typo here
1095 dup module.name .addr @ over module.name .len @ type
1096 dup module.loadname .len @ if
1097 ." (" dup module.loadname strtype ." )"
1100 ." Error executing "
1101 dup module.afterload strtype cr
1105 throw \ Don't know what it is all about -- pass ahead
1108 \ Module loading interface
1110 \ scan the list of modules, load enabled ones.
1111 : load_modules ( -- ) ( throws: abort & user-defined )
1112 module_options @ ( list_head )
1116 dup module.flag @ if
1117 ['] process_module catch
1118 process_module_errors
1124 \ h00h00 magic used to try loading either a kernel with a given name,
1125 \ or a kernel with the default name in a directory of a given name
1128 : bootpath s" /boot/" ;
1129 : modulepath s" module_path" ;
1131 \ Functions used to save and restore module_path's value.
1132 : saveenv ( addr len | -1 -- addr' len | 0 -1 )
1133 dup -1 = if 0 swap exit then
1136 : freeenv ( addr len | 0 -1 )
1137 -1 = if drop else free abort" Freeing error" then
1139 : restoreenv ( addr len | 0 -1 -- )
1140 dup -1 = if ( it wasn't set )
1146 r> free abort" Freeing error"
1150 : clip_args \ Drop second string if only one argument is passed
1161 \ Parse filename from a semicolon-separated list
1163 \ replacement, not working yet
1164 : newparse-; { addr len | a1 -- a' len-x addr x }
1165 addr len [char] ; strchr dup if ( a1 len1 )
1166 swap to a1 ( store address )
1167 1 - a1 @ 1 + swap ( remove match )
1174 : parse-; ( addr len -- addr' len-x addr x )
1175 over 0 2swap ( addr 0 addr len )
1177 dup 0 <> ( addr 0 addr len )
1179 over c@ [char] ; <> ( addr 0 addr len flag )
1190 \ Try loading one of multiple kernels specified
1192 : try_multiple_kernels ( addr len addr' len' args -- flag )
1198 s" DEBUG" getenv? if
1199 s" echo Module_path: ${module_path}" evaluate
1200 ." Kernel : " >r 2dup type r> cr
1201 dup 2 = if ." Flags : " >r 2over type r> cr then
1216 \ Try to load a kernel; the kernel name is taken from one of
1217 \ the following lists, as ordered:
1219 \ 1. The "bootfile" environment variable
1220 \ 2. The "kernel" environment variable
1222 \ Flags are passed, if available. If not, dummy values must be given.
1224 \ The kernel gets loaded from the current module_path.
1226 : load_a_kernel ( flags len 1 | x x 0 -- flag )
1232 \ Check if a default kernel name exists at all, exits if not
1233 s" bootfile" getenv dup -1 <> if
1235 flags kernel args 1+ try_multiple_kernels
1240 s" kernel" getenv dup -1 <> if
1247 \ Try all default kernel names
1248 flags kernel args 1+ try_multiple_kernels
1251 \ Try to load a kernel; the kernel name is taken from one of
1252 \ the following lists, as ordered:
1254 \ 1. The "bootfile" environment variable
1255 \ 2. The "kernel" environment variable
1257 \ Flags are passed, if provided.
1259 \ The kernel will be loaded from a directory computed from the
1260 \ path given. Two directories will be tried in the following order:
1265 \ The module_path variable is overridden if load is succesful, by
1266 \ prepending the successful path.
1268 : load_from_directory ( path len 1 | flags len' path len 2 -- flag )
1271 args 1 = if 0 0 then
1273 0 0 2local oldmodulepath \ like a string
1274 0 0 2local newmodulepath \ like a string
1277 \ Set the environment variable module_path, and try loading
1279 modulepath getenv saveenv to oldmodulepath
1281 \ Try prepending /boot/ first
1282 bootpath nip path nip + \ total length
1283 oldmodulepath nip dup -1 = if
1286 1+ + \ add oldpath -- XXX why the 1+ ?
1288 allocate if ( out of memory ) 1 exit then \ XXX throw ?
1293 2dup to newmodulepath
1296 \ Try all default kernel names
1297 flags args 1- load_a_kernel
1299 oldmodulepath nip -1 <> if
1300 newmodulepath s" ;" strcat
1301 oldmodulepath strcat
1303 newmodulepath drop free-memory
1304 oldmodulepath drop free-memory
1309 \ Well, try without the prepended /boot/
1310 path newmodulepath drop swap move
1311 newmodulepath drop path nip
1312 2dup to newmodulepath
1315 \ Try all default kernel names
1316 flags args 1- load_a_kernel
1317 if ( failed once more )
1318 oldmodulepath restoreenv
1319 newmodulepath drop free-memory
1322 oldmodulepath nip -1 <> if
1323 newmodulepath s" ;" strcat
1324 oldmodulepath strcat
1326 newmodulepath drop free-memory
1327 oldmodulepath drop free-memory
1333 \ Try to load a kernel; the kernel name is taken from one of
1334 \ the following lists, as ordered:
1336 \ 1. The "bootfile" environment variable
1337 \ 2. The "kernel" environment variable
1338 \ 3. The "path" argument
1340 \ Flags are passed, if provided.
1342 \ The kernel will be loaded from a directory computed from the
1343 \ path given. Two directories will be tried in the following order:
1348 \ Unless "path" is meant to be kernel name itself. In that case, it
1349 \ will first be tried as a full path, and, next, search on the
1350 \ directories pointed by module_path.
1352 \ The module_path variable is overridden if load is succesful, by
1353 \ prepending the successful path.
1355 : load_directory_or_file ( path len 1 | flags len' path len 2 -- flag )
1358 args 1 = if 0 0 then
1362 \ First, assume path is an absolute path to a directory
1363 flags path args clip_args load_from_directory
1364 dup 0= if exit else drop then
1366 \ Next, assume path points to the kernel
1367 flags path args try_multiple_kernels
1370 : initialize ( addr len -- )
1371 strdup conf_files strset
1374 : kernel_options ( -- addr len 1 | 0 )
1375 s" kernel_options" getenv
1376 dup -1 = if drop 0 else 1 then
1379 : standard_kernel_search ( flags 1 | 0 -- flag )
1384 dup -1 = if 0 swap then
1388 path nip -1 = if ( there isn't a "kernel" environment variable )
1389 flags args load_a_kernel
1391 flags path args 1+ clip_args load_directory_or_file
1395 : load_kernel ( -- ) ( throws: abort )
1396 kernel_options standard_kernel_search
1397 abort" Unable to load a kernel!"
1400 : set_defaultoptions ( -- )
1401 s" kernel_options" getenv dup -1 = if
1404 s" temp_options" setenv
1408 \ pick the i-th argument, i starts at 0
1409 : argv[] ( aN uN ... a1 u1 N i -- aN uN ... a1 u1 N ai+1 ui+1 )
1410 2dup = if 0 0 exit then \ out of range
1412 1+ 2* ( skip N and ui )
1415 1+ 2* ( skip N and ai )
1419 : drop_args ( aN uN ... a1 u1 N -- )
1427 : queue_argv ( aN uN ... a1 u1 N a u -- a u aN uN ... a1 u1 N+1 )
1435 : unqueue_argv ( aN uN ... a1 u1 N -- aN uN ... a2 u2 N-1 a1 u1 )
1439 \ compute the length of the buffer including the spaces between words
1440 : strlen(argv) ( aN uN .. a1 u1 N -- aN uN .. a1 u1 N len )
1441 dup 0= if 0 exit then
1456 : concat_argv ( aN uN ... a1 u1 N -- a u )
1457 strlen(argv) allocate if ENOMEM throw then
1458 0 2>r ( save addr 0 on return stack )
1463 unqueue_argv ( ... N a1 u1 )
1464 2r> 2swap ( old a1 u1 )
1466 s" " strcat ( append one space ) \ XXX this gives a trailing space
1467 2>r ( store string on the result stack )
1473 : set_tempoptions ( addrN lenN ... addr1 len1 N -- addr len 1 | 0 )
1474 \ Save the first argument, if it exists and is not a flag
1476 0 argv[] drop c@ [char] - <> if
1477 unqueue_argv 2>r \ Filename
1478 1 >r \ Filename present
1480 0 >r \ Filename not present
1483 0 >r \ Filename not present
1486 \ If there are other arguments, assume they are flags
1489 2dup s" temp_options" setenv
1490 drop free if EFREE throw then
1495 \ Bring back the filename, if one was provided
1496 r> if 2r> 1 else 0 then
1499 : get_arguments ( -- addrN lenN ... addr1 len1 N )
1502 \ Get next word on the command line
1507 drop ( empty string )
1510 : load_kernel_and_modules ( args -- flag )
1513 s" temp_options" getenv dup -1 <> if
1518 r> if ( a path was passed )
1519 load_directory_or_file
1521 standard_kernel_search
1523 ?dup 0= if ['] load_modules catch then
1526 \ Go back to straight forth vocabulary
1528 only forth also definitions