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 \ string password password
58 \ cell modules_options pointer to first module information
59 \ value verbose? indicates if user wants a verbose loading
60 \ value any_conf_read? indicates if a conf file was succesfully read
62 \ Other exported words:
63 \ note, strlen is internal
64 \ strdup ( addr len -- addr' len) similar to strdup(3)
65 \ strcat ( addr len addr' len' -- addr len+len' ) similar to strcat(3)
66 \ s' ( | string' -- addr len | ) similar to s"
67 \ rudimentary structure support
74 4 constant ESETERROR \ error setting environment variable
75 5 constant EREAD \ error reading
77 7 constant EEXEC \ XXX never catched
78 8 constant EBEFORELOAD
91 \ Crude structure support
94 create here 0 , ['] drop , 0
95 does> create here swap dup @ allot cell+ @ execute
97 : member: create dup , over , + does> cell+ @ + ;
99 : constructor! >body cell+ ! ;
100 : constructor: over :noname ;
101 : ;constructor postpone ; swap cell+ ! ; immediate
102 : sizeof ' >body @ state @ if postpone literal then ; immediate
103 : offsetof ' >body cell+ @ state @ if postpone literal then ; immediate
104 : ptr 1 cells member: ;
105 : int 1 cells member: ;
119 \ Module options linked list
123 sizeof string member: module.name
124 sizeof string member: module.loadname
125 sizeof string member: module.type
126 sizeof string member: module.args
127 sizeof string member: module.beforeload
128 sizeof string member: module.afterload
129 sizeof string member: module.loaderror
133 \ Internal loader structures (preloaded_file, kernel_module, file_metadata)
134 \ must be in sync with the C struct in sys/boot/common/bootstrap.h
135 structure: preloaded_file
139 ptr pf.metadata \ file_metadata
143 ptr pf.modules \ kernel_module
144 ptr pf.next \ preloaded_file
147 structure: kernel_module
150 ptr km.fp \ preloaded_file
151 ptr km.next \ kernel_module
154 structure: file_metadata
156 2 member: md.type \ this is not ANS Forth compatible (XXX)
157 ptr md.next \ file_metadata
158 0 member: md.data \ variable size
166 string nextboot_conf_file
168 create module_options sizeof module.next allot 0 module_options !
169 create last_module_option sizeof module.next allot 0 last_module_option !
173 \ Support string functions
174 : strdup { addr len -- addr' len' }
175 len allocate if ENOMEM throw then
176 addr over len move len
179 : strcat { addr len addr' len' -- addr len+len' }
180 addr' addr len + len' move
184 : strchr { addr len c -- addr' len' }
188 addr c@ c = if addr len exit then
195 : s' \ same as s", allows " in the string
197 state @ if postpone sliteral then
200 : 2>r postpone >r postpone >r ; immediate
201 : 2r> postpone r> postpone r> ; immediate
202 : 2r@ postpone 2r> postpone 2dup postpone 2>r ; immediate
204 : getenv? getenv -1 = if false else drop true then ;
206 \ Private definitions
208 vocabulary support-functions
209 only forth also support-functions definitions
211 \ Some control characters constants
221 80 constant read_buffer_size
225 : load_module_suffix s" _load" ;
226 : module_loadname_suffix s" _name" ;
227 : module_type_suffix s" _type" ;
228 : module_args_suffix s" _flags" ;
229 : module_beforeload_suffix s" _before" ;
230 : module_afterload_suffix s" _after" ;
231 : module_loaderror_suffix s" _error" ;
238 \ Assorted support functions
240 : free-memory free if EFREE throw then ;
242 : strget { var -- addr len } var .addr @ var .len @ ;
244 \ assign addr len to variable.
245 : strset { addr len var -- } addr var .addr ! len var .len ! ;
247 \ free memory and reset fields
248 : strfree { var -- } var .addr @ ?dup if free-memory 0 0 var strset then ;
250 \ free old content, make a copy of the string and assign to variable
251 : string= { addr len var -- } var strfree addr len strdup var strset ;
253 : strtype ( str -- ) strget type ;
255 \ assign a reference to what is on the stack
256 : strref { addr len var -- addr len }
257 addr var .addr ! len var .len ! addr len
261 : unquote ( addr len -- addr len )
262 over c@ [char] " = if 2 chars - swap char+ swap then
265 \ Assignment data temporary storage
270 \ Line by line file reading functions
279 vocabulary line-reading
280 also line-reading definitions also
282 \ File data temporary storage
285 0 value read_buffer_ptr
287 \ File's line reading function
289 support-functions definitions
295 line-reading definitions
299 read_buffer .len @ read_buffer_ptr >
301 read_buffer .addr @ read_buffer_ptr + c@ lf = if
302 read_buffer_ptr char+ to read_buffer_ptr
309 : scan_buffer ( -- addr len )
312 read_buffer .len @ r@ >
314 read_buffer .addr @ r@ + c@ lf = if
315 read_buffer .addr @ read_buffer_ptr + ( -- addr )
316 r@ read_buffer_ptr - ( -- len )
317 r> to read_buffer_ptr
322 read_buffer .addr @ read_buffer_ptr + ( -- addr )
323 r@ read_buffer_ptr - ( -- len )
324 r> to read_buffer_ptr
327 : line_buffer_resize ( len -- len )
329 line_buffer .len @ if
331 line_buffer .len @ r@ +
332 resize if ENOMEM throw then
334 r@ allocate if ENOMEM throw then
340 : append_to_line_buffer ( addr len -- )
348 scan_buffer ( -- addr len )
349 line_buffer_resize ( len -- len )
350 append_to_line_buffer ( addr len -- )
354 read_buffer .len @ read_buffer_ptr =
360 read_buffer .addr @ 0= if
361 read_buffer_size allocate if ENOMEM throw then
364 fd @ read_buffer .addr @ read_buffer_size fread
365 dup -1 = if EREAD throw then
366 dup 0= if true to end_of_file? then
370 support-functions definitions
387 only forth also support-functions definitions
389 \ Conf file line parser:
390 \ <line> ::= <spaces><name><spaces>'='<spaces><value><spaces>[<comment>] |
391 \ <spaces>[<comment>]
392 \ <name> ::= <letter>{<letter>|<digit>|'_'}
393 \ <value> ::= '"'{<character_set>|'\'<anything>}'"' | <name>
394 \ <character_set> ::= ASCII 32 to 126, except '\' and '"'
395 \ <comment> ::= '#'{<anything>}
403 vocabulary file-processing
404 also file-processing definitions
412 also parser definitions also
414 0 value parsing_function
417 : end_of_line? line_pointer end_of_line = ;
419 \ classifiers for various character classes in the input line
438 : quote? line_pointer c@ [char] " = ;
440 : assignment_sign? line_pointer c@ [char] = = ;
442 : comment? line_pointer c@ [char] # = ;
444 : space? line_pointer c@ bl = line_pointer c@ tab = or ;
446 : backslash? line_pointer c@ [char] \ = ;
448 : underscore? line_pointer c@ [char] _ = ;
450 : dot? line_pointer c@ [char] . = ;
452 \ manipulation of input line
453 : skip_character line_pointer char+ to line_pointer ;
455 : skip_to_end_of_line end_of_line to line_pointer ;
459 end_of_line? if 0 else space? then
465 : parse_name ( -- addr len )
468 end_of_line? if 0 else letter? digit? underscore? dot? or or or then
476 : remove_backslashes { addr len | addr' len' -- addr' len' }
477 len allocate if ENOMEM throw then
481 addr c@ [char] \ <> if
482 addr c@ addr' len' + c!
492 : parse_quote ( -- addr len )
495 end_of_line? if ESYNTAX throw then
501 end_of_line? if ESYNTAX throw then
504 end_of_line? if ESYNTAX throw then
512 parse_name ( -- addr len )
518 parse_quote ( -- addr len )
520 parse_name ( -- addr len )
531 comment? if ['] comment to parsing_function exit then
532 end_of_line? 0= if ESYNTAX throw then
537 ['] white_space_4 to parsing_function
542 letter? digit? quote? or or if
543 ['] variable_value to parsing_function exit
550 ['] white_space_3 to parsing_function
555 assignment_sign? if ['] assignment_sign to parsing_function exit then
561 ['] white_space_2 to parsing_function
566 letter? if ['] variable_name to parsing_function exit then
567 comment? if ['] comment to parsing_function exit then
568 end_of_line? 0= if ESYNTAX throw then
571 file-processing definitions
574 line_buffer strget + to end_of_line
575 line_buffer .addr @ to line_pointer
576 ['] white_space_1 to parsing_function
580 parsing_function execute
582 parsing_function ['] comment =
583 parsing_function ['] white_space_1 =
584 parsing_function ['] white_space_4 =
585 or or 0= if ESYNTAX throw then
588 only forth also support-functions also file-processing definitions also
592 : assignment_type? ( addr len -- flag )
597 : suffix_type? ( addr len -- flag )
598 name_buffer .len @ over <= if 2drop false exit then
599 name_buffer .len @ over - name_buffer .addr @ +
603 : loader_conf_files? s" loader_conf_files" assignment_type? ;
605 : nextboot_flag? s" nextboot_enable" assignment_type? ;
607 : nextboot_conf? s" nextboot_conf" assignment_type? ;
609 : verbose_flag? s" verbose_loading" assignment_type? ;
611 : execute? s" exec" assignment_type? ;
613 : password? s" password" assignment_type? ;
615 : module_load? load_module_suffix suffix_type? ;
617 : module_loadname? module_loadname_suffix suffix_type? ;
619 : module_type? module_type_suffix suffix_type? ;
621 : module_args? module_args_suffix suffix_type? ;
623 : module_beforeload? module_beforeload_suffix suffix_type? ;
625 : module_afterload? module_afterload_suffix suffix_type? ;
627 : module_loaderror? module_loaderror_suffix suffix_type? ;
629 \ build a 'set' statement and execute it
630 : set_environment_variable
631 name_buffer .len @ value_buffer .len @ + 5 chars + \ size of result string
632 allocate if ENOMEM throw then
633 dup 0 \ start with an empty string and append the pieces
635 name_buffer strget strcat
637 value_buffer strget strcat
638 ['] evaluate catch if
647 set_environment_variable
648 s" loader_conf_files" getenv conf_files string=
651 : set_nextboot_conf \ XXX maybe do as set_conf_files ?
652 value_buffer strget unquote nextboot_conf_file string=
655 : append_to_module_options_list ( addr -- )
656 module_options @ 0= if
660 dup last_module_option @ module.next !
665 : set_module_name { addr -- } \ check leaks
666 name_buffer strget addr module.name string=
670 value_buffer strget \ XXX could use unquote
671 2dup s' "YES"' compare >r
672 2dup s' "yes"' compare >r
673 2dup s" YES" compare >r
674 s" yes" compare r> r> r> and and and 0=
677 : find_module_option ( -- addr | 0 ) \ return ptr to entry matching name_buffer
682 dup module.name strget
684 compare 0= if exit then
689 : new_module_option ( -- addr )
690 sizeof module allocate if ENOMEM throw then
691 dup sizeof module erase
692 dup append_to_module_options_list
696 : get_module_option ( -- addr )
698 ?dup 0= if new_module_option then
702 name_buffer .len @ load_module_suffix nip - name_buffer .len !
703 yes_value? get_module_option module.flag !
707 name_buffer .len @ module_args_suffix nip - name_buffer .len !
708 value_buffer strget unquote
709 get_module_option module.args string=
712 : set_module_loadname
713 name_buffer .len @ module_loadname_suffix nip - name_buffer .len !
714 value_buffer strget unquote
715 get_module_option module.loadname string=
719 name_buffer .len @ module_type_suffix nip - name_buffer .len !
720 value_buffer strget unquote
721 get_module_option module.type string=
724 : set_module_beforeload
725 name_buffer .len @ module_beforeload_suffix nip - name_buffer .len !
726 value_buffer strget unquote
727 get_module_option module.beforeload string=
730 : set_module_afterload
731 name_buffer .len @ module_afterload_suffix nip - name_buffer .len !
732 value_buffer strget unquote
733 get_module_option module.afterload string=
736 : set_module_loaderror
737 name_buffer .len @ module_loaderror_suffix nip - name_buffer .len !
738 value_buffer strget unquote
739 get_module_option module.loaderror string=
743 yes_value? to nextboot?
747 yes_value? to verbose?
751 value_buffer strget unquote
752 ['] evaluate catch if EEXEC throw then
756 value_buffer strget unquote password string=
760 name_buffer .len @ 0= if exit then
761 loader_conf_files? if set_conf_files exit then
762 nextboot_flag? if set_nextboot_flag exit then
763 nextboot_conf? if set_nextboot_conf exit then
764 verbose_flag? if set_verbose exit then
765 execute? if execute_command exit then
766 password? if set_password exit then
767 module_load? if set_module_flag exit then
768 module_loadname? if set_module_loadname exit then
769 module_type? if set_module_type exit then
770 module_args? if set_module_args exit then
771 module_beforeload? if set_module_beforeload exit then
772 module_afterload? if set_module_afterload exit then
773 module_loaderror? if set_module_loaderror exit then
774 set_environment_variable
779 \ Free some pointers if needed. The code then tests for errors
780 \ in freeing, and throws an exception if needed. If a pointer is
781 \ not allocated, it's value (0) is used as flag.
788 \ Higher level file processing
790 support-functions definitions
799 ['] process_assignment catch
800 ['] free_buffers catch
809 fd @ -1 = if EOPEN throw then
813 ['] process_assignment catch
814 ['] free_buffers catch
818 only forth also support-functions definitions
820 \ Interface to loading conf files
822 : load_conf ( addr len -- )
823 \ ." ----- Trying conf " 2dup type cr \ debugging
827 fd @ -1 = if EOPEN throw then
828 ['] process_conf catch
833 : print_line line_buffer strtype cr ;
836 line_buffer strtype cr
848 \ Debugging support functions
850 only forth definitions also support-functions
853 ['] load_conf catch dup .
854 ESYNTAX = if cr print_syntax_error then
857 \ find a module name, leave addr on the stack (0 if not found)
858 : find-module ( <module> -- ptr | 0 )
859 bl parse ( addr len )
860 module_options @ >r ( store current pointer )
864 2dup ( addr len addr len )
865 r@ module.name strget
866 compare 0= if drop drop r> exit then ( found it )
869 type ." was not found" cr r>
872 : show-nonempty ( addr len mod -- )
873 strget dup verbose? or if
879 : show-one-module { addr -- addr }
880 ." Name: " addr module.name strtype cr
881 s" Path: " addr module.loadname show-nonempty
882 s" Type: " addr module.type show-nonempty
883 s" Flags: " addr module.args show-nonempty
884 s" Before load: " addr module.beforeload show-nonempty
885 s" After load: " addr module.afterload show-nonempty
886 s" Error: " addr module.loaderror show-nonempty
887 ." Status: " addr module.flag @ if ." Load" else ." Don't load" then cr
892 : show-module-options
902 only forth also support-functions definitions
904 \ Variables used for processing multiple conf files
906 string current_file_name_ref \ used to print the file name
908 \ Indicates if any conf file was succesfully read
910 0 value any_conf_read?
912 \ loader_conf_files processing support functions
914 : get_conf_files ( -- addr len ) \ put addr/len on stack, reset var
915 \ ." -- starting on <" conf_files strtype ." >" cr \ debugging
916 conf_files strget 0 0 conf_files strset
919 : skip_leading_spaces { addr len pos -- addr len pos' }
921 pos len = if 0 else addr pos + c@ bl = then
928 \ return the file name at pos, or free the string if nothing left
929 : get_file_name { addr len pos -- addr len pos' addr' len' || 0 }
931 addr free abort" Fatal error freeing memory"
936 \ stay in the loop until have chars and they are not blank
937 pos len = if 0 else addr pos + c@ bl <> then
941 addr len pos addr r@ + pos r> -
942 \ 2dup ." get_file_name has " type cr \ debugging
945 : get_next_file ( addr len ptr -- addr len ptr' addr' len' | 0 )
951 current_file_name_ref strtype
954 : process_conf_errors
955 dup 0= if true to any_conf_read? drop exit then
958 ." Warning: syntax error on file " print_current_file cr
959 print_syntax_error drop exit
962 ." Warning: bad definition on file " print_current_file cr
966 ." Warning: error reading file " print_current_file cr drop exit
969 verbose? if ." Warning: unable to open file " print_current_file cr then
972 dup EFREE = abort" Fatal error freeing memory"
973 dup ENOMEM = abort" Out of memory"
974 throw \ Unknown error -- pass ahead
977 \ Process loader_conf_files recursively
978 \ Interface to loader_conf_files processing
981 get_conf_files 0 ( addr len offset )
983 get_next_file ?dup ( addr len 1 | 0 )
985 current_file_name_ref strref
988 conf_files .addr @ if recurse then
992 : get_nextboot_conf_file ( -- addr len )
993 nextboot_conf_file strget strdup \ XXX is the strdup a leak ?
996 : rewrite_nextboot_file ( -- )
997 get_nextboot_conf_file
999 fd @ -1 = if EOPEN throw then
1000 fd @ s' nextboot_enable="NO" ' fwrite
1004 : include_nextboot_file
1005 get_nextboot_conf_file
1008 get_nextboot_conf_file
1011 ['] rewrite_nextboot_file catch
1015 \ Module loading functions
1017 : load_parameters { addr -- addr addrN lenN ... addr1 len1 N }
1019 addr module.args strget
1020 addr module.loadname .len @ if
1021 addr module.loadname strget
1023 addr module.name strget
1025 addr module.type .len @ if
1026 addr module.type strget
1028 4 ( -t type name flags )
1034 : before_load ( addr -- addr )
1035 dup module.beforeload .len @ if
1036 dup module.beforeload strget
1037 ['] evaluate catch if EBEFORELOAD throw then
1041 : after_load ( addr -- addr )
1042 dup module.afterload .len @ if
1043 dup module.afterload strget
1044 ['] evaluate catch if EAFTERLOAD throw then
1048 : load_error ( addr -- addr )
1049 dup module.loaderror .len @ if
1050 dup module.loaderror strget
1051 evaluate \ This we do not intercept so it can throw errors
1055 : pre_load_message ( addr -- addr )
1057 dup module.name strtype
1062 : load_error_message verbose? if ." failed!" cr then ;
1064 : load_succesful_message verbose? if ." ok" cr then ;
1067 load_parameters load
1070 : process_module ( addr -- addr )
1074 ['] load_module catch if
1075 dup module.loaderror .len @ if
1076 load_error \ Command should return a flag!
1078 load_error_message true \ Do not retry
1082 load_succesful_message true \ Succesful, do not retry
1087 : process_module_errors ( addr ior -- )
1088 dup EBEFORELOAD = if
1091 dup module.name strtype
1092 dup module.loadname .len @ if
1093 ." (" dup module.loadname strtype ." )"
1096 ." Error executing "
1097 dup module.beforeload strtype cr \ XXX there was a typo here
1104 dup module.name .addr @ over module.name .len @ type
1105 dup module.loadname .len @ if
1106 ." (" dup module.loadname strtype ." )"
1109 ." Error executing "
1110 dup module.afterload strtype cr
1114 throw \ Don't know what it is all about -- pass ahead
1117 \ Module loading interface
1119 \ scan the list of modules, load enabled ones.
1120 : load_modules ( -- ) ( throws: abort & user-defined )
1121 module_options @ ( list_head )
1125 dup module.flag @ if
1126 ['] process_module catch
1127 process_module_errors
1133 \ h00h00 magic used to try loading either a kernel with a given name,
1134 \ or a kernel with the default name in a directory of a given name
1137 : bootpath s" /boot/" ;
1138 : modulepath s" module_path" ;
1140 \ Functions used to save and restore module_path's value.
1141 : saveenv ( addr len | -1 -- addr' len | 0 -1 )
1142 dup -1 = if 0 swap exit then
1145 : freeenv ( addr len | 0 -1 )
1146 -1 = if drop else free abort" Freeing error" then
1148 : restoreenv ( addr len | 0 -1 -- )
1149 dup -1 = if ( it wasn't set )
1155 r> free abort" Freeing error"
1159 : clip_args \ Drop second string if only one argument is passed
1170 \ Parse filename from a semicolon-separated list
1172 \ replacement, not working yet
1173 : newparse-; { addr len | a1 -- a' len-x addr x }
1174 addr len [char] ; strchr dup if ( a1 len1 )
1175 swap to a1 ( store address )
1176 1 - a1 @ 1 + swap ( remove match )
1183 : parse-; ( addr len -- addr' len-x addr x )
1184 over 0 2swap ( addr 0 addr len )
1186 dup 0 <> ( addr 0 addr len )
1188 over c@ [char] ; <> ( addr 0 addr len flag )
1199 \ Try loading one of multiple kernels specified
1201 : try_multiple_kernels ( addr len addr' len' args -- flag )
1207 s" DEBUG" getenv? if
1208 s" echo Module_path: ${module_path}" evaluate
1209 ." Kernel : " >r 2dup type r> cr
1210 dup 2 = if ." Flags : " >r 2over type r> cr then
1225 \ Try to load a kernel; the kernel name is taken from one of
1226 \ the following lists, as ordered:
1228 \ 1. The "bootfile" environment variable
1229 \ 2. The "kernel" environment variable
1231 \ Flags are passed, if available. If not, dummy values must be given.
1233 \ The kernel gets loaded from the current module_path.
1235 : load_a_kernel ( flags len 1 | x x 0 -- flag )
1241 \ Check if a default kernel name exists at all, exits if not
1242 s" bootfile" getenv dup -1 <> if
1244 flags kernel args 1+ try_multiple_kernels
1249 s" kernel" getenv dup -1 <> if
1256 \ Try all default kernel names
1257 flags kernel args 1+ try_multiple_kernels
1260 \ Try to load a kernel; the kernel name is taken from one of
1261 \ the following lists, as ordered:
1263 \ 1. The "bootfile" environment variable
1264 \ 2. The "kernel" environment variable
1266 \ Flags are passed, if provided.
1268 \ The kernel will be loaded from a directory computed from the
1269 \ path given. Two directories will be tried in the following order:
1274 \ The module_path variable is overridden if load is succesful, by
1275 \ prepending the successful path.
1277 : load_from_directory ( path len 1 | flags len' path len 2 -- flag )
1280 args 1 = if 0 0 then
1282 0 0 2local oldmodulepath \ like a string
1283 0 0 2local newmodulepath \ like a string
1286 \ Set the environment variable module_path, and try loading
1288 modulepath getenv saveenv to oldmodulepath
1290 \ Try prepending /boot/ first
1291 bootpath nip path nip + \ total length
1292 oldmodulepath nip dup -1 = if
1295 1+ + \ add oldpath -- XXX why the 1+ ?
1297 allocate if ( out of memory ) 1 exit then \ XXX throw ?
1302 2dup to newmodulepath
1305 \ Try all default kernel names
1306 flags args 1- load_a_kernel
1308 oldmodulepath nip -1 <> if
1309 newmodulepath s" ;" strcat
1310 oldmodulepath strcat
1312 newmodulepath drop free-memory
1313 oldmodulepath drop free-memory
1318 \ Well, try without the prepended /boot/
1319 path newmodulepath drop swap move
1320 newmodulepath drop path nip
1321 2dup to newmodulepath
1324 \ Try all default kernel names
1325 flags args 1- load_a_kernel
1326 if ( failed once more )
1327 oldmodulepath restoreenv
1328 newmodulepath drop free-memory
1331 oldmodulepath nip -1 <> if
1332 newmodulepath s" ;" strcat
1333 oldmodulepath strcat
1335 newmodulepath drop free-memory
1336 oldmodulepath drop free-memory
1342 \ Try to load a kernel; the kernel name is taken from one of
1343 \ the following lists, as ordered:
1345 \ 1. The "bootfile" environment variable
1346 \ 2. The "kernel" environment variable
1347 \ 3. The "path" argument
1349 \ Flags are passed, if provided.
1351 \ The kernel will be loaded from a directory computed from the
1352 \ path given. Two directories will be tried in the following order:
1357 \ Unless "path" is meant to be kernel name itself. In that case, it
1358 \ will first be tried as a full path, and, next, search on the
1359 \ directories pointed by module_path.
1361 \ The module_path variable is overridden if load is succesful, by
1362 \ prepending the successful path.
1364 : load_directory_or_file ( path len 1 | flags len' path len 2 -- flag )
1367 args 1 = if 0 0 then
1371 \ First, assume path is an absolute path to a directory
1372 flags path args clip_args load_from_directory
1373 dup 0= if exit else drop then
1375 \ Next, assume path points to the kernel
1376 flags path args try_multiple_kernels
1379 : initialize ( addr len -- )
1380 strdup conf_files strset
1383 : kernel_options ( -- addr len 1 | 0 )
1384 s" kernel_options" getenv
1385 dup -1 = if drop 0 else 1 then
1388 : standard_kernel_search ( flags 1 | 0 -- flag )
1393 dup -1 = if 0 swap then
1397 path nip -1 = if ( there isn't a "kernel" environment variable )
1398 flags args load_a_kernel
1400 flags path args 1+ clip_args load_directory_or_file
1404 : load_kernel ( -- ) ( throws: abort )
1405 kernel_options standard_kernel_search
1406 abort" Unable to load a kernel!"
1409 : set_defaultoptions ( -- )
1410 s" kernel_options" getenv dup -1 = if
1413 s" temp_options" setenv
1417 \ pick the i-th argument, i starts at 0
1418 : argv[] ( aN uN ... a1 u1 N i -- aN uN ... a1 u1 N ai+1 ui+1 )
1419 2dup = if 0 0 exit then \ out of range
1421 1+ 2* ( skip N and ui )
1424 1+ 2* ( skip N and ai )
1428 : drop_args ( aN uN ... a1 u1 N -- )
1436 : queue_argv ( aN uN ... a1 u1 N a u -- a u aN uN ... a1 u1 N+1 )
1444 : unqueue_argv ( aN uN ... a1 u1 N -- aN uN ... a2 u2 N-1 a1 u1 )
1448 \ compute the length of the buffer including the spaces between words
1449 : strlen(argv) ( aN uN .. a1 u1 N -- aN uN .. a1 u1 N len )
1450 dup 0= if 0 exit then
1465 : concat_argv ( aN uN ... a1 u1 N -- a u )
1466 strlen(argv) allocate if ENOMEM throw then
1467 0 2>r ( save addr 0 on return stack )
1472 unqueue_argv ( ... N a1 u1 )
1473 2r> 2swap ( old a1 u1 )
1475 s" " strcat ( append one space ) \ XXX this gives a trailing space
1476 2>r ( store string on the result stack )
1482 : set_tempoptions ( addrN lenN ... addr1 len1 N -- addr len 1 | 0 )
1483 \ Save the first argument, if it exists and is not a flag
1485 0 argv[] drop c@ [char] - <> if
1486 unqueue_argv 2>r \ Filename
1487 1 >r \ Filename present
1489 0 >r \ Filename not present
1492 0 >r \ Filename not present
1495 \ If there are other arguments, assume they are flags
1498 2dup s" temp_options" setenv
1499 drop free if EFREE throw then
1504 \ Bring back the filename, if one was provided
1505 r> if 2r> 1 else 0 then
1508 : get_arguments ( -- addrN lenN ... addr1 len1 N )
1511 \ Get next word on the command line
1516 drop ( empty string )
1519 : load_kernel_and_modules ( args -- flag )
1522 s" temp_options" getenv dup -1 <> if
1527 r> if ( a path was passed )
1528 load_directory_or_file
1530 standard_kernel_search
1532 ?dup 0= if ['] load_modules catch then
1535 \ read and store only as many bytes as we need, drop the extra
1536 : read-password { size | buf len -- }
1537 size allocate if ENOMEM throw then
1545 backspace emit bl emit backspace emit
1551 dup <cr> = if cr drop buf len exit then
1553 len size < if buf len chars + c! else drop then
1559 \ Go back to straight forth vocabulary
1561 only forth also definitions